aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--source/another.lux4
-rw-r--r--source/lux.lux259
-rw-r--r--source/test2.lux480
-rw-r--r--source/util.lux169
-rw-r--r--src/lux.clj15
-rw-r--r--src/lux/analyser.clj103
-rw-r--r--src/lux/compiler.clj157
-rw-r--r--src/lux/util.clj18
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)