aboutsummaryrefslogtreecommitdiff
path: root/source/test2.lux
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--source/test2.lux480
1 files changed, 7 insertions, 473 deletions
diff --git a/source/test2.lux b/source/test2.lux
index d036bbde4..c72602edb 100644
--- a/source/test2.lux
+++ b/source/test2.lux
@@ -1,379 +1,4 @@
-## (use "./another" as another)
-
-(jvm/definterface Function
- (: apply (-> [java.lang.Object] java.lang.Object)))
-
-(jvm/defclass Tuple0 java.lang.Object
- [])
-(jvm/defclass Tuple1 java.lang.Object
- [[java.lang.Object _1]])
-(jvm/defclass Tuple2 java.lang.Object
- [[java.lang.Object _1] [java.lang.Object _2]])
-(jvm/defclass Tuple3 java.lang.Object
- [[java.lang.Object _1] [java.lang.Object _2]
- [java.lang.Object _3]])
-(jvm/defclass Tuple4 java.lang.Object
- [[java.lang.Object _1] [java.lang.Object _2]
- [java.lang.Object _3] [java.lang.Object _4]])
-(jvm/defclass Tuple5 java.lang.Object
- [[java.lang.Object _1] [java.lang.Object _2]
- [java.lang.Object _3] [java.lang.Object _4]
- [java.lang.Object _5]])
-(jvm/defclass Tuple6 java.lang.Object
- [[java.lang.Object _1] [java.lang.Object _2]
- [java.lang.Object _3] [java.lang.Object _4]
- [java.lang.Object _5] [java.lang.Object _6]])
-(jvm/defclass Tuple7 java.lang.Object
- [[java.lang.Object _1] [java.lang.Object _2]
- [java.lang.Object _3] [java.lang.Object _4]
- [java.lang.Object _5] [java.lang.Object _6]
- [java.lang.Object _7]])
-(jvm/defclass Tuple8 java.lang.Object
- [[java.lang.Object _1] [java.lang.Object _2]
- [java.lang.Object _3] [java.lang.Object _4]
- [java.lang.Object _5] [java.lang.Object _6]
- [java.lang.Object _7] [java.lang.Object _8]])
-
-(jvm/defclass Variant java.lang.Object
- [[java.lang.String tag]])
-(jvm/defclass Variant0 test2.Variant
- [])
-(jvm/defclass Variant1 test2.Variant
- [[java.lang.Object _1]])
-(jvm/defclass Variant2 test2.Variant
- [[java.lang.Object _1] [java.lang.Object _2]])
-(jvm/defclass Variant3 test2.Variant
- [[java.lang.Object _1] [java.lang.Object _2]
- [java.lang.Object _3]])
-(jvm/defclass Variant4 test2.Variant
- [[java.lang.Object _1] [java.lang.Object _2]
- [java.lang.Object _3] [java.lang.Object _4]])
-(jvm/defclass Variant5 test2.Variant
- [[java.lang.Object _1] [java.lang.Object _2]
- [java.lang.Object _3] [java.lang.Object _4]
- [java.lang.Object _5]])
-(jvm/defclass Variant6 test2.Variant
- [[java.lang.Object _1] [java.lang.Object _2]
- [java.lang.Object _3] [java.lang.Object _4]
- [java.lang.Object _5] [java.lang.Object _6]])
-(jvm/defclass Variant7 test2.Variant
- [[java.lang.Object _1] [java.lang.Object _2]
- [java.lang.Object _3] [java.lang.Object _4]
- [java.lang.Object _5] [java.lang.Object _6]
- [java.lang.Object _7]])
-(jvm/defclass Variant8 test2.Variant
- [[java.lang.Object _1] [java.lang.Object _2]
- [java.lang.Object _3] [java.lang.Object _4]
- [java.lang.Object _5] [java.lang.Object _6]
- [java.lang.Object _7] [java.lang.Object _8]])
-
-(def (print x)
- (jvm/invokevirtual java.io.PrintStream "print" [Object]
- (jvm/getstatic System out) [x]))
-
-(def (println x)
- (jvm/invokevirtual java.io.PrintStream "println" [Object]
- (jvm/getstatic System out) [x]))
-
-(defmacro (list xs)
- (case xs
- #Nil
- (#Tag "Nil")
-
- (#Cons x xs*)
- (#Form (#Cons (#Tag "Cons") (#Cons x (#Cons (list xs*) #Nil))))))
-
-(def (++ xs ys)
- (case xs
- #Nil
- ys
-
- (#Cons x xs*)
- (#Cons x (++ xs* ys))))
-
-(def (map f xs)
- (case xs
- #Nil
- #Nil
-
- (#Cons x xs*)
- (#Cons (f x) (map f xs*))))
-
-(def (untemplate-list untemplate tokens)
- (case tokens
- #Nil
- (#Tag "Nil")
-
- (#Cons token tokens')
- (#Form (list (#Tag "Cons") (untemplate token) (untemplate-list untemplate tokens')))))
-
-(def (untemplate token)
- (case token
- (#Bool elem)
- (#Form (list (#Tag "Bool") (#Bool elem)))
-
- (#Int elem)
- (#Form (list (#Tag "Int") (#Int elem)))
-
- (#Real elem)
- (#Form (list (#Tag "Real") (#Real elem)))
-
- (#Char elem)
- (#Form (list (#Tag "Char") (#Char elem)))
-
- (#Text elem)
- (#Form (list (#Tag "Text") (#Text elem)))
-
- (#Tag elem)
- (#Form (list (#Tag "Tag") (#Text elem)))
-
- (#Ident elem)
- (#Form (list (#Tag "Ident") (#Text elem)))
-
- (#Form (#Cons (#Ident "~") (#Cons unquoted #Nil)))
- unquoted
-
- (#Tuple elems)
- (#Form (list (#Tag "Tuple") (untemplate-list untemplate elems)))
-
- (#Form elems)
- (#Form (list (#Tag "Form") (untemplate-list untemplate elems)))
- ))
-
-(defmacro (' form)
- (case form
- (#Cons token #Nil)
- (untemplate token)))
-
-## Utils
-(def (fail* message)
- (#Failure message))
-
-(def (return* state value)
- (#Ok [state value]))
-
-(def (fail message)
- (lambda [state]
- (#Failure message)))
-
-(def (return value)
- (lambda [state]
- (#Ok [state value])))
-
-(def (bind m-value step)
- (lambda [state]
- (let inputs (m-value state)
- (case inputs
- (#Ok [?state ?datum])
- (step ?datum ?state)
-
- _
- inputs))))
-
-(def (+ x y)
- (jvm/i+ x y))
-
-(def inc (+ 1))
-
-(def (id x)
- x)
-
-(def (fold f init values)
- (case values
- #Nil
- init
- (#Cons x xs)
- (fold f (f init x) xs)))
-
-(def length (fold (lambda [l x] (inc l)) 0))
-
-(def (rem dividend divisor)
- (jvm/irem dividend divisor))
-
-(def (= x y)
- (jvm/invokevirtual Object "equals" [Object]
- x [y]))
-
-(def (as-pairs list)
- (case list
- (#Cons x (#Cons y list*))
- (#Cons [x y] (as-pairs list*))
-
- _
- #Nil))
-
-## Ideally, this is what I want...
-## (exec [yolo lol
-## #let [foo (bar 1 2 3)]]
-## (meme yolo foo))
-
-(defmacro (exec tokens)
- (case tokens
- (#Cons (#Tuple steps) (#Cons return #Nil))
- (if (= 0 (rem (length steps) 2))
- (fold (lambda [inner pair]
- (case pair
- [label computation]
- (' (bind (~ computation)
- (lambda [(~ label)] (~ inner))))))
- return
- (as-pairs steps))
- (#Text "Oh no!"))))
-
-(def (try-m monad)
- (lambda [state]
- (case (monad state)
- (#Ok [?state ?datum])
- (return* ?state (#Just ?datum))
-
- (#Failure _)
- (return* state #Nothing))))
-
-(def (repeat-m monad)
- (lambda [state]
- (case (monad state)
- (#Ok [?state ?head])
- (case ((repeat-m monad) ?state)
- (#Ok [?state* ?tail])
- (return* ?state* (#Cons ?head ?tail)))
-
- (#Failure ?message)
- (return* state #Nil))))
-
-(def (try-all-m monads)
- (lambda [state]
- (case monads
- #Nil
- (fail* "No alternative worked!")
- (#Cons monad monads')
- (let output (monad state)
- (case output
- (#Ok _)
- output
-
- (#Failure _)
- (case monads'
- #Nil
- output
- (#Cons _ _)
- ((try-all-m monads') state))
- ))
- )))
-
-(def (map-m f inputs)
- (case inputs
- #Nil
- (return #Nil)
- (#Cons input inputs')
- (exec [output (f input)
- outputs (map-m f inputs')]
- (return (#Cons output outputs)))))
-
-(def (fold-m f init inputs)
- (case inputs
- #Nil (return init)
- (#Cons x inputs') (exec [init* (f init x)]
- (fold-m f init* inputs'))))
-
-(def (apply-m monad call-state)
- (lambda [state]
- (let output (monad call-state)
- (case output
- (#Ok [?state ?datum])
- (#Ok [state ?datum])
-
- _
- output))))
-
-(def (assert test message)
- (if test
- (return [])
- (fail message)))
-
-(def (pass %value)
- (lambda [state]
- %value))
-
-(def get-state
- (lambda [state]
- (return* state state)))
-
-(def (show x)
- (jvm/invokevirtual Object "toString" []
- x []))
-
-(def (concat t1 t2)
- (jvm/invokevirtual String "concat" [String]
- t1 [t2]))
-
-(def (normalize-char char)
- (case char
- #"*" "_ASTER_"
- #"+" "_PLUS_"
- #"-" "_DASH_"
- #"/" "_SLASH_"
- #"_" "_UNDERS_"
- #"%" "_PERCENT_"
- #"$" "_DOLLAR_"
- #"'" "_QUOTE_"
- #"`" "_BQUOTE_"
- #"@" "_AT_"
- #"^" "_CARET_"
- #"&" "_AMPERS_"
- #"=" "_EQ_"
- #"!" "_BANG_"
- #"?" "_QM_"
- #":" "_COLON_"
- #";" "_SCOLON_"
- #"." "_PERIOD_"
- #"," "_COMMA_"
- #"<" "_LT_"
- #">" "_GT_"
- #"~" "_TILDE_"
- ##;;#"\" "_BSLASH_"
- _ (show char)
- ))
-
-(def (range from to)
- (if (= from to)
- #Nil
- (#Cons from (range (inc from) to))))
-
-(def (text->list text)
- (let length (jvm/invokevirtual String "length" []
- text [])
- (map (lambda [idx]
- (jvm/invokevirtual String "charAt" [int]
- text [idx]))
- (range 0 length))))
-
-(def (normalize-ident ident)
- (fold concat "" (map normalize-char (text->list ident))))
-
-(def (fresh-class-loader path)
- (let file (jvm/new java.io.File [String] [path])
- (let url (jvm/invokevirtual java.io.File "toURL" []
- file [])
- (let urls (jvm/new-array java.net.URL 1)
- (do (jvm/aastore urls 0 url)
- (jvm/new java.net.URLClassLoader [(Array java.net.URL)] [urls]))))
- ))
-
-(def (cons tail head)
- (#Cons head tail))
-
-(def (reverse list)
- (fold cons #Nil list))
-
-(def (enumerate list)
- (case (fold (lambda [state x]
- (case state
- [idx list']
- [(inc idx) (#Cons [idx x] list')]))
- [0 #Nil]
- list)
- [_ list']
- (reverse list')))
+(use "./util" as util)
(def (print-enum enum)
(case enum
@@ -384,108 +9,17 @@
(do (print "[") (print idx) (print ":") (print x) (print "]") (print " ")
(print-enum enum'))))
-(def get-state
- (lambda [state]
- (#Ok [state state])))
-
-(def list-map #Nil)
-
-(def (put key val map)
- (case map
- #Nil
- (#Cons [key val] map)
-
- (#Cons [?key ?val] map')
- (if (= key ?key)
- (#Cons [?key val] map')
- (#Cons [?key ?val] (put key val map')))))
-
-(def (get key map)
- (case map
- #Nil
- #None
-
- (#Cons [?key ?val] map')
- (if (= key ?key)
- (#Some ?val)
- (get key map'))))
-
-(def (show-kv kv)
- (case kv
- [?key ?val]
- (fold concat "" (list "#" ?key " " (show ?val)))))
-
-(def (within slot monad)
- (lambda [state]
- (let =return (monad (get slot state))
- (case =return
- (#Ok ?state ?value)
- (#Ok (put slot ?state state) ?value)
-
- _
- =return))))
-
-(def monadic-dup
- (exec [foo get-state
- bar get-state
- baz (return 1000)]
- (return (+ (+ foo bar) baz))))
-
-(def (run-state monad state)
- (monad state))
-
-(def (interpose elem list)
- (case list
- (#Cons x (#Cons y list'))
- (#Cons x (#Cons elem (#Cons y list')))
-
- _
- list))
+#((def monadic-dup
+ (util/exec [foo get-state
+ bar get-state
+ baz (util/return 1000)]
+ (util/return (+ (+ foo bar) baz)))))#
(def (print-map list-map)
(do (print "{")
(print (fold concat "" (interpose " " (map show-kv list-map))))
(println "}")))
-(def (show-list xs)
- (case xs
- #Nil
- "#Nil"
- (#Cons x xs')
- (fold concat "" (list "(#Cons " (show x) " " (show-list xs') ")"))))
-
## Program
(def (main args)
- (case (' ((~ "Oh yeah...")))
- (#Form (#Cons text #Nil))
- (do (println text)
- (println (+ 10 20))
- (println (inc 10))
- (println (jvm/i- 10 20))
- (println (jvm/i* 10 20))
- (println (jvm/i/ 10 2))
- (let xs (list 1 2 3 4 5 6 7 8 9)
- (do (println (fold + 0 xs))
- (println (length xs))))
- (println (rem 21 6))
- (println (rem 21 7))
- (println (= false false))
- (println (= false true))
- (println (= true false))
- (println (= true true))
- (case (run-state monadic-dup 123)
- (#Ok [_ ?value])
- (println ?value)
-
- (#Failure ?message)
- (println ?message))
- (print-enum (enumerate (list #"a" #"b" #"c" #"d" #"e")))
- (print-map (put "Nyan" "cat" (put "Yolo" "lol" list-map)))
- (let char #"*"
- (do (print (show char)) (print " -> ")
- (println (normalize-char char))))
- (println (show-list (range 0 10)))
- (println (normalize-ident "text->list"))
- (println (fresh-class-loader "./"))
- )
- ))
+ (println "Hello, world!"))
generated by cgit v1.2.3 (git 2.25.1) at 2024-08-27 02:10:41 +0000