diff options
Diffstat (limited to '')
| -rw-r--r-- | source/another.lux | 4 | ||||
| -rw-r--r-- | source/lux.lux | 259 | ||||
| -rw-r--r-- | source/test2.lux | 480 | ||||
| -rw-r--r-- | source/util.lux | 169 | ||||
| -rw-r--r-- | src/lux.clj | 15 | ||||
| -rw-r--r-- | src/lux/analyser.clj | 103 | ||||
| -rw-r--r-- | src/lux/compiler.clj | 157 | ||||
| -rw-r--r-- | src/lux/util.clj | 18 |
8 files changed, 600 insertions, 605 deletions
diff --git a/source/another.lux b/source/another.lux deleted file mode 100644 index ff5bb6f0a..000000000 --- a/source/another.lux +++ /dev/null @@ -1,4 +0,0 @@ - -## (ann id #type (All [x] (-> [x] x))) -(def (id x) - x) diff --git a/source/lux.lux b/source/lux.lux new file mode 100644 index 000000000..8f02c681d --- /dev/null +++ b/source/lux.lux @@ -0,0 +1,259 @@ +## Base interfaces & classes +(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 lux.Variant + []) +(jvm/defclass Variant1 lux.Variant + [[java.lang.Object _1]]) +(jvm/defclass Variant2 lux.Variant + [[java.lang.Object _1] [java.lang.Object _2]]) +(jvm/defclass Variant3 lux.Variant + [[java.lang.Object _1] [java.lang.Object _2] + [java.lang.Object _3]]) +(jvm/defclass Variant4 lux.Variant + [[java.lang.Object _1] [java.lang.Object _2] + [java.lang.Object _3] [java.lang.Object _4]]) +(jvm/defclass Variant5 lux.Variant + [[java.lang.Object _1] [java.lang.Object _2] + [java.lang.Object _3] [java.lang.Object _4] + [java.lang.Object _5]]) +(jvm/defclass Variant6 lux.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 lux.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 lux.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]]) + +## Base functions & macros +(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))) + )) + + +## I/O +(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 (' form) + (case form + (#Cons token #Nil) + (untemplate token))) + +(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 (pairs list) + (case list + (#Cons x (#Cons y list*)) + (#Cons [x y] (pairs list*)) + + _ + #Nil)) + +(def (show x) + (jvm/invokevirtual Object "toString" [] + x [])) + +(def (concat t1 t2) + (jvm/invokevirtual String "concat" [String] + t1 [t2])) + +(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 (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'))) + +(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 (interpose elem list) + (case list + (#Cons x (#Cons y list')) + (#Cons x (#Cons elem (#Cons y list'))) + + _ + list)) + +(def (show-list xs) + (case xs + #Nil + "#Nil" + (#Cons x xs') + (fold concat "" (list "(#Cons " (show x) " " (show-list xs') ")")))) 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!")) diff --git a/source/util.lux b/source/util.lux new file mode 100644 index 000000000..88b035571 --- /dev/null +++ b/source/util.lux @@ -0,0 +1,169 @@ +(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)))) + +## 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 value #Nil)) + (fold (lambda [inner pair] + (case pair + [label computation] + (' (bind (~ computation) (lambda [(~ label)] (~ inner)))))) + value + (pairs steps)))) + +(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 (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 (normalize-ident ident) + (fold concat "" (map normalize-char (text->list ident)))) + +(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 (run-state monad state) + (monad state)) + +(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])))) + )) diff --git a/src/lux.clj b/src/lux.clj index 6efbcc207..dca7034c3 100644 --- a/src/lux.clj +++ b/src/lux.clj @@ -24,19 +24,10 @@ ;; TODO: Reinplement "if" as a macro on top of case. ;; TODO: - (let [source-code (slurp "source/test2.lux") - tokens (&lexer/lex source-code) - ;; _ (prn 'tokens tokens) - syntax (&parser/parse tokens) - ;; _ (prn 'syntax syntax) - ;; ann-syntax (&analyser/analyse "test2" syntax) - ;; _ (prn 'ann-syntax ann-syntax) - ;; class-data (&compiler/compile "test2" ann-syntax) - class-data (&compiler/compile "test2" syntax) - ;; _ (prn 'class-data class-data) - ] - ) + (&compiler/compile-all ["lux" "test2"]) + + ;; jar cvf test2.jar *.class test2 && java -cp "test2.jar" test2 ;; cd output && jar cvf test2.jar * && java -cp "test2.jar" test2 && cd .. ) diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj index dd41f638d..179d2089e 100644 --- a/src/lux/analyser.clj +++ b/src/lux/analyser.clj @@ -4,7 +4,7 @@ [template :refer [do-template]]) [clojure.core.match :refer [match]] (lux [util :as &util :refer [exec return* return fail fail* - repeat-m try-m try-all-m map-m reduce-m + repeat-m exhaust-m try-m try-all-m map-m reduce-m apply-m within normalize-ident loader]] @@ -33,23 +33,26 @@ (defn ^:private define [name desc] (fn [state] [::&util/ok [(-> state - (assoc-in [:defs (:name state) name] desc) + (assoc-in [:modules (:name state) name] desc) (assoc-in [:defs-env name] (annotated [::global (:name state) name] (:type desc)))) nil]])) (defn ^:private define-fn [name desc] (fn [state] [::&util/ok [(-> state - (assoc-in [:defs (:name state) name] desc) + (assoc-in [:modules (:name state) name] desc) (assoc-in [:defs-env name] (annotated [::global-fn (:name state) name] (:type desc)))) nil]])) -(defn ^:private is-macro? [name] +(defn ^:private is-macro? [module name] (fn [state] ;; (prn 'is-macro? (nth name 1) ;; (get-in state [:defs (:name state) (nth name 1) :mode]) ;; (= (get-in state [:defs (:name state) (nth name 1) :mode]) ::macro)) - [::&util/ok [state (= (get-in state [:defs (:name state) (nth name 1) :mode]) ::macro)]])) + ;; (prn 'is-macro? name (get-in state [:modules module name :mode]) + ;; (get-in state [:modules module]) + ;; (get-in state [:modules])) + [::&util/ok [state (= (get-in state [:modules module name :mode]) ::macro)]])) (def ^:private next-local-idx (fn [state] @@ -63,18 +66,13 @@ (fn [state] [::&util/ok [state (-> state :env first)]])) -(defn ^:private in-scope? [scope] +(defn ^:private in-scope? [module name] (fn [state] - (match scope - [::&parser/ident ?macro-name] - (do ;; (prn 'in-scope? - ;; ?macro-name - ;; (get-in state [:lambda-scope 0]) - ;; (some (partial = ?macro-name) (get-in state [:lambda-scope 0]))) - [::&util/ok [state (some (partial = ?macro-name) (get-in state [:lambda-scope 0]))]]) - - _ - [::&util/ok [state false]]) + (do ;; (prn 'in-scope? + ;; ?macro-name + ;; (get-in state [:lambda-scope 0]) + ;; (some (partial = ?macro-name) (get-in state [:lambda-scope 0]))) + [::&util/ok [state (some (partial = name) (get-in state [:lambda-scope 0]))]]) )) (defn with-scope [scope body] @@ -184,8 +182,8 @@ [::&util/ok [?state ?value]] (do ;; (prn 'PRE-LAMBDA (:env state)) ;; (prn 'POST-LAMBDA (:env ?state) ?value) - (prn 'POST-LAMBDA1 (get-in ?state [:lambda-scope 0]) (-> ?state :env first :mappings)) - (prn 'POST-LAMBDA2 (get-in ?state [:lambda-scope 0]) (-> ?state :env first (update-in [:mappings] #(reduce dissoc % args-vars)) :mappings)) + ;; (prn 'POST-LAMBDA1 (get-in ?state [:lambda-scope 0]) (-> ?state :env first :mappings)) + ;; (prn 'POST-LAMBDA2 (get-in ?state [:lambda-scope 0]) (-> ?state :env first (update-in [:mappings] #(reduce dissoc % args-vars)) :mappings)) [::&util/ok [(-> ?state (update-in [:env] rest) ;; (update-in [:lambda-scope 1] inc) @@ -220,21 +218,25 @@ (fn [state] (or (if-let [[_ ?alias ?binding] (re-find #"^(.*)/(.*)$" ident)] (if-let [?module (get-in state [:deps ?alias])] - [::&util/ok [state (annotated [::global ?module ?binding] ::&type/nothing)]])) + (do (prn 'resolve '[_ ?alias ?binding] ident [:global ?module ?binding]) + [::&util/ok [state (annotated [::global ?module ?binding] ::&type/nothing)]]))) (let [[inner outer] (split-with #(nil? (get-in % [:mappings ident])) (:env state))] (cond (empty? inner) - (do (prn 'resolve/inner ident (get-in state [:lambda-scope 0])) + (do ;; (prn 'resolve/inner ident (get-in state [:lambda-scope 0])) + (prn 'resolve/env ident (-> state :env first :mappings (get ident))) [::&util/ok [state (-> state :env first :mappings (get ident))]]) (empty? outer) - (do (prn 'resolve/outer ident (get-in state [:lambda-scope 0])) + (do ;; (prn 'resolve/outer ident (get-in state [:lambda-scope 0])) (if-let [global|import (or (get-in state [:defs-env ident]) (get-in state [:imports ident]))] - [::&util/ok [state global|import]] - [::&util/failure (str "Unresolved identifier: " ident)])) + (do (prn 'resolve/global|import ident global|import) + [::&util/ok [state global|import]]) + (do (prn 'resolve/UNRESOLVED (str "Unresolved identifier: " ident)) + [::&util/failure (str "Unresolved identifier: " ident)]))) :else - (do (prn 'resolve/:else ident (get-in state [:lambda-scope 0])) + (do ;; (prn 'resolve/:else ident (get-in state [:lambda-scope 0])) (let [[=local inner*] (reduce (fn [[register new-inner] [frame scope]] (let [[register* frame*] (close-over scope ident register frame)] [register* (cons frame* new-inner)])) @@ -245,7 +247,8 @@ (iterate pop) (take (count inner)) reverse)))] - (prn 'resolve/inner* inner*) + ;; (prn 'resolve/inner* inner*) + (prn 'resolve/=local ident =local) [::&util/ok [(assoc state :env (concat inner* outer)) =local]]))))))) (defmacro ^:private defanalyser [name match return] @@ -480,7 +483,7 @@ (exec [=class (full-class-name ?class) =classes (map-m extract-jvm-param ?classes) =return (lookup-virtual-method (Class/forName =class) ?method =classes) - :let [_ (prn 'analyse-jvm-invokevirtual ?class ?method =classes '-> =return)] + ;; :let [_ (prn 'analyse-jvm-invokevirtual ?class ?method =classes '-> =return)] ;; =return =return =object (analyse-form* ?object) =args (map-m analyse-form* ?args)] @@ -550,39 +553,39 @@ ;; (prn '->token x) (match x [::&parser/bool ?bool] - (doto (.newInstance (.loadClass @loader "test2.Variant1")) + (doto (.newInstance (.loadClass @loader "lux.Variant1")) (-> .-tag (set! "Bool")) (-> .-_1 (set! ?bool))) [::&parser/int ?int] - (doto (.newInstance (.loadClass @loader "test2.Variant1")) + (doto (.newInstance (.loadClass @loader "lux.Variant1")) (-> .-tag (set! "Int")) (-> .-_1 (set! ?int))) [::&parser/real ?real] - (doto (.newInstance (.loadClass @loader "test2.Variant1")) + (doto (.newInstance (.loadClass @loader "lux.Variant1")) (-> .-tag (set! "Real")) (-> .-_1 (set! ?real))) [::&parser/char ?elem] - (doto (.newInstance (.loadClass @loader "test2.Variant1")) + (doto (.newInstance (.loadClass @loader "lux.Variant1")) (-> .-tag (set! "Char")) (-> .-_1 (set! ?elem))) [::&parser/text ?text] - (doto (.newInstance (.loadClass @loader "test2.Variant1")) + (doto (.newInstance (.loadClass @loader "lux.Variant1")) (-> .-tag (set! "Text")) (-> .-_1 (set! ?text))) [::&parser/tag ?tag] - (doto (.newInstance (.loadClass @loader "test2.Variant1")) + (doto (.newInstance (.loadClass @loader "lux.Variant1")) (-> .-tag (set! "Tag")) (-> .-_1 (set! ?tag))) [::&parser/ident ?ident] - (doto (.newInstance (.loadClass @loader "test2.Variant1")) + (doto (.newInstance (.loadClass @loader "lux.Variant1")) (-> .-tag (set! "Ident")) (-> .-_1 (set! ?ident))) [::&parser/tuple ?elems] - (doto (.newInstance (.loadClass @loader "test2.Variant1")) + (doto (.newInstance (.loadClass @loader "lux.Variant1")) (-> .-tag (set! "Tuple")) (-> .-_1 (set! (->tokens ?elems)))) [::&parser/form ?elems] - (doto (.newInstance (.loadClass @loader "test2.Variant1")) + (doto (.newInstance (.loadClass @loader "lux.Variant1")) (-> .-tag (set! "Form")) (-> .-_1 (set! (->tokens ?elems)))) )) @@ -590,11 +593,11 @@ (defn ->tokens [xs] (reduce (fn [tail x] ;; (prn 'tail (.-tag tail) 'x x) - (doto (.newInstance (.loadClass @loader "test2.Variant2")) + (doto (.newInstance (.loadClass @loader "lux.Variant2")) (-> .-tag (set! "Cons")) (-> .-_1 (set! (->token x))) (-> .-_2 (set! tail)))) - (doto (.newInstance (.loadClass @loader "test2.Variant0")) + (doto (.newInstance (.loadClass @loader "lux.Variant0")) (-> .-tag (set! "Nil"))) (reverse xs))) @@ -622,23 +625,25 @@ (defanalyser analyse-call [::&parser/form ([?fn & ?args] :seq)] (exec [=fn (analyse-form* ?fn) - :let [_ (prn 'analyse-call/=fn =fn)]] + ;; :let [_ (prn 'analyse-call/=fn =fn)] + ] (match (:form =fn) [::global-fn ?module ?name] - (exec [macro? (is-macro? ?fn) - scoped? (in-scope? ?fn) - :let [_ (prn 'analyse-call [:global-fn ?module ?name] macro? scoped?)]] + (exec [macro? (is-macro? ?module ?name) + scoped? (in-scope? ?module ?name) + :let [_ (prn 'analyse-call [:global-fn ?module ?name] macro? scoped?)] + ;; :let [_ (prn 'analyse-call [:global-fn ?module ?name] macro? scoped?)] + ] (if (and macro? (not scoped?)) (let [macro-class (str ?module "$" (normalize-ident ?name)) transformed (-> (.loadClass @loader macro-class) .newInstance (.apply (->tokens ?args)) ->clojure-token) - _ (prn 'analyse-call/transformed transformed)] - (-> (.loadClass @loader macro-class) - .newInstance - (.apply (->tokens ?args)) - ->clojure-token + _ (prn 'analyse-call/macro-raw ?args) + _ (prn 'analyse-call/transformed transformed) + ] + (-> transformed analyse-form*)) (exec [=args (map-m analyse-form* ?args) :let [[needs-num =return-type] (match (:type =fn) @@ -1016,15 +1021,19 @@ (defanalyser analyse-defmacro [::&parser/form ([[::&parser/ident "defmacro"] [::&parser/form ([[::&parser/ident ?name] [::&parser/ident ?tokens]] :seq)] ?value] :seq)] (exec [[=function =tokens =return] (within :types (&type/fresh-function 1)) + :let [_ (prn 'analyse-defmacro/_1 ?name)] =value (with-scope ?name (with-scoped-name ?name =function (with-local ?tokens =tokens (analyse-form* ?value)))) + :let [_ (prn 'analyse-defmacro/_2 ?name)] =function (within :types (exec [_ (&type/solve =return (:type =value))] (&type/clean =function))) + :let [_ (prn 'analyse-defmacro/_3 ?name)] _ (define-fn ?name {:mode ::macro :access ::public - :type =function})] + :type =function}) + :let [_ (prn 'analyse-defmacro/_4 ?name)]] (return (annotated [::def [?name (list ?tokens)] =value] ::&type/nothing)))) (defanalyser analyse-lambda diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj index 5b901c08e..07a1df1a4 100644 --- a/src/lux/compiler.clj +++ b/src/lux/compiler.clj @@ -5,7 +5,7 @@ [template :refer [do-template]]) [clojure.core.match :refer [match]] (lux [util :as &util :refer [exec return* return fail fail* - repeat-m try-m try-all-m map-m reduce-m + repeat-m exhaust-m try-m try-all-m map-m reduce-m apply-m within normalize-ident loader reset-loader!]] @@ -22,6 +22,8 @@ (declare compile-form compile) +(def +prefix+ "lux") + ;; [Utils/General] (defn ^:private write-file [file data] ;; (println 'write-file file (alength data)) @@ -33,20 +35,11 @@ (defn ^:private write-class [name data] (write-file (str "output/" name ".class") data)) -(let [;; loader (proxy [ClassLoader] []) - ] - (defn load-class! [name file-name] - ;; (println "Defining..." name "@" file-name ;; (alength bytecode) - ;; ) - ;; (prn 'loader loader) - (.loadClass @loader name) - ;; (println "SUCCESFUL LOAD!") - ;; (.defineClass loader name bytecode 0 (alength bytecode)) - ;; (-> (java.io.File. "./") .toURL vector into-array java.net.URLClassLoader. (.loadClass "test2/Function")) - )) +(defn load-class! [name file-name] + (.loadClass @loader name)) -(def ^:private +variant-class+ "test2.Variant") -(def ^:private +tuple-class+ "test2.Tuple") +(def ^:private +variant-class+ (str +prefix+ ".Variant")) +(def ^:private +tuple-class+ (str +prefix+ ".Tuple")) (defmacro ^:private defcompiler [name match body] `(defn ~name [~'*state*] @@ -117,7 +110,7 @@ (->type-signature +variant-class+) [::&type/function ?args ?return] - (->java-sig [::&type/object "test2/Function" []]))) + (->java-sig [::&type/object (str +prefix+ "/Function") []]))) (defn ^:private method->sig [method] (match method @@ -168,7 +161,7 @@ [::&analyser/tuple ?elems] (let [;; _ (prn 'compile-tuple (count ?elems)) num-elems (count ?elems)] - (let [tuple-class (str "test2/Tuple" num-elems)] + (let [tuple-class (str (str +prefix+ "/Tuple") num-elems)] (doto *writer* (.visitTypeInsn Opcodes/NEW tuple-class) (.visitInsn Opcodes/DUP) @@ -225,7 +218,7 @@ (let [apply-signature "(Ljava/lang/Object;)Ljava/lang/Object;"] (doseq [arg ?args] (compile-form (assoc *state* :form arg)) - (.visitMethodInsn *writer* Opcodes/INVOKEINTERFACE "test2/Function" "apply" apply-signature)))))) + (.visitMethodInsn *writer* Opcodes/INVOKEINTERFACE (str +prefix+ "/Function") "apply" apply-signature)))))) (defcompiler ^:private compile-static-call [::&analyser/static-call ?needs-num ?fn ?args] @@ -243,7 +236,7 @@ (->> (doseq [arg (take ?needs-num ?args)]))) (.visitMethodInsn Opcodes/INVOKESTATIC call-class "impl" impl-sig) (-> (doto (do (compile-form (assoc *state* :form arg))) - (.visitMethodInsn Opcodes/INVOKEINTERFACE "test2/Function" "apply" apply-signature)) + (.visitMethodInsn Opcodes/INVOKEINTERFACE (str +prefix+ "/Function") "apply" apply-signature)) (->> (doseq [arg (drop ?needs-num ?args)]))))) (let [counter-sig "I" init-signature (str "(" (apply str counter-sig (repeat (dec ?needs-num) arg-sig)) ")" "V")] @@ -346,7 +339,7 @@ (defcompiler ^:private compile-jvm-invokevirtual [::&analyser/jvm-invokevirtual ?class ?method ?classes ?object ?args] - (let [_ (prn 'compile-jvm-invokevirtual [?class ?method ?classes] '-> *type*) + (let [;; _ (prn 'compile-jvm-invokevirtual [?class ?method ?classes] '-> *type*) method-sig (str "(" (reduce str "" (map ->type-signature ?classes)) ")" (->java-sig *type*))] (compile-form (assoc *state* :form ?object)) (.visitTypeInsn *writer* Opcodes/CHECKCAST (->class ?class)) @@ -760,7 +753,7 @@ (.visitInnerClass writer current-class outer-class nil (+ Opcodes/ACC_STATIC Opcodes/ACC_SYNTHETIC)) (let [=class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS) (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_SUPER) - current-class nil "java/lang/Object" (into-array ["test2/Function"])) + current-class nil "java/lang/Object" (into-array [(str +prefix+ "/Function")])) (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "_datum" self-sig nil nil) (-> (.visitField (+ Opcodes/ACC_PRIVATE Opcodes/ACC_FINAL) "_counter" counter-sig nil nil) (->> (when (not= 0 num-captured)))) @@ -853,7 +846,7 @@ (.visitInnerClass writer current-class outer-class nil (+ Opcodes/ACC_STATIC Opcodes/ACC_SYNTHETIC)) (let [=class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS) (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_SUPER) - current-class nil "java/lang/Object" (into-array ["test2/Function"])) + current-class nil "java/lang/Object" (into-array [(str +prefix+ "/Function")])) (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_datum" datum-sig nil nil) (doto (.visitEnd))) (-> (.visitMethod Opcodes/ACC_PUBLIC "<clinit>" "()V" nil nil) @@ -900,7 +893,7 @@ (defcompiler ^:private compile-lambda [::&analyser/lambda ?scope ?frame ?args ?body] - (let [_ (prn '[?scope ?frame] ?scope ?frame ?args) + (let [;; _ (prn '[?scope ?frame] ?scope ?frame ?args) num-args (count ?args) ;; outer-class (->class *class-name*) clo-field-sig (->type-signature "java.lang.Object") @@ -923,7 +916,7 @@ ;; _ (prn current-class 'real-signature real-signature) =class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS) (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_SUPER) - current-class nil "java/lang/Object" (into-array ["test2/Function"])) + current-class nil "java/lang/Object" (into-array [(str +prefix+ "/Function")])) (-> (doto (.visitField (+ Opcodes/ACC_PRIVATE Opcodes/ACC_FINAL) captured-name clo-field-sig nil nil) (.visitEnd)) (->> (let [captured-name (str "__" ?captured-id)]) @@ -1178,50 +1171,76 @@ (assert false (str "Can't compile: " (pr-str (:form state))))))) ;; [Interface] -(defn compile [class-name inputs] +(def !state (atom nil)) + +;; "map" {:mode :lux.analyser/function, +;; :access :lux.analyser/public, +;; :type [:lux.type/function (:lux.type/any :lux.type/any) :lux.type/any]} + +;; "map" {:form [:lux.analyser/global-fn "lux" "map"], +;; :type [:lux.type/function (:lux.type/any :lux.type/any) :lux.type/any]} + +(defn compile [module-name inputs] ;; (prn 'inputs inputs) - (reset-loader!) - (let [=class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS) - (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER) - (->class class-name) nil "java/lang/Object" nil)) - compiler-state {:class-name class-name - :writer =class - :form nil - :parent nil}] - (match ((repeat-m - (&analyser/with-scope class-name - (exec [ann-input &analyser/analyse-form - :let [_ (when (not (compile-form (assoc compiler-state :form ann-input))) - (assert false ann-input))]] - (return ann-input)))) - {:name class-name - :forms inputs - :deps {} - :imports {} - :defs {} - :defs-env {} - :lambda-scope [[] 0] - :env (list (&analyser/fresh-env 0)) - :types &type/+init+}) - [::&util/ok [?state ?forms]] - (if (empty? (:forms ?state)) - ?forms - (assert false (str "Unconsumed input: " (pr-str (first (:forms ?state)))))) - - [::&util/failure ?message] - (assert false ?message)) - ;;; - (.visitEnd =class) - (let [bytecode (.toByteArray =class)] - (write-class class-name bytecode) - (load-class! (string/replace class-name #"/" ".") (str class-name ".class")) - bytecode) - ) - ;; (comment - ;; (-> (java.io.File. "./") .toURL vector into-array java.net.URLClassLoader. (.loadClass "test2")) - ;; (-> (java.io.File. "./") .toURL vector into-array java.net.URLClassLoader. (.loadClass "test2.Function")) - ;; (let [test2 (-> (java.io.File. "./") .toURL vector into-array java.net.URLClassLoader. (.loadClass "test2")) - ;; main (first (.getDeclaredMethods test2))] - ;; (.invoke main nil (to-array [nil]))) - ;; ) - ) + (if-let [module (get-in @!state [:modules module-name])] + (assert false "Can't redefine a module!") + (do (reset-loader!) + (let [init-state (let [+prelude-module+ "lux" + init-state (assoc @!state :name module-name, :forms inputs, :defs-env {})] + (if (= +prelude-module+ module-name) + init-state + (assoc init-state :defs-env (into {} (for [[?name ?desc] (get-in init-state [:modules +prelude-module+])] + (case (:mode ?desc) + ::&analyser/constant + [?name {:form [::&analyser/global +prelude-module+ ?name] + :type (:type ?desc)}] + (::&analyser/function ::&analyser/macro) + [?name {:form [::&analyser/global-fn +prelude-module+ ?name] + :type (:type ?desc)}])))))) + =class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS) + (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER) + (->class module-name) nil "java/lang/Object" nil)) + compiler-state {:class-name module-name + :writer =class + :form nil + :parent nil} + new-state (match ((exhaust-m + (&analyser/with-scope module-name + (exec [ann-input &analyser/analyse-form + :let [_ (when (not (compile-form (assoc compiler-state :form ann-input))) + (assert false ann-input))]] + (return ann-input)))) + init-state) + [::&util/ok [?state ?forms]] + (if (empty? (:forms ?state)) + (do (reset! !state ?state) + ?state) + (assert false (str "Unconsumed input: " (pr-str (first (:forms ?state)))))) + + [::&util/failure ?message] + (assert false ?message))] + (.visitEnd =class) + (let [bytecode (.toByteArray =class)] + (write-class module-name bytecode) + (load-class! (string/replace module-name #"/" ".") (str module-name ".class")) + bytecode) + new-state + )))) + +(defn compile-file [name] + (->> (slurp (str "source/" name ".lux")) + &lexer/lex + &parser/parse + (compile name))) + +(defn compile-all [files] + (reset! !state {:name nil + :forms nil + :modules {} + :deps {} + :imports {} + :defs-env {} + :lambda-scope [[] 0] + :env (list (&analyser/fresh-env 0)) + :types &type/+init+}) + (dorun (map compile-file files))) diff --git a/src/lux/util.clj b/src/lux/util.clj index 757648c31..3662a4ea5 100644 --- a/src/lux/util.clj +++ b/src/lux/util.clj @@ -64,6 +64,24 @@ (do ;; (println "Failed at last:" ?message) (return* state '()))))) +(defn exhaust-m [monad] + (fn [state] + (let [result (monad state)] + (match result + [::ok [?state ?head]] + (if (empty? (:forms ?state)) + (return* ?state (list ?head)) + (let [result* ((exhaust-m monad) ?state)] + (match result* + [::ok [?state* ?tail]] + (return* ?state* (cons ?head ?tail)) + + _ + result*))) + + _ + result)))) + (defn try-all-m [monads] (fn [state] (if (empty? monads) |