From b2f4b64467d49904509fd5e87735536f846121b2 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Thu, 19 Mar 2015 22:53:10 -0400 Subject: [2nd Super Refactoring That Breaks The System: Part 5] - Changed indents to symbols. - Corrected some of the bugs in the system. Many more still awaiting fixes. --- src/lux.clj | 9 +- src/lux/analyser.clj | 204 ++++++++--------- src/lux/analyser/case.clj | 2 +- src/lux/analyser/def.clj | 15 +- src/lux/analyser/env.clj | 22 +- src/lux/analyser/host.clj | 75 +++---- src/lux/analyser/lambda.clj | 10 +- src/lux/analyser/lux.clj | 111 +++++---- src/lux/base.clj | 225 ++++++++++++++----- src/lux/compiler.clj | 533 ++++++++++++++++++++++---------------------- src/lux/compiler/base.clj | 177 ++++++++------- src/lux/compiler/case.clj | 101 +++++---- src/lux/compiler/host.clj | 5 +- src/lux/compiler/lambda.clj | 37 +-- src/lux/compiler/lux.clj | 61 ++--- src/lux/host.clj | 4 +- src/lux/lexer.clj | 2 +- src/lux/parser.clj | 17 +- src/lux/type.clj | 128 ++++++----- 19 files changed, 964 insertions(+), 774 deletions(-) (limited to 'src') 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 [module name] (fn [state] (return* state - (->> state (&/get$ "modules") (&/|get module) (&/get$ ) (&/|get name) boolean)))) + (->> state (&/get$ "modules") (&/|get module) (&/get$ ) (&/|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 [ ] @@ -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 ¯o] @@ -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 (¯o/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 [ ] - (defn [f xs] - (matchv ::M/objects [xs] - [["Nil" _]] - (return xs) - - [["Cons" [x xs*]]] - (exec [y (f x) - ys ( f xs*)] - (return ( y ys))))) - - map% cons% - flat-map% ++%)) +(do-template [ ] + (defn [f xs] + (matchv ::M/objects [xs] + [["Nil" _]] + (return xs) + + [["Cons" [x xs*]]] + (exec [y (f x) + ys ( f xs*)] + (return ( 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 "" "()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 -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--signature [env] - (str "(" (reduce str "" (repeat (count env) clo-field-sig)) ")" + (str "(" (&/fold str "" (&/|repeat (&/|length env) clo-field-sig)) ")" -return)) (defn ^:private add-lambda- [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-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- 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 "" "()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] [[ _]] - (return (&/|list (&/V (&/|concat elems)))) + (return (&/|list (&/V (&/fold &/|++ (&/|list) elems)))) + [_] (fail (str "[Parser Error] Unbalanced " "."))))) @@ -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) -- cgit v1.2.3