aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/lux.clj9
-rw-r--r--src/lux/analyser.clj204
-rw-r--r--src/lux/analyser/case.clj2
-rw-r--r--src/lux/analyser/def.clj15
-rw-r--r--src/lux/analyser/env.clj22
-rw-r--r--src/lux/analyser/host.clj75
-rw-r--r--src/lux/analyser/lambda.clj10
-rw-r--r--src/lux/analyser/lux.clj111
-rw-r--r--src/lux/base.clj225
-rw-r--r--src/lux/compiler.clj533
-rw-r--r--src/lux/compiler/base.clj177
-rw-r--r--src/lux/compiler/case.clj101
-rw-r--r--src/lux/compiler/host.clj5
-rw-r--r--src/lux/compiler/lambda.clj37
-rw-r--r--src/lux/compiler/lux.clj61
-rw-r--r--src/lux/host.clj4
-rw-r--r--src/lux/lexer.clj2
-rw-r--r--src/lux/parser.clj17
-rw-r--r--src/lux/type.clj128
19 files changed, 964 insertions, 774 deletions
diff --git a/src/lux.clj b/src/lux.clj
index 3516f2a9c..b0a9a3c94 100644
--- a/src/lux.clj
+++ b/src/lux.clj
@@ -1,5 +1,6 @@
(ns lux
- (:require [lux.compiler :as &compiler]
+ (:require [lux.base :as &]
+ [lux.compiler :as &compiler]
:reload-all))
(comment
@@ -13,9 +14,9 @@
;; TODO: All optimizations
;; TODO: Take module-name aliasing into account.
;; TODO:
-
- (time (&compiler/compile-all ["lux"]))
- (time (&compiler/compile-all ["lux" "test2"]))
+
+ (time (&compiler/compile-all (&/|list "lux")))
+ (time (&compiler/compile-all (&/|list "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 235478782..f9c104378 100644
--- a/src/lux/analyser.clj
+++ b/src/lux/analyser.clj
@@ -14,14 +14,14 @@
;; [Utils]
(defn ^:private parse-handler [[catch+ finally+] token]
(matchv ::M/objects [token]
- [["Form" ["Cons" [["Ident" "jvm-catch"]
- ["Cons" [["Ident" ?ex-class]
- ["Cons" [["Ident" ?ex-arg]
+ [["Form" ["Cons" [["Symbol" "jvm-catch"]
+ ["Cons" [["Symbol" ?ex-class]
+ ["Cons" [["Symbol" ?ex-arg]
["Cons" [?catch-body
["Nil" _]]]]]]]]]]]
[(concat catch+ (list [?ex-class ?ex-arg ?catch-body])) finally+]
- [["Form" ["Cons" [["Ident" "jvm-finally"]
+ [["Form" ["Cons" [["Symbol" "jvm-finally"]
["Cons" [?finally-body
["Nil" _]]]]]]]
[catch+ ?finally-body]))
@@ -56,197 +56,197 @@
(return (&/|list [&/V "Expression" (&/T (&/V "variant" (&/T ?tag (&/V "Expression" (&/T (&/V "tuple" (&/|list)) tuple-type))))
(&/V "Variant" (&/V "Cons" (&/T (&/T ?tag tuple-type) (&/V "Nil" nil)))))])))
- [["Ident" "jvm-null"]]
+ [["Symbol" "jvm-null"]]
(return (&/|list [&/V "Expression" (&/T (&/V "jvm-null" nil) (&/V "Data" (&/T "null" (&/V "Nil" nil))))]))
- [["Ident" ?ident]]
+ [["Symbol" ?ident]]
(&&lux/analyse-ident analyse ?ident)
- [["Form" ["Cons" [["Ident" "case'"]
+ [["Form" ["Cons" [["Symbol" "case'"]
["Cons" [?variant ?branches]]]]]]
(&&lux/analyse-case analyse ?variant ?branches)
- [["Form" ["Cons" [["Ident" "lambda'"]
- ["Cons" [["Ident" ?self]
- ["Cons" [["Ident" ?arg]
+ [["Form" ["Cons" [["Symbol" "lambda'"]
+ ["Cons" [["Symbol" ?self]
+ ["Cons" [["Symbol" ?arg]
["Cons" [?body
["Nil" _]]]]]]]]]]]
(&&lux/analyse-lambda analyse ?self ?arg ?body)
- [["Form" ["Cons" [["Ident" "get@'"] ["Cons" [["Tag" ?slot] ["Cons" [?record ["Nil" _]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "get@'"] ["Cons" [["Tag" ?slot] ["Cons" [?record ["Nil" _]]]]]]]]]
(&&lux/analyse-get analyse ?slot ?record)
- [["Form" ["Cons" [["Ident" "set@'"] ["Cons" [["Tag" ?slot] ["Cons" [?value ["Cons" [?record ["Nil" _]]]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "set@'"] ["Cons" [["Tag" ?slot] ["Cons" [?value ["Cons" [?record ["Nil" _]]]]]]]]]]]
(&&lux/analyse-set analyse ?slot ?value ?record)
- [["Form" ["Cons" [["Ident" "def'"] ["Cons" [["Ident" ?name] ["Cons" [?value ["Nil" _]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "def'"] ["Cons" [["Symbol" ?name] ["Cons" [?value ["Nil" _]]]]]]]]]
(&&lux/analyse-def analyse ?name ?value)
- [["Form" ["Cons" [["Ident" "declare-macro"] ["Cons" [["Ident" ?ident] ["Nil" _]]]]]]]
+ [["Form" ["Cons" [["Symbol" "declare-macro"] ["Cons" [["Symbol" ?ident] ["Nil" _]]]]]]]
(&&lux/analyse-declare-macro ?ident)
- [["Form" ["Cons" [["Ident" "import'"] ["Cons" [["Text" ?path] ["Nil" _]]]]]]]
+ [["Form" ["Cons" [["Symbol" "import'"] ["Cons" [["Text" ?path] ["Nil" _]]]]]]]
(&&lux/analyse-import analyse ?path)
- [["Form" ["Cons" [["Ident" ":"] ["Cons" [?value ["Cons" [?type ["Nil" _]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" ":"] ["Cons" [?value ["Cons" [?type ["Nil" _]]]]]]]]]
(&&lux/analyse-check analyse eval! ?type ?value)
- [["Form" ["Cons" [["Ident" "coerce"] ["Cons" [?type ["Cons" [?value ["Nil" _]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "coerce"] ["Cons" [?type ["Cons" [?value ["Nil" _]]]]]]]]]
(&&lux/analyse-coerce analyse eval! ?type ?value)
;; Host special forms
- [["Form" ["Cons" [["Ident" "exec"] ?exprs]]]]
+ [["Form" ["Cons" [["Symbol" "exec"] ?exprs]]]]
(&&host/analyse-exec analyse ?exprs)
;; Integer arithmetic
- [["Form" ["Cons" [["Ident" "jvm-iadd"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-iadd"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
(&&host/analyse-jvm-iadd analyse ?x ?y)
- [["Form" ["Cons" [["Ident" "jvm-isub"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-isub"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
(&&host/analyse-jvm-isub analyse ?x ?y)
- [["Form" ["Cons" [["Ident" "jvm-imul"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-imul"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
(&&host/analyse-jvm-imul analyse ?x ?y)
- [["Form" ["Cons" [["Ident" "jvm-idiv"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-idiv"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
(&&host/analyse-jvm-idiv analyse ?x ?y)
- [["Form" ["Cons" [["Ident" "jvm-irem"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-irem"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
(&&host/analyse-jvm-irem analyse ?x ?y)
- [["Form" ["Cons" [["Ident" "jvm-ieq"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-ieq"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
(&&host/analyse-jvm-ieq analyse ?x ?y)
- [["Form" ["Cons" [["Ident" "jvm-ilt"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-ilt"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
(&&host/analyse-jvm-ilt analyse ?x ?y)
- [["Form" ["Cons" [["Ident" "jvm-igt"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-igt"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
(&&host/analyse-jvm-igt analyse ?x ?y)
;; Long arithmetic
- [["Form" ["Cons" [["Ident" "jvm-ladd"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-ladd"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
(&&host/analyse-jvm-ladd analyse ?x ?y)
- [["Form" ["Cons" [["Ident" "jvm-lsub"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-lsub"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
(&&host/analyse-jvm-lsub analyse ?x ?y)
- [["Form" ["Cons" [["Ident" "jvm-lmul"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-lmul"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
(&&host/analyse-jvm-lmul analyse ?x ?y)
- [["Form" ["Cons" [["Ident" "jvm-ldiv"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-ldiv"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
(&&host/analyse-jvm-ldiv analyse ?x ?y)
- [["Form" ["Cons" [["Ident" "jvm-lrem"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-lrem"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
(&&host/analyse-jvm-lrem analyse ?x ?y)
- [["Form" ["Cons" [["Ident" "jvm-leq"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-leq"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
(&&host/analyse-jvm-leq analyse ?x ?y)
- [["Form" ["Cons" [["Ident" "jvm-llt"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-llt"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
(&&host/analyse-jvm-llt analyse ?x ?y)
- [["Form" ["Cons" [["Ident" "jvm-lgt"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-lgt"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
(&&host/analyse-jvm-lgt analyse ?x ?y)
;; Float arithmetic
- [["Form" ["Cons" [["Ident" "jvm-fadd"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-fadd"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
(&&host/analyse-jvm-fadd analyse ?x ?y)
- [["Form" ["Cons" [["Ident" "jvm-fsub"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-fsub"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
(&&host/analyse-jvm-fsub analyse ?x ?y)
- [["Form" ["Cons" [["Ident" "jvm-fmul"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-fmul"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
(&&host/analyse-jvm-fmul analyse ?x ?y)
- [["Form" ["Cons" [["Ident" "jvm-fdiv"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-fdiv"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
(&&host/analyse-jvm-fdiv analyse ?x ?y)
- [["Form" ["Cons" [["Ident" "jvm-frem"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-frem"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
(&&host/analyse-jvm-frem analyse ?x ?y)
- [["Form" ["Cons" [["Ident" "jvm-feq"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-feq"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
(&&host/analyse-jvm-feq analyse ?x ?y)
- [["Form" ["Cons" [["Ident" "jvm-flt"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-flt"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
(&&host/analyse-jvm-flt analyse ?x ?y)
- [["Form" ["Cons" [["Ident" "jvm-fgt"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-fgt"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
(&&host/analyse-jvm-fgt analyse ?x ?y)
;; Double arithmetic
- [["Form" ["Cons" [["Ident" "jvm-dadd"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-dadd"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
(&&host/analyse-jvm-dadd analyse ?x ?y)
- [["Form" ["Cons" [["Ident" "jvm-dsub"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-dsub"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
(&&host/analyse-jvm-dsub analyse ?x ?y)
- [["Form" ["Cons" [["Ident" "jvm-dmul"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-dmul"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
(&&host/analyse-jvm-dmul analyse ?x ?y)
- [["Form" ["Cons" [["Ident" "jvm-ddiv"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-ddiv"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
(&&host/analyse-jvm-ddiv analyse ?x ?y)
- [["Form" ["Cons" [["Ident" "jvm-drem"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-drem"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
(&&host/analyse-jvm-drem analyse ?x ?y)
- [["Form" ["Cons" [["Ident" "jvm-deq"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-deq"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
(&&host/analyse-jvm-deq analyse ?x ?y)
- [["Form" ["Cons" [["Ident" "jvm-dlt"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-dlt"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
(&&host/analyse-jvm-dlt analyse ?x ?y)
- [["Form" ["Cons" [["Ident" "jvm-dgt"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-dgt"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
(&&host/analyse-jvm-dgt analyse ?x ?y)
;; Objects
- [["Form" ["Cons" [["Ident" "jvm-null?"] ["Cons" [?object ["Nil" _]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-null?"] ["Cons" [?object ["Nil" _]]]]]]]
(&&host/analyse-jvm-null? analyse ?object)
- [["Form" ["Cons" [["Ident" "jvm-new"]
- ["Cons" [["Ident" ?class]
+ [["Form" ["Cons" [["Symbol" "jvm-new"]
+ ["Cons" [["Symbol" ?class]
["Cons" [["Tuple" ?classes]
["Cons" [["Tuple" ?args]
["Nil" _]]]]]]]]]]]
(&&host/analyse-jvm-new analyse ?class ?classes ?args)
- [["Form" ["Cons" [["Ident" "jvm-getstatic"]
- ["Cons" [["Ident" ?class]
+ [["Form" ["Cons" [["Symbol" "jvm-getstatic"]
+ ["Cons" [["Symbol" ?class]
["Cons" [["Text" ?field]
["Nil" _]]]]]]]]]
(&&host/analyse-jvm-getstatic analyse ?class ?field)
- [["Form" ["Cons" [["Ident" "jvm-getfield"]
- ["Cons" [["Ident" ?class]
+ [["Form" ["Cons" [["Symbol" "jvm-getfield"]
+ ["Cons" [["Symbol" ?class]
["Cons" [["Text" ?field]
["Cons" [?object
["Nil" _]]]]]]]]]]]
(&&host/analyse-jvm-getfield analyse ?class ?field ?object)
- [["Form" ["Cons" [["Ident" "jvm-putstatic"]
- ["Cons" [["Ident" ?class]
+ [["Form" ["Cons" [["Symbol" "jvm-putstatic"]
+ ["Cons" [["Symbol" ?class]
["Cons" [["Text" ?field]
["Cons" [?value
["Nil" _]]]]]]]]]]]
(&&host/analyse-jvm-putstatic analyse ?class ?field ?value)
- [["Form" ["Cons" [["Ident" "jvm-putfield"]
- ["Cons" [["Ident" ?class]
+ [["Form" ["Cons" [["Symbol" "jvm-putfield"]
+ ["Cons" [["Symbol" ?class]
["Cons" [["Text" ?field]
["Cons" [?object
["Cons" [?value
["Nil" _]]]]]]]]]]]]]
(&&host/analyse-jvm-putfield analyse ?class ?field ?object ?value)
- [["Form" ["Cons" [["Ident" "jvm-invokestatic"]
- ["Cons" [["Ident" ?class]
+ [["Form" ["Cons" [["Symbol" "jvm-invokestatic"]
+ ["Cons" [["Symbol" ?class]
["Cons" [["Text" ?method]
["Cons" [["Tuple" ?classes]
["Cons" [["Tuple" ?args]
["Nil" _]]]]]]]]]]]]]
(&&host/analyse-jvm-invokestatic analyse ?class ?method ?classes ?args)
- [["Form" ["Cons" [["Ident" "jvm-invokevirtual"]
- ["Cons" [["Ident" ?class]
+ [["Form" ["Cons" [["Symbol" "jvm-invokevirtual"]
+ ["Cons" [["Symbol" ?class]
["Cons" [["Text" ?method]
["Cons" [["Tuple" ?classes]
["Cons" [?object
@@ -254,8 +254,8 @@
["Nil" _]]]]]]]]]]]]]]]
(&&host/analyse-jvm-invokevirtual analyse ?class ?method ?classes ?object ?args)
- [["Form" ["Cons" [["Ident" "jvm-invokeinterface"]
- ["Cons" [["Ident" ?class]
+ [["Form" ["Cons" [["Symbol" "jvm-invokeinterface"]
+ ["Cons" [["Symbol" ?class]
["Cons" [["Text" ?method]
["Cons" [["Tuple" ?classes]
["Cons" [?object
@@ -263,8 +263,8 @@
["Nil" _]]]]]]]]]]]]]]]
(&&host/analyse-jvm-invokeinterface analyse ?class ?method ?classes ?object ?args)
- [["Form" ["Cons" [["Ident" "jvm-invokespecial"]
- ["Cons" [["Ident" ?class]
+ [["Form" ["Cons" [["Symbol" "jvm-invokespecial"]
+ ["Cons" [["Symbol" ?class]
["Cons" [["Text" ?method]
["Cons" [["Tuple" ?classes]
["Cons" [?object
@@ -273,117 +273,117 @@
(&&host/analyse-jvm-invokespecial analyse ?class ?method ?classes ?object ?args)
;; Exceptions
- [["Form" ["Cons" [["Ident" "jvm-try"]
+ [["Form" ["Cons" [["Symbol" "jvm-try"]
["Cons" [?body
?handlers]]]]]]
(&&host/analyse-jvm-try analyse ?body (&/fold parse-handler [(list) nil] ?handlers))
- [["Form" ["Cons" [["Ident" "jvm-throw"]
+ [["Form" ["Cons" [["Symbol" "jvm-throw"]
["Cons" [?ex
["Nil" _]]]]]]]
(&&host/analyse-jvm-throw analyse ?ex)
;; Syncronization/monitos
- [["Form" ["Cons" [["Ident" "jvm-monitorenter"]
+ [["Form" ["Cons" [["Symbol" "jvm-monitorenter"]
["Cons" [?monitor
["Nil" _]]]]]]]
(&&host/analyse-jvm-monitorenter analyse ?monitor)
- [["Form" ["Cons" [["Ident" "jvm-monitorexit"]
+ [["Form" ["Cons" [["Symbol" "jvm-monitorexit"]
["Cons" [?monitor
["Nil" _]]]]]]]
(&&host/analyse-jvm-monitorexit analyse ?monitor)
;; Primitive conversions
- [["Form" ["Cons" [["Ident" "jvm-d2f"] ["Cons" [?value ["Nil" _]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-d2f"] ["Cons" [?value ["Nil" _]]]]]]]
(&&host/analyse-jvm-d2f analyse ?value)
- [["Form" ["Cons" [["Ident" "jvm-d2i"] ["Cons" [?value ["Nil" _]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-d2i"] ["Cons" [?value ["Nil" _]]]]]]]
(&&host/analyse-jvm-d2i analyse ?value)
- [["Form" ["Cons" [["Ident" "jvm-d2l"] ["Cons" [?value ["Nil" _]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-d2l"] ["Cons" [?value ["Nil" _]]]]]]]
(&&host/analyse-jvm-d2l analyse ?value)
- [["Form" ["Cons" [["Ident" "jvm-f2d"] ["Cons" [?value ["Nil" _]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-f2d"] ["Cons" [?value ["Nil" _]]]]]]]
(&&host/analyse-jvm-f2d analyse ?value)
- [["Form" ["Cons" [["Ident" "jvm-f2i"] ["Cons" [?value ["Nil" _]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-f2i"] ["Cons" [?value ["Nil" _]]]]]]]
(&&host/analyse-jvm-f2i analyse ?value)
- [["Form" ["Cons" [["Ident" "jvm-f2l"] ["Cons" [?value ["Nil" _]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-f2l"] ["Cons" [?value ["Nil" _]]]]]]]
(&&host/analyse-jvm-f2l analyse ?value)
- [["Form" ["Cons" [["Ident" "jvm-i2b"] ["Cons" [?value ["Nil" _]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-i2b"] ["Cons" [?value ["Nil" _]]]]]]]
(&&host/analyse-jvm-i2b analyse ?value)
- [["Form" ["Cons" [["Ident" "jvm-i2c"] ["Cons" [?value ["Nil" _]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-i2c"] ["Cons" [?value ["Nil" _]]]]]]]
(&&host/analyse-jvm-i2c analyse ?value)
- [["Form" ["Cons" [["Ident" "jvm-i2d"] ["Cons" [?value ["Nil" _]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-i2d"] ["Cons" [?value ["Nil" _]]]]]]]
(&&host/analyse-jvm-i2d analyse ?value)
- [["Form" ["Cons" [["Ident" "jvm-i2f"] ["Cons" [?value ["Nil" _]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-i2f"] ["Cons" [?value ["Nil" _]]]]]]]
(&&host/analyse-jvm-i2f analyse ?value)
- [["Form" ["Cons" [["Ident" "jvm-i2l"] ["Cons" [?value ["Nil" _]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-i2l"] ["Cons" [?value ["Nil" _]]]]]]]
(&&host/analyse-jvm-i2l analyse ?value)
- [["Form" ["Cons" [["Ident" "jvm-i2s"] ["Cons" [?value ["Nil" _]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-i2s"] ["Cons" [?value ["Nil" _]]]]]]]
(&&host/analyse-jvm-i2s analyse ?value)
- [["Form" ["Cons" [["Ident" "jvm-l2d"] ["Cons" [?value ["Nil" _]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-l2d"] ["Cons" [?value ["Nil" _]]]]]]]
(&&host/analyse-jvm-l2d analyse ?value)
- [["Form" ["Cons" [["Ident" "jvm-l2f"] ["Cons" [?value ["Nil" _]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-l2f"] ["Cons" [?value ["Nil" _]]]]]]]
(&&host/analyse-jvm-l2f analyse ?value)
- [["Form" ["Cons" [["Ident" "jvm-l2i"] ["Cons" [?value ["Nil" _]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-l2i"] ["Cons" [?value ["Nil" _]]]]]]]
(&&host/analyse-jvm-l2i analyse ?value)
;; Bitwise operators
- [["Form" ["Cons" [["Ident" "jvm-iand"] ["Cons" [?x ["Cons" [?y ["Nil" _]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-iand"] ["Cons" [?x ["Cons" [?y ["Nil" _]]]]]]]]]
(&&host/analyse-jvm-iand analyse ?x ?y)
- [["Form" ["Cons" [["Ident" "jvm-ior"] ["Cons" [?x ["Cons" [?y ["Nil" _]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-ior"] ["Cons" [?x ["Cons" [?y ["Nil" _]]]]]]]]]
(&&host/analyse-jvm-ior analyse ?x ?y)
- [["Form" ["Cons" [["Ident" "jvm-land"] ["Cons" [?x ["Cons" [?y ["Nil" _]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-land"] ["Cons" [?x ["Cons" [?y ["Nil" _]]]]]]]]]
(&&host/analyse-jvm-land analyse ?x ?y)
- [["Form" ["Cons" [["Ident" "jvm-lor"] ["Cons" [?x ["Cons" [?y ["Nil" _]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-lor"] ["Cons" [?x ["Cons" [?y ["Nil" _]]]]]]]]]
(&&host/analyse-jvm-lor analyse ?x ?y)
- [["Form" ["Cons" [["Ident" "jvm-lxor"] ["Cons" [?x ["Cons" [?y ["Nil" _]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-lxor"] ["Cons" [?x ["Cons" [?y ["Nil" _]]]]]]]]]
(&&host/analyse-jvm-lxor analyse ?x ?y)
- [["Form" ["Cons" [["Ident" "jvm-lshl"] ["Cons" [?x ["Cons" [?y ["Nil" _]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-lshl"] ["Cons" [?x ["Cons" [?y ["Nil" _]]]]]]]]]
(&&host/analyse-jvm-lshl analyse ?x ?y)
- [["Form" ["Cons" [["Ident" "jvm-lshr"] ["Cons" [?x ["Cons" [?y ["Nil" _]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-lshr"] ["Cons" [?x ["Cons" [?y ["Nil" _]]]]]]]]]
(&&host/analyse-jvm-lshr analyse ?x ?y)
- [["Form" ["Cons" [["Ident" "jvm-lushr"] ["Cons" [?x ["Cons" [?y ["Nil" _]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-lushr"] ["Cons" [?x ["Cons" [?y ["Nil" _]]]]]]]]]
(&&host/analyse-jvm-lushr analyse ?x ?y)
;; Arrays
- [["Form" ["Cons" [["Ident" "jvm-new-array"] ["Cons" [["Ident" ?class] ["Cons" [["Int" ?length] ["Nil" _]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-new-array"] ["Cons" [["Symbol" ?class] ["Cons" [["Int" ?length] ["Nil" _]]]]]]]]]
(&&host/analyse-jvm-new-array analyse ?class ?length)
- [["Form" ["Cons" [["Ident" "jvm-aastore"] ["Cons" [?array ["Cons" [["Int" ?idx] ["Cons" [?elem ["Nil" _]]]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-aastore"] ["Cons" [?array ["Cons" [["Int" ?idx] ["Cons" [?elem ["Nil" _]]]]]]]]]]]
(&&host/analyse-jvm-aastore analyse ?array ?idx ?elem)
- [["Form" ["Cons" [["Ident" "jvm-aaload"] ["Cons" [?array ["Cons" [["Int" ?idx] ["Nil" _]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-aaload"] ["Cons" [?array ["Cons" [["Int" ?idx] ["Nil" _]]]]]]]]]
(&&host/analyse-jvm-aaload analyse ?array ?idx)
;; Classes & interfaces
- [["Form" ["Cons" [["Ident" "jvm-class"] ["Cons" [["Ident" ?name] ["Cons" [["Ident" ?super-class] ["Cons" [["Tuple" ?fields] ["Nil" _]]]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-class"] ["Cons" [["Symbol" ?name] ["Cons" [["Symbol" ?super-class] ["Cons" [["Tuple" ?fields] ["Nil" _]]]]]]]]]]]
(&&host/analyse-jvm-class analyse ?name ?super-class ?fields)
- [["Form" ["Cons" [["Ident" "jvm-interface"] ["Cons" [["Ident" ?name] ?members]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-interface"] ["Cons" [["Symbol" ?name] ?members]]]]]]
(&&host/analyse-jvm-interface analyse ?name ?members)
;; Programs
- [["Form" ["Cons" [["Ident" "jvm-program"] ["Cons" [["Ident" ?args] ["Cons" [?body ["Nil" _]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-program"] ["Cons" [["Symbol" ?args] ["Cons" [?body ["Nil" _]]]]]]]]]
(&&host/analyse-jvm-program analyse ?args ?body)
[_]
diff --git a/src/lux/analyser/case.clj b/src/lux/analyser/case.clj
index cd5bf9e39..1574218c3 100644
--- a/src/lux/analyser/case.clj
+++ b/src/lux/analyser/case.clj
@@ -10,7 +10,7 @@
;; [Resources]
(defn locals [member]
(matchv ::M/objects [member]
- [["Ident" ?name]]
+ [["Symbol" ?name]]
(&/|list ?name)
[["Tuple" ?submembers]]
diff --git a/src/lux/analyser/def.clj b/src/lux/analyser/def.clj
index e83bbb85d..45bb5aca7 100644
--- a/src/lux/analyser/def.clj
+++ b/src/lux/analyser/def.clj
@@ -14,7 +14,7 @@
(defn <name> [module name]
(fn [state]
(return* state
- (->> state (&/get$ "modules") (&/|get module) (&/get$ <category>) (&/|get name) boolean))))
+ (->> state (&/get$ "modules") (&/|get module) (&/get$ <category>) (&/|contains? name)))))
defined? "defs"
macro? "macros"
@@ -31,5 +31,16 @@
bound (&/V "Expression" (&/T (&/V "global" (&/T module name)) type))]
(return* (->> state
(&/update$ "modules" (fn [ms] (&/|update module (fn [m] (&/update$ "defs" #(&/|put name type %) m)) ms)))
- (&/update$ "global-env" #(&/|merge (&/|table full-name bound, name bound) %)))
+ (&/update$ "global-env" #(matchv ::M/objects [%]
+ [["None" _]]
+ (assert false)
+
+ [["Some" table]]
+ (&/V "Some" (&/update$ "locals" (fn [locals]
+ (&/update$ "mappings" (fn [mappings]
+ (&/|merge (&/|table full-name bound, name bound)
+ mappings))
+ locals))
+ table))
+ )))
nil))))
diff --git a/src/lux/analyser/env.clj b/src/lux/analyser/env.clj
index 816332404..4d1af9aa9 100644
--- a/src/lux/analyser/env.clj
+++ b/src/lux/analyser/env.clj
@@ -13,20 +13,20 @@
(fn [state]
(let [old-mappings (->> state (&/get$ "local-envs") &/|head (&/get$ "locals") (&/get$ "mappings"))
=return (body (&/update$ "local-envs"
- (fn [[top & stack]]
- (let [bound-unit (&/V "local" (-> top (&/get$ "locals") (&/get$ "counter")))]
- (cons (-> top
- (&/update$ "locals" #(&/update$ "counter" inc %))
- (&/update$ "locals" #(&/update$ "mappings" (fn [m] (&/|put name (&/V "Expression" (&/T bound-unit type)) m)) %)))
- stack)))
+ (fn [stack]
+ (let [bound-unit (&/V "local" (->> (&/|head stack) (&/get$ "locals") (&/get$ "counter")))]
+ (&/|cons (->> (&/|head stack)
+ (&/update$ "locals" #(&/update$ "counter" inc %))
+ (&/update$ "locals" #(&/update$ "mappings" (fn [m] (&/|put name (&/V "Expression" (&/T bound-unit type)) m)) %)))
+ (&/|tail stack))))
state))]
(matchv ::M/objects [=return]
[["Right" [?state ?value]]]
- (return* (&/update$ "local-envs" (fn [[top* & stack*]]
- (cons (->> top*
- (&/update$ "locals" #(&/update$ "counter" dec %))
- (&/update$ "locals" #(&/set$ "mappings" old-mappings %)))
- stack*))
+ (return* (&/update$ "local-envs" (fn [stack*]
+ (&/|cons (->> (&/|head stack*)
+ (&/update$ "locals" #(&/update$ "counter" dec %))
+ (&/update$ "locals" #(&/set$ "mappings" old-mappings %)))
+ (&/|tail stack*)))
?state)
?value)
diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj
index 15680d681..6fff76590 100644
--- a/src/lux/analyser/host.clj
+++ b/src/lux/analyser/host.clj
@@ -10,21 +10,13 @@
[env :as &&env])))
;; [Utils]
-(defn ^:private ->seq [xs]
- (matchv ::M/objects [xs]
- [["Nil" _]]
- (list)
-
- [["Cons" [x xs*]]]
- (cons x (->seq xs*))))
-
(defn ^:private extract-ident [ident]
(matchv ::M/objects [ident]
- [["Ident" ?ident]]
+ [["Symbol" ?ident]]
(return ?ident)
[_]
- (fail "[Analyser Error] Can't extract Ident.")))
+ (fail "[Analyser Error] Can't extract Symbol.")))
;; [Resources]
(do-template [<name> <output-tag> <input-class> <output-class>]
@@ -144,7 +136,7 @@
(defn analyse-jvm-new-array [analyse ?class ?length]
(exec [=class (&host/full-class-name ?class)]
(return (&/|list (&/V "Expression" (&/T (&/V "jvm-new-array" (&/T =class ?length)) (&/V "array" (&/T (&/V "Data" (to-array [=class (&/V "Nil" nil)]))
- (&/V "Nil" nil)))))))))
+ (&/V "Nil" nil)))))))))
(defn analyse-jvm-aastore [analyse ?array ?idx ?elem]
(exec [=array+=elem (&&/analyse-2 analyse ?array ?elem)
@@ -161,13 +153,13 @@
(defn analyse-jvm-class [analyse ?name ?super-class ?fields]
(exec [?fields (&/map% (fn [?field]
- (matchv ::M/objects [?field]
- [["Tuple" ["Cons" [["Ident" ?class] ["Cons" [["Ident" ?field-name] ["Nil" _]]]]]]]
- (return [?class ?field-name])
-
- [_]
- (fail "[Analyser Error] Fields must be Tuple2 of [Ident, Ident]")))
- ?fields)
+ (matchv ::M/objects [?field]
+ [["Tuple" ["Cons" [["Symbol" ?class] ["Cons" [["Symbol" ?field-name] ["Nil" _]]]]]]]
+ (return [?class ?field-name])
+
+ [_]
+ (fail "[Analyser Error] Fields must be Tuple2 of [Symbol, Symbol]")))
+ ?fields)
:let [=fields (into {} (for [[class field] ?fields]
[field {:access :public
:type class}]))]
@@ -175,25 +167,26 @@
(return (&/|list (&/V "Statement" (&/V "jvm-class" (&/T $module ?name ?super-class =fields {})))))))
(defn analyse-jvm-interface [analyse ?name ?members]
- ;; (prn 'analyse-jvm-interface ?name ?members)
- (exec [?members (&/map% (fn [member]
- ;; (prn 'analyse-jvm-interface (&/show-ast member))
- (matchv ::M/objects [member]
- [["Form" ["Cons" [["Ident" ":"]
- ["Cons" [["Ident" ?member-name]
- ["Cons" [["Form" ["Cons" [["Ident" "->"]
- ["Cons" [["Tuple" ?inputs]
- ["Cons" [["Ident" ?output]
- ["Nil" _]]]]]]]]
- ["Nil" _]]]]]]]]]
- (do ;; (prn 'analyse-jvm-interface ?member-name ?inputs ?output)
- (exec [?inputs (&/map% extract-ident (->seq ?inputs))]
- (return [?member-name [?inputs ?output]])))
-
- [_]
- (fail "[Analyser Error] Invalid method signature!")))
- (->seq ?members))
- :let [=methods (into {} (for [[method [inputs output]] ?members]
+ (prn 'analyse-jvm-interface ?name ?members)
+ (exec [=members (&/map% (fn [member]
+ ;; (prn 'analyse-jvm-interface (&/show-ast member))
+ (matchv ::M/objects [member]
+ [["Form" ["Cons" [["Symbol" ":"]
+ ["Cons" [["Symbol" ?member-name]
+ ["Cons" [["Form" ["Cons" [["Symbol" "->"]
+ ["Cons" [["Tuple" ?inputs]
+ ["Cons" [["Symbol" ?output]
+ ["Nil" _]]]]]]]]
+ ["Nil" _]]]]]]]]]
+ (do ;; (prn 'analyse-jvm-interface ?member-name ?inputs ?output)
+ (exec [?inputs (&/map% extract-ident ?inputs)]
+ (return [?member-name [?inputs ?output]])))
+
+ [_]
+ (fail "[Analyser Error] Invalid method signature!")))
+ ?members)
+ :let [_ (prn '=members =members)
+ =methods (into {} (for [[method [inputs output]] (&/->seq =members)]
[method {:access :public
:type [inputs output]}]))]
$module &/get-module-name]
@@ -208,10 +201,10 @@
(defn analyse-jvm-try [analyse ?body [?catches ?finally]]
(exec [=body (&&/analyse-1 analyse ?body)
=catches (&/map% (fn [[?ex-class ?ex-arg ?catch-body]]
- (&&env/with-local ?ex-arg (&/V "Data" (&/T ?ex-class (&/V "Nil" nil)))
- (exec [=catch-body (&&/analyse-1 analyse ?catch-body)]
- (return [?ex-class ?ex-arg =catch-body]))))
- ?catches)
+ (&&env/with-local ?ex-arg (&/V "Data" (&/T ?ex-class (&/V "Nil" nil)))
+ (exec [=catch-body (&&/analyse-1 analyse ?catch-body)]
+ (return [?ex-class ?ex-arg =catch-body]))))
+ ?catches)
=finally (&&/analyse-1 analyse ?finally)
=body-type (&&/expr-type =body)]
(return (&/|list (&/V "Expression" (&/T (&/V "jvm-try" (&/T =body =catches =finally)) =body-type))))))
diff --git a/src/lux/analyser/lambda.clj b/src/lux/analyser/lambda.clj
index e70fd7bf6..758d0bb6b 100644
--- a/src/lux/analyser/lambda.clj
+++ b/src/lux/analyser/lambda.clj
@@ -13,13 +13,13 @@
(&env/with-local arg arg-type
(exec [=return body
=captured &env/captured-vars]
- (return [scope-name =captured =return])))))))
+ (return (&/T scope-name =captured =return))))))))
(defn close-over [scope ident register frame]
(matchv ::M/objects [register]
[["Expression" [_ register-type]]]
(let [register* (&/V "Expression" (&/T (&/V "captured" (&/T scope (->> frame (&/get$ "closure") (&/get$ "counter")) register)) register-type))]
- [register* (&/update$ "closure" #(-> %
- (&/update$ "counter" inc)
- (&/update$ "mappings" (fn [mps] (&/|put ident register* mps))))
- frame)])))
+ (&/T register* (&/update$ "closure" #(->> %
+ (&/update$ "counter" inc)
+ (&/update$ "mappings" (fn [mps] (&/|put ident register* mps))))
+ frame)))))
diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj
index c0124936e..daec2bd0a 100644
--- a/src/lux/analyser/lux.clj
+++ b/src/lux/analyser/lux.clj
@@ -2,7 +2,7 @@
(:require (clojure [template :refer [do-template]])
[clojure.core.match :as M :refer [matchv]]
clojure.core.match.array
- (lux [base :as & :refer [exec return return* fail fail*]]
+ (lux [base :as & :refer [exec return return* fail fail* |let]]
[parser :as &parser]
[type :as &type]
[macro :as &macro]
@@ -23,48 +23,64 @@
(defn analyse-record [analyse ?elems]
(exec [=elems (&/map% (fn [kv]
- (matchv ::M/objects [kv]
- [[k v]]
- (exec [=v (&&/analyse-1 analyse v)]
- (return (to-array [k =v])))))
- ?elems)
+ (matchv ::M/objects [kv]
+ [[k v]]
+ (exec [=v (&&/analyse-1 analyse v)]
+ (return (to-array [k =v])))))
+ ?elems)
=elems-types (&/map% (fn [kv]
- (matchv ::M/objects [kv]
- [[k v]]
- (exec [=v (&&/expr-type v)]
- (return (to-array [k =v])))))
- =elems)
+ (matchv ::M/objects [kv]
+ [[k v]]
+ (exec [=v (&&/expr-type v)]
+ (return (to-array [k =v])))))
+ =elems)
;; :let [_ (prn 'analyse-tuple =elems)]
]
(return (&/|list (&/V "Expression" (&/T (&/V "record" =elems) (&/V "Record" =elems-types)))))))
(defn analyse-ident [analyse ident]
+ (prn 'analyse-ident ident)
(exec [module-name &/get-module-name]
(fn [state]
- (let [[top & stack*] (&/get$ "local-envs" state)]
- (if-let [=bound (or (->> top (&/get$ "locals") (&/get$ "mappings") (&/|get ident))
- (->> top (&/get$ "closure") (&/get$ "mappings") (&/|get ident)))]
- (return* state (&/|list =bound))
- (let [no-binding? #(and (->> % (&/get$ "locals") (&/get$ "mappings") (&/|contains? ident) not)
- (->> % (&/get$ "closure") (&/get$ "mappings") (&/|contains? ident) not))
- [inner outer] (split-with no-binding? stack*)]
- (if (empty? outer)
- (if-let [global (->> state (&/get$ "global-env") (&/|get ident))]
- (return* state (&/|list global))
- (fail* (str "[Analyser Error] Unresolved identifier: " ident)))
- (let [in-stack (cons top inner)
- scopes (rest (reductions #(cons (&/get$ "name" %2) %1) (map #(&/get$ "name" %) outer) (reverse in-stack)))
- _ (prn 'in-stack module-name ident (map #(&/get$ "name" %) in-stack) scopes)
- [=local inner*] (reduce (fn [[register new-inner] [frame in-scope]]
- (let [[register* frame*] (&&lambda/close-over (cons module-name (reverse in-scope)) ident register frame)]
- [register* (cons frame* new-inner)]))
- [(or (->> outer &/|head (&/get$ "locals") (&/get$ "mappings") (&/|get ident))
- (->> outer &/|head (&/get$ "closure") (&/get$ "mappings") (&/|get ident)))
- '()]
- (map vector (reverse in-stack) scopes)
- )]
- (return* (&/set$ "local-envs" (&/|concat inner* outer) state) (&/|list =local)))
- ))
+ (prn 'module-name module-name)
+ (prn '(&/get$ "local-envs" state) (&/get$ "local-envs" state))
+ (prn '(&/->seq (&/get$ "local-envs" state)) (&/->seq (&/get$ "local-envs" state)))
+ (println (&/show-state state))
+ (let [stack (&/get$ "local-envs" state)]
+ (matchv ::M/objects [(&/get$ "local-envs" state)]
+ [["Nil" _]]
+ (fail* (str "[Analyser Error] Unresolved identifier: " ident))
+
+ [["Cons" [top stack*]]]
+ (if-let [=bound (or (->> stack &/|head (&/get$ "locals") (&/get$ "mappings") (&/|get ident))
+ (->> stack &/|head (&/get$ "closure") (&/get$ "mappings") (&/|get ident)))]
+ (return* state (&/|list =bound))
+ (|let [no-binding? #(and (->> % (&/get$ "locals") (&/get$ "mappings") (&/|contains? ident) not)
+ (->> % (&/get$ "closure") (&/get$ "mappings") (&/|contains? ident) not))
+ [inner outer] (&/|split-with no-binding? stack*)]
+ (matchv ::M/objects [outer]
+ [["Nil" _]]
+ (if-let [global (->> state (&/get$ "global-env") &/from-some (&/get$ "locals") (&/get$ "mappings") (&/|get ident))]
+ (return* state (&/|list global))
+ (fail* (str "[Analyser Error] Unresolved identifier: " ident)))
+
+ [["Cons" [top-outer _]]]
+ (let [in-stack (&/|cons top inner)
+ scopes (&/|tail (&/folds #(&/|cons (&/get$ "name" %2) %1)
+ (&/|map #(&/get$ "name" %) outer)
+ (&/|reverse in-stack)))
+ _ (prn 'in-stack module-name ident (&/->seq (&/|map #(&/get$ "name" %) in-stack)) scopes)
+ [=local inner*] (&/fold (fn [register+new-inner frame+in-scope]
+ (|let [[register new-inner] register+new-inner
+ [frame in-scope] frame+in-scope
+ [register* frame*] (&&lambda/close-over (&/|cons module-name (&/|reverse in-scope)) ident register frame)]
+ (&/T register* (&/|cons frame* new-inner))))
+ (&/T (or (->> top-outer (&/get$ "locals") (&/get$ "mappings") (&/|get ident))
+ (->> top-outer (&/get$ "closure") (&/get$ "mappings") (&/|get ident)))
+ (&/|list))
+ (&/zip2 (&/|reverse in-stack) scopes))]
+ (return* (&/set$ "local-envs" (&/|++ inner* outer) state) (&/|list =local)))
+ )))
))
)))
@@ -72,17 +88,18 @@
(exec [=args (&/flat-map% analyse ?args)
=fn-type (&&/expr-type =fn)
=apply+=apply-type (&/fold (fn [[=fn =fn-type] =input]
- (exec [=input-type (&&/expr-type =input)
- =output-type (&type/apply-lambda =fn-type =input-type)]
- (return [(&/V "apply" (&/T =fn =input)) =output-type])))
- [=fn =fn-type]
- =args)
+ (exec [=input-type (&&/expr-type =input)
+ =output-type (&type/apply-lambda =fn-type =input-type)]
+ (return [(&/V "apply" (&/T =fn =input)) =output-type])))
+ [=fn =fn-type]
+ =args)
:let [[=apply =apply-type] (matchv ::M/objects [=apply+=apply-type]
[[=apply =apply-type]]
[=apply =apply-type])]]
(return (&/|list (&/V "Expression" (&/T =apply =apply-type))))))
(defn analyse-apply [analyse =fn ?args]
+ (prn 'analyse-apply (aget =fn 0))
(exec [loader &/loader]
(matchv ::M/objects [=fn]
[["Expression" [=fn-form =fn-type]]]
@@ -90,7 +107,7 @@
[["global" [?module ?name]]]
(exec [macro? (&&def/macro? ?module ?name)]
(if macro?
- (let [macro-class (&host/location (list ?module ?name))]
+ (let [macro-class (&host/location (&/|list ?module ?name))]
(exec [macro-expansion (&macro/expand loader macro-class ?args)
output (&/flat-map% analyse macro-expansion)]
(return output)))
@@ -105,24 +122,24 @@
(defn analyse-case [analyse ?value ?branches]
;; (prn 'analyse-case ?value ?branches)
- (exec [:let [num-branches (count ?branches)]
+ (exec [:let [num-branches (&/|length ?branches)]
_ (&/assert! (and (> num-branches 0) (even? num-branches))
"[Analyser Error] Unbalanced branches in \"case'\" expression.")
- :let [branches (partition 2 ?branches)
- locals-per-branch (map (comp &&case/locals first) branches)
- max-locals (reduce max 0 (map count locals-per-branch))]
+ :let [branches (&/|as-pairs ?branches)
+ locals-per-branch (&/|map (comp &&case/locals &/|first) branches)
+ max-locals (&/fold max 0 (&/|map &/|length locals-per-branch))]
;; :let [_ (prn '[branches locals-per-branch max-locals] [branches locals-per-branch max-locals])]
base-register &&env/next-local-idx
;; :let [_ (prn 'base-register base-register)]
=value (&&/analyse-1 analyse ?value)
;; :let [_ (prn '=value =value)]
=bodies (&/map% (partial &&case/analyse-branch analyse max-locals)
- (map vector locals-per-branch (map second branches)))
+ (&/zip2 locals-per-branch (&/|map &/|second branches)))
;; :let [_ (prn '=bodies =bodies)]
;; :let [_ (prn 'analyse-case/=bodies =bodies)]
=body-types (&/map% &&/expr-type =bodies)
:let [=case-type (&/fold &type/merge (&/|table) =body-types)]
- :let [=branches (map vector (map first branches) =bodies)]]
+ :let [=branches (&/zip2 (&/|map &/|first branches) =bodies)]]
(return (&/|list (&/V "Expression" (&/T (&/V "case" (&/T =value base-register max-locals =branches)) =case-type))))))
(defn analyse-lambda [analyse ?self ?arg ?body]
diff --git a/src/lux/base.clj b/src/lux/base.clj
index 0706a563b..74b1a6d9e 100644
--- a/src/lux/base.clj
+++ b/src/lux/base.clj
@@ -30,7 +30,8 @@
(loop [idx 0]
(if (< idx size)
(if (= slot (aget record idx))
- (aset record (+ 1 idx) value)
+ (doto record
+ (aset (+ 1 idx) value))
(recur (+ 2 idx)))
(assert false)))))
@@ -45,6 +46,14 @@
(defn return* [state value]
(V "Right" (T state value)))
+(defmacro |let [bindings body]
+ (reduce (fn [inner [left right]]
+ `(matchv ::M/objects [~right]
+ [~left]
+ ~inner))
+ body
+ (reverse (partition 2 bindings))))
+
(defmacro |list [& elems]
(reduce (fn [tail head]
`(V "Cons" (T ~head ~tail)))
@@ -58,13 +67,14 @@
(partition 2 elems)))
(defn |get [slot table]
+ (prn '|get slot (aget table 0))
(matchv ::M/objects [table]
[["Nil" _]]
- (V "Left" (str "Not found: " slot))
+ nil
[["Cons" [[k v] table*]]]
(if (= k slot)
- (V "Right" v)
+ v
(|get slot table*))))
(defn |put [slot value table]
@@ -78,6 +88,7 @@
(V "Cons" (T (T k v) (|put slot value table*))))))
(defn |merge [table1 table2]
+ (prn '|merge (aget table1 0) (aget table2 0))
(matchv ::M/objects [table2]
[["Nil" _]]
table1
@@ -103,6 +114,14 @@
[["Cons" [x _]]]
x))
+(defn |tail [xs]
+ (matchv ::M/objects [xs]
+ [["Nil" _]]
+ (assert false)
+
+ [["Cons" [_ xs*]]]
+ xs*))
+
;; [Resources/Monads]
(defn fail [message]
(fn [_]
@@ -113,8 +132,10 @@
(V "Right" (T state value))))
(defn bind [m-value step]
+ ;; (prn 'bind m-value step)
(fn [state]
(let [inputs (m-value state)]
+ ;; (prn 'bind/inputs (aget inputs 0))
(matchv ::M/objects [inputs]
[["Right" [?state ?datum]]]
((step ?datum) ?state)
@@ -146,13 +167,14 @@
(defn |cons [head tail]
(V "Cons" (T head tail)))
-(defn |concat [xs ys]
+(defn |++ [xs ys]
+ (prn '|++ (and xs (aget xs 0)) (and ys (aget ys 0)))
(matchv ::M/objects [xs]
[["Nil" _]]
ys
[["Cons" [x xs*]]]
- (V "Cons" (T x (|concat xs* ys)))))
+ (V "Cons" (T x (|++ xs* ys)))))
(defn |map [f xs]
(matchv ::M/objects [xs]
@@ -168,7 +190,18 @@
xs
[["Cons" [x xs*]]]
- (|concat (f x) (flat-map f xs*))))
+ (|++ (f x) (flat-map f xs*))))
+
+(defn |split-with [p xs]
+ (matchv ::M/objects [xs]
+ [["Nil" _]]
+ (T xs xs)
+
+ [["Cons" [x xs*]]]
+ (if (p x)
+ (|let [[pre post] (|split-with p xs*)]
+ (T (|cons x pre) post))
+ (T (V "Nil" nil) xs))))
(defn |contains? [k table]
(matchv ::M/objects [table]
@@ -187,9 +220,33 @@
[["Cons" [x xs*]]]
(fold f (f init x) xs*)))
+(defn folds [f init xs]
+ (matchv ::M/objects [xs]
+ [["Nil" _]]
+ (|list init)
+
+ [["Cons" [x xs*]]]
+ (|cons init (folds f (f init x) xs*))))
+
(defn |length [xs]
+ (prn '|length (aget xs 0))
(fold (fn [acc _] (inc acc)) 0 xs))
+(let [|range* (fn |range* [from to]
+ (if (< from to)
+ (V "Cons" (T from (|range* (inc from) to)))
+ (V "Nil" nil)))]
+ (defn |range [n]
+ (|range* 0 n)))
+
+(defn |first [pair]
+ (|let [[_1 _2] pair]
+ _1))
+
+(defn |second [pair]
+ (|let [[_1 _2] pair]
+ _2))
+
(defn zip2 [xs ys]
(matchv ::M/objects [xs ys]
[["Cons" [x xs*]] ["Cons" [y ys*]]]
@@ -217,28 +274,19 @@
[["Cons" [x xs*]]]
(V "Cons" (T x (V "Cons" (T sep (|interpose sep xs*)))))))
-(let [cons% (fn [head tail]
- (V "Cons" (T head tail)))
- ++% (fn ++% [xs ys]
- (matchv ::M/objects [xs]
- [["Nil" _]]
- ys
-
- [["Cons" [x xs*]]]
- (V "Cons" (T x (++% xs* ys)))))]
- (do-template [<name> <joiner>]
- (defn <name> [f xs]
- (matchv ::M/objects [xs]
- [["Nil" _]]
- (return xs)
-
- [["Cons" [x xs*]]]
- (exec [y (f x)
- ys (<name> f xs*)]
- (return (<joiner> y ys)))))
-
- map% cons%
- flat-map% ++%))
+(do-template [<name> <joiner>]
+ (defn <name> [f xs]
+ (matchv ::M/objects [xs]
+ [["Nil" _]]
+ (return xs)
+
+ [["Cons" [x xs*]]]
+ (exec [y (f x)
+ ys (<name> f xs*)]
+ (return (<joiner> y ys)))))
+
+ map% |cons
+ flat-map% |++)
(defn |as-pairs [xs]
(matchv ::M/objects [xs]
@@ -388,7 +436,7 @@
"locals" +init-bindings+
"closure" +init-bindings+))
-(defn init-state []
+(defn init-state [_]
(R "source" (V "None" nil)
"modules" (|list)
"global-env" (V "None" nil)
@@ -398,18 +446,54 @@
"loader" (-> (java.io.File. "./output/") .toURL vector into-array java.net.URLClassLoader.)
"eval-ctor" 0))
+(defn from-some [some]
+ (matchv ::M/objects [some]
+ [["Some" datum]]
+ datum
+
+ [_]
+ (assert false)))
+
+(defn show-state [state]
+ (let [source (get$ "source" state)
+ modules (get$ "modules" state)
+ global-env (get$ "global-env" state)
+ local-envs (get$ "local-envs" state)
+ types (get$ "types" state)
+ writer (get$ "writer" state)
+ loader (get$ "loader" state)
+ eval-ctor (get$ "eval-ctor" state)]
+ (str "{"
+ (->> (for [slot ["source", "modules", "global-env", "local-envs", "types", "writer", "loader", "eval-ctor"]
+ :let [value (get$ slot state)]]
+ (str "#" slot " " (case slot
+ "source" "???"
+ "modules" "???"
+ "global-env" "???"
+ "local-envs" (|length value)
+ "types" "???"
+ "writer" "???"
+ "loader" "???"
+ "eval-ctor" value)))
+ (interpose " ")
+ (reduce str ""))
+ "}")))
+
(def get-eval-ctor
(fn [state]
(return* (update$ "eval-ctor" inc state) (get$ "eval-ctor" state))))
(def get-writer
(fn [state]
- (matchv ::M/objects [(get$ "writer" state)]
- [["Some" datum]]
- (return* state datum)
+ (let [writer* (get$ "writer" state)]
+ (prn 'get-writer (class writer*))
+ (prn 'get-writer (aget writer* 0))
+ (matchv ::M/objects [writer*]
+ [["Some" datum]]
+ (return* state datum)
- [_]
- (fail* "Writer hasn't been set."))))
+ [_]
+ (fail* "Writer hasn't been set.")))))
(def get-top-local-env
(fn [state]
@@ -417,12 +501,32 @@
(def get-current-module-env
(fn [state]
- (matchv ::M/objects [(get$ "global-env" state)]
- [["Some" datum]]
- (return* state datum)
+ (let [global-env* (get$ "global-env" state)]
+ (prn 'get-current-module-env (aget global-env* 0))
+ (matchv ::M/objects [global-env*]
+ [["Some" datum]]
+ (return* state datum)
- [_]
- (fail* "Module hasn't been set."))))
+ [_]
+ (fail* "Module hasn't been set.")))))
+
+(defn ->seq [xs]
+ (matchv ::M/objects [xs]
+ [["Nil" _]]
+ (list)
+
+ [["Cons" [x xs*]]]
+ (cons x (->seq xs*))))
+
+(defn ->list [seq]
+ (if (empty? seq)
+ (|list)
+ (|cons (first seq) (->list (rest seq)))))
+
+(defn |repeat [n x]
+ (if (> n 0)
+ (|cons x (|repeat (dec n) x))
+ (|list)))
(def get-module-name
(exec [module get-current-module-env]
@@ -430,36 +534,45 @@
(defn ^:private with-scope [name body]
(fn [state]
- (let [output (body (update$ "local-envs" #(conj % (env name)) state))]
+ (let [output (body (update$ "local-envs" #(|cons (env name) %) state))]
(matchv ::M/objects [output]
[["Right" [state* datum]]]
- (return* (update$ "local-envs" rest state*) datum)
+ (return* (update$ "local-envs" |tail state*) datum)
[_]
output))))
(defn with-closure [body]
- (exec [[local? closure-name] (try-all% (list (exec [top get-top-local-env]
- (return [true (->> top (get$ "inner-closures") str)]))
- (exec [global get-current-module-env]
- (return [false (->> global (get$ "inner-closures") str)]))))]
- (fn [state]
- (let [body* (with-scope closure-name
- body)]
- (body* (if local?
- (update$ "local-envs" #(cons (update$ "inner-closures" inc (first %))
- (rest %))
- state)
- (update$ "global-env" #(update$ "inner-closures" inc %) state)))))))
+ (exec [closure-info (try-all% (|list (exec [top get-top-local-env]
+ (return (T true (->> top (get$ "inner-closures") str))))
+ (exec [global get-current-module-env]
+ (return (T false (->> global (get$ "inner-closures") str))))))]
+ (matchv ::M/objects [closure-info]
+ [[local? closure-name]]
+ (fn [state]
+ (let [body* (with-scope closure-name
+ body)]
+ (body* (if local?
+ (update$ "local-envs" #(|cons (update$ "inner-closures" inc (|head %))
+ (|tail %))
+ state)
+ (update$ "global-env" #(matchv ::M/objects [%]
+ [["Some" global-env]]
+ (V "Some" (update$ "inner-closures" inc global-env))
+
+ [_]
+ %)
+ state)))))
+ )))
(def get-scope-name
(exec [module-name get-module-name]
(fn [state]
- (return* state (->> state (get$ "local-envs") (map #(get$ "name" %)) reverse (cons module-name))))))
+ (return* state (->> state (get$ "local-envs") (|map #(get$ "name" %)) |reverse (|cons module-name))))))
(defn with-writer [writer body]
(fn [state]
- (let [output (body (set$ "writer" writer state))]
+ (let [output (body (set$ "writer" (V "Some" writer) state))]
(matchv ::M/objects [output]
[["Right" [?state ?value]]]
(return* (set$ "writer" (get$ "writer" state) ?state) ?value)
@@ -490,7 +603,7 @@
[["Tag" ?tag]]
(str "#" ?tag)
- [["Ident" ?ident]]
+ [["Symbol" ?ident]]
?ident
[["Tuple" ?elems]]
diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj
index fd60537e5..1489cceb2 100644
--- a/src/lux/compiler.clj
+++ b/src/lux/compiler.clj
@@ -28,287 +28,288 @@
;; [Utils/Compilers]
(defn ^:private compile-expression [syntax]
- ;; (prn 'compile-expression syntax)
+ (prn 'compile-expression (aget syntax 0))
(matchv ::M/objects [syntax]
- [["Expression" ?form ?type]]
- (matchv ::M/objects [?form]
- [["bool" ?value]]
- (&&lux/compile-bool compile-expression ?type ?value)
-
- [["int" ?value]]
- (&&lux/compile-int compile-expression ?type ?value)
-
- [["real" ?value]]
- (&&lux/compile-real compile-expression ?type ?value)
-
- [["char" ?value]]
- (&&lux/compile-char compile-expression ?type ?value)
-
- [["text" ?value]]
- (&&lux/compile-text compile-expression ?type ?value)
-
- [["tuple" ?elems]]
- (&&lux/compile-tuple compile-expression ?type ?elems)
-
- [["record" ?elems]]
- (&&lux/compile-record compile-expression ?type ?elems)
-
- [["local" ?idx]]
- (&&lux/compile-local compile-expression ?type ?idx)
-
- [["captured" [?scope ?captured-id ?source]]]
- (&&lux/compile-captured compile-expression ?type ?scope ?captured-id ?source)
-
- [["global" [?owner-class ?name]]]
- (&&lux/compile-global compile-expression ?type ?owner-class ?name)
-
- [["call" [?fn ?args]]]
- (&&lux/compile-call compile-expression ?type ?fn ?args)
-
- [["variant" [?tag ?members]]]
- (&&lux/compile-variant compile-expression ?type ?tag ?members)
-
- [["case" [?variant ?base-register ?num-registers ?branches]]]
- (&&case/compile-case compile-expression ?type ?variant ?base-register ?num-registers ?branches)
-
- [["lambda" [?scope ?env ?args ?body]]]
- (&&lambda/compile-lambda compile-expression ?scope ?env ?args ?body)
-
- [["get" [?slot ?record]]]
- (&&lux/compile-get compile-expression ?type ?slot ?record)
-
- [["set" [?slot ?value ?record]]]
- (&&lux/compile-set compile-expression ?type ?slot ?value ?record)
-
- ;; Integer arithmetic
- [["jvm-iadd" [?x ?y]]]
- (&&host/compile-jvm-iadd compile-expression ?type ?x ?y)
-
- [["jvm-isub" [?x ?y]]]
- (&&host/compile-jvm-isub compile-expression ?type ?x ?y)
-
- [["jvm-imul" [?x ?y]]]
- (&&host/compile-jvm-imul compile-expression ?type ?x ?y)
-
- [["jvm-idiv" [?x ?y]]]
- (&&host/compile-jvm-idiv compile-expression ?type ?x ?y)
-
- [["jvm-irem" [?x ?y]]]
- (&&host/compile-jvm-irem compile-expression ?type ?x ?y)
-
- [["jvm-ieq" [?x ?y]]]
- (&&host/compile-jvm-ieq compile-expression ?type ?x ?y)
-
- [["jvm-ilt" [?x ?y]]]
- (&&host/compile-jvm-ilt compile-expression ?type ?x ?y)
-
- [["jvm-igt" [?x ?y]]]
- (&&host/compile-jvm-igt compile-expression ?type ?x ?y)
-
- ;; Long arithmetic
- [["jvm-ladd" [?x ?y]]]
- (&&host/compile-jvm-ladd compile-expression ?type ?x ?y)
-
- [["jvm-lsub" [?x ?y]]]
- (&&host/compile-jvm-lsub compile-expression ?type ?x ?y)
-
- [["jvm-lmul" [?x ?y]]]
- (&&host/compile-jvm-lmul compile-expression ?type ?x ?y)
-
- [["jvm-ldiv" [?x ?y]]]
- (&&host/compile-jvm-ldiv compile-expression ?type ?x ?y)
-
- [["jvm-lrem" [?x ?y]]]
- (&&host/compile-jvm-lrem compile-expression ?type ?x ?y)
-
- [["jvm-leq" [?x ?y]]]
- (&&host/compile-jvm-leq compile-expression ?type ?x ?y)
-
- [["jvm-llt" [?x ?y]]]
- (&&host/compile-jvm-llt compile-expression ?type ?x ?y)
-
- [["jvm-lgt" [?x ?y]]]
- (&&host/compile-jvm-lgt compile-expression ?type ?x ?y)
-
- ;; Float arithmetic
- [["jvm-fadd" [?x ?y]]]
- (&&host/compile-jvm-fadd compile-expression ?type ?x ?y)
-
- [["jvm-fsub" [?x ?y]]]
- (&&host/compile-jvm-fsub compile-expression ?type ?x ?y)
-
- [["jvm-fmul" [?x ?y]]]
- (&&host/compile-jvm-fmul compile-expression ?type ?x ?y)
-
- [["jvm-fdiv" [?x ?y]]]
- (&&host/compile-jvm-fdiv compile-expression ?type ?x ?y)
-
- [["jvm-frem" [?x ?y]]]
- (&&host/compile-jvm-frem compile-expression ?type ?x ?y)
-
- [["jvm-feq" [?x ?y]]]
- (&&host/compile-jvm-feq compile-expression ?type ?x ?y)
-
- [["jvm-flt" [?x ?y]]]
- (&&host/compile-jvm-flt compile-expression ?type ?x ?y)
-
- [["jvm-fgt" [?x ?y]]]
- (&&host/compile-jvm-fgt compile-expression ?type ?x ?y)
-
- ;; Double arithmetic
- [["jvm-dadd" [?x ?y]]]
- (&&host/compile-jvm-dadd compile-expression ?type ?x ?y)
-
- [["jvm-dsub" [?x ?y]]]
- (&&host/compile-jvm-dsub compile-expression ?type ?x ?y)
-
- [["jvm-dmul" [?x ?y]]]
- (&&host/compile-jvm-dmul compile-expression ?type ?x ?y)
-
- [["jvm-ddiv" [?x ?y]]]
- (&&host/compile-jvm-ddiv compile-expression ?type ?x ?y)
-
- [["jvm-drem" [?x ?y]]]
- (&&host/compile-jvm-drem compile-expression ?type ?x ?y)
-
- [["jvm-deq" [?x ?y]]]
- (&&host/compile-jvm-deq compile-expression ?type ?x ?y)
-
- [["jvm-dlt" [?x ?y]]]
- (&&host/compile-jvm-dlt compile-expression ?type ?x ?y)
-
- [["jvm-dgt" [?x ?y]]]
- (&&host/compile-jvm-dgt compile-expression ?type ?x ?y)
-
- [["exec" ?exprs]]
- (&&host/compile-exec compile-expression ?type ?exprs)
-
- [["jvm-null" _]]
- (&&host/compile-jvm-null compile-expression ?type)
-
- [["jvm-null?" ?object]]
- (&&host/compile-jvm-null? compile-expression ?type ?object)
-
- [["jvm-new" [?class ?classes ?args]]]
- (&&host/compile-jvm-new compile-expression ?type ?class ?classes ?args)
-
- [["jvm-getstatic" [?class ?field]]]
- (&&host/compile-jvm-getstatic compile-expression ?type ?class ?field)
-
- [["jvm-getfield" [?class ?field ?object]]]
- (&&host/compile-jvm-getfield compile-expression ?type ?class ?field ?object)
-
- [["jvm-putstatic" [?class ?field ?value]]]
- (&&host/compile-jvm-putstatic compile-expression ?type ?class ?field ?value)
-
- [["jvm-putfield" [?class ?field ?object ?value]]]
- (&&host/compile-jvm-putfield compile-expression ?type ?class ?field ?object ?value)
-
- [["jvm-invokestatic" [?class ?method ?classes ?args]]]
- (&&host/compile-jvm-invokestatic compile-expression ?type ?class ?method ?classes ?args)
-
- [["jvm-invokevirtual" [?class ?method ?classes ?object ?args]]]
- (&&host/compile-jvm-invokevirtual compile-expression ?type ?class ?method ?classes ?object ?args)
+ [["Expression" [?form ?type]]]
+ (do (prn 'compile-expression2 (aget ?form 0))
+ (matchv ::M/objects [?form]
+ [["bool" ?value]]
+ (&&lux/compile-bool compile-expression ?type ?value)
+
+ [["int" ?value]]
+ (&&lux/compile-int compile-expression ?type ?value)
+
+ [["real" ?value]]
+ (&&lux/compile-real compile-expression ?type ?value)
+
+ [["char" ?value]]
+ (&&lux/compile-char compile-expression ?type ?value)
+
+ [["text" ?value]]
+ (&&lux/compile-text compile-expression ?type ?value)
+
+ [["tuple" ?elems]]
+ (&&lux/compile-tuple compile-expression ?type ?elems)
+
+ [["record" ?elems]]
+ (&&lux/compile-record compile-expression ?type ?elems)
+
+ [["local" ?idx]]
+ (&&lux/compile-local compile-expression ?type ?idx)
+
+ [["captured" [?scope ?captured-id ?source]]]
+ (&&lux/compile-captured compile-expression ?type ?scope ?captured-id ?source)
+
+ [["global" [?owner-class ?name]]]
+ (&&lux/compile-global compile-expression ?type ?owner-class ?name)
+
+ [["call" [?fn ?args]]]
+ (&&lux/compile-call compile-expression ?type ?fn ?args)
+
+ [["variant" [?tag ?members]]]
+ (&&lux/compile-variant compile-expression ?type ?tag ?members)
+
+ [["case" [?variant ?base-register ?num-registers ?branches]]]
+ (&&case/compile-case compile-expression ?type ?variant ?base-register ?num-registers ?branches)
+
+ [["lambda" [?scope ?env ?args ?body]]]
+ (&&lambda/compile-lambda compile-expression ?scope ?env ?args ?body)
+
+ [["get" [?slot ?record]]]
+ (&&lux/compile-get compile-expression ?type ?slot ?record)
+
+ [["set" [?slot ?value ?record]]]
+ (&&lux/compile-set compile-expression ?type ?slot ?value ?record)
+
+ ;; Integer arithmetic
+ [["jvm-iadd" [?x ?y]]]
+ (&&host/compile-jvm-iadd compile-expression ?type ?x ?y)
+
+ [["jvm-isub" [?x ?y]]]
+ (&&host/compile-jvm-isub compile-expression ?type ?x ?y)
+
+ [["jvm-imul" [?x ?y]]]
+ (&&host/compile-jvm-imul compile-expression ?type ?x ?y)
+
+ [["jvm-idiv" [?x ?y]]]
+ (&&host/compile-jvm-idiv compile-expression ?type ?x ?y)
+
+ [["jvm-irem" [?x ?y]]]
+ (&&host/compile-jvm-irem compile-expression ?type ?x ?y)
+
+ [["jvm-ieq" [?x ?y]]]
+ (&&host/compile-jvm-ieq compile-expression ?type ?x ?y)
+
+ [["jvm-ilt" [?x ?y]]]
+ (&&host/compile-jvm-ilt compile-expression ?type ?x ?y)
+
+ [["jvm-igt" [?x ?y]]]
+ (&&host/compile-jvm-igt compile-expression ?type ?x ?y)
+
+ ;; Long arithmetic
+ [["jvm-ladd" [?x ?y]]]
+ (&&host/compile-jvm-ladd compile-expression ?type ?x ?y)
+
+ [["jvm-lsub" [?x ?y]]]
+ (&&host/compile-jvm-lsub compile-expression ?type ?x ?y)
+
+ [["jvm-lmul" [?x ?y]]]
+ (&&host/compile-jvm-lmul compile-expression ?type ?x ?y)
+
+ [["jvm-ldiv" [?x ?y]]]
+ (&&host/compile-jvm-ldiv compile-expression ?type ?x ?y)
+
+ [["jvm-lrem" [?x ?y]]]
+ (&&host/compile-jvm-lrem compile-expression ?type ?x ?y)
+
+ [["jvm-leq" [?x ?y]]]
+ (&&host/compile-jvm-leq compile-expression ?type ?x ?y)
+
+ [["jvm-llt" [?x ?y]]]
+ (&&host/compile-jvm-llt compile-expression ?type ?x ?y)
+
+ [["jvm-lgt" [?x ?y]]]
+ (&&host/compile-jvm-lgt compile-expression ?type ?x ?y)
+
+ ;; Float arithmetic
+ [["jvm-fadd" [?x ?y]]]
+ (&&host/compile-jvm-fadd compile-expression ?type ?x ?y)
+
+ [["jvm-fsub" [?x ?y]]]
+ (&&host/compile-jvm-fsub compile-expression ?type ?x ?y)
+
+ [["jvm-fmul" [?x ?y]]]
+ (&&host/compile-jvm-fmul compile-expression ?type ?x ?y)
+
+ [["jvm-fdiv" [?x ?y]]]
+ (&&host/compile-jvm-fdiv compile-expression ?type ?x ?y)
+
+ [["jvm-frem" [?x ?y]]]
+ (&&host/compile-jvm-frem compile-expression ?type ?x ?y)
+
+ [["jvm-feq" [?x ?y]]]
+ (&&host/compile-jvm-feq compile-expression ?type ?x ?y)
+
+ [["jvm-flt" [?x ?y]]]
+ (&&host/compile-jvm-flt compile-expression ?type ?x ?y)
+
+ [["jvm-fgt" [?x ?y]]]
+ (&&host/compile-jvm-fgt compile-expression ?type ?x ?y)
+
+ ;; Double arithmetic
+ [["jvm-dadd" [?x ?y]]]
+ (&&host/compile-jvm-dadd compile-expression ?type ?x ?y)
+
+ [["jvm-dsub" [?x ?y]]]
+ (&&host/compile-jvm-dsub compile-expression ?type ?x ?y)
+
+ [["jvm-dmul" [?x ?y]]]
+ (&&host/compile-jvm-dmul compile-expression ?type ?x ?y)
+
+ [["jvm-ddiv" [?x ?y]]]
+ (&&host/compile-jvm-ddiv compile-expression ?type ?x ?y)
+
+ [["jvm-drem" [?x ?y]]]
+ (&&host/compile-jvm-drem compile-expression ?type ?x ?y)
+
+ [["jvm-deq" [?x ?y]]]
+ (&&host/compile-jvm-deq compile-expression ?type ?x ?y)
+
+ [["jvm-dlt" [?x ?y]]]
+ (&&host/compile-jvm-dlt compile-expression ?type ?x ?y)
+
+ [["jvm-dgt" [?x ?y]]]
+ (&&host/compile-jvm-dgt compile-expression ?type ?x ?y)
+
+ [["exec" ?exprs]]
+ (&&host/compile-exec compile-expression ?type ?exprs)
+
+ [["jvm-null" _]]
+ (&&host/compile-jvm-null compile-expression ?type)
+
+ [["jvm-null?" ?object]]
+ (&&host/compile-jvm-null? compile-expression ?type ?object)
+
+ [["jvm-new" [?class ?classes ?args]]]
+ (&&host/compile-jvm-new compile-expression ?type ?class ?classes ?args)
+
+ [["jvm-getstatic" [?class ?field]]]
+ (&&host/compile-jvm-getstatic compile-expression ?type ?class ?field)
+
+ [["jvm-getfield" [?class ?field ?object]]]
+ (&&host/compile-jvm-getfield compile-expression ?type ?class ?field ?object)
+
+ [["jvm-putstatic" [?class ?field ?value]]]
+ (&&host/compile-jvm-putstatic compile-expression ?type ?class ?field ?value)
+
+ [["jvm-putfield" [?class ?field ?object ?value]]]
+ (&&host/compile-jvm-putfield compile-expression ?type ?class ?field ?object ?value)
+
+ [["jvm-invokestatic" [?class ?method ?classes ?args]]]
+ (&&host/compile-jvm-invokestatic compile-expression ?type ?class ?method ?classes ?args)
+
+ [["jvm-invokevirtual" [?class ?method ?classes ?object ?args]]]
+ (&&host/compile-jvm-invokevirtual compile-expression ?type ?class ?method ?classes ?object ?args)
- [["jvm-invokeinterface" [?class ?method ?classes ?object ?args]]]
- (&&host/compile-jvm-invokeinterface compile-expression ?type ?class ?method ?classes ?object ?args)
+ [["jvm-invokeinterface" [?class ?method ?classes ?object ?args]]]
+ (&&host/compile-jvm-invokeinterface compile-expression ?type ?class ?method ?classes ?object ?args)
- [["jvm-invokespecial" [?class ?method ?classes ?object ?args]]]
- (&&host/compile-jvm-invokespecial compile-expression ?type ?class ?method ?classes ?object ?args)
-
- [["jvm-new-array" [?class ?length]]]
- (&&host/compile-jvm-new-array compile-expression ?type ?class ?length)
+ [["jvm-invokespecial" [?class ?method ?classes ?object ?args]]]
+ (&&host/compile-jvm-invokespecial compile-expression ?type ?class ?method ?classes ?object ?args)
+
+ [["jvm-new-array" [?class ?length]]]
+ (&&host/compile-jvm-new-array compile-expression ?type ?class ?length)
- [["jvm-aastore" [?array ?idx ?elem]]]
- (&&host/compile-jvm-aastore compile-expression ?type ?array ?idx ?elem)
+ [["jvm-aastore" [?array ?idx ?elem]]]
+ (&&host/compile-jvm-aastore compile-expression ?type ?array ?idx ?elem)
- [["jvm-aaload" [?array ?idx]]]
- (&&host/compile-jvm-aaload compile-expression ?type ?array ?idx)
+ [["jvm-aaload" [?array ?idx]]]
+ (&&host/compile-jvm-aaload compile-expression ?type ?array ?idx)
- [["jvm-try" [?body ?catches ?finally]]]
- (&&host/compile-jvm-try compile-expression ?type ?body ?catches ?finally)
+ [["jvm-try" [?body ?catches ?finally]]]
+ (&&host/compile-jvm-try compile-expression ?type ?body ?catches ?finally)
- [["jvm-throw" ?ex]]
- (&&host/compile-jvm-throw compile-expression ?type ?ex)
+ [["jvm-throw" ?ex]]
+ (&&host/compile-jvm-throw compile-expression ?type ?ex)
- [["jvm-monitorenter" ?monitor]]
- (&&host/compile-jvm-monitorenter compile-expression ?type ?monitor)
+ [["jvm-monitorenter" ?monitor]]
+ (&&host/compile-jvm-monitorenter compile-expression ?type ?monitor)
- [["jvm-monitorexit" ?monitor]]
- (&&host/compile-jvm-monitorexit compile-expression ?type ?monitor)
+ [["jvm-monitorexit" ?monitor]]
+ (&&host/compile-jvm-monitorexit compile-expression ?type ?monitor)
- [["jvm-d2f" ?value]]
- (&&host/compile-jvm-d2f compile-expression ?type ?value)
+ [["jvm-d2f" ?value]]
+ (&&host/compile-jvm-d2f compile-expression ?type ?value)
- [["jvm-d2i" ?value]]
- (&&host/compile-jvm-d2i compile-expression ?type ?value)
+ [["jvm-d2i" ?value]]
+ (&&host/compile-jvm-d2i compile-expression ?type ?value)
- [["jvm-d2l" ?value]]
- (&&host/compile-jvm-d2l compile-expression ?type ?value)
-
- [["jvm-f2d" ?value]]
- (&&host/compile-jvm-f2d compile-expression ?type ?value)
+ [["jvm-d2l" ?value]]
+ (&&host/compile-jvm-d2l compile-expression ?type ?value)
+
+ [["jvm-f2d" ?value]]
+ (&&host/compile-jvm-f2d compile-expression ?type ?value)
- [["jvm-f2i" ?value]]
- (&&host/compile-jvm-f2i compile-expression ?type ?value)
+ [["jvm-f2i" ?value]]
+ (&&host/compile-jvm-f2i compile-expression ?type ?value)
- [["jvm-f2l" ?value]]
- (&&host/compile-jvm-f2l compile-expression ?type ?value)
-
- [["jvm-i2b" ?value]]
- (&&host/compile-jvm-i2b compile-expression ?type ?value)
+ [["jvm-f2l" ?value]]
+ (&&host/compile-jvm-f2l compile-expression ?type ?value)
+
+ [["jvm-i2b" ?value]]
+ (&&host/compile-jvm-i2b compile-expression ?type ?value)
- [["jvm-i2c" ?value]]
- (&&host/compile-jvm-i2c compile-expression ?type ?value)
+ [["jvm-i2c" ?value]]
+ (&&host/compile-jvm-i2c compile-expression ?type ?value)
- [["jvm-i2d" ?value]]
- (&&host/compile-jvm-i2d compile-expression ?type ?value)
+ [["jvm-i2d" ?value]]
+ (&&host/compile-jvm-i2d compile-expression ?type ?value)
- [["jvm-i2f" ?value]]
- (&&host/compile-jvm-i2f compile-expression ?type ?value)
+ [["jvm-i2f" ?value]]
+ (&&host/compile-jvm-i2f compile-expression ?type ?value)
- [["jvm-i2l" ?value]]
- (&&host/compile-jvm-i2l compile-expression ?type ?value)
+ [["jvm-i2l" ?value]]
+ (&&host/compile-jvm-i2l compile-expression ?type ?value)
- [["jvm-i2s" ?value]]
- (&&host/compile-jvm-i2s compile-expression ?type ?value)
+ [["jvm-i2s" ?value]]
+ (&&host/compile-jvm-i2s compile-expression ?type ?value)
- [["jvm-l2d" ?value]]
- (&&host/compile-jvm-l2d compile-expression ?type ?value)
+ [["jvm-l2d" ?value]]
+ (&&host/compile-jvm-l2d compile-expression ?type ?value)
- [["jvm-l2f" ?value]]
- (&&host/compile-jvm-l2f compile-expression ?type ?value)
+ [["jvm-l2f" ?value]]
+ (&&host/compile-jvm-l2f compile-expression ?type ?value)
- [["jvm-l2i" ?value]]
- (&&host/compile-jvm-l2i compile-expression ?type ?value)
+ [["jvm-l2i" ?value]]
+ (&&host/compile-jvm-l2i compile-expression ?type ?value)
- [["jvm-iand" [?x ?y]]]
- (&&host/compile-jvm-iand compile-expression ?type ?x ?y)
+ [["jvm-iand" [?x ?y]]]
+ (&&host/compile-jvm-iand compile-expression ?type ?x ?y)
- [["jvm-ior" [?x ?y]]]
- (&&host/compile-jvm-ior compile-expression ?type ?x ?y)
+ [["jvm-ior" [?x ?y]]]
+ (&&host/compile-jvm-ior compile-expression ?type ?x ?y)
- [["jvm-land" [?x ?y]]]
- (&&host/compile-jvm-land compile-expression ?type ?x ?y)
+ [["jvm-land" [?x ?y]]]
+ (&&host/compile-jvm-land compile-expression ?type ?x ?y)
- [["jvm-lor" [?x ?y]]]
- (&&host/compile-jvm-lor compile-expression ?type ?x ?y)
+ [["jvm-lor" [?x ?y]]]
+ (&&host/compile-jvm-lor compile-expression ?type ?x ?y)
- [["jvm-lxor" [?x ?y]]]
- (&&host/compile-jvm-lxor compile-expression ?type ?x ?y)
+ [["jvm-lxor" [?x ?y]]]
+ (&&host/compile-jvm-lxor compile-expression ?type ?x ?y)
- [["jvm-lshl" [?x ?y]]]
- (&&host/compile-jvm-lshl compile-expression ?type ?x ?y)
+ [["jvm-lshl" [?x ?y]]]
+ (&&host/compile-jvm-lshl compile-expression ?type ?x ?y)
- [["jvm-lshr" [?x ?y]]]
- (&&host/compile-jvm-lshr compile-expression ?type ?x ?y)
+ [["jvm-lshr" [?x ?y]]]
+ (&&host/compile-jvm-lshr compile-expression ?type ?x ?y)
- [["jvm-lushr" [?x ?y]]]
- (&&host/compile-jvm-lushr compile-expression ?type ?x ?y)
+ [["jvm-lushr" [?x ?y]]]
+ (&&host/compile-jvm-lushr compile-expression ?type ?x ?y)
- [["jvm-program" ?body]]
- (&&host/compile-jvm-program compile-expression ?type ?body)
- )
+ [["jvm-program" ?body]]
+ (&&host/compile-jvm-program compile-expression ?type ?body)
+ ))
[_]
(fail "[Compiler Error] Can't compile statements as expressions.")))
@@ -317,15 +318,16 @@
;; (prn 'compile-statement syntax)
(matchv ::M/objects [syntax]
[["Statement" ?form]]
- (matchv ::M/objects [?form]
- [["def" ?name ?body]]
- (&&lux/compile-def compile-expression ?name ?body)
-
- [["jvm-interface" ?package ?name ?methods]]
- (&&host/compile-jvm-interface compile-expression ?package ?name ?methods)
+ (do (prn 'compile-statement (aget syntax 0) (aget ?form 0))
+ (matchv ::M/objects [?form]
+ [["def" [?name ?body]]]
+ (&&lux/compile-def compile-expression ?name ?body)
+
+ [["jvm-interface" [?package ?name ?methods]]]
+ (&&host/compile-jvm-interface compile-expression ?package ?name ?methods)
- [["jvm-class" ?package ?name ?super-class ?fields ?methods]]
- (&&host/compile-jvm-class compile-expression ?package ?name ?super-class ?fields ?methods))
+ [["jvm-class" [?package ?name ?super-class ?fields ?methods]]]
+ (&&host/compile-jvm-class compile-expression ?package ?name ?super-class ?fields ?methods)))
[_]
(fail "[Compiler Error] Can't compile expressions as top-level forms.")))
@@ -361,7 +363,7 @@
(let [compiler-step (exec [analysis+ (&optimizer/optimize eval!)
;; :let [_ (prn 'analysis+ analysis+)]
]
- (&/flat-map% compile-statement analysis+))]
+ (&/map% compile-statement analysis+))]
(defn ^:private compile-module [name]
(fn [state]
(if (->> state (&/get$ "modules") (&/|contains? name))
@@ -369,13 +371,14 @@
(let [=class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
(.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER)
(&host/->class name) nil "java/lang/Object" nil))]
- (matchv ::M/objects [(&/run-state (&/exhaust% compiler-step) (-> state
- (&/set$ "source" (slurp (str "source/" name ".lux")))
- (&/set$ "global-env" (&/env name))
- (&/set$ "writer" =class)
- (&/update$ "modules" #(&/|put name &a-def/init-module %))))]
+ (matchv ::M/objects [(&/run-state (&/exhaust% compiler-step) (->> state
+ (&/set$ "source" (slurp (str "source/" name ".lux")))
+ (&/set$ "global-env" (&/V "Some" (&/env name)))
+ (&/set$ "writer" (&/V "Some" =class))
+ (&/update$ "modules" #(&/|put name &a-def/init-module %))))]
[["Right" [?state ?vals]]]
(do (.visitEnd =class)
+ (prn 'compile-module 'DONE name)
;; (prn 'compile-module/?vals ?vals)
(&/run-state (&&/save-class! name (.toByteArray =class)) ?state))
@@ -385,7 +388,7 @@
;; [Resources]
(defn compile-all [modules]
(.mkdir (java.io.File. "output"))
- (matchv ::M/objects [(&/run-state (&/map% compile-module modules) (&/init-state))]
+ (matchv ::M/objects [(&/run-state (&/map% compile-module modules) (&/init-state nil))]
[["Right" [?state _]]]
(println (str "Compilation complete! " (pr-str modules)))
diff --git a/src/lux/compiler/base.clj b/src/lux/compiler/base.clj
index f09008ca8..09fc811d8 100644
--- a/src/lux/compiler/base.clj
+++ b/src/lux/compiler/base.clj
@@ -32,97 +32,104 @@
(return nil)))
(defn total-locals [expr]
+ (prn 'total-locals1 (aget expr 0))
(matchv ::M/objects [expr]
- [["case" [?variant ?base-register ?num-registers ?branches]]]
- (+ ?num-registers (&/fold max 0 (&/|map (comp total-locals second) ?branches)))
-
- [["tuple" ?members]]
- (&/fold max 0 (&/|map total-locals ?members))
+ [["Expression" [?struct ?type]]]
+ (do (prn 'total-locals2 (aget ?struct 0))
+ (matchv ::M/objects [?struct]
+ [["case" [?variant ?base-register ?num-registers ?branches]]]
+ (+ ?num-registers (&/fold max 0 (&/|map (comp total-locals second) ?branches)))
+
+ [["tuple" ?members]]
+ (&/fold max 0 (&/|map total-locals ?members))
- [["variant" ?tag ?value]]
- (total-locals ?value)
+ [["variant" [?tag ?value]]]
+ (total-locals ?value)
- [["call" [?fn ?args]]]
- (&/fold max 0 (&/|map total-locals (&/|cons ?fn ?args)))
-
- [["jvm-iadd" [?x ?y]]]
- (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
-
- [["jvm-isub" [?x ?y]]]
- (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
-
- [["jvm-imul" [?x ?y]]]
- (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
-
- [["jvm-idiv" [?x ?y]]]
- (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
-
- [["jvm-irem" [?x ?y]]]
- (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
-
- [["jvm-ladd" [?x ?y]]]
- (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
-
- [["jvm-lsub" [?x ?y]]]
- (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
-
- [["jvm-lmul" [?x ?y]]]
- (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
-
- [["jvm-ldiv" [?x ?y]]]
- (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
-
- [["jvm-lrem" [?x ?y]]]
- (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
-
- [["jvm-fadd" [?x ?y]]]
- (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
-
- [["jvm-fsub" [?x ?y]]]
- (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
-
- [["jvm-fmul" [?x ?y]]]
- (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
-
- [["jvm-fdiv" [?x ?y]]]
- (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
-
- [["jvm-frem" [?x ?y]]]
- (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
-
- [["jvm-dadd" [?x ?y]]]
- (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
-
- [["jvm-dsub" [?x ?y]]]
- (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
-
- [["jvm-dmul" [?x ?y]]]
- (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
-
- [["jvm-ddiv" [?x ?y]]]
- (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
-
- [["jvm-drem" [?x ?y]]]
- (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
+ [["call" [?fn ?args]]]
+ (&/fold max 0 (&/|map total-locals (&/|cons ?fn ?args)))
+
+ [["jvm-iadd" [?x ?y]]]
+ (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
+
+ [["jvm-isub" [?x ?y]]]
+ (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
+
+ [["jvm-imul" [?x ?y]]]
+ (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
+
+ [["jvm-idiv" [?x ?y]]]
+ (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
+
+ [["jvm-irem" [?x ?y]]]
+ (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
+
+ [["jvm-ladd" [?x ?y]]]
+ (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
+
+ [["jvm-lsub" [?x ?y]]]
+ (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
+
+ [["jvm-lmul" [?x ?y]]]
+ (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
+
+ [["jvm-ldiv" [?x ?y]]]
+ (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
+
+ [["jvm-lrem" [?x ?y]]]
+ (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
+
+ [["jvm-fadd" [?x ?y]]]
+ (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
+
+ [["jvm-fsub" [?x ?y]]]
+ (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
+
+ [["jvm-fmul" [?x ?y]]]
+ (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
+
+ [["jvm-fdiv" [?x ?y]]]
+ (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
+
+ [["jvm-frem" [?x ?y]]]
+ (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
+
+ [["jvm-dadd" [?x ?y]]]
+ (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
+
+ [["jvm-dsub" [?x ?y]]]
+ (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
+
+ [["jvm-dmul" [?x ?y]]]
+ (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
+
+ [["jvm-ddiv" [?x ?y]]]
+ (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
+
+ [["jvm-drem" [?x ?y]]]
+ (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
- [["exec" ?exprs]]
- (&/fold max 0 (&/|map total-locals ?exprs))
+ [["exec" ?exprs]]
+ (&/fold max 0 (&/|map total-locals ?exprs))
- [["jvm-new" [?class ?classes ?args]]]
- (&/fold max 0 (&/|map total-locals ?args))
+ [["jvm-new" [?class ?classes ?args]]]
+ (&/fold max 0 (&/|map total-locals ?args))
- [["jvm-invokestatic" [?class ?method ?classes ?args]]]
- (&/fold max 0 (&/|map total-locals ?args))
+ [["jvm-invokestatic" [?class ?method ?classes ?args]]]
+ (&/fold max 0 (&/|map total-locals ?args))
- [["jvm-invokevirtual" [?class ?method ?classes ?object ?args]]]
- (&/fold max 0 (&/|map total-locals ?args))
+ [["jvm-invokevirtual" [?class ?method ?classes ?object ?args]]]
+ (&/fold max 0 (&/|map total-locals ?args))
- [["jvm-aastore" [?array ?idx ?elem]]]
- (&/fold max 0 (&/|map total-locals (&/|list ?array ?elem)))
+ [["jvm-aastore" [?array ?idx ?elem]]]
+ (&/fold max 0 (&/|map total-locals (&/|list ?array ?elem)))
- [["jvm-aaload" [?array ?idx]]]
- (total-locals ?array)
-
- ;; [_]
- ;; 0
- ))
+ [["jvm-aaload" [?array ?idx]]]
+ (total-locals ?array)
+
+ [["lambda" _]]
+ 0
+
+ ;; [_]
+ ;; 0
+ ))))
diff --git a/src/lux/compiler/case.clj b/src/lux/compiler/case.clj
index 6f9fd998a..336d0c645 100644
--- a/src/lux/compiler/case.clj
+++ b/src/lux/compiler/case.clj
@@ -3,7 +3,7 @@
[template :refer [do-template]])
[clojure.core.match :as M :refer [match matchv]]
clojure.core.match.array
- (lux [base :as & :refer [exec return* return fail fail*]]
+ (lux [base :as & :refer [exec return* return fail fail* |let]]
[type :as &type]
[lexer :as &lexer]
[parser :as &parser]
@@ -17,51 +17,56 @@
;; [Utils]
(defn ^:private ->match [$body register token]
+ (prn '->match token)
+ (prn '->match (aget token 0))
(matchv ::M/objects [token]
- [["Ident" ?name]]
- [(inc register) (&/V "Pattern" (&/T $body [&/V "StoreMatch" register]))]
+ [["Symbol" ?name]]
+ (&/T (inc register) (&/V "Pattern" (&/T $body [&/V "StoreMatch" register])))
[["Bool" ?value]]
- [register (&/V "Pattern" (&/T $body [&/V "BoolMatch" ?value]))]
+ (&/T register (&/V "Pattern" (&/T $body [&/V "BoolMatch" ?value])))
[["Int" ?value]]
- [register (&/V "Pattern" (&/T $body [&/V "IntMatch" ?value]))]
+ (&/T register (&/V "Pattern" (&/T $body [&/V "IntMatch" ?value])))
[["Real" ?value]]
- [register (&/V "Pattern" (&/T $body [&/V "RealMatch" ?value]))]
+ (&/T register (&/V "Pattern" (&/T $body [&/V "RealMatch" ?value])))
[["Char" ?value]]
- [register (&/V "Pattern" (&/T $body [&/V "CharMatch" ?value]))]
+ (&/T register (&/V "Pattern" (&/T $body [&/V "CharMatch" ?value])))
[["Text" ?value]]
- [register (&/V "Pattern" (&/T $body [&/V "TextMatch" ?value]))]
+ (&/T register (&/V "Pattern" (&/T $body [&/V "TextMatch" ?value])))
[["Tuple" ?members]]
- (let [[register* =members] (&/fold (fn [[register =members] member]
- (let [[register* =member] (->match $body register member)]
- [register* (cons =member =members)]))
- [register (list)]
- ?members)]
- [register* (&/V "Pattern" (&/T $body [&/V "TupleMatch" (reverse =members)]))])
+ (|let [[register* =members] (&/fold (fn [[register =members] member]
+ (|let [[register* =member] (->match $body register member)]
+ (&/T register* (&/|cons =member =members))))
+ (&/T register (&/|list))
+ ?members)]
+ (&/T register* (&/V "Pattern" (&/T $body [&/V "TupleMatch" (&/|reverse =members)]))))
[["Tag" ?tag]]
- [register (&/V "Pattern" (&/T $body [&/V "VariantMatch" (&/T ?tag [&/V "Pattern" (&/T $body [&/V "TupleMatch" (list)])])]))]
+ (&/T register (&/V "Pattern" (&/T $body [&/V "VariantMatch" (&/T ?tag [&/V "Pattern" (&/T $body [&/V "TupleMatch" (list)])])])))
[["Form" ["Cons" [["Tag" ?tag]
["Cons" [?value
["Nil" _]]]]]]]
- (let [[register* =value] (->match $body register ?value)]
+ (|let [[register* =value] (->match $body register ?value)]
- [register* (&/V "Pattern" (&/T $body [&/V "VariantMatch" (&/T ?tag =value)]))])
+ (&/T register* (&/V "Pattern" (&/T $body [&/V "VariantMatch" (&/T ?tag =value)]))))
))
(defn ^:private process-branches [base-register branches]
- (let [[_ mappings pms] (reduce (fn [[$id mappings =matches] [pattern body]]
- (let [[_ =match] (->match $id base-register pattern)]
- [(inc $id) (assoc mappings $id body) (cons =match =matches)]))
- [0 {} (list)]
- branches)]
- [mappings (reverse pms)]))
+ (prn 'process-branches base-register branches)
+ (|let [[_ mappings pms] (&/fold (fn [$id+mappings+=matches pattern+body]
+ (|let [[$id mappings =matches] $id+mappings+=matches
+ [pattern body] pattern+body
+ [_ =match] (->match $id base-register pattern)]
+ (&/T (inc $id) (&/|put $id body mappings) (&/|cons =match =matches))))
+ (&/T 0 (&/|table) (&/|list))
+ branches)]
+ (&/T mappings (&/|reverse pms))))
(let [+tag-sig+ (&host/->type-signature "java.lang.String")
+oclass+ (&host/->class "java.lang.Object")
@@ -131,9 +136,10 @@
(.visitInsn Opcodes/POP)
(.visitJumpInsn Opcodes/GOTO $else)
(.visitLabel $next))
- (->> (doseq [[idx [_ _ member]] (map vector (range (count ?members)) ?members)
- :let [$next (new Label)
- $sub-else (new Label)]])))
+ (->> (|let [[idx [_ _ member]] idx+member
+ $next (new Label)
+ $sub-else (new Label)])
+ (doseq [idx+member (&/->seq (&/zip2 (&/|range (&/|length ?members)) ?members))])))
(.visitInsn Opcodes/POP)
(.visitJumpInsn Opcodes/GOTO $target))
@@ -162,16 +168,19 @@
(let [ex-class (&host/->class "java.lang.IllegalStateException")]
(defn ^:private compile-pattern-matching [writer compile mappings patterns $end]
- ;; (prn 'compile-pattern-matching patterns)
- (let [entries (for [[?branch ?body] mappings
- :let [label (new Label)]]
- [[?branch label]
- [label ?body]])
- mappings* (into {} (map first entries))]
+ (prn 'compile-pattern-matching mappings patterns $end)
+ (let [entries (&/|map (fn [?branch+?body]
+ (|let [[?branch ?body] ?branch+?body
+ label (new Label)]
+ (&/T (&/T ?branch label)
+ (&/T label ?body))))
+ mappings)
+ mappings* (&/|map &/|first entries)]
(doto writer
- (-> (doto (compile-match ?match (get mappings* ?body) $else)
+ (-> (doto (compile-match ?match (&/|get ?body mappings*) $else)
(.visitLabel $else))
- (->> (doseq [[_ ?body ?match :as pattern] patterns
+ (->> (|let [[_ ?body ?match] ?body+?match])
+ (doseq [?body+?match (&/->seq patterns)
:let [;; _ (prn 'compile-pattern-matching/pattern pattern)
$else (new Label)]])))
(.visitInsn Opcodes/POP)
@@ -179,20 +188,22 @@
(.visitInsn Opcodes/DUP)
(.visitMethodInsn Opcodes/INVOKESPECIAL ex-class "<init>" "()V")
(.visitInsn Opcodes/ATHROW))
- (&/map% (fn [[?label ?body]]
- (exec [:let [_ (.visitLabel writer ?label)]
- ret (compile ?body)
- :let [_ (.visitJumpInsn writer Opcodes/GOTO $end)]]
- (return ret)))
- (map second entries))
+ (&/map% (fn [?label+?body]
+ (|let [[?label ?body] ?label+?body]
+ (exec [:let [_ (.visitLabel writer ?label)]
+ ret (compile ?body)
+ :let [_ (.visitJumpInsn writer Opcodes/GOTO $end)]]
+ (return ret))))
+ (&/|map &/|second entries))
)))
;; [Resources]
(defn compile-case [compile *type* ?variant ?base-register ?num-registers ?branches]
(exec [*writer* &/get-writer
:let [$end (new Label)]
- _ (compile ?variant)
- :let [[mappings patterns] (process-branches ?base-register ?branches)]
- _ (compile-pattern-matching *writer* compile mappings patterns $end)
- :let [_ (.visitLabel *writer* $end)]]
- (return nil)))
+ _ (compile ?variant)]
+ (|let [[mappings patterns] (process-branches ?base-register ?branches)]
+ (exec [_ (compile-pattern-matching *writer* compile mappings patterns $end)
+ :let [_ (.visitLabel *writer* $end)]]
+ (return nil)))
+ ))
diff --git a/src/lux/compiler/host.clj b/src/lux/compiler/host.clj
index 08a00b536..c14924efd 100644
--- a/src/lux/compiler/host.clj
+++ b/src/lux/compiler/host.clj
@@ -310,6 +310,7 @@
(&&/save-class! full-name (.toByteArray =class))))
(defn compile-jvm-interface [compile ?package ?name ?methods]
+ (prn 'compile-jvm-interface ?package ?name ?methods)
(let [parent-dir (&host/->package ?package)
full-name (str parent-dir "/" ?name)
=interface (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
@@ -317,10 +318,12 @@
full-name nil "java/lang/Object" nil))
_ (do (doseq [[?method ?props] ?methods
:let [[?args ?return] (:type ?props)
- signature (str "(" (reduce str "" (map &host/->type-signature ?args)) ")" (&host/->type-signature ?return))]]
+ signature (str "(" (&/fold str "" (&/|map &host/->type-signature ?args)) ")" (&host/->type-signature ?return))
+ _ (prn 'signature signature)]]
(.visitMethod =interface (+ Opcodes/ACC_PUBLIC Opcodes/ACC_ABSTRACT) ?method signature nil nil))
(.visitEnd =interface)
(.mkdirs (java.io.File. (str "output/" parent-dir))))]
+ (prn 'SAVED_CLASS full-name)
(&&/save-class! full-name (.toByteArray =interface))))
(defn compile-exec [compile *type* ?exprs]
diff --git a/src/lux/compiler/lambda.clj b/src/lux/compiler/lambda.clj
index 45a75337c..c249924ec 100644
--- a/src/lux/compiler/lambda.clj
+++ b/src/lux/compiler/lambda.clj
@@ -12,7 +12,8 @@
[host :as &host])
[lux.analyser.base :as &a]
(lux.compiler [base :as &&])
- :reload)
+ ;; :reload
+ )
(:import (org.objectweb.asm Opcodes
Label
ClassWriter
@@ -24,11 +25,10 @@
(def ^:private <init>-return "V")
(def ^:private lambda-impl-signature
- (str (reduce str "(" clo-field-sig) ")"
- lambda-return-sig))
+ (str "(" clo-field-sig ")" lambda-return-sig))
(defn ^:private lambda-<init>-signature [env]
- (str "(" (reduce str "" (repeat (count env) clo-field-sig)) ")"
+ (str "(" (&/fold str "" (&/|repeat (&/|length env) clo-field-sig)) ")"
<init>-return))
(defn ^:private add-lambda-<init> [class class-name env]
@@ -40,9 +40,9 @@
(.visitVarInsn Opcodes/ALOAD (inc ?captured-id))
(.visitFieldInsn Opcodes/PUTFIELD class-name captured-name clo-field-sig))
(->> (let [captured-name (str &&/closure-prefix ?captured-id)])
- (matchv ::M/objects [?captured]
- [["Expression" [["captured" [_ ?captured-id ?source]] _]]])
- (doseq [[?name ?captured] env])))
+ (matchv ::M/objects [?name+?captured]
+ [[?name ["Expression" [["captured" [_ ?captured-id ?source]] _]]]])
+ (doseq [?name+?captured (&/->seq env)])))
(.visitInsn Opcodes/RETURN)
(.visitMaxs 0 0)
(.visitEnd)))
@@ -77,25 +77,28 @@
(return ret))))
(defn ^:private instance-closure [compile lambda-class closed-over init-signature]
+ (prn 'instance-closure lambda-class closed-over init-signature)
(exec [*writer* &/get-writer
:let [_ (doto *writer*
(.visitTypeInsn Opcodes/NEW lambda-class)
(.visitInsn Opcodes/DUP))]
_ (->> closed-over
- (sort #(matchv ::M/objects [(second %1) (second %2)]
+ &/->seq
+ (sort #(matchv ::M/objects [(&/|second %1) (&/|second %2)]
[["Expression" [["captured" [_ ?cid1 _]] _]]
["Expression" [["captured" [_ ?cid2 _]] _]]]
(< ?cid1 ?cid2)))
- (&/map% (fn [[?name ?captured]]
- (matchv ::M/objects [?captured]
- [["Expression" [["captured" [_ _ ?source]] _]]]
- (compile ?source)))))
+ &/->list
+ (&/map% (fn [?name+?captured]
+ (matchv ::M/objects [?name+?captured]
+ [[?name ["Expression" [["captured" [_ _ ?source]] _]]]]
+ (compile ?source)))))
:let [_ (.visitMethodInsn *writer* Opcodes/INVOKESPECIAL lambda-class "<init>" init-signature)]]
(return nil)))
;; [Exports]
(defn compile-lambda [compile ?scope ?env ?arg ?body]
- (prn 'compile-lambda ?scope ?arg)
+ (prn 'compile-lambda ?scope (&host/location ?scope) ?arg ?env)
(exec [:let [lambda-class (&host/location ?scope)
=class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
(.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_SUPER)
@@ -103,10 +106,10 @@
(-> (doto (.visitField (+ Opcodes/ACC_PRIVATE Opcodes/ACC_FINAL) captured-name clo-field-sig nil nil)
(.visitEnd))
(->> (let [captured-name (str &&/closure-prefix ?captured-id)])
- (matchv ::M/objects [?captured]
- [["Expression" [["captured" [_ ?captured-id ?source]] _]]])
- (doseq [[?name ?captured] ?env
- ;; :let [_ (prn '?captured ?captured)]
+ (matchv ::M/objects [?name+?captured]
+ [[?name ["Expression" [["captured" [_ ?captured-id ?source]] _]]]])
+ (doseq [?name+?captured (&/->seq ?env)
+ ;; :let [_ (prn '?captured ?name ?captured)]
])))
(add-lambda-apply lambda-class ?env)
(add-lambda-<init> lambda-class ?env)
diff --git a/src/lux/compiler/lux.clj b/src/lux/compiler/lux.clj
index 9ce0da213..22018808a 100644
--- a/src/lux/compiler/lux.clj
+++ b/src/lux/compiler/lux.clj
@@ -4,7 +4,7 @@
[template :refer [do-template]])
[clojure.core.match :as M :refer [matchv]]
clojure.core.match.array
- (lux [base :as & :refer [exec return* return fail fail*]]
+ (lux [base :as & :refer [exec return* return fail fail* |let]]
[type :as &type]
[lexer :as &lexer]
[parser :as &parser]
@@ -50,40 +50,42 @@
(defn compile-tuple [compile *type* ?elems]
(exec [*writer* &/get-writer
- :let [num-elems (count ?elems)
+ :let [num-elems (&/|length ?elems)
_ (doto *writer*
(.visitLdcInsn (int num-elems))
(.visitTypeInsn Opcodes/ANEWARRAY (&host/->class "java.lang.Object")))]
- _ (&/map% (fn [[idx elem]]
- (exec [:let [_ (doto *writer*
- (.visitInsn Opcodes/DUP)
- (.visitLdcInsn (int idx)))]
- ret (compile elem)
- :let [_ (.visitInsn *writer* Opcodes/AASTORE)]]
- (return ret)))
- (map vector (range num-elems) ?elems))]
+ _ (&/map% (fn [idx+elem]
+ (|let [[idx elem] idx+elem]
+ (exec [:let [_ (doto *writer*
+ (.visitInsn Opcodes/DUP)
+ (.visitLdcInsn (int idx)))]
+ ret (compile elem)
+ :let [_ (.visitInsn *writer* Opcodes/AASTORE)]]
+ (return ret))))
+ (&/zip2 (&/|range num-elems) ?elems))]
(return nil)))
(defn compile-record [compile *type* ?elems]
(exec [*writer* &/get-writer
- :let [num-elems (count ?elems)
+ :let [num-elems (&/|length ?elems)
_ (doto *writer*
(.visitLdcInsn (int (* 2 num-elems)))
(.visitTypeInsn Opcodes/ANEWARRAY (&host/->class "java.lang.Object")))]
- _ (&/map% (fn [[idx [k v]]]
- (exec [:let [idx* (* 2 idx)
- _ (doto *writer*
- (.visitInsn Opcodes/DUP)
- (.visitLdcInsn (int idx*))
- (.visitLdcInsn k)
- (.visitInsn Opcodes/AASTORE))]
- :let [_ (doto *writer*
- (.visitInsn Opcodes/DUP)
- (.visitLdcInsn (int (inc idx*))))]
- ret (compile v)
- :let [_ (.visitInsn *writer* Opcodes/AASTORE)]]
- (return ret)))
- (map vector (range num-elems) ?elems))]
+ _ (&/map% (fn [idx+kv]
+ (|let [[idx [k v]] idx+kv]
+ (exec [:let [idx* (* 2 idx)
+ _ (doto *writer*
+ (.visitInsn Opcodes/DUP)
+ (.visitLdcInsn (int idx*))
+ (.visitLdcInsn k)
+ (.visitInsn Opcodes/AASTORE))]
+ :let [_ (doto *writer*
+ (.visitInsn Opcodes/DUP)
+ (.visitLdcInsn (int (inc idx*))))]
+ ret (compile v)
+ :let [_ (.visitInsn *writer* Opcodes/AASTORE)]]
+ (return ret))))
+ (&/zip2 (&/|range num-elems) ?elems))]
(return nil)))
(defn compile-variant [compile *type* ?tag ?value]
@@ -119,7 +121,7 @@
(defn compile-global [compile *type* ?owner-class ?name]
(exec [*writer* &/get-writer
- :let [_ (.visitFieldInsn *writer* Opcodes/GETSTATIC (&host/->class (&host/location (list ?owner-class ?name))) "_datum" "Ljava/lang/Object;")]]
+ :let [_ (.visitFieldInsn *writer* Opcodes/GETSTATIC (&host/->class (&host/location (&/|list ?owner-class ?name))) "_datum" "Ljava/lang/Object;")]]
(return nil)))
(defn compile-call [compile *type* ?fn ?args]
@@ -237,17 +239,22 @@
current-class nil "java/lang/Object" (into-array [(&host/->class &host/function-class)]))
(-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_datum" datum-sig nil nil)
(doto (.visitEnd))))]
+ :let [_ (prn 'compile-def/pre-body)]
_ (&/with-writer (.visitMethod =class Opcodes/ACC_PUBLIC "<clinit>" "()V" nil nil)
(exec [*writer* &/get-writer
:let [_ (.visitCode *writer*)]
+ :let [_ (prn 'compile-def/pre-body2)]
_ (compile ?body)
+ :let [_ (prn 'compile-def/post-body2)]
:let [_ (doto *writer*
(.visitFieldInsn Opcodes/PUTSTATIC current-class "_datum" datum-sig)
(.visitInsn Opcodes/RETURN)
(.visitMaxs 0 0)
(.visitEnd))]]
(return nil)))
+ :let [_ (prn 'compile-def/post-body)]
:let [_ (.visitEnd *writer*)]
+ :let [_ (prn 'compile-def/_1 ?name current-class)]
_ (&&/save-class! current-class (.toByteArray =class))
- :let [_ (prn 'compile-def ?name)]]
+ :let [_ (prn 'compile-def/_2 ?name)]]
(return nil)))
diff --git a/src/lux/host.clj b/src/lux/host.clj
index 0becee945..e76f6625f 100644
--- a/src/lux/host.clj
+++ b/src/lux/host.clj
@@ -96,10 +96,10 @@
(defn extract-jvm-param [token]
(matchv ::M/objects [token]
- [["Ident" ?ident]]
+ [["Symbol" ?ident]]
(full-class-name ?ident)
- [["Form" ["Cons" [["Ident" "Array"] ["Cons" [["Ident" ?inner] ["Nil" _]]]]]]]
+ [["Form" ["Cons" [["Symbol" "Array"] ["Cons" [["Symbol" ?inner] ["Nil" _]]]]]]]
(exec [=inner (full-class-name ?inner)]
(return (str "[L" (->class =inner) ";")))
diff --git a/src/lux/lexer.clj b/src/lux/lexer.clj
index 1c506950c..bebf9423e 100644
--- a/src/lux/lexer.clj
+++ b/src/lux/lexer.clj
@@ -75,7 +75,7 @@
^:private lex-bool "Bool" #"^(true|false)"
^:private lex-real "Real" #"^-?(0|[1-9][0-9]*)\.[0-9]+"
^:private lex-int "Int" #"^-?(0|[1-9][0-9]*)"
- ^:private lex-ident "Ident" +ident-re+)
+ ^:private lex-ident "Symbol" +ident-re+)
(def ^:private lex-char
(exec [_ (lex-prefix "#\"")
diff --git a/src/lux/parser.clj b/src/lux/parser.clj
index 49a636bd6..56d8eb38f 100644
--- a/src/lux/parser.clj
+++ b/src/lux/parser.clj
@@ -12,7 +12,8 @@
token &lexer/lex]
(matchv ::M/objects [token]
[[<close-token> _]]
- (return (&/|list (&/V <tag> (&/|concat elems))))
+ (return (&/|list (&/V <tag> (&/fold &/|++ (&/|list) elems))))
+
[_]
(fail (str "[Parser Error] Unbalanced " <description> ".")))))
@@ -23,7 +24,7 @@
(defn ^:private parse-record [parse]
(exec [elems* (&/repeat% parse)
token &lexer/lex
- :let [elems (&/|concat elems*)]]
+ :let [elems (&/fold &/|++ (&/|list) elems*)]]
(matchv ::M/objects [token]
[["Close_Brace" _]]
(fail (str "[Parser Error] Unbalanced braces."))
@@ -37,6 +38,7 @@
(def parse
(exec [token &lexer/lex
;; :let [_ (prn 'parse/token token)]
+ ;; :let [_ (prn 'parse (aget token 0))]
]
(matchv ::M/objects [token]
[["White_Space" _]]
@@ -60,8 +62,8 @@
[["Text" ?value]]
(return (&/|list (&/V "Text" ?value)))
- [["Ident" ?value]]
- (return (&/|list (&/V "Ident" ?value)))
+ [["Symbol" ?value]]
+ (return (&/|list (&/V "Symbol" ?value)))
[["Tag" ?value]]
(return (&/|list (&/V "Tag" ?value)))
@@ -69,9 +71,12 @@
[["Open_Paren" _]]
(parse-form parse)
- [["Open-Bracket" _]]
+ [["Open_Bracket" _]]
(parse-tuple parse)
- [["Open_Brace"]]
+ [["Open_Brace" _]]
(parse-record parse)
+
+ [_]
+ (fail "[Parser Error] Unknown lexer token.")
)))
diff --git a/src/lux/type.clj b/src/lux/type.clj
index a59ef19ca..927110cc6 100644
--- a/src/lux/type.clj
+++ b/src/lux/type.clj
@@ -9,8 +9,13 @@
(defn ^:private deref [id]
(fn [state]
- (if-let [type (->> state (&/get$ "types") (&/get$ "mappings") (&/|get id))]
- (return* state type)
+ (if-let [type* (->> state (&/get$ "types") (&/get$ "mappings") (&/|get id))]
+ (matchv ::M/objects [type*]
+ [["Some" type]]
+ (return* state type)
+
+ [["None" _]]
+ (fail* (str "Unbound type-var: " id)))
(fail* (str "Unknown type-var: " id)))))
(defn ^:private reset [id type]
@@ -26,9 +31,9 @@
(def fresh-var
(fn [state]
(let [id (->> state (&/get$ "types") (&/get$ "counter"))]
- (return* (&/update$ "types" #(-> %
- (&/update$ "counter" inc)
- (&/update$ "mappings" (fn [ms] (&/|put id (&/V "None" nil) ms))))
+ (return* (&/update$ "types" #(->> %
+ (&/update$ "counter" inc)
+ (&/update$ "mappings" (fn [ms] (&/|put id (&/V "None" nil) ms))))
state)
(&/V "Var" id)))))
@@ -82,7 +87,7 @@
(def +list+
[::All (&/|list) "List" "a"
[::Variant (&/|list ["Cons" [::Tuple (&/|list [::Bound "a"] [::App [::Bound "List"] [::Bound "a"]])]]
- ["Nil" [::Tuple (&/|list)]])]])
+ ["Nil" [::Tuple (&/|list)]])]])
(def +type+
(let [text [::Data "java.lang.String" (&/|list)]
@@ -105,52 +110,58 @@
["All" [::Tuple (&/|list string=>type text text type)]]
)]])))
-(defn clean [type]
- (matchv ::M/objects [type]
- [["Var" ?id]]
- (exec [=type (deref ?id)]
- (clean =type))
-
- [["Lambda" [?arg ?return]]]
- (exec [=arg (clean ?arg)
- =return (clean ?return)]
- (return (&/V "Lambda" (to-array [=arg =return]))))
-
- [["App" [?lambda ?param]]]
- (exec [=lambda (clean ?lambda)
- =param (clean ?param)]
- (return (&/V "App" (to-array [=lambda =param]))))
-
- [["Tuple" ?members]]
- (exec [=members (&/map% clean ?members)]
- (return (&/V "Tuple" =members)))
-
- [["Variant" ?members]]
- (exec [=members (&/map% (fn [[k v]]
- (exec [=v (clean v)]
- (return (to-array [k =v]))))
- ?members)]
- (return (&/V "Variant" =members)))
-
- [["Record" ?members]]
- (exec [=members (&/map% (fn [[k v]]
- (exec [=v (clean v)]
+(defn clean [tvar type]
+ (matchv ::M/objects [tvar]
+ [["Var" ?tid]]
+ (matchv ::M/objects [type]
+ [["Var" ?id]]
+ (if (= ?tid ?id)
+ (&/try-all% (&/|list (exec [=type (deref ?id)]
+ (clean tvar =type))
+ (return type)))
+ (return type))
+
+ [["Lambda" [?arg ?return]]]
+ (exec [=arg (clean tvar ?arg)
+ =return (clean tvar ?return)]
+ (return (&/V "Lambda" (to-array [=arg =return]))))
+
+ [["App" [?lambda ?param]]]
+ (exec [=lambda (clean tvar ?lambda)
+ =param (clean tvar ?param)]
+ (return (&/V "App" (to-array [=lambda =param]))))
+
+ [["Tuple" ?members]]
+ (exec [=members (&/map% (partial clean tvar) ?members)]
+ (return (&/V "Tuple" =members)))
+
+ [["Variant" ?members]]
+ (exec [=members (&/map% (fn [[k v]]
+ (exec [=v (clean tvar v)]
+ (return (to-array [k =v]))))
+ ?members)]
+ (return (&/V "Variant" =members)))
+
+ [["Record" ?members]]
+ (exec [=members (&/map% (fn [[k v]]
+ (exec [=v (clean tvar v)]
+ (return (to-array [k =v]))))
+ ?members)]
+ (return (&/V "Record" =members)))
+
+ [["All" [?env ?name ?arg ?body]]]
+ (exec [=env (&/map% (fn [[k v]]
+ (exec [=v (clean tvar v)]
(return (to-array [k =v]))))
- ?members)]
- (return (&/V "Record" =members)))
-
- [["All" [?env ?name ?arg ?body]]]
- (exec [=env (&/map% (fn [[k v]]
- (exec [=v (clean v)]
- (return (to-array [k =v]))))
- ?env)]
- (return (&/V "All" (to-array [=env ?name ?arg ?body]))))
+ ?env)]
+ (return (&/V "All" (to-array [=env ?name ?arg ?body]))))
- [_]
- (return type)
- ))
+ [_]
+ (return type)
+ )))
(defn ^:private show-type [type]
+ (prn 'show-type (aget type 0))
(matchv ::M/objects [type]
[["Any" _]]
"Any"
@@ -206,6 +217,7 @@
(str "Type " (show-type expected) " does not subsume type " (show-type actual)))
(defn solve [expected actual]
+ (prn 'solve (aget expected 0) (aget actual 0))
(matchv ::M/objects [expected actual]
[["Any" _] _]
success
@@ -243,16 +255,20 @@
(solve e!output a!output))
[["Var" e!id] _]
- (exec [=e!type (deref e!id)
- _ (solve =e!type actual)
- _ (reset e!id =e!type)]
- success)
+ (&/try-all% (&/|list (exec [=e!type (deref e!id)
+ _ (solve =e!type actual)
+ _ (reset e!id =e!type)]
+ success)
+ (exec [_ (reset e!id actual)]
+ success)))
[_ ["Var" a!id]]
- (exec [=a!type (deref a!id)
- _ (solve expected =a!type)
- _ (reset a!id =a!type)]
- success)
+ (&/try-all% (&/|list (exec [=a!type (deref a!id)
+ _ (solve expected =a!type)
+ _ (reset a!id =a!type)]
+ success)
+ (exec [_ (reset a!id expected)]
+ success)))
[_ _]
(solve-error expected actual)
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-24 12:32:32 +0000