From 2560b63dcc98a6a6b5e2f938d8279d9bb4627052 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 6 May 2015 17:46:08 -0400 Subject: - Removed all the unnecesary comments. - Made some changes to the way type-checking is performed on variants, records & tuples in order to improve the speed of type-checking. --- src/lux.clj | 10 - src/lux/analyser.clj | 46 ++-- src/lux/analyser/base.clj | 13 +- src/lux/analyser/case.clj | 188 ++++++++--------- src/lux/analyser/host.clj | 35 +--- src/lux/analyser/lambda.clj | 7 - src/lux/analyser/lux.clj | 267 +++++++---------------- src/lux/analyser/module.clj | 29 ++- src/lux/base.clj | 74 +++---- src/lux/compiler.clj | 500 +++++++++++++++++++++----------------------- src/lux/compiler/base.clj | 178 ++++++++-------- src/lux/compiler/case.clj | 9 +- src/lux/compiler/host.clj | 7 +- src/lux/compiler/lambda.clj | 20 +- src/lux/compiler/lux.clj | 16 +- src/lux/host.clj | 5 +- src/lux/lexer.clj | 16 +- src/lux/parser.clj | 17 +- src/lux/reader.clj | 13 +- src/lux/type.clj | 241 +++++++-------------- 20 files changed, 689 insertions(+), 1002 deletions(-) (limited to 'src') diff --git a/src/lux.clj b/src/lux.clj index de302b260..62e9d14f9 100644 --- a/src/lux.clj +++ b/src/lux.clj @@ -11,15 +11,5 @@ (comment ;; TODO: Finish total-locals - (time (&compiler/compile-all (&/|list "program"))) - - (time (&compiler/compile-all (&/|list "lux"))) - (System/gc) - (time (&compiler/compile-all (&/|list "lux" "test2"))) - - ;; jar cvf test2.jar *.class test2 && java -cp "test2.jar" test2 - ;; jar cvf program.jar output/*.class output/program && java -cp "program.jar" program - ;; cd output && jar cvf test2.jar * && java -cp "test2.jar" test2 && cd .. - ;; cd output && jar cvf program.jar * && java -cp "program.jar" program && cd .. ) diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj index e2cdb83ce..eefb5b41c 100644 --- a/src/lux/analyser.clj +++ b/src/lux/analyser.clj @@ -88,9 +88,7 @@ ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ?name]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]]]] - (do ;; (when (= "if" ?name) - ;; (prn "if" (&/show-ast ?value))) - (&&lux/analyse-def analyse ?name ?value)) + (&&lux/analyse-def analyse ?name ?value) [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "declare-macro'"]]]] ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ?name]]]] @@ -458,10 +456,6 @@ (fail ""))) (defn ^:private analyse-basic-ast [analyse eval! exo-type token] - ;; (prn 'analyse-basic-ast (aget token 0)) - ;; (when (= "lux;Tag" (aget token 0)) - ;; (prn 'analyse-basic-ast/tag (aget token 1))) - ;; (prn 'analyse-basic-ast token (&/show-ast token)) (fn [state] (matchv ::M/objects [((aba1 analyse eval! exo-type token) state)] [["lux;Right" [state* output]]] @@ -472,36 +466,53 @@ [["lux;Right" [state* output]]] (return* state* output) - [_] + [["lux;Left" ""]] (matchv ::M/objects [((aba3 analyse eval! exo-type token) state)] [["lux;Right" [state* output]]] (return* state* output) - [_] + [["lux;Left" ""]] (matchv ::M/objects [((aba4 analyse eval! exo-type token) state)] [["lux;Right" [state* output]]] (return* state* output) - [_] + [["lux;Left" ""]] (matchv ::M/objects [((aba5 analyse eval! exo-type token) state)] [["lux;Right" [state* output]]] (return* state* output) - [_] + [["lux;Left" ""]] (matchv ::M/objects [((aba6 analyse eval! exo-type token) state)] [["lux;Right" [state* output]]] (return* state* output) - - [_] + + [["lux;Left" ""]] (matchv ::M/objects [((aba7 analyse eval! exo-type token) state)] [["lux;Right" [state* output]]] (return* state* output) [_] - (fail* (str "[Analyser Error] Unmatched token: " (&/show-ast token)))))))))))) + (fail* (str "[Analyser Error] Unmatched token: " (&/show-ast token)))) + + [_] + (fail* (str "[Analyser Error] Unmatched token: " (&/show-ast token)))) + + [_] + (fail* (str "[Analyser Error] Unmatched token: " (&/show-ast token)))) + + [_] + (fail* (str "[Analyser Error] Unmatched token: " (&/show-ast token)))) + + [_] + (fail* (str "[Analyser Error] Unmatched token: " (&/show-ast token)))) + + [_] + (fail* (str "[Analyser Error] Unmatched token: " (&/show-ast token)))) + + [_] + (fail* (str "[Analyser Error] Unmatched token: " (&/show-ast token)))))) (defn ^:private analyse-ast [eval! exo-type token] - ;; (prn 'analyse-ast (aget token 0)) (matchv ::M/objects [token] [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Tag" ?ident]]] ?values]]]]]] (do (assert (= 1 (&/|length ?values)) "[Analyser Error] Can only tag 1 value.") @@ -509,15 +520,12 @@ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [?fn ?args]]]]]] (fn [state] - ;; (prn 'analyse-ast '(&/show-ast ?fn) (&/show-ast ?fn)) (matchv ::M/objects [((&type/with-var #(&&/analyse-1 (partial analyse-ast eval!) % ?fn)) state)] [["lux;Right" [state* =fn]]] ((&&lux/analyse-apply (partial analyse-ast eval!) exo-type =fn ?args) state*) [_] - (do ;; (prn 'analyse-ast/token (aget token 0) (&/show-state state)) - ;; (prn 'NOT_A_FUNCTION (&/show-ast ?fn)) - ((analyse-basic-ast (partial analyse-ast eval!) eval! exo-type token) state)))) + ((analyse-basic-ast (partial analyse-ast eval!) eval! exo-type token) state))) [_] (analyse-basic-ast (partial analyse-ast eval!) eval! exo-type token))) diff --git a/src/lux/analyser/base.clj b/src/lux/analyser/base.clj index 9913da4ae..b16025349 100644 --- a/src/lux/analyser/base.clj +++ b/src/lux/analyser/base.clj @@ -6,21 +6,18 @@ ;; [Exports] (defn expr-type [syntax+] - ;; (prn 'expr-type syntax+) - ;; (prn 'expr-type (aget syntax+ 0)) (matchv ::M/objects [syntax+] [[_ type]] (return type))) (defn analyse-1 [analyse exo-type elem] (|do [output (analyse exo-type elem)] - (do ;; (prn 'analyse-1 (aget output 0)) - (matchv ::M/objects [output] - [["lux;Cons" [x ["lux;Nil" _]]]] - (return x) + (matchv ::M/objects [output] + [["lux;Cons" [x ["lux;Nil" _]]]] + (return x) - [_] - (fail "[Analyser Error] Can't expand to other than 1 element."))))) + [_] + (fail "[Analyser Error] Can't expand to other than 1 element.")))) (defn resolved-ident [ident] (|let [[?module ?name] ident] diff --git a/src/lux/analyser/case.clj b/src/lux/analyser/case.clj index ea767d11c..cdcf40e0f 100644 --- a/src/lux/analyser/case.clj +++ b/src/lux/analyser/case.clj @@ -19,105 +19,102 @@ (&type/actual-type type))) (defn ^:private analyse-pattern [value-type pattern kont] - ;; (prn 'analyse-pattern/pattern (aget pattern 0) (aget pattern 1) (alength (aget pattern 1))) (matchv ::M/objects [pattern] [["lux;Meta" [_ pattern*]]] - ;; (assert false) - (do ;; (prn 'analyse-pattern/pattern* (aget pattern* 0)) - (matchv ::M/objects [pattern*] - [["lux;Symbol" ?ident]] - (|do [=kont (&env/with-local (&/ident->text ?ident) value-type - kont) - idx &env/next-local-idx] - (return (&/T (&/V "StoreTestAC" idx) =kont))) - - [["lux;Bool" ?value]] - (|do [_ (&type/check value-type &type/Bool) - =kont kont] - (return (&/T (&/V "BoolTestAC" ?value) =kont))) - - [["lux;Int" ?value]] - (|do [_ (&type/check value-type &type/Int) - =kont kont] - (return (&/T (&/V "IntTestAC" ?value) =kont))) - - [["lux;Real" ?value]] - (|do [_ (&type/check value-type &type/Real) - =kont kont] - (return (&/T (&/V "RealTestAC" ?value) =kont))) - - [["lux;Char" ?value]] - (|do [_ (&type/check value-type &type/Char) - =kont kont] - (return (&/T (&/V "CharTestAC" ?value) =kont))) - - [["lux;Text" ?value]] - (|do [_ (&type/check value-type &type/Text) - =kont kont] - (return (&/T (&/V "TextTestAC" ?value) =kont))) - - [["lux;Tuple" ?members]] - (matchv ::M/objects [value-type] - [["lux;TupleT" ?member-types]] - (if (not (= (&/|length ?member-types) (&/|length ?members))) - (fail (str "[Analyser error] Pattern-matching mismatch. Require tuple[" (&/|length ?member-types) "]. Given tuple [" (&/|length ?members) "]")) - (|do [[=tests =kont] (&/fold (fn [kont* vm] - (|let [[v m] vm] - (|do [[=test [=tests =kont]] (analyse-pattern v m kont*)] - (return (&/T (&/|cons =test =tests) =kont))))) + (matchv ::M/objects [pattern*] + [["lux;Symbol" ?ident]] + (|do [=kont (&env/with-local (&/ident->text ?ident) value-type + kont) + idx &env/next-local-idx] + (return (&/T (&/V "StoreTestAC" idx) =kont))) + + [["lux;Bool" ?value]] + (|do [_ (&type/check value-type &type/Bool) + =kont kont] + (return (&/T (&/V "BoolTestAC" ?value) =kont))) + + [["lux;Int" ?value]] + (|do [_ (&type/check value-type &type/Int) + =kont kont] + (return (&/T (&/V "IntTestAC" ?value) =kont))) + + [["lux;Real" ?value]] + (|do [_ (&type/check value-type &type/Real) + =kont kont] + (return (&/T (&/V "RealTestAC" ?value) =kont))) + + [["lux;Char" ?value]] + (|do [_ (&type/check value-type &type/Char) + =kont kont] + (return (&/T (&/V "CharTestAC" ?value) =kont))) + + [["lux;Text" ?value]] + (|do [_ (&type/check value-type &type/Text) + =kont kont] + (return (&/T (&/V "TextTestAC" ?value) =kont))) + + [["lux;Tuple" ?members]] + (matchv ::M/objects [value-type] + [["lux;TupleT" ?member-types]] + (if (not (= (&/|length ?member-types) (&/|length ?members))) + (fail (str "[Analyser error] Pattern-matching mismatch. Require tuple[" (&/|length ?member-types) "]. Given tuple [" (&/|length ?members) "]")) + (|do [[=tests =kont] (&/fold (fn [kont* vm] + (|let [[v m] vm] + (|do [[=test [=tests =kont]] (analyse-pattern v m kont*)] + (return (&/T (&/|cons =test =tests) =kont))))) + (|do [=kont kont] + (return (&/T (&/|list) =kont))) + (&/|reverse (&/zip2 ?member-types ?members)))] + (return (&/T (&/V "TupleTestAC" =tests) =kont)))) + + [_] + (fail "[Analyser Error] Tuple requires tuple-type.")) + + [["lux;Record" ?slots]] + (|do [value-type* (resolve-type value-type)] + (matchv ::M/objects [value-type*] + [["lux;RecordT" ?slot-types]] + (if (not (= (&/|length ?slot-types) (&/|length ?slots))) + (fail (str "[Analyser error] Pattern-matching mismatch. Require record[" (&/|length ?slot-types) "]. Given record[" (&/|length ?slots) "]")) + (|do [[=tests =kont] (&/fold (fn [kont* slot] + (|let [[sn sv] slot] + (matchv ::M/objects [sn] + [["lux;Meta" [_ ["lux;Tag" ?ident]]]] + (|do [=tag (&&/resolved-ident ?ident)] + (if-let [=slot-type (&/|get =tag ?slot-types)] + (|do [[=test [=tests =kont]] (analyse-pattern =slot-type sv kont*)] + (return (&/T (&/|put =tag =test =tests) =kont))) + (fail (str "[Pattern-Matching Error] Record-type lacks slot: " =tag)))) + + [_] + (fail (str "[Pattern-Matching Error] Record must use tags as slot-names: " (&/show-ast sn)))))) (|do [=kont kont] - (return (&/T (&/|list) =kont))) - (&/|reverse (&/zip2 ?member-types ?members)))] - (return (&/T (&/V "TupleTestAC" =tests) =kont)))) + (return (&/T (&/|table) =kont))) + (&/|reverse ?slots))] + (return (&/T (&/V "RecordTestAC" =tests) =kont)))) [_] - (fail "[Analyser Error] Tuple requires tuple-type.")) - - [["lux;Record" ?slots]] - (|do [value-type* (resolve-type value-type)] - (matchv ::M/objects [value-type*] - [["lux;RecordT" ?slot-types]] - (if (not (= (&/|length ?slot-types) (&/|length ?slots))) - (fail (str "[Analyser error] Pattern-matching mismatch. Require record[" (&/|length ?slot-types) "]. Given record[" (&/|length ?slots) "]")) - (|do [[=tests =kont] (&/fold (fn [kont* slot] - (|let [[sn sv] slot] - (matchv ::M/objects [sn] - [["lux;Meta" [_ ["lux;Tag" ?ident]]]] - (|do [=tag (&&/resolved-ident ?ident)] - (if-let [=slot-type (&/|get =tag ?slot-types)] - (|do [[=test [=tests =kont]] (analyse-pattern =slot-type sv kont*)] - (return (&/T (&/|put =tag =test =tests) =kont))) - (fail (str "[Pattern-Matching Error] Record-type lacks slot: " =tag)))) - - [_] - (fail (str "[Pattern-Matching Error] Record must use tags as slot-names: " (&/show-ast sn)))))) - (|do [=kont kont] - (return (&/T (&/|table) =kont))) - (&/|reverse ?slots))] - (return (&/T (&/V "RecordTestAC" =tests) =kont)))) - - [_] - (fail "[Analyser Error] Record requires record-type."))) - - [["lux;Tag" ?ident]] - (|do [=tag (&&/resolved-ident ?ident) - value-type* (resolve-type value-type) - case-type (&type/variant-case =tag value-type*) - [=test =kont] (analyse-pattern case-type (&/V "lux;Meta" (&/T (&/T "" -1 -1) - (&/V "lux;Tuple" (&/|list)))) - kont)] - (return (&/T (&/V "VariantTestAC" (&/T =tag =test)) =kont))) - - [["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Tag" ?ident]]] - ["lux;Cons" [?value - ["lux;Nil" _]]]]]]] - (|do [=tag (&&/resolved-ident ?ident) - value-type* (resolve-type value-type) - case-type (&type/variant-case =tag value-type*) - [=test =kont] (analyse-pattern case-type ?value - kont)] - (return (&/T (&/V "VariantTestAC" (&/T =tag =test)) =kont))) - )))) + (fail "[Analyser Error] Record requires record-type."))) + + [["lux;Tag" ?ident]] + (|do [=tag (&&/resolved-ident ?ident) + value-type* (resolve-type value-type) + case-type (&type/variant-case =tag value-type*) + [=test =kont] (analyse-pattern case-type (&/V "lux;Meta" (&/T (&/T "" -1 -1) + (&/V "lux;Tuple" (&/|list)))) + kont)] + (return (&/T (&/V "VariantTestAC" (&/T =tag =test)) =kont))) + + [["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Tag" ?ident]]] + ["lux;Cons" [?value + ["lux;Nil" _]]]]]]] + (|do [=tag (&&/resolved-ident ?ident) + value-type* (resolve-type value-type) + case-type (&type/variant-case =tag value-type*) + [=test =kont] (analyse-pattern case-type ?value + kont)] + (return (&/T (&/V "VariantTestAC" (&/T =tag =test)) =kont))) + ))) (defn ^:private analyse-branch [analyse exo-type value-type pattern body patterns] (|do [pattern+body (analyse-pattern value-type pattern @@ -219,7 +216,6 @@ )))) (defn ^:private check-totality [value-type struct] - ;; (prn 'check-totality (aget value-type 0) (aget struct 0) (&type/show-type value-type)) (matchv ::M/objects [struct] [["BoolTotal" [?total ?values]]] (return (or ?total @@ -296,10 +292,8 @@ (analyse-branch analyse exo-type value-type pattern body patterns))) (&/|list) branches) - ;; :let [_ (prn 'PRE_MERGE_TOTALS)] struct (&/fold% merge-total (&/V "DefaultTotal" false) patterns) ? (check-totality value-type struct)] (if ? - ;; (return (&/|reverse patterns)) (return patterns) (fail "[Pattern-maching error] Pattern-matching is non-total.")))) diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj index 3c9e3ce3f..d57493439 100644 --- a/src/lux/analyser/host.clj +++ b/src/lux/analyser/host.clj @@ -21,7 +21,6 @@ (defn ^:private analyse-1+ [analyse ?token] (&type/with-var (fn [$var] - ;; (prn 'analyse-1+ (aget $var 1) (&/show-ast ?token)) (|do [=expr (&&/analyse-1 analyse $var ?token)] (matchv ::M/objects [=expr] [[?item ?type]] @@ -77,10 +76,7 @@ (defn analyse-jvm-getstatic [analyse ?class ?field] (|do [=class (&host/full-class-name ?class) - ;; :let [_ (prn 'analyse-jvm-getstatic/=class =class)] - =type (&host/lookup-static-field =class ?field) - ;; :let [_ (prn 'analyse-jvm-getstatic/=type =type)] - ] + =type (&host/lookup-static-field =class ?field)] (return (&/|list (&/T (&/V "jvm-getstatic" (&/T =class ?field)) =type))))) (defn analyse-jvm-getfield [analyse ?class ?field ?object] @@ -91,9 +87,7 @@ (defn analyse-jvm-putstatic [analyse ?class ?field ?value] (|do [=class (&host/full-class-name ?class) - ;; :let [_ (prn 'analyse-jvm-getstatic/=class =class)] =type (&host/lookup-static-field =class ?field) - ;; :let [_ (prn 'analyse-jvm-getstatic/=type =type)] =value (&&/analyse-1 analyse ?value)] (return (&/|list (&/T (&/V "jvm-putstatic" (&/T =class ?field =value)) =type))))) @@ -113,21 +107,14 @@ (do-template [ ] (defn [analyse ?class ?method ?classes ?object ?args] - ;; (prn ' ?class ?method) (|do [=class (&host/full-class-name ?class) - ;; :let [_ (prn 'analyse-jvm-invokevirtual/=class =class)] =classes (&/map% &host/extract-jvm-param ?classes) - ;; :let [_ (prn 'analyse-jvm-invokevirtual/=classes =classes)] =return (&host/lookup-virtual-method =class ?method =classes) - ;; :let [_ (prn 'analyse-jvm-invokevirtual/=return =return)] =object (&&/analyse-1 analyse (&/V "lux;DataT" ?class) ?object) - ;; :let [_ (prn 'analyse-jvm-invokevirtual/=object =object)] =args (&/map% (fn [c+o] (|let [[?c ?o] c+o] (&&/analyse-1 analyse (&/V "lux;DataT" ?c) ?o))) - (&/zip2 =classes ?args)) - ;; :let [_ (prn 'analyse-jvm-invokevirtual/=args =args)] - ] + (&/zip2 =classes ?args))] (return (&/|list (&/T (&/V (&/T =class ?method =classes =object =args)) =return))))) analyse-jvm-invokevirtual "jvm-invokevirtual" @@ -179,9 +166,7 @@ (return (&/|list (&/V "jvm-class" (&/T $module ?name ?super-class =fields {})))))) (defn analyse-jvm-interface [analyse ?name ?members] - ;; (prn 'analyse-jvm-interface ?name ?members) (|do [=members (&/map% (fn [member] - ;; (prn 'analyse-jvm-interface (&/show-ast member)) (matchv ::M/objects [member] [["lux;Meta" [_ ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ":'"]]]] ["lux;Cons" [["lux;Meta" [_ ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "->"]]]] @@ -190,15 +175,13 @@ ["lux;Nil" _]]]]]]]]]] ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ ?member-name]]]] ["lux;Nil" _]]]]]]]]]]] - (do ;; (prn 'analyse-jvm-interface ?member-name ?inputs ?output) - (|do [inputs* (&/map% extract-ident ?inputs)] - (return [?member-name [inputs* ?output]]))) + (|do [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)] + :let [=methods (into {} (for [[method [inputs output]] (&/->seq =members)] [method {:access :public :type [inputs output]}]))] $module &/get-module-name] @@ -270,11 +253,7 @@ ) (defn analyse-jvm-program [analyse ?args ?body] - (|do [;; =body (&&env/with-local ?args (&/V "lux;AppT" (&/T &type/List &type/Text)) - ;; (&&/analyse-1 analyse ?body)) - =body (&/with-scope "" + (|do [=body (&/with-scope "" (&&env/with-local "" (&/V "lux;AppT" (&/T &type/List &type/Text)) - (analyse-1+ analyse ?body))) - ;; =body (analyse-1+ analyse ?body) - ] + (analyse-1+ analyse ?body)))] (return (&/|list (&/V "jvm-program" =body))))) diff --git a/src/lux/analyser/lambda.clj b/src/lux/analyser/lambda.clj index 859f47e56..4dd1be38f 100644 --- a/src/lux/analyser/lambda.clj +++ b/src/lux/analyser/lambda.clj @@ -8,8 +8,6 @@ ;; [Resource] (defn with-lambda [self self-type arg arg-type body] - ;; (prn 'with-lambda (&/|length self) (&/|length arg)) - ;; (prn 'with-lambda [(aget self 0) (aget self 1)] [(aget arg 0) (aget arg 1)] (alength self) (alength arg)) (|let [[?module1 ?name1] self [?module2 ?name2] arg] (&/with-closure @@ -21,11 +19,6 @@ (return (&/T scope-name =captured =return))))))))) (defn close-over [scope ident register frame] - ;; (prn 'close-over - ;; (&host/location scope) - ;; (&host/location (&/|list ident)) - ;; register - ;; (->> frame (&/get$ &/$CLOSURE) (&/get$ &/$COUNTER))) (matchv ::M/objects [register] [[_ register-type]] (|let [register* (&/T (&/V "captured" (&/T scope diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj index 2a68e0aeb..d461d5b6b 100644 --- a/src/lux/analyser/lux.clj +++ b/src/lux/analyser/lux.clj @@ -15,7 +15,6 @@ (defn ^:private analyse-1+ [analyse ?token] (&type/with-var (fn [$var] - ;; (prn 'analyse-1+ (aget $var 1) (&/show-ast ?token)) (|do [=expr (&&/analyse-1 analyse $var ?token)] (matchv ::M/objects [=expr] [[?item ?type]] @@ -25,9 +24,6 @@ ;; [Exports] (defn analyse-tuple [analyse exo-type ?elems] - ;; (prn "^^ analyse-tuple ^^") - ;; (prn 'analyse-tuple (str "[" (->> ?elems (&/|map &/show-ast) (&/|interpose " ") (&/fold str "")) "]") - ;; (&type/show-type exo-type)) (|do [exo-type* (&type/actual-type exo-type)] (matchv ::M/objects [exo-type*] [["lux;TupleT" ?members]] @@ -48,9 +44,7 @@ (fail (str "[Analyser Error] Tuples require tuple-types: " (&type/show-type exo-type*)))))) (defn analyse-variant [analyse exo-type ident ?value] - ;; (prn "^^ analyse-variant ^^") - (|do [;; :let [_ (prn 'analyse-variant/exo-type (&type/show-type exo-type))] - exo-type* (matchv ::M/objects [exo-type] + (|do [exo-type* (matchv ::M/objects [exo-type] [["lux;VarT" ?id]] (&/try-all% (&/|list (|do [exo-type* (&/try-all% (&/|list (&type/deref ?id) (fail "##8##")))] @@ -59,17 +53,12 @@ (&type/actual-type &type/Type)))) [_] - (&type/actual-type exo-type)) - ;; :let [_ (prn 'analyse-variant/exo-type* (&type/show-type exo-type*))] - ] + (&type/actual-type exo-type))] (matchv ::M/objects [exo-type*] [["lux;VariantT" ?cases]] (|do [?tag (&&/resolved-ident ident)] (if-let [vtype (&/|get ?tag ?cases)] - (|do [;; :let [_ (prn 'VARIANT_BODY ?tag (&/show-ast ?value) (&type/show-type vtype))] - =value (&&/analyse-1 analyse vtype ?value) - ;; :let [_ (prn 'GOT_VALUE =value)] - ] + (|do [=value (&&/analyse-1 analyse vtype ?value)] (return (&/|list (&/T (&/V "variant" (&/T ?tag =value)) exo-type)))) (fail (str "[Analyser Error] There is no case " ?tag " for variant type " (&type/show-type exo-type*))))) @@ -105,7 +94,6 @@ slot-type (if-let [slot-type (&/|get ?tag types)] (return slot-type) (fail (str "[Analyser Error] Record type does not have slot: " ?tag))) - ;; :let [_ (prn 'slot ?tag (&/show-ast ?value) (&type/show-type slot-type))] =value (&&/analyse-1 analyse slot-type ?value)] (return (&/T ?tag =value))) @@ -118,101 +106,77 @@ (|do [module-name &/get-module-name] (fn [state] (|let [[?module ?name] ident - ;; _ (prn 'analyse-symbol ?module ?name) local-ident (str ?module ";" ?name) stack (&/get$ &/$ENVS state) no-binding? #(and (->> % (&/get$ &/$LOCALS) (&/get$ &/$MAPPINGS) (&/|contains? local-ident) not) (->> % (&/get$ &/$CLOSURE) (&/get$ &/$MAPPINGS) (&/|contains? local-ident) not)) [inner outer] (&/|split-with no-binding? stack)] - (do ;; (when (= "<" ?name) - ;; (prn 'HALLO (&/|length inner) (&/|length outer))) - (matchv ::M/objects [outer] - [["lux;Nil" _]] - (&/run-state (|do [[[r-module r-name] $def] (&&module/find-def (if (= "" ?module) module-name ?module) - ?name) - endo-type (matchv ::M/objects [$def] - [["lux;ValueD" ?type]] - (return ?type) - - [["lux;MacroD" _]] - (return &type/Macro) - - [["lux;TypeD" _]] - (return &type/Type)) - ;; :let [_ (println "Got endo-type:" endo-type)] - _ (if (and (= &type/Type endo-type) (= &type/Type exo-type)) - (do ;; (println "OH YEAH" (if (= "" ?module) module-name ?module) - ;; ?name) - (return nil)) - (&type/check exo-type endo-type)) - ;; :let [_ (println "Type-checked:" exo-type endo-type)] - ] - (return (&/|list (&/T (&/V "lux;Global" (&/T r-module r-name)) - endo-type)))) - state) - - [["lux;Cons" [?genv ["lux;Nil" _]]]] - (if-let [global (->> ?genv (&/get$ &/$LOCALS) (&/get$ &/$MAPPINGS) (&/|get local-ident))] - (do (when (= "<" ?name) - (prn 'GOT_GLOBAL local-ident)) - (matchv ::M/objects [global] - [[["lux;Global" [?module* ?name*]] _]] - (&/run-state (|do [;; :let [_ (prn 'GLOBAL/_1 ?module* ?name*)] - ;; :let [_ (when (= "<" ?name) - ;; (println "Pre Found def:" ?module* ?name*))] - [[r-module r-name] $def] (&&module/find-def ?module* ?name*) - ;; :let [_ (prn 'GLOBAL/_2 r-module r-name)] - ;; :let [_ (when (= "<" ?name) - ;; (println "Found def:" r-module r-name))] - endo-type (matchv ::M/objects [$def] - [["lux;ValueD" ?type]] - (return ?type) - - [["lux;MacroD" _]] - (return &type/Macro) - - [["lux;TypeD" _]] - (return &type/Type)) - ;; :let [_ (println "Got endo-type:" endo-type)] - _ (if (and (= &type/Type endo-type) (= &type/Type exo-type)) - (do ;; (println "OH YEAH" ?module* ?name*) - (return nil)) - (&type/check exo-type endo-type)) - ;; :let [_ (println "Type-checked:" exo-type endo-type)] - ;; :let [_ (when (= "<" ?name) - ;; (println "Returnin'"))] - ] - (return (&/|list (&/T (&/V "lux;Global" (&/T r-module r-name)) - endo-type)))) - state) - - [_] - (fail* "[Analyser Error] Can't have anything other than a global def in the global environment."))) - (fail* "")) - - [["lux;Cons" [top-outer _]]] - (|let [scopes (&/|tail (&/folds #(&/|cons (&/get$ &/$NAME %2) %1) - (&/|map #(&/get$ &/$NAME %) outer) - (&/|reverse inner))) - [=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 local-ident)) - (->> top-outer (&/get$ &/$CLOSURE) (&/get$ &/$MAPPINGS) (&/|get local-ident))) - (&/|list)) - (&/zip2 (&/|reverse inner) scopes))] - (&/run-state (|do [btype (&&/expr-type =local) - _ (&type/check exo-type btype)] - (return (&/|list =local))) - (&/set$ &/$ENVS (&/|++ inner* outer) state))) - )))) + (matchv ::M/objects [outer] + [["lux;Nil" _]] + (&/run-state (|do [[[r-module r-name] $def] (&&module/find-def (if (= "" ?module) module-name ?module) + ?name) + endo-type (matchv ::M/objects [$def] + [["lux;ValueD" ?type]] + (return ?type) + + [["lux;MacroD" _]] + (return &type/Macro) + + [["lux;TypeD" _]] + (return &type/Type)) + _ (if (and (= &type/Type endo-type) (= &type/Type exo-type)) + (return nil) + (&type/check exo-type endo-type))] + (return (&/|list (&/T (&/V "lux;Global" (&/T r-module r-name)) + endo-type)))) + state) + + [["lux;Cons" [?genv ["lux;Nil" _]]]] + (if-let [global (->> ?genv (&/get$ &/$LOCALS) (&/get$ &/$MAPPINGS) (&/|get local-ident))] + (matchv ::M/objects [global] + [[["lux;Global" [?module* ?name*]] _]] + (&/run-state (|do [[[r-module r-name] $def] (&&module/find-def ?module* ?name*) + endo-type (matchv ::M/objects [$def] + [["lux;ValueD" ?type]] + (return ?type) + + [["lux;MacroD" _]] + (return &type/Macro) + + [["lux;TypeD" _]] + (return &type/Type)) + _ (if (and (= &type/Type endo-type) (= &type/Type exo-type)) + (return nil) + (&type/check exo-type endo-type))] + (return (&/|list (&/T (&/V "lux;Global" (&/T r-module r-name)) + endo-type)))) + state) + + [_] + (fail* "[Analyser Error] Can't have anything other than a global def in the global environment.")) + (fail* "")) + + [["lux;Cons" [top-outer _]]] + (|let [scopes (&/|tail (&/folds #(&/|cons (&/get$ &/$NAME %2) %1) + (&/|map #(&/get$ &/$NAME %) outer) + (&/|reverse inner))) + [=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 local-ident)) + (->> top-outer (&/get$ &/$CLOSURE) (&/get$ &/$MAPPINGS) (&/|get local-ident))) + (&/|list)) + (&/zip2 (&/|reverse inner) scopes))] + (&/run-state (|do [btype (&&/expr-type =local) + _ (&type/check exo-type btype)] + (return (&/|list =local))) + (&/set$ &/$ENVS (&/|++ inner* outer) state))) + ))) )) (defn ^:private analyse-apply* [analyse exo-type =fn ?args] - ;; (prn 'analyse-apply* (&/->seq (&/|map &/show-ast ?args))) - ;; (prn 'analyse-apply*/exo-type (&type/show-type exo-type)) (matchv ::M/objects [=fn] [[?fun-expr ?fun-type]] (matchv ::M/objects [?args] @@ -230,11 +194,6 @@ output (analyse-apply* analyse exo-type (&/T ?fun-expr type*) ?args)] (matchv ::M/objects [output $var] [[?expr* ?type*] ["lux;VarT" ?id]] - ;; (|do [? (&type/bound? ?id)] - ;; (if ? - ;; (return (&/T ?expr* ?type*)) - ;; (|do [type** (&type/clean $var ?type*)] - ;; (return (&/T ?expr* type**))))) (|do [? (&type/bound? ?id) _ (if ? (return nil) @@ -245,9 +204,6 @@ )))) [["lux;LambdaT" [?input-t ?output-t]]] - ;; (|do [=arg (&&/analyse-1 analyse ?input-t ?arg)] - ;; (return (&/T (&/V "apply" (&/T =fn =arg)) - ;; ?output-t))) (|do [=arg (&&/analyse-1 analyse ?input-t ?arg)] (analyse-apply* analyse exo-type (&/T (&/V "apply" (&/T =fn =arg)) ?output-t) @@ -258,58 +214,37 @@ ))) (defn analyse-apply [analyse exo-type =fn ?args] - ;; (prn 'analyse-apply1 (aget =fn 0)) (|do [loader &/loader] (matchv ::M/objects [=fn] [[=fn-form =fn-type]] - (do ;; (prn 'analyse-apply2 (aget =fn-form 0)) - (matchv ::M/objects [=fn-form] - [["lux;Global" [?module ?name]]] - (|do [[[r-module r-name] $def] (&&module/find-def ?module ?name) - ;; :let [_ (prn 'apply [?module ?name] (aget $def 0))] - ] - (matchv ::M/objects [$def] - [["lux;MacroD" macro]] - (|do [macro-expansion #(-> macro (.apply ?args) (.apply %)) - ;; :let [_ (cond (= ?name "using") - ;; (println (str "using: " (->> macro-expansion (&/|map &/show-ast) (&/|interpose " ") (&/fold str "")))) - - ;; ;; (= ?name "def") - ;; ;; (println (str "def " ?module ";" ?name ": " (->> macro-expansion (&/|map &/show-ast) (&/|interpose " ") (&/fold str "")))) - - ;; ;; (= ?name "type`") - ;; ;; (println (str "type`: " (->> macro-expansion (&/|map &/show-ast) (&/|interpose " ") (&/fold str "")))) - - ;; :else - ;; nil)] - ] - (&/flat-map% (partial analyse exo-type) macro-expansion)) + (matchv ::M/objects [=fn-form] + [["lux;Global" [?module ?name]]] + (|do [[[r-module r-name] $def] (&&module/find-def ?module ?name)] + (matchv ::M/objects [$def] + [["lux;MacroD" macro]] + (|do [macro-expansion #(-> macro (.apply ?args) (.apply %))] + (&/flat-map% (partial analyse exo-type) macro-expansion)) - [_] - (|do [output (analyse-apply* analyse exo-type =fn ?args)] - (return (&/|list output))))) - [_] (|do [output (analyse-apply* analyse exo-type =fn ?args)] (return (&/|list output))))) + + [_] + (|do [output (analyse-apply* analyse exo-type =fn ?args)] + (return (&/|list output)))) ))) (defn analyse-case [analyse exo-type ?value ?branches] - ;; (prn 'analyse-case 'exo-type (&type/show-type exo-type) (&/show-ast ?value)) (|do [:let [num-branches (&/|length ?branches)] _ (&/assert! (> num-branches 0) "[Analyser Error] Can't have empty branches in \"case'\" expression.") _ (&/assert! (even? num-branches) "[Analyser Error] Unbalanced branches in \"case'\" expression.") =value (analyse-1+ analyse ?value) =value-type (&&/expr-type =value) - ;; :let [_ (prn 'analyse-case/GOT_VALUE (&type/show-type =value-type))] - =match (&&case/analyse-branches analyse exo-type =value-type (&/|as-pairs ?branches)) - ;; :let [_ (prn 'analyse-case/GOT_MATCH)] - ] + =match (&&case/analyse-branches analyse exo-type =value-type (&/|as-pairs ?branches))] (return (&/|list (&/T (&/V "case" (&/T =value =match)) exo-type))))) (defn analyse-lambda* [analyse exo-type ?self ?arg ?body] - ;; (prn 'analyse-lambda ?self ?arg ?body) (matchv ::M/objects [exo-type] [["lux;LambdaT" [?arg-t ?return-t]]] (|do [[=scope =captured =body] (&&lambda/with-lambda ?self exo-type @@ -319,13 +254,9 @@ [_] (fail (str "[Analyser Error] Functions require function types: " - ;; (str (aget ?self 0) ";" (aget ?self 1)) - ;; (str( aget ?arg 0) ";" (aget ?arg 1)) - ;; (&/show-ast ?body) (&type/show-type exo-type))))) (defn analyse-lambda** [analyse exo-type ?self ?arg ?body] - ;; (prn 'analyse-lambda**/&& (aget exo-type 0)) (matchv ::M/objects [exo-type] [["lux;AllT" [_env _self _arg _body]]] (&type/with-var @@ -351,44 +282,19 @@ (analyse-lambda* analyse exo-type* ?self ?arg ?body)) )) -;; (defn analyse-lambda** [analyse exo-type ?self ?arg ?body] -;; ;; (prn 'analyse-lambda**/&& (aget exo-type 0)) -;; (matchv ::M/objects [exo-type] -;; [["lux;AllT" [_env _self _arg _body]]] -;; (&type/with-var -;; (fn [$var] -;; (|do [exo-type* (&type/apply-type exo-type $var) -;; output (analyse-lambda** analyse exo-type* ?self ?arg ?body)] -;; (matchv ::M/objects [$var] -;; [["lux;VarT" ?id]] -;; (|do [? (&type/bound? ?id)] -;; (if ? -;; (|do [dtype (&type/deref ?id)] -;; (fail (str "[Analyser Error] Can't use type-var in any type-specific way inside polymorphic functions: " ?id ":" _arg " " (&type/show-type dtype)))) -;; (return output))))))) - -;; [_] -;; (|do [exo-type* (&type/actual-type exo-type)] -;; (analyse-lambda* analyse exo-type* ?self ?arg ?body)) -;; )) - (defn analyse-lambda [analyse exo-type ?self ?arg ?body] (|do [output (analyse-lambda** analyse exo-type ?self ?arg ?body)] (return (&/|list output)))) (defn analyse-def [analyse ?name ?value] - ;; (prn 'analyse-def/CODE ?name (&/show-ast ?value)) (prn 'analyse-def/BEGIN ?name) (|do [module-name &/get-module-name ? (&&module/defined? module-name ?name)] (if ? (fail (str "[Analyser Error] Can't redefine " ?name)) - (|do [;; :let [_ (prn 'analyse-def/_0)] - =value (&/with-scope ?name + (|do [=value (&/with-scope ?name (analyse-1+ analyse ?value)) - =value-type (&&/expr-type =value) - ;; :let [_ (prn 'analyse-def/_1 [?name ?value] (aget =value 0 0))] - ] + =value-type (&&/expr-type =value)] (matchv ::M/objects [=value] [[["lux;Global" [?r-module ?r-name]] _]] (|do [_ (&&module/def-alias module-name ?name ?r-module ?r-name =value-type) @@ -409,11 +315,6 @@ (return (&/|list (&/V "def" (&/T ?name =value def-data)))))) )))) -(defn analyse-declare-macro [analyse ?name] - (|do [module-name &/get-module-name - _ (&&module/declare-macro module-name ?name)] - (return (&/|list)))) - (defn analyse-declare-macro [analyse ?name] (|do [module-name &/get-module-name] (return (&/|list (&/V "declare-macro" (&/T module-name ?name)))))) @@ -427,16 +328,10 @@ (return (&/|list)))) (defn analyse-check [analyse eval! exo-type ?type ?value] - ;; (println "analyse-check#0") (|do [=type (&&/analyse-1 analyse &type/Type ?type) - ;; =type (analyse-1+ analyse ?type) - ;; :let [_ (println "analyse-check#1")] ==type (eval! =type) _ (&type/check exo-type ==type) - ;; :let [_ (println "analyse-check#4" (&type/show-type ==type))] - =value (&&/analyse-1 analyse ==type ?value) - ;; :let [_ (println "analyse-check#5")] - ] + =value (&&/analyse-1 analyse ==type ?value)] (matchv ::M/objects [=value] [[?expr ?expr-type]] (return (&/|list (&/T ?expr ==type)))))) diff --git a/src/lux/analyser/module.clj b/src/lux/analyser/module.clj index de68f48aa..5960d3080 100644 --- a/src/lux/analyser/module.clj +++ b/src/lux/analyser/module.clj @@ -32,7 +32,6 @@ (defn def-alias [a-module a-name r-module r-name type] (fn [state] - ;; (prn 'def-alias [a-module a-name] '=> [r-module r-name]) (matchv ::M/objects [(&/get$ &/$ENVS state)] [["lux;Cons" [?env ["lux;Nil" _]]]] (return* (->> state @@ -53,7 +52,6 @@ (defn exists? [name] (fn [state] - ;; (prn `exists? name (->> state (&/get$ &/$MODULES) (&/|contains? name))) (return* state (->> state (&/get$ &/$MODULES) (&/|contains? name))))) @@ -96,20 +94,19 @@ (if-let [$def (&/|get name $module)] (matchv ::M/objects [$def] [[exported? ["lux;ValueD" ?type]]] - (do ;; (prn 'declare-macro/?type (aget ?type 0)) - (&/run-state (|do [_ (&type/check &type/Macro ?type) - ^ClassLoader loader &/loader - :let [macro (-> (.loadClass loader (&host/location (&/|list module name))) - (.getField "_datum") - (.get nil))]] - (fn [state*] - (return* (&/update$ &/$MODULES - (fn [$modules] - (&/|put module (&/|put name (&/T exported? (&/V "lux;MacroD" macro)) $module) - $modules)) - state*) - nil))) - state)) + (&/run-state (|do [_ (&type/check &type/Macro ?type) + ^ClassLoader loader &/loader + :let [macro (-> (.loadClass loader (&host/location (&/|list module name))) + (.getField "_datum") + (.get nil))]] + (fn [state*] + (return* (&/update$ &/$MODULES + (fn [$modules] + (&/|put module (&/|put name (&/T exported? (&/V "lux;MacroD" macro)) $module) + $modules)) + state*) + nil))) + state) [[_ ["lux;MacroD" _]]] (fail* (str "[Analyser Error] Can't re-declare a macro: " (str module &/+name-separator+ name))) diff --git a/src/lux/base.clj b/src/lux/base.clj index 70a658d19..283d06f52 100644 --- a/src/lux/base.clj +++ b/src/lux/base.clj @@ -81,7 +81,6 @@ (reverse (partition 2 elems)))) (defn |get [slot table] - ;; (prn '|get slot (aget table 0)) (matchv ::M/objects [table] [["lux;Nil" _]] nil @@ -112,7 +111,6 @@ (V "lux;Cons" (T (T k v) (|remove slot table*)))))) (defn |merge [table1 table2] - ;; (prn '|merge (aget table1 0) (aget table2 0)) (matchv ::M/objects [table2] [["lux;Nil" _]] table1 @@ -149,7 +147,6 @@ ;; [Resources/Monads] (defn fail [message] (fn [_] - ;; (prn 'FAIL message) (V "lux;Left" message))) (defn return [value] @@ -178,10 +175,7 @@ (fn [val#] (matchv ::M/objects [val#] [~label] - ~inner))) - ;; `(bind ~computation - ;; (fn [~label] ~inner)) - )) + ~inner))))) return (reverse (partition 2 steps)))) @@ -199,7 +193,6 @@ (V "lux;Cons" (T head tail))) (defn |++ [xs ys] - ;; (prn '|++ (and xs (aget xs 0)) (and ys (aget ys 0))) (matchv ::M/objects [xs] [["lux;Nil" _]] ys @@ -208,7 +201,6 @@ (V "lux;Cons" (T x (|++ xs* ys))))) (defn |map [f xs] - ;; (prn '|map (aget xs 0)) (matchv ::M/objects [xs] [["lux;Nil" _]] xs @@ -288,7 +280,6 @@ (|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] @@ -343,16 +334,13 @@ (do-template [ ] (defn [f xs] - ;; (prn ' 0 (aget xs 0)) (matchv ::M/objects [xs] [["lux;Nil" _]] (return xs) [["lux;Cons" [x xs*]]] (|do [y (f x) - ;; :let [_ (prn ' 1 (class y)) - ;; _ (prn ' 2 (aget y 0))] - ys ( f xs*)] + ys ( f xs*)] (return ( y ys))))) map% |cons @@ -373,7 +361,6 @@ xs)) (defn show-table [table] - ;; (prn 'show-table (aget table 0)) (str "{{" (->> table (|map (fn [kv] (|let [[k v] kv] (str k " = ???")))) @@ -383,9 +370,7 @@ (defn apply% [monad call-state] (fn [state] - ;; (prn 'apply-m monad call-state) (let [output (monad call-state)] - ;; (prn 'apply-m/output output) (matchv ::M/objects [output] [["lux;Right" [?state ?datum]]] (return* state ?datum) @@ -469,12 +454,6 @@ (return nil) (fail msg))) state) - ;; (if (= "[Reader Error] EOF" msg) - ;; ((|do [? source-consumed? - ;; :let [_ (prn '? ?)]] - ;; (return nil)) - ;; state) - ;; (fail* msg)) ))) (defn ^:private normalize-char [char] @@ -569,8 +548,6 @@ (def get-writer (fn [state] (let [writer* (->> state (get$ $HOST) (get$ $WRITER))] - ;; (prn 'get-writer (class writer*)) - ;; (prn 'get-writer (aget writer* 0)) (matchv ::M/objects [writer*] [["lux;Some" datum]] (return* state datum) @@ -656,16 +633,6 @@ output)))) (defn show-ast [ast] - ;; (prn 'show-ast (aget ast 0)) - ;; (prn 'show-ast (aget ast 1 1 0)) - ;; (cond (= "lux;Meta" (aget ast 1 1 0)) - ;; (prn 'EXTRA 'show-ast (aget ast 1 1 1 1 0)) - - ;; (= "lux;Symbol" (aget ast 1 1 0)) - ;; (prn 'EXTRA 'show-ast (aget ast 1 1 1 1)) - - ;; :else - ;; nil) (matchv ::M/objects [ast] [["lux;Meta" [_ ["lux;Bool" ?value]]]] (pr-str ?value) @@ -707,3 +674,40 @@ (defn ident->text [ident] (|let [[?module ?name] ident] (str ?module ";" ?name))) + +(defn map2% [f xs ys] + (matchv ::M/objects [xs ys] + [["lux;Cons" [x xs*]] ["lux;Cons" [y ys*]]] + (|do [z (f x y) + zs (map2% f xs* ys*)] + (return (|cons z zs))) + + [["lux;Nil" _] ["lux;Nil" _]] + (return (V "lux;Nil" nil)) + + [_ _] + (fail "Lists don't match in size."))) + +(defn fold2% [f init xs ys] + (matchv ::M/objects [xs ys] + [["lux;Cons" [x xs*]] ["lux;Cons" [y ys*]]] + (|do [init* (f init x y)] + (fold2% f init* xs* ys*)) + + [["lux;Nil" _] ["lux;Nil" _]] + (return init) + + [_ _] + (fail "Lists don't match in size."))) + +(defn fold2 [f init xs ys] + (matchv ::M/objects [xs ys] + [["lux;Cons" [x xs*]] ["lux;Cons" [y ys*]]] + (and init + (fold2 f (f init x y) xs* ys*)) + + [["lux;Nil" _] ["lux;Nil" _]] + init + + [_ _] + false)) diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj index 5a9f1b39d..f970540c9 100644 --- a/src/lux/compiler.clj +++ b/src/lux/compiler.clj @@ -19,9 +19,7 @@ [lux :as &&lux] [host :as &&host] [case :as &&case] - [lambda :as &&lambda]) - ;; :reload - ) + [lambda :as &&lambda])) (:import (org.objectweb.asm Opcodes Label ClassWriter @@ -29,280 +27,277 @@ ;; [Utils/Compilers] (defn ^:private compile-expression [syntax] - ;; (prn 'compile-expression (aget syntax 0)) (matchv ::M/objects [syntax] [[?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) - - [["lux;Local" ?idx]] - (&&lux/compile-local compile-expression ?type ?idx) - - [["captured" [?scope ?captured-id ?source]]] - (&&lux/compile-captured compile-expression ?type ?scope ?captured-id ?source) - - [["lux;Global" [?owner-class ?name]]] - (&&lux/compile-global compile-expression ?type ?owner-class ?name) - - [["apply" [?fn ?arg]]] - (&&lux/compile-apply compile-expression ?type ?fn ?arg) - - [["variant" [?tag ?members]]] - (&&lux/compile-variant compile-expression ?type ?tag ?members) - - [["case" [?value ?match]]] - (&&case/compile-case compile-expression ?type ?value ?match) - - [["lambda" [?scope ?env ?body]]] - (&&lambda/compile-lambda compile-expression ?scope ?env ?body) - - ;; 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) - - [["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-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) + (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) + + [["lux;Local" ?idx]] + (&&lux/compile-local compile-expression ?type ?idx) + + [["captured" [?scope ?captured-id ?source]]] + (&&lux/compile-captured compile-expression ?type ?scope ?captured-id ?source) + + [["lux;Global" [?owner-class ?name]]] + (&&lux/compile-global compile-expression ?type ?owner-class ?name) + + [["apply" [?fn ?arg]]] + (&&lux/compile-apply compile-expression ?type ?fn ?arg) + + [["variant" [?tag ?members]]] + (&&lux/compile-variant compile-expression ?type ?tag ?members) + + [["case" [?value ?match]]] + (&&case/compile-case compile-expression ?type ?value ?match) + + [["lambda" [?scope ?env ?body]]] + (&&lambda/compile-lambda compile-expression ?scope ?env ?body) + + ;; 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) + + [["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-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) + ) )) (defn ^:private compile-statement [syntax] - ;; (prn 'compile-statement syntax) (matchv ::M/objects [syntax] [["def" [?name ?body ?def-data]]] (&&lux/compile-def compile-expression ?name ?body ?def-data) @@ -320,8 +315,6 @@ (&&host/compile-jvm-class compile-expression ?package ?name ?super-class ?fields ?methods))) (defn ^:private eval! [expr] - ;; (prn 'eval! (aget expr 0)) - ;; (assert false) (|do [eval-ctor &/get-eval-ctor :let [class-name (str eval-ctor) =class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS) @@ -348,17 +341,10 @@ (.get nil) return))) -(let [compiler-step (|do [analysis+ (&optimizer/optimize eval!) - ;; :let [_ (prn 'analysis+ analysis+)] - ] - (&/map% compile-statement analysis+) - ;; (if (&/|empty? analysis+) - ;; (fail "[Compiler Error] No more to compile.") - ;; (&/map% compile-statement analysis+)) - )] +(let [compiler-step (|do [analysis+ (&optimizer/optimize eval!)] + (&/map% compile-statement analysis+))] (defn ^:private compile-module [name] (fn [state] - (prn 'compile-module name (->> state (&/get$ &/$MODULES) &/|keys &/->seq)) (if (->> state (&/get$ &/$MODULES) (&/|contains? name)) (if (= name "lux") (return* state nil) @@ -373,8 +359,6 @@ (&/update$ &/$MODULES #(&/|put name &a-module/init-module %))))] [["lux;Right" [?state _]]] (do (.visitEnd =class) - ;; (prn 'compile-module 'DONE name) - ;; (prn 'compile-module/?vals ?vals) (&/run-state (&&/save-class! name (.toByteArray =class)) ?state)) [["lux;Left" ?message]] diff --git a/src/lux/compiler/base.clj b/src/lux/compiler/base.clj index dd7e0ae13..c0a54ba53 100644 --- a/src/lux/compiler/base.clj +++ b/src/lux/compiler/base.clj @@ -32,104 +32,102 @@ (return nil))) (defn total-locals [expr] - ;; (prn 'total-locals1 (aget expr 0)) (matchv ::M/objects [expr] [[?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)) + (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))) - [["|do" ?exprs]] - (&/fold max 0 (&/|map total-locals ?exprs)) + [["|do" ?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) + [["jvm-aaload" [?array ?idx]]] + (total-locals ?array) - ;; [["lambda" _]] - ;; 0 - - [_] - 0 - )))) + ;; [["lambda" _]] + ;; 0 + + [_] + 0 + ))) diff --git a/src/lux/compiler/case.clj b/src/lux/compiler/case.clj index 738d6bc35..2720e31f7 100644 --- a/src/lux/compiler/case.clj +++ b/src/lux/compiler/case.clj @@ -21,7 +21,6 @@ +equals-sig+ (str "(" (&host/->type-signature "java.lang.Object") ")Z") compare-kv #(.compareTo ^String (aget ^objects %1 0) ^String (aget ^objects %2 0))] (defn ^:private compile-match [^MethodVisitor writer ?match $target $else] - ;; (prn 'compile-match (aget ?match 0) $target $else) (matchv ::M/objects [?match] [["StoreTestAC" ?idx]] (doto writer @@ -143,7 +142,6 @@ ))) (defn ^:private separate-bodies [patterns] - ;; (prn 'separate-bodies (aget matches 0)) (|let [[_ mappings patterns*] (&/fold (fn [$id+mappings+=matches pattern+body] (|let [[$id mappings =matches] $id+mappings+=matches [pattern body] pattern+body] @@ -154,7 +152,6 @@ (let [ex-class (&host/->class "java.lang.IllegalStateException")] (defn ^:private compile-pattern-matching [^MethodVisitor writer compile mappings patterns $end] - ;; (prn 'compile-pattern-matching ?matches $end) (let [entries (&/|map (fn [?branch+?body] (|let [[?branch ?body] ?branch+?body label (new Label)] @@ -167,10 +164,7 @@ (.visitLabel $else)) (->> (|let [[?body ?match] ?body+?match]) (doseq [?body+?match (&/->seq patterns) - :let [;; _ (prn 'compile-pattern-matching/pattern pattern) - ;; _ (prn '?body+?match (alength ?body+?match) (aget ?body+?match 0)) - ;; _ (prn '?body+?match (aget ?body+?match 0)) - $else (new Label)]]))) + :let [$else (new Label)]]))) (.visitInsn Opcodes/POP) (.visitTypeInsn Opcodes/NEW ex-class) (.visitInsn Opcodes/DUP) @@ -187,7 +181,6 @@ ;; [Resources] (defn compile-case [compile *type* ?value ?matches] - ;; (prn 'compile-case ?value ?matches) (|do [^MethodVisitor *writer* &/get-writer :let [$end (new Label)] _ (compile ?value) diff --git a/src/lux/compiler/host.clj b/src/lux/compiler/host.clj index 71d3ced53..429424240 100644 --- a/src/lux/compiler/host.clj +++ b/src/lux/compiler/host.clj @@ -198,7 +198,6 @@ (do-template [ ] (defn [compile *type* ?class ?method ?classes ?object ?args] - ;; (prn 'compile-jvm-invokevirtual ?classes *type*) (|do [^MethodVisitor *writer* &/get-writer :let [method-sig (str "(" (&/fold str "" (&/|map &host/->type-signature ?classes)) ")" (&host/->java-sig *type*))] _ (compile ?object) @@ -327,7 +326,6 @@ (&&/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) @@ -335,13 +333,10 @@ full-name nil "java/lang/Object" nil)) _ (do (doseq [[?method ?props] ?methods :let [[?args ?return] (:type ?props) - signature (str "(" (&/fold str "" (&/|map &host/->type-signature ?args)) ")" (&host/->type-signature ?return)) - ;; _ (prn 'signature signature) - ]] + signature (str "(" (&/fold str "" (&/|map &host/->type-signature ?args)) ")" (&host/->type-signature ?return))]] (.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-jvm-try [compile *type* ?body ?catches ?finally] diff --git a/src/lux/compiler/lambda.clj b/src/lux/compiler/lambda.clj index 962a32ab6..3ba6e52f1 100644 --- a/src/lux/compiler/lambda.clj +++ b/src/lux/compiler/lambda.clj @@ -11,9 +11,7 @@ [analyser :as &analyser] [host :as &host]) [lux.analyser.base :as &a] - (lux.compiler [base :as &&]) - ;; :reload - ) + (lux.compiler [base :as &&])) (:import (org.objectweb.asm Opcodes Label ClassWriter @@ -39,9 +37,7 @@ (-> (doto (.visitVarInsn Opcodes/ALOAD 0) (.visitVarInsn Opcodes/ALOAD (inc ?captured-id)) (.visitFieldInsn Opcodes/PUTFIELD class-name captured-name clo-field-sig)) - (->> (let [captured-name (str &&/closure-prefix ?captured-id) - ;; _ (prn 'add-lambda- class-name ?captured-id) - ]) + (->> (let [captured-name (str &&/closure-prefix ?captured-id)]) (matchv ::M/objects [?name+?captured] [[?name [["captured" [_ ?captured-id ?source]] _]]]) (doseq [?name+?captured (&/->seq env)]))) @@ -79,7 +75,6 @@ (return ret)))) (defn ^:private instance-closure [compile lambda-class closed-over init-signature] - ;; (prn 'instance-closure lambda-class (&/|length closed-over) init-signature) (|do [^MethodVisitor *writer* &/get-writer :let [_ (doto *writer* (.visitTypeInsn Opcodes/NEW lambda-class) @@ -100,7 +95,6 @@ ;; [Exports] (defn compile-lambda [compile ?scope ?env ?body] - ;; (prn 'compile-lambda ?scope (&host/location ?scope) ?env) (|do [: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) @@ -110,17 +104,11 @@ (->> (let [captured-name (str &&/closure-prefix ?captured-id)]) (matchv ::M/objects [?name+?captured] [[?name [["captured" [_ ?captured-id ?source]] _]]]) - (doseq [?name+?captured (&/->seq ?env) - ;; :let [_ (prn '?name+?captured (alength ?name+?captured)) - ;; _ (prn '?name+?captured (aget ?name+?captured 1 0)) - ;; _ (prn '?name+?captured (aget ?name+?captured 1 1 0 0))] - ]))) + (doseq [?name+?captured (&/->seq ?env)]))) (add-lambda-apply lambda-class ?env) (add-lambda- lambda-class ?env) )] _ (add-lambda-impl =class compile lambda-impl-signature ?body) - :let [_ (.visitEnd =class) - ;; _ (prn 'SAVING_LAMBDA lambda-class) - ] + :let [_ (.visitEnd =class)] _ (&&/save-class! lambda-class (.toByteArray =class))] (instance-closure compile lambda-class ?env (lambda--signature ?env)))) diff --git a/src/lux/compiler/lux.clj b/src/lux/compiler/lux.clj index ad2c9d0c6..4e3e4add1 100644 --- a/src/lux/compiler/lux.clj +++ b/src/lux/compiler/lux.clj @@ -13,9 +13,7 @@ (lux.analyser [base :as &a] [module :as &a-module]) (lux.compiler [base :as &&] - [lambda :as &&lambda]) - ;; :reload - ) + [lambda :as &&lambda])) (:import (org.objectweb.asm Opcodes Label ClassWriter @@ -68,13 +66,11 @@ (return nil))) (defn compile-record [compile *type* ?elems] - ;; (prn 'compile-record (str "{{" (->> ?elems &/|keys (&/|interpose " ") (&/fold str "")) "}}")) (|do [^MethodVisitor *writer* &/get-writer :let [elems* (->> ?elems &/->seq (sort #(compare (&/|first %1) (&/|first %2))) &/->list) - ;; _ (prn 'compile-record (str "{{" (->> elems* &/|keys (&/|interpose " ") (&/fold str "")) "}}")) num-elems (&/|length elems*) _ (doto *writer* (.visitLdcInsn (int num-elems)) @@ -111,7 +107,6 @@ (return nil))) (defn compile-captured [compile *type* ?scope ?captured-id ?source] - ;; (prn 'compile-captured ?scope ?captured-id) (|do [^MethodVisitor *writer* &/get-writer :let [_ (doto *writer* (.visitVarInsn Opcodes/ALOAD 0) @@ -145,25 +140,18 @@ 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) (|do [^MethodVisitor **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/_2 ?name)] - ] + _ (&&/save-class! current-class (.toByteArray =class))] (return nil))) (defn compile-declare-macro [compile module name] diff --git a/src/lux/host.clj b/src/lux/host.clj index 80dfd78d5..783b61298 100644 --- a/src/lux/host.clj +++ b/src/lux/host.clj @@ -25,8 +25,7 @@ ))) (defn ^:private method->type [^Method method] - (|do [;; =args (&/map% class->type (&/->list (seq (.getParameterTypes method)))) - =return (class->type (.getReturnType method))] + (|do [=return (class->type (.getReturnType method))] (return =return))) ;; [Resources] @@ -46,7 +45,6 @@ (fail (str "[Analyser Error] Unknown class: " class-name)))))) (defn full-class-name [class-name] - ;; (prn 'full-class-name class-name) (|do [^Class =class (full-class class-name)] (return (.getName =class)))) @@ -116,7 +114,6 @@ (defn [target method-name args] (let [target (Class/forName target)] (if-let [method (first (for [^Method =method (.getMethods target) - ;; :let [_ (prn ' '=method =method (mapv #(.getName %) (.getParameterTypes =method)))] :when (and (= target (.getDeclaringClass =method)) (= method-name (.getName =method)) (= (Modifier/isStatic (.getModifiers =method))) diff --git a/src/lux/lexer.clj b/src/lux/lexer.clj index b7729156a..eb4e7af7c 100644 --- a/src/lux/lexer.clj +++ b/src/lux/lexer.clj @@ -6,7 +6,6 @@ ;; [Utils] (defn ^:private escape-char [escaped] - ;; (prn 'escape-char escaped) (condp = escaped "\\t" (return "\t") "\\b" (return "\b") @@ -20,12 +19,8 @@ (defn ^:private lex-text-body [_] (&/try-all% (&/|list (|do [[_ [_ [prefix escaped]]] (&reader/read-regex2 #"(?s)^([^\"\\]*)(\\.)") - ;; :let [_ (prn '[prefix escaped] [prefix escaped])] unescaped (escape-char escaped) - ;; :let [_ (prn 'unescaped unescaped)] - postfix (lex-text-body nil) - ;; :let [_ (prn 'postfix postfix)] - ] + postfix (lex-text-body nil)] (return (str prefix unescaped postfix))) (|do [[_ [_ body]] (&reader/read-regex #"(?s)^([^\"\\]*)")] (return body))))) @@ -54,9 +49,7 @@ (return (&/V "lux;Meta" (&/T meta (&/V "Comment" comment)))))) (def ^:private lex-comment - (&/try-all% (&/|list lex-single-line-comment - ;; (lex-multi-line-comment nil) - ))) + (&/try-all% (&/|list lex-single-line-comment))) (do-template [ ] (def @@ -111,10 +104,7 @@ (def ^:private lex-tag (|do [[_ [meta _]] (&reader/read-text "#") - ;; :let [_ (prn 'lex-tag)] - [_ [_ ident]] lex-ident - ;; :let [_ (prn 'lex-tag [(aget ident 0) (aget ident 1)])] - ] + [_ [_ ident]] lex-ident] (return (&/V "lux;Meta" (&/T meta (&/V "Tag" ident)))))) (do-template [ ] diff --git a/src/lux/parser.clj b/src/lux/parser.clj index cb89f63a2..d8817fc05 100644 --- a/src/lux/parser.clj +++ b/src/lux/parser.clj @@ -22,19 +22,13 @@ ) (defn ^:private parse-record [parse] - (|do [;; :let [_ (prn 'parse-record 0)] - elems* (&/repeat% parse) - ;; :let [_ (prn 'parse-record 1)] + (|do [elems* (&/repeat% parse) token &lexer/lex - ;; :let [_ (prn 'parse-record 2)] - :let [elems (&/fold &/|++ (&/|list) elems*)] - ;; :let [_ (prn 'parse-record 3)] - ] + :let [elems (&/fold &/|++ (&/|list) elems*)]] (matchv ::M/objects [token] [["lux;Meta" [meta ["Close_Brace" _]]]] (if (even? (&/|length elems)) - (do ;; (prn 'PARSED_RECORD (&/|length elems)) - (return (&/V "lux;Record" (&/|as-pairs elems)))) + (return (&/V "lux;Record" (&/|as-pairs elems))) (fail (str "[Parser Error] Records must have an even number of elements."))) [_] @@ -42,10 +36,7 @@ ;; [Interface] (def parse - (|do [token &lexer/lex - ;; :let [_ (prn 'parse/token token)] - ;; :let [_ (prn 'parse (aget token 0))] - ] + (|do [token &lexer/lex] (matchv ::M/objects [token] [["lux;Meta" [meta ["White_Space" _]]]] (return (&/|list)) diff --git a/src/lux/reader.clj b/src/lux/reader.clj index d66a671aa..38ff4d5e6 100644 --- a/src/lux/reader.clj +++ b/src/lux/reader.clj @@ -35,9 +35,7 @@ (fn [file-name line-num column-num ^String line] (if-let [[^String match] (re-find regex line)] (let [match-length (.length match) - line* (.substring line match-length) - ;; _ (prn 'with-line line*) - ] + line* (.substring line match-length)] (&/V "Yes" (&/T (&/V "lux;Meta" (&/T (&/T file-name line-num column-num) match)) (if (empty? line*) (&/V "lux;None" nil) @@ -49,9 +47,7 @@ (fn [file-name line-num column-num ^String line] (if-let [[^String match tok1 tok2] (re-find regex line)] (let [match-length (.length match) - line* (.substring line match-length) - ;; _ (prn 'with-line line*) - ] + line* (.substring line match-length)] (&/V "Yes" (&/T (&/V "lux;Meta" (&/T (&/T file-name line-num column-num) (&/T tok1 tok2))) (if (empty? line*) (&/V "lux;None" nil) @@ -61,12 +57,9 @@ (defn read-text [^String text] (with-line (fn [file-name line-num column-num ^String line] - ;; (prn 'read-text text line) (if (.startsWith line text) (let [match-length (.length text) - line* (.substring line match-length) - ;; _ (prn 'with-line line*) - ] + line* (.substring line match-length)] (&/V "Yes" (&/T (&/V "lux;Meta" (&/T (&/T file-name line-num column-num) text)) (if (empty? line*) (&/V "lux;None" nil) diff --git a/src/lux/type.clj b/src/lux/type.clj index 0df628b15..57c2d4624 100644 --- a/src/lux/type.clj +++ b/src/lux/type.clj @@ -190,29 +190,18 @@ (fail* (str "[Type Error] Unbound type-var: " id))) (fail* (str "[Type Error] Unknown type-var: " id)))))) -(defn set-var* [id type] - (fn [state] - (if-let [tvar (->> state (&/get$ &/$TYPES) (&/get$ &/$MAPPINGS) (&/|get id))] - (return* (&/update$ &/$TYPES (fn [ts] (&/update$ &/$MAPPINGS #(&/|put id (&/V "lux;Some" type) %) - ts)) - state) - nil) - (fail* (str "[Type Error] Unknown type-var: " id " | " (->> state (&/get$ &/$TYPES) (&/get$ &/$MAPPINGS) &/|length)))))) - (defn set-var [id type] (fn [state] (if-let [tvar (->> state (&/get$ &/$TYPES) (&/get$ &/$MAPPINGS) (&/|get id))] - (do ;; (prn 'set-var (aget tvar 0)) - (matchv ::M/objects [tvar] - [["lux;Some" bound]] - (fail* (str "[Type Error] Can't rebind type var: " id " | Current type: " (show-type bound))) - - [["lux;None" _]] - (do ;; (prn 'set-var id (show-type type)) - (return* (&/update$ &/$TYPES (fn [ts] (&/update$ &/$MAPPINGS #(&/|put id (&/V "lux;Some" type) %) - ts)) - state) - nil)))) + (matchv ::M/objects [tvar] + [["lux;Some" bound]] + (fail* (str "[Type Error] Can't rebind type var: " id " | Current type: " (show-type bound))) + + [["lux;None" _]] + (return* (&/update$ &/$TYPES (fn [ts] (&/update$ &/$MAPPINGS #(&/|put id (&/V "lux;Some" type) %) + ts)) + state) + nil)) (fail* (str "[Type Error] Unknown type-var: " id " | " (->> state (&/get$ &/$TYPES) (&/get$ &/$MAPPINGS) &/|length)))))) ;; [Exports] @@ -251,10 +240,7 @@ [["lux;VarT" ?id*]] (if (= id ?id*) (return (&/T ?id (&/V "lux;None" nil))) - (return binding) - ;; (|do [?type** (clean* id ?type*)] - ;; (return (&/T ?id (&/V "lux;Some" ?type**)))) - ) + (return binding)) [_] (|do [?type** (clean* id ?type*)] @@ -275,11 +261,6 @@ _ (delete-var id)] (return output))) -;; (def delete-vars -;; (|do [vars #(->> % (&/get$ &/$TYPES) (&/get$ &/$MAPPINGS) &/|keys (return* %)) -;; _ (&/map% delete-var vars)] -;; (return nil))) - (defn with-vars [amount k] (|do [=vars (&/map% (constantly create-var) (&/|range amount)) output (k (&/|map #(&/V "lux;VarT" %) =vars)) @@ -341,7 +322,6 @@ )) (defn clean [tvar type] - ;; (prn "^^ clean ^^") (matchv ::M/objects [tvar] [["lux;VarT" ?id]] (clean* ?id type) @@ -350,7 +330,6 @@ (fail (str "[Type Error] Not type-var: " (show-type tvar))))) (defn show-type [^objects type] - ;; (prn 'show-type (aget type 0)) (matchv ::M/objects [type] [["lux;DataT" name]] (str "(^ " name ")") @@ -413,34 +392,31 @@ )) (defn type= [x y] - ;; (prn "^^ type= ^^") (let [output (matchv ::M/objects [x y] [["lux;DataT" xname] ["lux;DataT" yname]] (= xname yname) [["lux;TupleT" xelems] ["lux;TupleT" yelems]] - (&/fold (fn [old xy] - (|let [[x* y*] xy] - (and old - (type= x* y*)))) - true - (&/zip2 xelems yelems)) + (&/fold2 (fn [old x y] + (and old (type= x y))) + true + xelems yelems) [["lux;VariantT" xcases] ["lux;VariantT" ycases]] - (and (= (&/|length xcases) (&/|length ycases)) - (&/fold (fn [old case] - (and old - (type= (&/|get case xcases) (&/|get case ycases)))) - true - (&/|keys xcases))) - - [["lux;RecordT" xfields] ["lux;RecordT" yfields]] - (and (= (&/|length xfields) (&/|length yfields)) - (&/fold (fn [old field] - (and old - (type= (&/|get field xfields) (&/|get field yfields)))) - true - (&/|keys xfields))) + (&/fold2 (fn [old xcase ycase] + (|let [[xname xtype] xcase + [yname ytype] ycase] + (and old (= xname yname) (type= xtype ytype)))) + true + xcases ycases) + + [["lux;RecordT" xslots] ["lux;RecordT" yslots]] + (&/fold2 (fn [old xslot yslot] + (|let [[xname xtype] xslot + [yname ytype] yslot] + (and old (= xname yname) (type= xtype ytype)))) + true + xslots yslots) [["lux;LambdaT" [xinput xoutput]] ["lux;LambdaT" [yinput youtput]]] (and (type= xinput yinput) @@ -456,37 +432,30 @@ (= xid yid) [["lux;AppT" [xlambda xparam]] ["lux;AppT" [ylambda yparam]]] - (and (type= xlambda ylambda) - (type= xparam yparam)) + (and (type= xlambda ylambda) (type= xparam yparam)) [["lux;AllT" [xenv xname xarg xbody]] ["lux;AllT" [yenv yname yarg ybody]]] - (do ;; (prn 'TESTING_ALLT - ;; 'NAME [xname yname] (= xname yname) - ;; 'ARG (= xarg yarg) - ;; 'LENGTH [(&/|length xenv) (&/|length yenv)] (= (&/|length xenv) (&/|length yenv))) - (and (= xname yname) - (= xarg yarg) - ;; (matchv ::M/objects [xenv yenv] - ;; [["lux;None" _] ["lux;None" _]] - ;; true - - ;; [["lux;Some" xenv*] ["lux;Some" yenv*]] - ;; (&/fold (fn [old bname] - ;; (and old - ;; (type= (&/|get bname xenv*) (&/|get bname yenv*)))) - ;; (= (&/|length xenv*) (&/|length yenv*)) - ;; (&/|keys xenv*)) - - ;; [_ _] - ;; false) - (type= xbody ybody) - )) + (and (= xname yname) + (= xarg yarg) + ;; (matchv ::M/objects [xenv yenv] + ;; [["lux;None" _] ["lux;None" _]] + ;; true + + ;; [["lux;Some" xenv*] ["lux;Some" yenv*]] + ;; (&/fold (fn [old bname] + ;; (and old + ;; (type= (&/|get bname xenv*) (&/|get bname yenv*)))) + ;; (= (&/|length xenv*) (&/|length yenv*)) + ;; (&/|keys xenv*)) + + ;; [_ _] + ;; false) + (type= xbody ybody) + ) [_ _] - (do ;; (prn 'type= (show-type x) (show-type y)) - false) + false )] - ;; (prn 'type= output (show-type x) (show-type y)) output)) (defn ^:private fp-get [k fixpoints] @@ -509,7 +478,6 @@ (str "Type " (show-type expected) " does not subsume type " (show-type actual))) (defn beta-reduce [env type] - ;; (prn 'beta-reduce (aget type 0)) (matchv ::M/objects [type] [["lux;VariantT" ?cases]] (&/V "lux;VariantT" (&/|map (fn [kv] @@ -559,11 +527,9 @@ (return* state type)))) (defn apply-type [type-fn param] - ;; (prn 'apply-type (aget type-fn 0) (aget param 0)) (matchv ::M/objects [type-fn] [["lux;AllT" [local-env local-name local-arg local-def]]] - (let [;; _ (prn 'apply-type/local-env (aget local-env 0) (show-type type-fn)) - local-env* (matchv ::M/objects [local-env] + (let [local-env* (matchv ::M/objects [local-env] [["lux;None" _]] (&/|table) @@ -584,9 +550,6 @@ (def init-fixpoints (&/|list)) (defn ^:private check* [fixpoints expected actual] - ;; (prn "^^ check* ^^") - ;; (prn 'check* (aget expected 0) (aget actual 0)) - ;; (prn 'check* (show-type expected) (show-type actual)) (matchv ::M/objects [expected actual] [["lux;VarT" ?eid] ["lux;VarT" ?aid]] (if (= ?eid ?aid) @@ -601,8 +564,6 @@ (return (&/V "lux;None" nil))))] (matchv ::M/objects [ebound abound] [["lux;None" _] ["lux;None" _]] - ;; (|do [_ (set-var ?aid expected)] - ;; (return (&/T fixpoints nil))) (|do [_ (set-var ?eid actual)] (return (&/T fixpoints nil))) @@ -613,8 +574,7 @@ (check* fixpoints expected atype) [["lux;Some" etype] ["lux;Some" atype]] - (check* fixpoints etype atype))) - ) + (check* fixpoints etype atype)))) [["lux;VarT" ?id] _] (&/try-all% (&/|list (|do [_ (set-var ?id actual)] @@ -635,10 +595,6 @@ _ (check* fixpoints A1 A2)] (return (&/T fixpoints nil))) - ;; [["lux;AppT" [["lux;VarT" ?id] A1]] ["lux;AppT" [F2 A2]]] - ;; (|do [[fixpoints* _] (check* fixpoints (&/V "lux;VarT" ?id) F2) - ;; [fixpoints** _] (check* fixpoints* A1 A2)] - ;; (return (&/T fixpoints** nil))) [["lux;AppT" [["lux;VarT" ?id] A1]] ["lux;AppT" [F2 A2]]] (|do [[fixpoints* _] (check* fixpoints (&/V "lux;VarT" ?id) F2) e* (apply-type F2 A1) @@ -646,25 +602,15 @@ [fixpoints** _] (check* fixpoints* e* a*)] (return (&/T fixpoints** nil))) - ;; [["lux;AppT" [F1 A1]] ["lux;AppT" [["lux;VarT" ?id] A2]]] - ;; (|do [[fixpoints* _] (check* fixpoints F1 (&/V "lux;VarT" ?id)) - ;; [fixpoints** _] (check* fixpoints* A1 A2)] - ;; (return (&/T fixpoints** nil))) [["lux;AppT" [F1 A1]] ["lux;AppT" [["lux;VarT" ?id] A2]]] (|do [[fixpoints* _] (check* fixpoints F1 (&/V "lux;VarT" ?id)) e* (apply-type F1 A1) a* (apply-type F1 A2) [fixpoints** _] (check* fixpoints* e* a*)] (return (&/T fixpoints** nil))) - - ;; [["lux;AppT" [F1 A1]] ["lux;AppT" [F2 A2]]] - ;; (|do [[fixpoints* _] (check* (fp-put fp-pair true fixpoints) F1 F2) - ;; [fixpoints** _] (check* fixpoints* A1 A2)] - ;; (return (&/T fixpoints** nil))) [["lux;AppT" [F A]] _] (let [fp-pair (&/T expected actual) - ;; _ (prn 'LEFT_APP (&/|length fixpoints)) _ (when (> (&/|length fixpoints) 40) (println 'FIXPOINTS (->> (&/|keys fixpoints) (&/|map (fn [pair] @@ -687,26 +633,6 @@ [_ ["lux;AppT" [F A]]] (|do [actual* (apply-type F A)] (check* fixpoints expected actual*)) - ;; (let [fp-pair (&/T expected actual) - ;; _ (prn 'RIGHT_APP (&/|length fixpoints)) - ;; _ (when (> (&/|length fixpoints) 10) - ;; (println 'FIXPOINTS (->> (&/|keys fixpoints) - ;; (&/|map (fn [pair] - ;; (|let [[e a] pair] - ;; (str (show-type e) ":+:" - ;; (show-type a))))) - ;; (&/|interpose "\n\n") - ;; (&/fold str ""))) - ;; (assert false))] - ;; (matchv ::M/objects [(fp-get fp-pair fixpoints)] - ;; [["lux;Some" ?]] - ;; (if ? - ;; (return (&/T fixpoints nil)) - ;; (fail (check-error expected actual))) - - ;; [["lux;None" _]] - ;; (|do [actual* (apply-type F A)] - ;; (check* (fp-put fp-pair true fixpoints) expected actual*)))) [["lux;AllT" _] _] (with-var @@ -779,48 +705,36 @@ (check* fixpoints* eO aO)) [["lux;TupleT" e!members] ["lux;TupleT" a!members]] - (if (= (&/|length e!members) (&/|length a!members)) - (|do [fixpoints* (&/fold% (fn [fixp ea] - (|let [[e a] ea] - (do ;; (prn "lux;TupleT" 'ITER (show-type e) (show-type a)) - (|do [[fixp* _] (check* fixp e a)] - (return fixp*))))) - fixpoints - (&/zip2 e!members a!members)) - ;; :let [_ (prn "lux;TupleT" 'DONE)] - ] - (return (&/T fixpoints* nil))) - (fail "[Type Error] Tuples don't match in size.")) + (|do [fixpoints* (&/fold2% (fn [fp e a] + (|do [[fp* _] (check* fp e a)] + (return fp*))) + fixpoints + e!members a!members)] + (return (&/T fixpoints* nil))) [["lux;VariantT" e!cases] ["lux;VariantT" a!cases]] - (if (= (&/|length e!cases) (&/|length a!cases)) - (|do [fixpoints* (&/fold% (fn [fixp slot] - ;; (prn 'VARIANT_CASE slot) - (if-let [e!type (&/|get slot e!cases)] - (if-let [a!type (&/|get slot a!cases)] - (|do [[fixp* _] (check* fixp e!type a!type)] - (return fixp*)) - (fail (check-error expected actual))) - (fail (check-error expected actual)))) - fixpoints - (&/|keys e!cases))] - (return (&/T fixpoints* nil))) - (fail "[Type Error] Variants don't match in size.")) - - [["lux;RecordT" e!fields] ["lux;RecordT" a!fields]] - (if (= (&/|length e!fields) (&/|length a!fields)) - (|do [fixpoints* (&/fold% (fn [fixp slot] - ;; (prn 'RECORD_FIELD slot) - (if-let [e!type (&/|get slot e!fields)] - (if-let [a!type (&/|get slot a!fields)] - (|do [[fixp* _] (check* fixp e!type a!type)] - (return fixp*)) - (fail (check-error expected actual))) - (fail (check-error expected actual)))) - fixpoints - (&/|keys e!fields))] - (return (&/T fixpoints* nil))) - (fail "[Type Error] Records don't match in size.")) + (|do [fixpoints* (&/fold2% (fn [fp e!case a!case] + (|let [[e!name e!type] e!case + [a!name a!type] a!case] + (if (= e!name a!name) + (|do [[fp* _] (check* fp e!type a!type)] + (return fp*)) + (fail (check-error expected actual))))) + fixpoints + e!cases a!cases)] + (return (&/T fixpoints* nil))) + + [["lux;RecordT" e!slots] ["lux;RecordT" a!slots]] + (|do [fixpoints* (&/fold2% (fn [fp e!slot a!slot] + (|let [[e!name e!type] e!slot + [a!name a!type] a!slot] + (if (= e!name a!name) + (|do [[fp* _] (check* fp e!type a!type)] + (return fp*)) + (fail (check-error expected actual))))) + fixpoints + e!slots a!slots)] + (return (&/T fixpoints* nil))) [["lux;ExT" e!id] ["lux;ExT" a!id]] (if (= e!id a!id) @@ -832,7 +746,6 @@ )) (defn check [expected actual] - ;; (prn "^^ check ^^") (|do [_ (check* init-fixpoints expected actual)] (return nil))) -- cgit v1.2.3 From 94891d38a25ae4e4cec4471d04eace38b47357c6 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 6 May 2015 18:09:18 -0400 Subject: - Removed a few unused definitions inside lux.base --- src/lux/base.clj | 94 ++------------------------------------------------------ 1 file changed, 3 insertions(+), 91 deletions(-) (limited to 'src') diff --git a/src/lux/base.clj b/src/lux/base.clj index 283d06f52..d834915de 100644 --- a/src/lux/base.clj +++ b/src/lux/base.clj @@ -110,14 +110,6 @@ table* (V "lux;Cons" (T (T k v) (|remove slot table*)))))) -(defn |merge [table1 table2] - (matchv ::M/objects [table2] - [["lux;Nil" _]] - table1 - - [["lux;Cons" [[k v] table2*]]] - (|merge (|put k v table1) table2*))) - (defn |update [k f table] (matchv ::M/objects [table] [["lux;Nil" _]] @@ -180,15 +172,6 @@ (reverse (partition 2 steps)))) ;; [Resources/Combinators] -(defn try% [monad] - (fn [state] - (matchv ::M/objects [(monad state)] - [["lux;Right" [?state ?datum]]] - (return* ?state ?datum) - - [_] - (return* state nil)))) - (defn |cons [head tail] (V "lux;Cons" (T head tail))) @@ -360,62 +343,15 @@ (|list) xs)) -(defn show-table [table] - (str "{{" - (->> table - (|map (fn [kv] (|let [[k v] kv] (str k " = ???")))) - (|interpose " ") - (fold str "")) - "}}")) - -(defn apply% [monad call-state] - (fn [state] - (let [output (monad call-state)] - (matchv ::M/objects [output] - [["lux;Right" [?state ?datum]]] - (return* state ?datum) - - [_] - output)))) - (defn assert! [test message] (if test (return nil) (fail message))) -(defn comp% [f-m g-m] - (|do [temp g-m] - (f-m temp))) - -(defn pass [m-value] - (fn [state] - m-value)) - (def get-state (fn [state] (return* state state))) -(defn sequence% [m-values] - (matchv ::M/objects [m-values] - [["lux;Cons" [head tail]]] - (|do [_ head] - (sequence% tail)) - - [_] - (return nil))) - -(def source-consumed? - (fn [state] - (matchv ::M/objects [(get$ $SOURCE state)] - [["lux;None" _]] - (fail* "No source code.") - - [["lux;Some" ["lux;Nil" _]]] - (return* state true) - - [["lux;Some" _]] - (return* state false)))) - (defn try-all% [monads] (matchv ::M/objects [monads] [["lux;Nil" _]] @@ -449,12 +385,9 @@ ((exhaust% step) state*) [["lux;Left" msg]] - ((|do [? source-consumed?] - (if ? - (return nil) - (fail msg))) - state) - ))) + (if (= "[Reader Error] EOF" msg) + (return* state nil) + (fail* msg))))) (defn ^:private normalize-char [char] (case char @@ -532,14 +465,6 @@ +init-bindings+ )) -(defn from-some [some] - (matchv ::M/objects [some] - [["lux;Some" datum]] - datum - - [_] - (assert false))) - (def get-eval-ctor (fn [state] (return* (update$ $HOST #(update$ $EVAL-CTOR inc %) state) @@ -675,19 +600,6 @@ (|let [[?module ?name] ident] (str ?module ";" ?name))) -(defn map2% [f xs ys] - (matchv ::M/objects [xs ys] - [["lux;Cons" [x xs*]] ["lux;Cons" [y ys*]]] - (|do [z (f x y) - zs (map2% f xs* ys*)] - (return (|cons z zs))) - - [["lux;Nil" _] ["lux;Nil" _]] - (return (V "lux;Nil" nil)) - - [_ _] - (fail "Lists don't match in size."))) - (defn fold2% [f init xs ys] (matchv ::M/objects [xs ys] [["lux;Cons" [x xs*]] ["lux;Cons" [y ys*]]] -- cgit v1.2.3 From c0bd1c6af6d1691ddc2627710e352a1bbe3eb1c7 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 6 May 2015 19:10:55 -0400 Subject: - Made some small optimizations in the compiler. --- src/lux/analyser/case.clj | 37 ++++++++++++++++++------------------- src/lux/analyser/host.clj | 7 +++---- src/lux/analyser/lux.clj | 24 +++++++++++------------- src/lux/base.clj | 26 ++++++++++++++++++++++++++ src/lux/compiler/case.clj | 13 +++++++------ src/lux/compiler/host.clj | 11 +++++------ src/lux/compiler/lux.clj | 35 +++++++++++++++++------------------ src/lux/host.clj | 43 ++++++++++++++++++------------------------- src/lux/reader.clj | 7 +++---- 9 files changed, 108 insertions(+), 95 deletions(-) (limited to 'src') diff --git a/src/lux/analyser/case.clj b/src/lux/analyser/case.clj index cdcf40e0f..f18dc7836 100644 --- a/src/lux/analyser/case.clj +++ b/src/lux/analyser/case.clj @@ -169,10 +169,9 @@ [["TupleTotal" [total? ?values]] ["TupleTestAC" ?tests]] (if (= (&/|length ?values) (&/|length ?tests)) - (|do [structs (&/map% (fn [vt] - (|let [[v t] vt] - (merge-total v (&/T t ?body)))) - (&/zip2 ?values ?tests))] + (|do [structs (&/map2% (fn [v t] + (merge-total v (&/T t ?body))) + ?values ?tests)] (return (&/V "TupleTotal" (&/T total? structs)))) (fail "[Pattern-matching error] Inconsistent tuple-size.")) @@ -189,17 +188,18 @@ [["RecordTotal" [total? ?values]] ["RecordTestAC" ?tests]] (if (= (&/|length ?values) (&/|length ?tests)) - (|do [structs (&/map% (fn [lr] - (|let [[[lslot sub-struct] [rslot value]] lr] - (if (= lslot rslot) - (|do [sub-struct* (merge-total sub-struct (&/T value ?body))] - (return (&/T lslot sub-struct*))) - (fail "[Pattern-matching error] Record slots mismatch.")))) - (&/zip2 ?values - (->> ?tests - &/->seq - (sort compare-kv) - &/->list)))] + (|do [structs (&/map2% (fn [left right] + (|let [[lslot sub-struct] left + [rslot value]right] + (if (= lslot rslot) + (|do [sub-struct* (merge-total sub-struct (&/T value ?body))] + (return (&/T lslot sub-struct*))) + (fail "[Pattern-matching error] Record slots mismatch.")))) + ?values + (->> ?tests + &/->seq + (sort compare-kv) + &/->list))] (return (&/V "RecordTotal" (&/T total? structs)))) (fail "[Pattern-matching error] Inconsistent record-size.")) @@ -238,10 +238,9 @@ (return true) (matchv ::M/objects [value-type] [["lux;TupleT" ?members]] - (|do [totals (&/map% (fn [sv] - (|let [[sub-struct ?member] sv] - (check-totality ?member sub-struct))) - (&/zip2 ?structs ?members))] + (|do [totals (&/map2% (fn [sub-struct ?member] + (check-totality ?member sub-struct)) + ?structs ?members)] (return (&/fold #(and %1 %2) true totals))) [_] diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj index d57493439..0d9fb1333 100644 --- a/src/lux/analyser/host.clj +++ b/src/lux/analyser/host.clj @@ -111,10 +111,9 @@ =classes (&/map% &host/extract-jvm-param ?classes) =return (&host/lookup-virtual-method =class ?method =classes) =object (&&/analyse-1 analyse (&/V "lux;DataT" ?class) ?object) - =args (&/map% (fn [c+o] - (|let [[?c ?o] c+o] - (&&/analyse-1 analyse (&/V "lux;DataT" ?c) ?o))) - (&/zip2 =classes ?args))] + =args (&/map2% (fn [?c ?o] + (&&/analyse-1 analyse (&/V "lux;DataT" ?c) ?o)) + =classes ?args)] (return (&/|list (&/T (&/V (&/T =class ?method =classes =object =args)) =return))))) analyse-jvm-invokevirtual "jvm-invokevirtual" diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj index d461d5b6b..26376ad60 100644 --- a/src/lux/analyser/lux.clj +++ b/src/lux/analyser/lux.clj @@ -27,10 +27,9 @@ (|do [exo-type* (&type/actual-type exo-type)] (matchv ::M/objects [exo-type*] [["lux;TupleT" ?members]] - (|do [=elems (&/map% (fn [ve] - (|let [[elem-t elem] ve] - (&&/analyse-1 analyse elem-t elem))) - (&/zip2 ?members ?elems))] + (|do [=elems (&/map2% (fn [elem-t elem] + (&&/analyse-1 analyse elem-t elem)) + ?members ?elems)] (return (&/|list (&/T (&/V "tuple" =elems) exo-type)))) @@ -160,15 +159,14 @@ (|let [scopes (&/|tail (&/folds #(&/|cons (&/get$ &/$NAME %2) %1) (&/|map #(&/get$ &/$NAME %) outer) (&/|reverse inner))) - [=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 local-ident)) - (->> top-outer (&/get$ &/$CLOSURE) (&/get$ &/$MAPPINGS) (&/|get local-ident))) - (&/|list)) - (&/zip2 (&/|reverse inner) scopes))] + [=local inner*] (&/fold2 (fn [register+new-inner frame in-scope] + (|let [[register new-inner] register+new-inner + [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 local-ident)) + (->> top-outer (&/get$ &/$CLOSURE) (&/get$ &/$MAPPINGS) (&/|get local-ident))) + (&/|list)) + (&/|reverse inner) scopes)] (&/run-state (|do [btype (&&/expr-type =local) _ (&type/check exo-type btype)] (return (&/|list =local))) diff --git a/src/lux/base.clj b/src/lux/base.clj index d834915de..5292faffa 100644 --- a/src/lux/base.clj +++ b/src/lux/base.clj @@ -612,6 +612,19 @@ [_ _] (fail "Lists don't match in size."))) +(defn map2% [f xs ys] + (matchv ::M/objects [xs ys] + [["lux;Cons" [x xs*]] ["lux;Cons" [y ys*]]] + (|do [z (f x y) + zs (map2% f xs* ys*)] + (return (|cons z zs))) + + [["lux;Nil" _] ["lux;Nil" _]] + (return (V "lux;Nil" nil)) + + [_ _] + (fail "Lists don't match in size."))) + (defn fold2 [f init xs ys] (matchv ::M/objects [xs ys] [["lux;Cons" [x xs*]] ["lux;Cons" [y ys*]]] @@ -623,3 +636,16 @@ [_ _] false)) + +(defn enumerate* [idx xs] + (matchv ::M/objects [xs] + [["lux;Cons" [x xs*]]] + (V "lux;Cons" (T (T idx x) + (enumerate* (inc idx) xs*))) + + [["lux;Nil" _]] + xs + )) + +(defn enumerate [xs] + (enumerate* 0 xs)) diff --git a/src/lux/compiler/case.clj b/src/lux/compiler/case.clj index 2720e31f7..37847f553 100644 --- a/src/lux/compiler/case.clj +++ b/src/lux/compiler/case.clj @@ -92,7 +92,7 @@ (->> (|let [[idx test] idx+member $next (new Label) $sub-else (new Label)]) - (doseq [idx+member (&/->seq (&/zip2 (&/|range (&/|length ?members)) ?members))]))) + (doseq [idx+member (->> ?members &/enumerate &/->seq)]))) (.visitInsn Opcodes/POP) (.visitJumpInsn Opcodes/GOTO $target)) @@ -110,11 +110,12 @@ (->> (|let [[idx [_ test]] idx+member $next (new Label) $sub-else (new Label)]) - (doseq [idx+member (&/->seq (&/zip2 (&/|range (&/|length ?slots)) - (->> ?slots - &/->seq - (sort compare-kv) - &/->list)))]))) + (doseq [idx+member (->> ?slots + &/->seq + (sort compare-kv) + &/->list + &/enumerate + &/->seq)]))) (.visitInsn Opcodes/POP) (.visitJumpInsn Opcodes/GOTO $target)) diff --git a/src/lux/compiler/host.clj b/src/lux/compiler/host.clj index 429424240..8782acfa5 100644 --- a/src/lux/compiler/host.clj +++ b/src/lux/compiler/host.clj @@ -202,12 +202,11 @@ :let [method-sig (str "(" (&/fold str "" (&/|map &host/->type-signature ?classes)) ")" (&host/->java-sig *type*))] _ (compile ?object) :let [_ (.visitTypeInsn *writer* Opcodes/CHECKCAST (&host/->class ?class))] - _ (&/map% (fn [class-name+arg] - (|let [[class-name arg] class-name+arg] - (|do [ret (compile arg) - :let [_ (prepare-arg! *writer* class-name)]] - (return ret)))) - (&/zip2 ?classes ?args)) + _ (&/map2% (fn [class-name arg] + (|do [ret (compile arg) + :let [_ (prepare-arg! *writer* class-name)]] + (return ret))) + ?classes ?args) :let [_ (doto *writer* (.visitMethodInsn (&host/->class ?class) ?method method-sig) (prepare-return! *type*))]] diff --git a/src/lux/compiler/lux.clj b/src/lux/compiler/lux.clj index 4e3e4add1..491cf62fb 100644 --- a/src/lux/compiler/lux.clj +++ b/src/lux/compiler/lux.clj @@ -54,15 +54,14 @@ _ (doto *writer* (.visitLdcInsn (int num-elems)) (.visitTypeInsn Opcodes/ANEWARRAY (&host/->class "java.lang.Object")))] - _ (&/map% (fn [idx+elem] - (|let [[idx elem] idx+elem] - (|do [:let [_ (doto *writer* - (.visitInsn Opcodes/DUP) - (.visitLdcInsn (int idx)))] - ret (compile elem) - :let [_ (.visitInsn *writer* Opcodes/AASTORE)]] - (return ret)))) - (&/zip2 (&/|range num-elems) ?elems))] + _ (&/map2% (fn [idx elem] + (|do [:let [_ (doto *writer* + (.visitInsn Opcodes/DUP) + (.visitLdcInsn (int idx)))] + ret (compile elem) + :let [_ (.visitInsn *writer* Opcodes/AASTORE)]] + (return ret))) + (&/|range num-elems) ?elems)] (return nil))) (defn compile-record [compile *type* ?elems] @@ -75,15 +74,15 @@ _ (doto *writer* (.visitLdcInsn (int num-elems)) (.visitTypeInsn Opcodes/ANEWARRAY (&host/->class "java.lang.Object")))] - _ (&/map% (fn [idx+kv] - (|let [[idx [k v]] idx+kv] - (|do [:let [_ (doto *writer* - (.visitInsn Opcodes/DUP) - (.visitLdcInsn (int idx)))] - ret (compile v) - :let [_ (.visitInsn *writer* Opcodes/AASTORE)]] - (return ret)))) - (&/zip2 (&/|range num-elems) elems*))] + _ (&/map2% (fn [idx kv] + (|let [[k v] kv] + (|do [:let [_ (doto *writer* + (.visitInsn Opcodes/DUP) + (.visitLdcInsn (int idx)))] + ret (compile v) + :let [_ (.visitInsn *writer* Opcodes/AASTORE)]] + (return ret)))) + (&/|range num-elems) elems*)] (return nil))) (defn compile-variant [compile *type* ?tag ?value] diff --git a/src/lux/host.clj b/src/lux/host.clj index 783b61298..55a772fcc 100644 --- a/src/lux/host.clj +++ b/src/lux/host.clj @@ -54,7 +54,7 @@ (def ->package ->class) (defn ->type-signature [class] - (assert (string? class)) + ;; (assert (string? class)) (case class "void" "V" "boolean" "Z" @@ -96,15 +96,13 @@ (do-template [ ] (defn [target field] - (let [target (Class/forName target)] - (if-let [type* (first (for [^Field =field (.getFields target) - :when (and (= target (.getDeclaringClass =field)) - (= field (.getName =field)) - (= (Modifier/isStatic (.getModifiers =field))))] - (.getType =field)))] - (|do [=type (class->type type*)] - (return =type)) - (fail (str "[Analyser Error] Field does not exist: " target field))))) + (if-let [type* (first (for [^Field =field (.getDeclaredFields (Class/forName target)) + :when (and (= field (.getName =field)) + (= (Modifier/isStatic (.getModifiers =field))))] + (.getType =field)))] + (|do [=type (class->type type*)] + (return =type)) + (fail (str "[Analyser Error] Field does not exist: " target "." field)))) lookup-static-field true lookup-field false @@ -112,21 +110,16 @@ (do-template [ ] (defn [target method-name args] - (let [target (Class/forName target)] - (if-let [method (first (for [^Method =method (.getMethods target) - :when (and (= target (.getDeclaringClass =method)) - (= method-name (.getName =method)) - (= (Modifier/isStatic (.getModifiers =method))) - (&/fold #(and %1 %2) - true - (&/|map (fn [xy] - (|let [[x y] xy] - (= x y))) - (&/zip2 args - (&/|map #(.getName ^Class %) (&/->list (seq (.getParameterTypes =method))))))))] - =method))] - (method->type method) - (fail (str "[Analyser Error] Method does not exist: " target method-name))))) + (if-let [method (first (for [^Method =method (.getDeclaredMethods (Class/forName target)) + :when (and (= method-name (.getName =method)) + (= (Modifier/isStatic (.getModifiers =method))) + (&/fold2 #(and %1 (= %2 %3)) + true + args + (&/|map #(.getName ^Class %) (&/->list (seq (.getParameterTypes =method))))))] + =method))] + (method->type method) + (fail (str "[Analyser Error] Method does not exist: " target "." method-name)))) lookup-static-method true lookup-virtual-method false diff --git a/src/lux/reader.clj b/src/lux/reader.clj index 38ff4d5e6..3c5f0066d 100644 --- a/src/lux/reader.clj +++ b/src/lux/reader.clj @@ -69,14 +69,13 @@ (defn from [file-name] (let [lines (&/->list (string/split-lines (slurp file-name)))] (&/|map (fn [line+line-num] - (|let [[line line-num] line+line-num] + (|let [[line-num line] line+line-num] (&/V "lux;Meta" (&/T (&/T file-name line-num 0) line)))) (&/|filter (fn [line+line-num] - (|let [[line line-num] line+line-num] + (|let [[line-num line] line+line-num] (not (empty? line)))) - (&/zip2 lines - (&/|range (&/|length lines))))))) + (&/enumerate lines))))) (def current-line (fn [state] -- cgit v1.2.3 From 7f39dd6a229b3b5a8e8d4108ecd1f5307b3cbf06 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 6 May 2015 23:44:24 -0400 Subject: - Made several optimizations to the compiler. - Also removed several unused definitions. --- src/lux/analyser.clj | 5 +-- src/lux/analyser/base.clj | 7 ---- src/lux/analyser/env.clj | 6 ---- src/lux/analyser/host.clj | 44 ++++++++++--------------- src/lux/analyser/lux.clj | 9 ++--- src/lux/compiler.clj | 2 +- src/lux/compiler/case.clj | 80 +++++++++++++++++++++------------------------ src/lux/compiler/lambda.clj | 16 +++------ src/lux/compiler/lux.clj | 45 ++++++++++++------------- src/lux/host.clj | 21 +----------- src/lux/lexer.clj | 4 ++- src/lux/parser.clj | 66 +++++++++++++++++++------------------ src/lux/reader.clj | 77 ++++++++++++++++++++----------------------- src/lux/type.clj | 38 +++++++++------------ 14 files changed, 177 insertions(+), 243 deletions(-) (limited to 'src') diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj index eefb5b41c..8fad07dfa 100644 --- a/src/lux/analyser.clj +++ b/src/lux/analyser.clj @@ -26,9 +26,6 @@ ["lux;Nil" _]]]]]]]]] (&/T catch+ ?finally-body))) -(defn ^:private _meta [token] - (&/V "lux;Meta" (&/T (&/T "" -1 -1) token))) - (defn ^:private aba1 [analyse eval! exo-type token] (matchv ::M/objects [token] ;; Standard special forms @@ -59,7 +56,7 @@ (&&lux/analyse-record analyse exo-type ?elems) [["lux;Meta" [meta ["lux;Tag" ?ident]]]] - (&&lux/analyse-variant analyse exo-type ?ident (_meta (&/V "lux;Tuple" (|list)))) + (&&lux/analyse-variant analyse exo-type ?ident (&/V "lux;Meta" (&/T (&/T "" -1 -1) (&/V "lux;Tuple" (|list))))) [["lux;Meta" [meta ["lux;Symbol" [_ "jvm-null"]]]]] (return (&/|list (&/T (&/V "jvm-null" nil) (&/V "lux;DataT" "null")))) diff --git a/src/lux/analyser/base.clj b/src/lux/analyser/base.clj index b16025349..a4c96c350 100644 --- a/src/lux/analyser/base.clj +++ b/src/lux/analyser/base.clj @@ -25,10 +25,3 @@ &/get-module-name (return ?module))] (return (&/ident->text (&/T module* ?name)))))) - -(defn resolved-ident* [ident] - (|let [[?module ?name] ident] - (|do [module* (if (= "" ?module) - &/get-module-name - (return ?module))] - (return (&/T module* ?name))))) diff --git a/src/lux/analyser/env.clj b/src/lux/analyser/env.clj index 77fba3ca0..fa7b9aa1a 100644 --- a/src/lux/analyser/env.clj +++ b/src/lux/analyser/env.clj @@ -34,12 +34,6 @@ [_] =return)))) -(defn with-locals [locals monad] - (reduce (fn [inner [label elem]] - (with-local label elem inner)) - monad - (reverse locals))) - (def captured-vars (fn [state] (return* state (->> state (&/get$ &/$ENVS) &/|head (&/get$ &/$CLOSURE) (&/get$ &/$MAPPINGS))))) diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj index 0d9fb1333..3631bddb2 100644 --- a/src/lux/analyser/host.clj +++ b/src/lux/analyser/host.clj @@ -75,46 +75,40 @@ ) (defn analyse-jvm-getstatic [analyse ?class ?field] - (|do [=class (&host/full-class-name ?class) - =type (&host/lookup-static-field =class ?field)] - (return (&/|list (&/T (&/V "jvm-getstatic" (&/T =class ?field)) =type))))) + (|do [=type (&host/lookup-static-field ?class ?field)] + (return (&/|list (&/T (&/V "jvm-getstatic" (&/T ?class ?field)) =type))))) (defn analyse-jvm-getfield [analyse ?class ?field ?object] - (|do [=class (&host/full-class-name ?class) - =type (&host/lookup-static-field =class ?field) + (|do [=type (&host/lookup-static-field ?class ?field) =object (&&/analyse-1 analyse ?object)] - (return (&/|list (&/T (&/V "jvm-getfield" (&/T =class ?field =object)) =type))))) + (return (&/|list (&/T (&/V "jvm-getfield" (&/T ?class ?field =object)) =type))))) (defn analyse-jvm-putstatic [analyse ?class ?field ?value] - (|do [=class (&host/full-class-name ?class) - =type (&host/lookup-static-field =class ?field) + (|do [=type (&host/lookup-static-field ?class ?field) =value (&&/analyse-1 analyse ?value)] - (return (&/|list (&/T (&/V "jvm-putstatic" (&/T =class ?field =value)) =type))))) + (return (&/|list (&/T (&/V "jvm-putstatic" (&/T ?class ?field =value)) =type))))) (defn analyse-jvm-putfield [analyse ?class ?field ?object ?value] - (|do [=class (&host/full-class-name ?class) - =type (&host/lookup-static-field =class ?field) + (|do [=type (&host/lookup-static-field ?class ?field) =object (&&/analyse-1 analyse ?object) =value (&&/analyse-1 analyse ?value)] - (return (&/|list (&/T (&/V "jvm-putfield" (&/T =class ?field =object =value)) =type))))) + (return (&/|list (&/T (&/V "jvm-putfield" (&/T ?class ?field =object =value)) =type))))) (defn analyse-jvm-invokestatic [analyse ?class ?method ?classes ?args] - (|do [=class (&host/full-class-name ?class) - =classes (&/map% &host/extract-jvm-param ?classes) - =return (&host/lookup-static-method =class ?method =classes) + (|do [=classes (&/map% &host/extract-jvm-param ?classes) + =return (&host/lookup-static-method ?class ?method =classes) =args (&/flat-map% analyse ?args)] - (return (&/|list (&/T (&/V "jvm-invokestatic" (&/T =class ?method =classes =args)) =return))))) + (return (&/|list (&/T (&/V "jvm-invokestatic" (&/T ?class ?method =classes =args)) =return))))) (do-template [ ] (defn [analyse ?class ?method ?classes ?object ?args] - (|do [=class (&host/full-class-name ?class) - =classes (&/map% &host/extract-jvm-param ?classes) - =return (&host/lookup-virtual-method =class ?method =classes) + (|do [=classes (&/map% &host/extract-jvm-param ?classes) + =return (&host/lookup-virtual-method ?class ?method =classes) =object (&&/analyse-1 analyse (&/V "lux;DataT" ?class) ?object) =args (&/map2% (fn [?c ?o] (&&/analyse-1 analyse (&/V "lux;DataT" ?c) ?o)) =classes ?args)] - (return (&/|list (&/T (&/V (&/T =class ?method =classes =object =args)) =return))))) + (return (&/|list (&/T (&/V (&/T ?class ?method =classes =object =args)) =return))))) analyse-jvm-invokevirtual "jvm-invokevirtual" analyse-jvm-invokeinterface "jvm-invokeinterface" @@ -126,15 +120,13 @@ (return (&/|list (&/T (&/V "jvm-null?" =object) (&/V "lux;DataT" "java.lang.Boolean")))))) (defn analyse-jvm-new [analyse ?class ?classes ?args] - (|do [=class (&host/full-class-name ?class) - =classes (&/map% &host/extract-jvm-param ?classes) + (|do [=classes (&/map% &host/extract-jvm-param ?classes) =args (&/flat-map% analyse ?args)] - (return (&/|list (&/T (&/V "jvm-new" (&/T =class =classes =args)) (&/V "lux;DataT" =class)))))) + (return (&/|list (&/T (&/V "jvm-new" (&/T ?class =classes =args)) (&/V "lux;DataT" ?class)))))) (defn analyse-jvm-new-array [analyse ?class ?length] - (|do [=class (&host/full-class-name ?class)] - (return (&/|list (&/T (&/V "jvm-new-array" (&/T =class ?length)) (&/V "array" (&/T (&/V "lux;DataT" =class) - (&/V "lux;Nil" nil)))))))) + (return (&/|list (&/T (&/V "jvm-new-array" (&/T ?class ?length)) (&/V "array" (&/T (&/V "lux;DataT" ?class) + (&/V "lux;Nil" nil))))))) (defn analyse-jvm-aastore [analyse ?array ?idx ?elem] (|do [=array (&&/analyse-1 analyse &type/$Void ?array) diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj index 26376ad60..df87a08b6 100644 --- a/src/lux/analyser/lux.clj +++ b/src/lux/analyser/lux.clj @@ -45,8 +45,7 @@ (defn analyse-variant [analyse exo-type ident ?value] (|do [exo-type* (matchv ::M/objects [exo-type] [["lux;VarT" ?id]] - (&/try-all% (&/|list (|do [exo-type* (&/try-all% (&/|list (&type/deref ?id) - (fail "##8##")))] + (&/try-all% (&/|list (|do [exo-type* (&type/deref ?id)] (&type/actual-type exo-type*)) (|do [_ (&type/set-var ?id &type/Type)] (&type/actual-type &type/Type)))) @@ -74,8 +73,7 @@ (defn analyse-record [analyse exo-type ?elems] (|do [exo-type* (matchv ::M/objects [exo-type] [["lux;VarT" ?id]] - (|do [exo-type* (&/try-all% (&/|list (&type/deref ?id) - (fail "##7##")))] + (|do [exo-type* (&type/deref ?id)] (&type/actual-type exo-type*)) [_] @@ -265,8 +263,7 @@ [["lux;VarT" ?id]] (|do [? (&type/bound? ?id)] (if ? - (|do [dtype (&/try-all% (&/|list (&type/deref ?id) - (fail "##6##")))] + (|do [dtype (&type/deref ?id)] (matchv ::M/objects [dtype] [["lux;ExT" _]] (return (&/T _expr exo-type)) diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj index f970540c9..209e29626 100644 --- a/src/lux/compiler.clj +++ b/src/lux/compiler.clj @@ -353,7 +353,7 @@ (.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 (&/V "lux;Some" (&reader/from (str "source/" name ".lux")))) + (&/set$ &/$SOURCE (&reader/from (str "source/" name ".lux"))) (&/set$ &/$ENVS (&/|list (&/env name))) (&/update$ &/$HOST #(&/set$ &/$WRITER (&/V "lux;Some" =class) %)) (&/update$ &/$MODULES #(&/|put name &a-module/init-module %))))] diff --git a/src/lux/compiler/case.clj b/src/lux/compiler/case.clj index 37847f553..1a0a9c6bc 100644 --- a/src/lux/compiler/case.clj +++ b/src/lux/compiler/case.clj @@ -16,10 +16,7 @@ MethodVisitor))) ;; [Utils] -(let [+tag-sig+ (&host/->type-signature "java.lang.String") - +oclass+ (&host/->class "java.lang.Object") - +equals-sig+ (str "(" (&host/->type-signature "java.lang.Object") ")Z") - compare-kv #(.compareTo ^String (aget ^objects %1 0) ^String (aget ^objects %2 0))] +(let [compare-kv #(.compareTo ^String (aget ^objects %1 0) ^String (aget ^objects %2 0))] (defn ^:private compile-match [^MethodVisitor writer ?match $target $else] (matchv ::M/objects [?match] [["StoreTestAC" ?idx]] @@ -29,9 +26,9 @@ [["BoolTestAC" ?value]] (doto writer - (.visitTypeInsn Opcodes/CHECKCAST (&host/->class "java.lang.Boolean")) + (.visitTypeInsn Opcodes/CHECKCAST "java/lang/Boolean") (.visitInsn Opcodes/DUP) - (.visitMethodInsn Opcodes/INVOKEVIRTUAL (&host/->class "java.lang.Boolean") "booleanValue" "()Z") + (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/Boolean" "booleanValue" "()Z") (.visitLdcInsn ?value) (.visitJumpInsn Opcodes/IF_ICMPNE $else) (.visitInsn Opcodes/POP) @@ -39,9 +36,9 @@ [["IntTestAC" ?value]] (doto writer - (.visitTypeInsn Opcodes/CHECKCAST (&host/->class "java.lang.Long")) + (.visitTypeInsn Opcodes/CHECKCAST "java/lang/Long") (.visitInsn Opcodes/DUP) - (.visitMethodInsn Opcodes/INVOKEVIRTUAL (&host/->class "java.lang.Long") "longValue" "()J") + (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/Long" "longValue" "()J") (.visitLdcInsn ?value) (.visitInsn Opcodes/LCMP) (.visitJumpInsn Opcodes/IFNE $else) @@ -50,9 +47,9 @@ [["RealTestAC" ?value]] (doto writer - (.visitTypeInsn Opcodes/CHECKCAST (&host/->class "java.lang.Double")) + (.visitTypeInsn Opcodes/CHECKCAST "java/lang/Double") (.visitInsn Opcodes/DUP) - (.visitMethodInsn Opcodes/INVOKEVIRTUAL (&host/->class "java.lang.Double") "doubleValue" "()D") + (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/Double" "doubleValue" "()D") (.visitLdcInsn ?value) (.visitInsn Opcodes/DCMPL) (.visitJumpInsn Opcodes/IFNE $else) @@ -61,9 +58,9 @@ [["CharTestAC" ?value]] (doto writer - (.visitTypeInsn Opcodes/CHECKCAST (&host/->class "java.lang.Character")) + (.visitTypeInsn Opcodes/CHECKCAST "java/lang/Character") (.visitInsn Opcodes/DUP) - (.visitMethodInsn Opcodes/INVOKEVIRTUAL (&host/->class "java.lang.Character") "charValue" "()C") + (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/Character" "charValue" "()C") (.visitLdcInsn ?value) (.visitJumpInsn Opcodes/IF_ICMPNE $else) (.visitInsn Opcodes/POP) @@ -73,7 +70,7 @@ (doto writer (.visitInsn Opcodes/DUP) (.visitLdcInsn ?value) - (.visitMethodInsn Opcodes/INVOKEVIRTUAL (&host/->class "java.lang.Object") "equals" (str "(" (&host/->type-signature "java.lang.Object") ")Z")) + (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/Object" "equals" "(Ljava/lang/Object;)Z") (.visitJumpInsn Opcodes/IFEQ $else) (.visitInsn Opcodes/POP) (.visitJumpInsn Opcodes/GOTO $target)) @@ -126,7 +123,7 @@ (.visitLdcInsn (int 0)) (.visitInsn Opcodes/AALOAD) (.visitLdcInsn ?tag) - (.visitMethodInsn Opcodes/INVOKEVIRTUAL +oclass+ "equals" +equals-sig+) + (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/Object" "equals" "(Ljava/lang/Object;)Z") (.visitJumpInsn Opcodes/IFEQ $else) (.visitInsn Opcodes/DUP) (.visitLdcInsn (int 1)) @@ -151,34 +148,33 @@ patterns)] (&/T mappings (&/|reverse patterns*)))) -(let [ex-class (&host/->class "java.lang.IllegalStateException")] - (defn ^:private compile-pattern-matching [^MethodVisitor writer compile 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 ?body mappings*) $else) - (.visitLabel $else)) - (->> (|let [[?body ?match] ?body+?match]) - (doseq [?body+?match (&/->seq patterns) - :let [$else (new Label)]]))) - (.visitInsn Opcodes/POP) - (.visitTypeInsn Opcodes/NEW ex-class) - (.visitInsn Opcodes/DUP) - (.visitMethodInsn Opcodes/INVOKESPECIAL ex-class "" "()V") - (.visitInsn Opcodes/ATHROW)) - (&/map% (fn [?label+?body] - (|let [[?label ?body] ?label+?body] - (|do [:let [_ (.visitLabel writer ?label)] - ret (compile ?body) - :let [_ (.visitJumpInsn writer Opcodes/GOTO $end)]] - (return ret)))) - (&/|map &/|second entries)) - ))) +(defn ^:private compile-pattern-matching [^MethodVisitor writer compile 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 ?body mappings*) $else) + (.visitLabel $else)) + (->> (|let [[?body ?match] ?body+?match]) + (doseq [?body+?match (&/->seq patterns) + :let [$else (new Label)]]))) + (.visitInsn Opcodes/POP) + (.visitTypeInsn Opcodes/NEW "java/lang/IllegalStateException") + (.visitInsn Opcodes/DUP) + (.visitMethodInsn Opcodes/INVOKESPECIAL "java/lang/IllegalStateException" "" "()V") + (.visitInsn Opcodes/ATHROW)) + (&/map% (fn [?label+?body] + (|let [[?label ?body] ?label+?body] + (|do [:let [_ (.visitLabel writer ?label)] + ret (compile ?body) + :let [_ (.visitJumpInsn writer Opcodes/GOTO $end)]] + (return ret)))) + (&/|map &/|second entries)) + )) ;; [Resources] (defn compile-case [compile *type* ?value ?matches] diff --git a/src/lux/compiler/lambda.clj b/src/lux/compiler/lambda.clj index 3ba6e52f1..65c7e58aa 100644 --- a/src/lux/compiler/lambda.clj +++ b/src/lux/compiler/lambda.clj @@ -79,17 +79,11 @@ :let [_ (doto *writer* (.visitTypeInsn Opcodes/NEW lambda-class) (.visitInsn Opcodes/DUP))] - _ (->> closed-over - &/->seq - (sort #(matchv ::M/objects [(&/|second %1) (&/|second %2)] - [[["captured" [_ ?cid1 _]] _] - [["captured" [_ ?cid2 _]] _]] - (< ?cid1 ?cid2))) - &/->list - (&/map% (fn [?name+?captured] - (matchv ::M/objects [?name+?captured] - [[?name [["captured" [_ _ ?source]] _]]] - (compile ?source))))) + _ (&/map% (fn [?name+?captured] + (matchv ::M/objects [?name+?captured] + [[?name [["captured" [_ _ ?source]] _]]] + (compile ?source))) + closed-over) :let [_ (.visitMethodInsn *writer* Opcodes/INVOKESPECIAL lambda-class "" init-signature)]] (return nil))) diff --git a/src/lux/compiler/lux.clj b/src/lux/compiler/lux.clj index 491cf62fb..cf4a65f04 100644 --- a/src/lux/compiler/lux.clj +++ b/src/lux/compiler/lux.clj @@ -20,27 +20,24 @@ MethodVisitor))) ;; [Exports] -(let [+class+ (&host/->class "java.lang.Boolean") - +sig+ (&host/->type-signature "java.lang.Boolean")] - (defn compile-bool [compile *type* ?value] - (|do [^MethodVisitor *writer* &/get-writer - :let [_ (.visitFieldInsn *writer* Opcodes/GETSTATIC (&host/->class "java.lang.Boolean") (if ?value "TRUE" "FALSE") (&host/->type-signature "java.lang.Boolean"))]] - (return nil)))) +(defn compile-bool [compile *type* ?value] + (|do [^MethodVisitor *writer* &/get-writer + :let [_ (.visitFieldInsn *writer* Opcodes/GETSTATIC "java/lang/Boolean" (if ?value "TRUE" "FALSE") "Ljava/lang/Boolean;")]] + (return nil))) (do-template [ ] - (let [+class+ (&host/->class )] - (defn [compile *type* value] - (|do [^MethodVisitor *writer* &/get-writer - :let [_ (doto *writer* - (.visitTypeInsn Opcodes/NEW +class+) - (.visitInsn Opcodes/DUP) - (.visitLdcInsn ( value)) - (.visitMethodInsn Opcodes/INVOKESPECIAL +class+ "" ))]] - (return nil)))) + (defn [compile *type* value] + (|do [^MethodVisitor *writer* &/get-writer + :let [_ (doto *writer* + (.visitTypeInsn Opcodes/NEW ) + (.visitInsn Opcodes/DUP) + (.visitLdcInsn ( value)) + (.visitMethodInsn Opcodes/INVOKESPECIAL "" ))]] + (return nil))) - compile-int "java.lang.Long" "(J)V" long - compile-real "java.lang.Double" "(D)V" double - compile-char "java.lang.Character" "(C)V" char + compile-int "java/lang/Long" "(J)V" long + compile-real "java/lang/Double" "(D)V" double + compile-char "java/lang/Character" "(C)V" char ) (defn compile-text [compile *type* ?value] @@ -53,7 +50,7 @@ :let [num-elems (&/|length ?elems) _ (doto *writer* (.visitLdcInsn (int num-elems)) - (.visitTypeInsn Opcodes/ANEWARRAY (&host/->class "java.lang.Object")))] + (.visitTypeInsn Opcodes/ANEWARRAY "java/lang/Object"))] _ (&/map2% (fn [idx elem] (|do [:let [_ (doto *writer* (.visitInsn Opcodes/DUP) @@ -73,7 +70,7 @@ num-elems (&/|length elems*) _ (doto *writer* (.visitLdcInsn (int num-elems)) - (.visitTypeInsn Opcodes/ANEWARRAY (&host/->class "java.lang.Object")))] + (.visitTypeInsn Opcodes/ANEWARRAY "java/lang/Object"))] _ (&/map2% (fn [idx kv] (|let [[k v] kv] (|do [:let [_ (doto *writer* @@ -89,7 +86,7 @@ (|do [^MethodVisitor *writer* &/get-writer :let [_ (doto *writer* (.visitLdcInsn (int 2)) - (.visitTypeInsn Opcodes/ANEWARRAY (&host/->class "java.lang.Object")) + (.visitTypeInsn Opcodes/ANEWARRAY "java/lang/Object") (.visitInsn Opcodes/DUP) (.visitLdcInsn (int 0)) (.visitLdcInsn ?tag) @@ -124,19 +121,19 @@ (|do [^MethodVisitor *writer* &/get-writer _ (compile ?fn) _ (compile ?arg) - :let [_ (.visitMethodInsn *writer* Opcodes/INVOKEINTERFACE (&host/->class &host/function-class) "apply" &&/apply-signature)]] + :let [_ (.visitMethodInsn *writer* Opcodes/INVOKEINTERFACE "lux/Function" "apply" &&/apply-signature)]] (return nil))) (defn compile-def [compile ?name ?body ?def-data] (|do [^ClassWriter *writer* &/get-writer module-name &/get-module-name :let [outer-class (&host/->class module-name) - datum-sig (&host/->type-signature "java.lang.Object") + datum-sig "Ljava/lang/Object;" current-class (&host/location (&/|list outer-class ?name)) _ (.visitInnerClass *writer* current-class outer-class nil (+ Opcodes/ACC_STATIC Opcodes/ACC_SYNTHETIC)) =class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS) (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_SUPER) - current-class nil "java/lang/Object" (into-array [(&host/->class &host/function-class)])) + current-class nil "java/lang/Object" (into-array ["lux/Function"])) (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_datum" datum-sig nil nil) (doto (.visitEnd))))] _ (&/with-writer (.visitMethod =class Opcodes/ACC_PUBLIC "" "()V" nil nil) diff --git a/src/lux/host.clj b/src/lux/host.clj index 55a772fcc..d159d2608 100644 --- a/src/lux/host.clj +++ b/src/lux/host.clj @@ -29,25 +29,6 @@ (return =return))) ;; [Resources] -(defn full-class [class-name] - (case class-name - "boolean" (return Boolean/TYPE) - "byte" (return Byte/TYPE) - "short" (return Short/TYPE) - "int" (return Integer/TYPE) - "long" (return Long/TYPE) - "float" (return Float/TYPE) - "double" (return Double/TYPE) - "char" (return Character/TYPE) - ;; else - (try (return (Class/forName class-name)) - (catch Exception e - (fail (str "[Analyser Error] Unknown class: " class-name)))))) - -(defn full-class-name [class-name] - (|do [^Class =class (full-class class-name)] - (return (.getName =class)))) - (defn ^String ->class [class] (string/replace class #"\." "/")) @@ -89,7 +70,7 @@ (defn extract-jvm-param [token] (matchv ::M/objects [token] [["lux;Meta" [_ ["lux;Symbol" [_ ?ident]]]]] - (full-class-name ?ident) + (return ?ident) [_] (fail (str "[Host] Unknown JVM param: " (pr-str token))))) diff --git a/src/lux/lexer.clj b/src/lux/lexer.clj index eb4e7af7c..f94a3d058 100644 --- a/src/lux/lexer.clj +++ b/src/lux/lexer.clj @@ -25,7 +25,9 @@ (|do [[_ [_ body]] (&reader/read-regex #"(?s)^([^\"\\]*)")] (return body))))) -(def ^:private +ident-re+ #"^([a-zA-Z\-\+\_\=!@$%^&*<>\.,/\\\|'`:\~\?][0-9a-zA-Z\-\+\_\=!@$%^&*<>\.,/\\\|'`:\~\?]*)") +(def ^:private +ident-re+ #"^([a-zA-Z\-\+\_\=!@$%^&*<>\.,/\\\|'`:\~\?][0-9a-zA-Z\-\+\_\=!@$%^&*<>\.,/\\\|'`:\~\?]*)" + ;; #"^([^0-9\[\]\(\)\{\};#\s\"][^\[\]\(\)\{\};#\s\"]*)" + ) ;; [Lexers] (def ^:private lex-white-space diff --git a/src/lux/parser.clj b/src/lux/parser.clj index d8817fc05..6b392ea96 100644 --- a/src/lux/parser.clj +++ b/src/lux/parser.clj @@ -38,45 +38,47 @@ (def parse (|do [token &lexer/lex] (matchv ::M/objects [token] - [["lux;Meta" [meta ["White_Space" _]]]] - (return (&/|list)) + [["lux;Meta" [meta token*]]] + (matchv ::M/objects [token*] + [["White_Space" _]] + (return (&/|list)) - [["lux;Meta" [meta ["Comment" _]]]] - (return (&/|list)) - - [["lux;Meta" [meta ["Bool" ?value]]]] - (return (&/|list (&/V "lux;Meta" (&/T meta (&/V "lux;Bool" (Boolean/parseBoolean ?value)))))) + [["Comment" _]] + (return (&/|list)) + + [["Bool" ?value]] + (return (&/|list (&/V "lux;Meta" (&/T meta (&/V "lux;Bool" (Boolean/parseBoolean ?value)))))) - [["lux;Meta" [meta ["Int" ?value]]]] - (return (&/|list (&/V "lux;Meta" (&/T meta (&/V "lux;Int" (Integer/parseInt ?value)))))) + [["Int" ?value]] + (return (&/|list (&/V "lux;Meta" (&/T meta (&/V "lux;Int" (Integer/parseInt ?value)))))) - [["lux;Meta" [meta ["Real" ?value]]]] - (return (&/|list (&/V "lux;Meta" (&/T meta (&/V "lux;Real" (Float/parseFloat ?value)))))) + [["Real" ?value]] + (return (&/|list (&/V "lux;Meta" (&/T meta (&/V "lux;Real" (Float/parseFloat ?value)))))) - [["lux;Meta" [meta ["Char" ^String ?value]]]] - (return (&/|list (&/V "lux;Meta" (&/T meta (&/V "lux;Char" (.charAt ?value 0)))))) + [["Char" ^String ?value]] + (return (&/|list (&/V "lux;Meta" (&/T meta (&/V "lux;Char" (.charAt ?value 0)))))) - [["lux;Meta" [meta ["Text" ?value]]]] - (return (&/|list (&/V "lux;Meta" (&/T meta (&/V "lux;Text" ?value))))) + [["Text" ?value]] + (return (&/|list (&/V "lux;Meta" (&/T meta (&/V "lux;Text" ?value))))) - [["lux;Meta" [meta ["Symbol" ?ident]]]] - (return (&/|list (&/V "lux;Meta" (&/T meta (&/V "lux;Symbol" ?ident))))) + [["Symbol" ?ident]] + (return (&/|list (&/V "lux;Meta" (&/T meta (&/V "lux;Symbol" ?ident))))) - [["lux;Meta" [meta ["Tag" ?ident]]]] - (return (&/|list (&/V "lux;Meta" (&/T meta (&/V "lux;Tag" ?ident))))) + [["Tag" ?ident]] + (return (&/|list (&/V "lux;Meta" (&/T meta (&/V "lux;Tag" ?ident))))) - [["lux;Meta" [meta ["Open_Paren" _]]]] - (|do [syntax (parse-form parse)] - (return (&/|list (&/V "lux;Meta" (&/T meta syntax))))) - - [["lux;Meta" [meta ["Open_Bracket" _]]]] - (|do [syntax (parse-tuple parse)] - (return (&/|list (&/V "lux;Meta" (&/T meta syntax))))) + [["Open_Paren" _]] + (|do [syntax (parse-form parse)] + (return (&/|list (&/V "lux;Meta" (&/T meta syntax))))) + + [["Open_Bracket" _]] + (|do [syntax (parse-tuple parse)] + (return (&/|list (&/V "lux;Meta" (&/T meta syntax))))) - [["lux;Meta" [meta ["Open_Brace" _]]]] - (|do [syntax (parse-record parse)] - (return (&/|list (&/V "lux;Meta" (&/T meta syntax))))) + [["Open_Brace" _]] + (|do [syntax (parse-record parse)] + (return (&/|list (&/V "lux;Meta" (&/T meta syntax))))) - [_] - (fail "[Parser Error] Unknown lexer token.") - ))) + [_] + (fail "[Parser Error] Unknown lexer token.") + )))) diff --git a/src/lux/reader.clj b/src/lux/reader.clj index 3c5f0066d..6a954d5ff 100644 --- a/src/lux/reader.clj +++ b/src/lux/reader.clj @@ -8,50 +8,59 @@ (defn ^:private with-line [body] (fn [state] (matchv ::M/objects [(&/get$ &/$SOURCE state)] - [["lux;None" _]] - (fail* "[Reader Error] No source code.") - - [["lux;Some" ["lux;Nil" _]]] + [["lux;Nil" _]] (fail* "[Reader Error] EOF") - [["lux;Some" ["lux;Cons" [["lux;Meta" [[file-name line-num column-num] line]] - more]]]] + [["lux;Cons" [["lux;Meta" [[file-name line-num column-num] line]] + more]]] (matchv ::M/objects [(body file-name line-num column-num line)] [["No" msg]] (fail* msg) - [["Yes" [meta ["lux;None" _]]]] - (return* (&/set$ &/$SOURCE (&/V "lux;Some" more) state) - meta) + [["Done" output]] + (return* (&/set$ &/$SOURCE more state) + output) - [["Yes" [meta ["lux;Some" line-meta]]]] - (return* (&/set$ &/$SOURCE (&/V "lux;Some" (&/|cons line-meta more)) state) - meta)) + [["Yes" [output line*]]] + (return* (&/set$ &/$SOURCE (&/|cons line* more) state) + output)) ))) ;; [Exports] +(defn ^:private re-find! [regex line] + (let [matcher (.matcher regex line)] + (when (.find matcher) + (.group matcher 0)))) + +(defn ^:private re-find3! [regex line] + (let [matcher (.matcher regex line)] + (when (.find matcher) + (list (.group matcher 0) + (.group matcher 1) + (.group matcher 2))))) + (defn read-regex [regex] (with-line (fn [file-name line-num column-num ^String line] - (if-let [[^String match] (re-find regex line)] + (if-let [^String match (re-find! regex line)] (let [match-length (.length match) line* (.substring line match-length)] - (&/V "Yes" (&/T (&/V "lux;Meta" (&/T (&/T file-name line-num column-num) match)) - (if (empty? line*) - (&/V "lux;None" nil) - (&/V "lux;Some" (&/V "lux;Meta" (&/T (&/T file-name line-num (+ column-num match-length)) line*))))))) + (if (empty? line*) + (&/V "Done" (&/V "lux;Meta" (&/T (&/T file-name line-num column-num) match))) + (&/V "Yes" (&/T (&/V "lux;Meta" (&/T (&/T file-name line-num column-num) match)) + (&/V "lux;Meta" (&/T (&/T file-name line-num (+ column-num match-length)) line*)))))) (&/V "No" (str "[Reader Error] Pattern failed: " regex)))))) (defn read-regex2 [regex] (with-line (fn [file-name line-num column-num ^String line] - (if-let [[^String match tok1 tok2] (re-find regex line)] + (if-let [[^String match tok1 tok2] (re-find3! regex line)] (let [match-length (.length match) line* (.substring line match-length)] - (&/V "Yes" (&/T (&/V "lux;Meta" (&/T (&/T file-name line-num column-num) (&/T tok1 tok2))) - (if (empty? line*) - (&/V "lux;None" nil) - (&/V "lux;Some" (&/V "lux;Meta" (&/T (&/T file-name line-num (+ column-num match-length)) line*))))))) + (if (empty? line*) + (&/V "Done" (&/V "lux;Meta" (&/T (&/T file-name line-num column-num) (&/T tok1 tok2)))) + (&/V "Yes" (&/T (&/V "lux;Meta" (&/T (&/T file-name line-num column-num) (&/T tok1 tok2))) + (&/V "lux;Meta" (&/T (&/T file-name line-num (+ column-num match-length)) line*)))))) (&/V "No" (str "[Reader Error] Pattern failed: " regex)))))) (defn read-text [^String text] @@ -60,10 +69,10 @@ (if (.startsWith line text) (let [match-length (.length text) line* (.substring line match-length)] - (&/V "Yes" (&/T (&/V "lux;Meta" (&/T (&/T file-name line-num column-num) text)) - (if (empty? line*) - (&/V "lux;None" nil) - (&/V "lux;Some" (&/V "lux;Meta" (&/T (&/T file-name line-num (+ column-num match-length)) line*))))))) + (if (empty? line*) + (&/V "Done" (&/V "lux;Meta" (&/T (&/T file-name line-num column-num) text))) + (&/V "Yes" (&/T (&/V "lux;Meta" (&/T (&/T file-name line-num column-num) text)) + (&/V "lux;Meta" (&/T (&/T file-name line-num (+ column-num match-length)) line*)))))) (&/V "No" (str "[Reader Error] Text failed: " text)))))) (defn from [file-name] @@ -74,19 +83,5 @@ line)))) (&/|filter (fn [line+line-num] (|let [[line-num line] line+line-num] - (not (empty? line)))) + (not= "" line))) (&/enumerate lines))))) - -(def current-line - (fn [state] - (matchv ::M/objects [(&/get$ &/$SOURCE state)] - [["lux;None" _]] - (fail* "[Reader Error] No source code.") - - [["lux;Some" ["lux;Nil" _]]] - (fail* "[Reader Error] EOF") - - [["lux;Some" ["lux;Cons" [["lux;Meta" [_ line]] - more]]]] - (return* state line) - ))) diff --git a/src/lux/type.clj b/src/lux/type.clj index 57c2d4624..2e9e85092 100644 --- a/src/lux/type.clj +++ b/src/lux/type.clj @@ -142,7 +142,7 @@ (def CompilerState (&/V "lux;AppT" (&/T (fAll "CompilerState" "" (&/V "lux;RecordT" - (&/|list (&/T "lux;source" (&/V "lux;AppT" (&/T Maybe Reader))) + (&/|list (&/T "lux;source" Reader) (&/T "lux;modules" (&/V "lux;AppT" (&/T List (&/V "lux;TupleT" (&/|list Text (&/V "lux;AppT" (&/T List (&/V "lux;TupleT" @@ -180,15 +180,14 @@ (defn deref [id] (fn [state] - (let [mappings (->> state (&/get$ &/$TYPES) (&/get$ &/$MAPPINGS))] - (if-let [type* (->> mappings (&/|get id))] - (matchv ::M/objects [type*] - [["lux;Some" type]] - (return* state type) - - [["lux;None" _]] - (fail* (str "[Type Error] Unbound type-var: " id))) - (fail* (str "[Type Error] Unknown type-var: " id)))))) + (if-let [type* (->> state (&/get$ &/$TYPES) (&/get$ &/$MAPPINGS) (&/|get id))] + (matchv ::M/objects [type*] + [["lux;Some" type]] + (return* state type) + + [["lux;None" _]] + (fail* (str "[Type Error] Unbound type-var: " id))) + (fail* (str "[Type Error] Unknown type-var: " id))))) (defn set-var [id type] (fn [state] @@ -210,8 +209,8 @@ (fn [state] (let [id (->> state (&/get$ &/$TYPES) (&/get$ &/$COUNTER))] (return* (&/update$ &/$TYPES #(->> % - (&/update$ &/$COUNTER inc) - (&/update$ &/$MAPPINGS (fn [ms] (&/|put id (&/V "lux;None" nil) ms)))) + (&/update$ &/$COUNTER inc) + (&/update$ &/$MAPPINGS (fn [ms] (&/|put id (&/V "lux;None" nil) ms)))) state) id)))) @@ -271,8 +270,7 @@ (matchv ::M/objects [type] [["lux;VarT" ?id]] (if (= ?tid ?id) - (&/try-all% (&/|list (deref ?id) - (fail "##5##"))) + (deref ?id) (return type)) [["lux;LambdaT" [?arg ?return]]] @@ -554,12 +552,10 @@ [["lux;VarT" ?eid] ["lux;VarT" ?aid]] (if (= ?eid ?aid) (return (&/T fixpoints nil)) - (|do [ebound (&/try-all% (&/|list (|do [ebound (&/try-all% (&/|list (deref ?eid) - (fail "##4##")))] + (|do [ebound (&/try-all% (&/|list (|do [ebound (deref ?eid)] (return (&/V "lux;Some" ebound))) (return (&/V "lux;None" nil)))) - abound (&/try-all% (&/|list (|do [abound (&/try-all% (&/|list (deref ?aid) - (fail "##3##")))] + abound (&/try-all% (&/|list (|do [abound (deref ?aid)] (return (&/V "lux;Some" abound))) (return (&/V "lux;None" nil))))] (matchv ::M/objects [ebound abound] @@ -579,15 +575,13 @@ [["lux;VarT" ?id] _] (&/try-all% (&/|list (|do [_ (set-var ?id actual)] (return (&/T fixpoints nil))) - (|do [bound (&/try-all% (&/|list (deref ?id) - (fail "##1##")))] + (|do [bound (deref ?id)] (check* fixpoints bound actual)))) [_ ["lux;VarT" ?id]] (&/try-all% (&/|list (|do [_ (set-var ?id expected)] (return (&/T fixpoints nil))) - (|do [bound (&/try-all% (&/|list (deref ?id) - (fail "##2##")))] + (|do [bound (deref ?id)] (check* fixpoints expected bound)))) [["lux;AppT" [["lux;VarT" ?eid] A1]] ["lux;AppT" [["lux;VarT" ?aid] A2]]] -- cgit v1.2.3 From 0d365358ebc7d3e6f99c74641162d2024772698c Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Thu, 7 May 2015 00:19:31 -0400 Subject: - Eliminated #eval-ctor from the HostState and now #seed is used for the same purpose. - Optimized some code a bit. --- src/lux/base.clj | 14 +++----------- src/lux/compiler.clj | 42 +++++++++++++++++++++--------------------- src/lux/compiler/lambda.clj | 4 ++-- src/lux/lexer.clj | 30 +++++++++++++++--------------- src/lux/type.clj | 2 +- 5 files changed, 42 insertions(+), 50 deletions(-) (limited to 'src') diff --git a/src/lux/base.clj b/src/lux/base.clj index 5292faffa..9ea255132 100644 --- a/src/lux/base.clj +++ b/src/lux/base.clj @@ -15,9 +15,8 @@ (def $NAME 3) ;; Host -(def $EVAL-CTOR 0) -(def $LOADER 1) -(def $WRITER 2) +(def $LOADER 0) +(def $WRITER 1) ;; CompilerState (def $ENVS 0) @@ -441,9 +440,7 @@ )) (defn host [_] - (R ;; "lux;eval-ctor" - 0 - ;; "lux;loader" + (R ;; "lux;loader" (-> (java.io.File. "./output/") .toURL vector into-array java.net.URLClassLoader.) ;; "lux;writer" (V "lux;None" nil))) @@ -465,11 +462,6 @@ +init-bindings+ )) -(def get-eval-ctor - (fn [state] - (return* (update$ $HOST #(update$ $EVAL-CTOR inc %) state) - (get$ $EVAL-CTOR (get$ $HOST state))))) - (def get-writer (fn [state] (let [writer* (->> state (get$ $HOST) (get$ $WRITER))] diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj index 209e29626..40bb3a710 100644 --- a/src/lux/compiler.clj +++ b/src/lux/compiler.clj @@ -315,27 +315,27 @@ (&&host/compile-jvm-class compile-expression ?package ?name ?super-class ?fields ?methods))) (defn ^:private eval! [expr] - (|do [eval-ctor &/get-eval-ctor - :let [class-name (str eval-ctor) - =class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS) - (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER) - class-name nil "java/lang/Object" nil) - (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_eval" "Ljava/lang/Object;" nil nil) - (doto (.visitEnd))))] - _ (&/with-writer (.visitMethod =class Opcodes/ACC_PUBLIC "" "()V" nil nil) - (|do [^MethodVisitor *writer* &/get-writer - :let [_ (.visitCode *writer*)] - _ (compile-expression expr) - :let [_ (doto *writer* - (.visitFieldInsn Opcodes/PUTSTATIC class-name "_eval" "Ljava/lang/Object;") - (.visitInsn Opcodes/RETURN) - (.visitMaxs 0 0) - (.visitEnd))]] - (return nil))) - :let [bytecode (.toByteArray (doto =class - .visitEnd))] - _ (&&/save-class! class-name bytecode) - loader &/loader] + (|do [id &/gen-id + :let [class-name (str id) + =class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS) + (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER) + class-name nil "java/lang/Object" nil) + (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_eval" "Ljava/lang/Object;" nil nil) + (doto (.visitEnd))))] + _ (&/with-writer (.visitMethod =class Opcodes/ACC_PUBLIC "" "()V" nil nil) + (|do [^MethodVisitor *writer* &/get-writer + :let [_ (.visitCode *writer*)] + _ (compile-expression expr) + :let [_ (doto *writer* + (.visitFieldInsn Opcodes/PUTSTATIC class-name "_eval" "Ljava/lang/Object;") + (.visitInsn Opcodes/RETURN) + (.visitMaxs 0 0) + (.visitEnd))]] + (return nil))) + :let [bytecode (.toByteArray (doto =class + .visitEnd))] + _ (&&/save-class! class-name bytecode) + loader &/loader] (-> (.loadClass ^ClassLoader loader class-name) (.getField "_eval") (.get nil) diff --git a/src/lux/compiler/lambda.clj b/src/lux/compiler/lambda.clj index 65c7e58aa..625599617 100644 --- a/src/lux/compiler/lambda.clj +++ b/src/lux/compiler/lambda.clj @@ -63,7 +63,7 @@ $start (new Label) $end (new Label) _ (doto *writer* - (-> (.visitLocalVariable (str &&/local-prefix idx) (&host/->java-sig (&/V "lux;DataT" "java.lang.Object")) nil $start $end (+ 2 idx)) + (-> (.visitLocalVariable (str &&/local-prefix idx) "Ljava/lang/Object;" nil $start $end (+ 2 idx)) (->> (dotimes [idx num-locals]))) (.visitLabel $start))] ret (compile impl-body) @@ -92,7 +92,7 @@ (|do [: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) - lambda-class nil "java/lang/Object" (into-array [(&host/->class &host/function-class)])) + lambda-class nil "java/lang/Object" (into-array ["lux/Function"])) (-> (doto (.visitField (+ Opcodes/ACC_PRIVATE Opcodes/ACC_FINAL) captured-name clo-field-sig nil nil) (.visitEnd)) (->> (let [captured-name (str &&/closure-prefix ?captured-id)]) diff --git a/src/lux/lexer.clj b/src/lux/lexer.clj index f94a3d058..31258bc4b 100644 --- a/src/lux/lexer.clj +++ b/src/lux/lexer.clj @@ -36,18 +36,18 @@ (def ^:private lex-single-line-comment (|do [[_ [meta _]] (&reader/read-text "##") - [_ [_ comment]] (&reader/read-regex #"^(.*)$")] + [_ [_ comment]] (&reader/read-regex #"^(.*)$")] (return (&/V "lux;Meta" (&/T meta (&/V "Comment" comment)))))) (defn ^:private lex-multi-line-comment [_] (|do [_ (&reader/read-text "#(") - [meta comment] (&/try-all% (&/|list (|do [[_ [meta comment]] (&reader/read-regex #"(?is)^((?!#\().)*?(?=\)#)")] - (return comment)) - (|do [[_ [meta pre]] (&reader/read-regex #"(?is)^(.+?(?=#\())") - [_ inner] (lex-multi-line-comment nil) - [_ [_ post]] (&reader/read-regex #"(?is)^(.+?(?=\)#))")] - (return (str pre "#(" inner ")#" post))))) - _ (&reader/read-text ")#")] + [meta comment] (&/try-all% (&/|list (|do [[_ [meta comment]] (&reader/read-regex #"(?is)^((?!#\().)*?(?=\)#)")] + (return comment)) + (|do [[_ [meta pre]] (&reader/read-regex #"(?is)^(.+?(?=#\())") + [_ inner] (lex-multi-line-comment nil) + [_ [_ post]] (&reader/read-regex #"(?is)^(.+?(?=\)#))")] + (return (str pre "#(" inner ")#" post))))) + _ (&reader/read-text ")#")] (return (&/V "lux;Meta" (&/T meta (&/V "Comment" comment)))))) (def ^:private lex-comment @@ -65,17 +65,17 @@ (def ^:private lex-char (|do [[_ [meta _]] (&reader/read-text "#\"") - token (&/try-all% (&/|list (|do [[_ [_ escaped]] (&reader/read-regex #"^(\\.)")] - (escape-char escaped)) - (|do [[_ [_ char]] (&reader/read-regex #"^(.)")] - (return char)))) - _ (&reader/read-text "\"")] + token (&/try-all% (&/|list (|do [[_ [_ escaped]] (&reader/read-regex #"^(\\.)")] + (escape-char escaped)) + (|do [[_ [_ char]] (&reader/read-regex #"^(.)")] + (return char)))) + _ (&reader/read-text "\"")] (return (&/V "lux;Meta" (&/T meta (&/V "Char" token)))))) (def ^:private lex-text (|do [[_ [meta _]] (&reader/read-text "\"") - token (lex-text-body nil) - _ (&reader/read-text "\"")] + token (lex-text-body nil) + _ (&reader/read-text "\"")] (return (&/V "lux;Meta" (&/T meta (&/V "Text" token)))))) (def ^:private lex-ident diff --git a/src/lux/type.clj b/src/lux/type.clj index 2e9e85092..b2ea0ff0d 100644 --- a/src/lux/type.clj +++ b/src/lux/type.clj @@ -126,7 +126,7 @@ (&/V "lux;RecordT" (&/|list (&/T "lux;writer" (&/V "lux;DataT" "org.objectweb.asm.ClassWriter")) (&/T "lux;loader" (&/V "lux;DataT" "java.lang.ClassLoader")) - (&/T "lux;eval-ctor" Int)))) + ))) (def DefData* (fAll "DefData'" "" -- cgit v1.2.3 From ab7b946a980475cad1e58186ac8c929c7659f529 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sun, 10 May 2015 10:37:06 -0400 Subject: - Now analysing function-application backwards. --- src/lux/analyser.clj | 75 +++++++++++++++++++++++----------------------- src/lux/analyser/lux.clj | 77 ++++++++++++++++++++++++------------------------ src/lux/compiler.clj | 4 +-- src/lux/compiler/lux.clj | 9 ++++-- 4 files changed, 84 insertions(+), 81 deletions(-) (limited to 'src') diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj index 8fad07dfa..939a3ea0a 100644 --- a/src/lux/analyser.clj +++ b/src/lux/analyser.clj @@ -26,44 +26,45 @@ ["lux;Nil" _]]]]]]]]] (&/T catch+ ?finally-body))) -(defn ^:private aba1 [analyse eval! exo-type token] - (matchv ::M/objects [token] - ;; Standard special forms - [["lux;Meta" [meta ["lux;Bool" ?value]]]] - (|do [_ (&type/check exo-type &type/Bool)] - (return (&/|list (&/T (&/V "bool" ?value) exo-type)))) - - [["lux;Meta" [meta ["lux;Int" ?value]]]] - (|do [_ (&type/check exo-type &type/Int)] - (return (&/|list (&/T (&/V "int" ?value) exo-type)))) - - [["lux;Meta" [meta ["lux;Real" ?value]]]] - (|do [_ (&type/check exo-type &type/Real)] - (return (&/|list (&/T (&/V "real" ?value) exo-type)))) - - [["lux;Meta" [meta ["lux;Char" ?value]]]] - (|do [_ (&type/check exo-type &type/Char)] - (return (&/|list (&/T (&/V "char" ?value) exo-type)))) - - [["lux;Meta" [meta ["lux;Text" ?value]]]] - (|do [_ (&type/check exo-type &type/Text)] - (return (&/|list (&/T (&/V "text" ?value) exo-type)))) - - [["lux;Meta" [meta ["lux;Tuple" ?elems]]]] - (&&lux/analyse-tuple analyse exo-type ?elems) +(let [unit (&/V "lux;Meta" (&/T (&/T "" -1 -1) (&/V "lux;Tuple" (|list))))] + (defn ^:private aba1 [analyse eval! exo-type token] + (matchv ::M/objects [token] + ;; Standard special forms + [["lux;Meta" [meta ["lux;Bool" ?value]]]] + (|do [_ (&type/check exo-type &type/Bool)] + (return (&/|list (&/T (&/V "bool" ?value) exo-type)))) + + [["lux;Meta" [meta ["lux;Int" ?value]]]] + (|do [_ (&type/check exo-type &type/Int)] + (return (&/|list (&/T (&/V "int" ?value) exo-type)))) + + [["lux;Meta" [meta ["lux;Real" ?value]]]] + (|do [_ (&type/check exo-type &type/Real)] + (return (&/|list (&/T (&/V "real" ?value) exo-type)))) + + [["lux;Meta" [meta ["lux;Char" ?value]]]] + (|do [_ (&type/check exo-type &type/Char)] + (return (&/|list (&/T (&/V "char" ?value) exo-type)))) + + [["lux;Meta" [meta ["lux;Text" ?value]]]] + (|do [_ (&type/check exo-type &type/Text)] + (return (&/|list (&/T (&/V "text" ?value) exo-type)))) + + [["lux;Meta" [meta ["lux;Tuple" ?elems]]]] + (&&lux/analyse-tuple analyse exo-type ?elems) + + [["lux;Meta" [meta ["lux;Record" ?elems]]]] + (&&lux/analyse-record analyse exo-type ?elems) + + [["lux;Meta" [meta ["lux;Tag" ?ident]]]] + (&&lux/analyse-variant analyse exo-type ?ident unit) + + [["lux;Meta" [meta ["lux;Symbol" [_ "jvm-null"]]]]] + (return (&/|list (&/T (&/V "jvm-null" nil) (&/V "lux;DataT" "null")))) - [["lux;Meta" [meta ["lux;Record" ?elems]]]] - (&&lux/analyse-record analyse exo-type ?elems) - - [["lux;Meta" [meta ["lux;Tag" ?ident]]]] - (&&lux/analyse-variant analyse exo-type ?ident (&/V "lux;Meta" (&/T (&/T "" -1 -1) (&/V "lux;Tuple" (|list))))) - - [["lux;Meta" [meta ["lux;Symbol" [_ "jvm-null"]]]]] - (return (&/|list (&/T (&/V "jvm-null" nil) (&/V "lux;DataT" "null")))) - - [_] - (fail "") - )) + [_] + (fail "") + ))) (defn ^:private aba2 [analyse eval! exo-type token] (matchv ::M/objects [token] diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj index df87a08b6..e4237d8dd 100644 --- a/src/lux/analyser/lux.clj +++ b/src/lux/analyser/lux.clj @@ -172,42 +172,39 @@ ))) )) -(defn ^:private analyse-apply* [analyse exo-type =fn ?args] - (matchv ::M/objects [=fn] - [[?fun-expr ?fun-type]] - (matchv ::M/objects [?args] - [["lux;Nil" _]] - (|do [_ (&type/check exo-type ?fun-type)] - (return =fn)) - - [["lux;Cons" [?arg ?args*]]] - (|do [?fun-type* (&type/actual-type ?fun-type)] - (matchv ::M/objects [?fun-type*] - [["lux;AllT" _]] - (&type/with-var - (fn [$var] - (|do [type* (&type/apply-type ?fun-type* $var) - output (analyse-apply* analyse exo-type (&/T ?fun-expr type*) ?args)] - (matchv ::M/objects [output $var] - [[?expr* ?type*] ["lux;VarT" ?id]] - (|do [? (&type/bound? ?id) - _ (if ? - (return nil) - (|do [ex &type/existential] - (&type/set-var ?id ex))) - type** (&type/clean $var ?type*)] - (return (&/T ?expr* type**))) - )))) - - [["lux;LambdaT" [?input-t ?output-t]]] - (|do [=arg (&&/analyse-1 analyse ?input-t ?arg)] - (analyse-apply* analyse exo-type (&/T (&/V "apply" (&/T =fn =arg)) - ?output-t) - ?args*)) +(defn ^:private analyse-apply* [analyse exo-type fun-type args] + (matchv ::M/objects [args] + [["lux;Nil" _]] + (|do [_ (&type/check exo-type fun-type)] + (return (&/T (&/|list) fun-type))) + + [["lux;Cons" [?arg ?args*]]] + (|do [?fun-type* (&type/actual-type fun-type)] + (matchv ::M/objects [?fun-type*] + [["lux;AllT" _]] + (&type/with-var + (fn [$var] + (|do [type* (&type/apply-type ?fun-type* $var) + [?args** ?type**] (analyse-apply* analyse exo-type type* args)] + (matchv ::M/objects [$var] + [["lux;VarT" ?id]] + (|do [? (&type/bound? ?id) + _ (if ? + (return nil) + (|do [ex &type/existential] + (&type/set-var ?id ex))) + type*** (&type/clean $var ?type**)] + (return (&/T ?args** type***))) + )))) + + [["lux;LambdaT" [?input-t ?output-t]]] + (|do [[=args ?output-t*] (analyse-apply* analyse exo-type ?output-t ?args*) + =arg (&&/analyse-1 analyse ?input-t ?arg)] + (return (&/T (&/|cons =arg =args) ?output-t*))) - [_] - (fail (str "[Analyser Error] Can't apply a non-function: " (&type/show-type ?fun-type*))))) - ))) + [_] + (fail (str "[Analyser Error] Can't apply a non-function: " (&type/show-type ?fun-type*))))) + )) (defn analyse-apply [analyse exo-type =fn ?args] (|do [loader &/loader] @@ -222,12 +219,14 @@ (&/flat-map% (partial analyse exo-type) macro-expansion)) [_] - (|do [output (analyse-apply* analyse exo-type =fn ?args)] - (return (&/|list output))))) + (|do [[=args =app-type] (analyse-apply* analyse exo-type =fn-type ?args)] + (return (&/|list (&/T (&/V "apply" (&/T =fn =args)) + =app-type)))))) [_] - (|do [output (analyse-apply* analyse exo-type =fn ?args)] - (return (&/|list output)))) + (|do [[=args =app-type] (analyse-apply* analyse exo-type =fn-type ?args)] + (return (&/|list (&/T (&/V "apply" (&/T =fn =args)) + =app-type))))) ))) (defn analyse-case [analyse exo-type ?value ?branches] diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj index 40bb3a710..6739c5529 100644 --- a/src/lux/compiler.clj +++ b/src/lux/compiler.clj @@ -60,8 +60,8 @@ [["lux;Global" [?owner-class ?name]]] (&&lux/compile-global compile-expression ?type ?owner-class ?name) - [["apply" [?fn ?arg]]] - (&&lux/compile-apply compile-expression ?type ?fn ?arg) + [["apply" [?fn ?args]]] + (&&lux/compile-apply compile-expression ?type ?fn ?args) [["variant" [?tag ?members]]] (&&lux/compile-variant compile-expression ?type ?tag ?members) diff --git a/src/lux/compiler/lux.clj b/src/lux/compiler/lux.clj index cf4a65f04..2c5073a4d 100644 --- a/src/lux/compiler/lux.clj +++ b/src/lux/compiler/lux.clj @@ -117,11 +117,14 @@ :let [_ (.visitFieldInsn *writer* Opcodes/GETSTATIC (&host/->class (&host/location (&/|list ?owner-class ?name))) "_datum" "Ljava/lang/Object;")]] (return nil))) -(defn compile-apply [compile *type* ?fn ?arg] +(defn compile-apply [compile *type* ?fn ?args] (|do [^MethodVisitor *writer* &/get-writer _ (compile ?fn) - _ (compile ?arg) - :let [_ (.visitMethodInsn *writer* Opcodes/INVOKEINTERFACE "lux/Function" "apply" &&/apply-signature)]] + _ (&/map% (fn [?arg] + (|do [_ (compile ?arg) + :let [_ (.visitMethodInsn *writer* Opcodes/INVOKEINTERFACE "lux/Function" "apply" &&/apply-signature)]] + (return nil))) + ?args)] (return nil))) (defn compile-def [compile ?name ?body ?def-data] -- cgit v1.2.3 From 8dc736e2a383fe964d63dda6b885d41cabc6261c Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sun, 10 May 2015 15:04:36 -0400 Subject: - Switched to the new prefix convention for both lux's special forms and the host's. - Made a few optimizations to speed-up the now slowed-down compiler. --- src/lux/analyser.clj | 202 ++++++++++++++++++++++---------------------- src/lux/analyser/host.clj | 2 +- src/lux/analyser/lux.clj | 81 +++++++++--------- src/lux/analyser/module.clj | 30 +++---- src/lux/base.clj | 6 ++ src/lux/compiler.clj | 15 ++-- src/lux/reader.clj | 4 +- src/lux/type.clj | 109 +++++++++++++++--------- 8 files changed, 238 insertions(+), 211 deletions(-) (limited to 'src') diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj index 939a3ea0a..a47360ffb 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] - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-catch"]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_catch"]]]] ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ ?ex-class]]]] ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ ?ex-arg]]]] ["lux;Cons" [?catch-body ["lux;Nil" _]]]]]]]]]]]]] (&/T (&/|++ catch+ (|list (&/T ?ex-class ?ex-arg ?catch-body))) finally+) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-finally"]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_finally"]]]] ["lux;Cons" [?finally-body ["lux;Nil" _]]]]]]]]] (&/T catch+ ?finally-body))) @@ -59,7 +59,7 @@ [["lux;Meta" [meta ["lux;Tag" ?ident]]]] (&&lux/analyse-variant analyse exo-type ?ident unit) - [["lux;Meta" [meta ["lux;Symbol" [_ "jvm-null"]]]]] + [["lux;Meta" [meta ["lux;Symbol" [_ "_jvm_null"]]]]] (return (&/|list (&/T (&/V "jvm-null" nil) (&/V "lux;DataT" "null")))) [_] @@ -71,46 +71,46 @@ [["lux;Meta" [meta ["lux;Symbol" ?ident]]]] (&&lux/analyse-symbol analyse exo-type ?ident) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "case'"]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_lux_case"]]]] ["lux;Cons" [?value ?branches]]]]]]]] (&&lux/analyse-case analyse exo-type ?value ?branches) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "lambda'"]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_lux_lambda"]]]] ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ?self]]] ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ?arg]]] ["lux;Cons" [?body ["lux;Nil" _]]]]]]]]]]]]] (&&lux/analyse-lambda analyse exo-type ?self ?arg ?body) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "def'"]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_lux_def"]]]] ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ?name]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]]]] (&&lux/analyse-def analyse ?name ?value) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "declare-macro'"]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_lux_declare-macro"]]]] ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ?name]]]] ["lux;Nil" _]]]]]]]]] (&&lux/analyse-declare-macro analyse ?name) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "import'"]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_lux_import"]]]] ["lux;Cons" [["lux;Meta" [_ ["lux;Text" ?path]]] ["lux;Nil" _]]]]]]]]] (&&lux/analyse-import analyse ?path) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ ":'"]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_lux_:"]]]] ["lux;Cons" [?type ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]]]] (&&lux/analyse-check analyse eval! exo-type ?type ?value) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ ":!'"]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_lux_:!"]]]] ["lux;Cons" [?type ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]]]] (&&lux/analyse-coerce analyse eval! ?type ?value) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "export'"]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_lux_export"]]]] ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ?ident]]]] ["lux;Nil" _]]]]]]]]] (&&lux/analyse-export analyse ?ident) @@ -122,53 +122,53 @@ (matchv ::M/objects [token] ;; Host special forms ;; Integer arithmetic - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-iadd"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_iadd"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-iadd analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-isub"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_isub"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-isub analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-imul"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_imul"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-imul analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-idiv"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_idiv"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-idiv analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-irem"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_irem"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-irem analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-ieq"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_ieq"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-ieq analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-ilt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_ilt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-ilt analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-igt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_igt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-igt analyse ?x ?y) ;; Long arithmetic - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-ladd"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_ladd"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-ladd analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-lsub"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_lsub"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-lsub analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-lmul"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_lmul"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-lmul analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-ldiv"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_ldiv"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-ldiv analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-lrem"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_lrem"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-lrem analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-leq"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_leq"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-leq analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-llt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_llt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-llt analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-lgt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_lgt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-lgt analyse ?x ?y) [_] @@ -177,53 +177,53 @@ (defn ^:private aba4 [analyse eval! exo-type token] (matchv ::M/objects [token] ;; Float arithmetic - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-fadd"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_fadd"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-fadd analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-fsub"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_fsub"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-fsub analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-fmul"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_fmul"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-fmul analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-fdiv"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_fdiv"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-fdiv analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-frem"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_frem"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-frem analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-feq"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_feq"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-feq analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-flt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_flt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-flt analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-fgt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_fgt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-fgt analyse ?x ?y) ;; Double arithmetic - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-dadd"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_dadd"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-dadd analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-dsub"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_dsub"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-dsub analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-dmul"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_dmul"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-dmul analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-ddiv"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_ddiv"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-ddiv analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-drem"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_drem"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-drem analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-deq"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_deq"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-deq analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-dlt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_dlt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-dlt analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-dgt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_dgt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-dgt analyse ?x ?y) [_] @@ -232,39 +232,39 @@ (defn ^:private aba5 [analyse eval! exo-type token] (matchv ::M/objects [token] ;; Objects - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-null?"]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_null?"]]]] ["lux;Cons" [?object ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-null? analyse ?object) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-new"]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_new"]]]] ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ ?class]]]] ["lux;Cons" [["lux;Meta" [_ ["lux;Tuple" ?classes]]] ["lux;Cons" [["lux;Meta" [_ ["lux;Tuple" ?args]]] ["lux;Nil" _]]]]]]]]]]]]] (&&host/analyse-jvm-new analyse ?class ?classes ?args) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-getstatic"]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_getstatic"]]]] ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ?class]]]] ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ?field]]]] ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-getstatic analyse ?class ?field) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-getfield"]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_getfield"]]]] ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ?class]]]] ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ?field]]]] ["lux;Cons" [?object ["lux;Nil" _]]]]]]]]]]]]] (&&host/analyse-jvm-getfield analyse ?class ?field ?object) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-putstatic"]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_putstatic"]]]] ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ?class]]]] ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ?field]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]]]]]] (&&host/analyse-jvm-putstatic analyse ?class ?field ?value) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-putfield"]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_putfield"]]]] ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ?class]]]] ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ?field]]]] ["lux;Cons" [?object @@ -272,7 +272,7 @@ ["lux;Nil" _]]]]]]]]]]]]]]] (&&host/analyse-jvm-putfield analyse ?class ?field ?object ?value) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-invokestatic"]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_invokestatic"]]]] ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ?class]]]] ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ?method]]]] ["lux;Cons" [["lux;Meta" [_ ["lux;Tuple" ?classes]]] @@ -280,7 +280,7 @@ ["lux;Nil" _]]]]]]]]]]]]]]] (&&host/analyse-jvm-invokestatic analyse ?class ?method ?classes ?args) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-invokevirtual"]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_invokevirtual"]]]] ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ?class]]]] ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ?method]]]] ["lux;Cons" [["lux;Meta" [_ ["lux;Tuple" ?classes]]] @@ -289,7 +289,7 @@ ["lux;Nil" _]]]]]]]]]]]]]]]]] (&&host/analyse-jvm-invokevirtual analyse ?class ?method ?classes ?object ?args) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-invokeinterface"]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_invokeinterface"]]]] ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ?class]]]] ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ?method]]]] ["lux;Cons" [["lux;Meta" [_ ["lux;Tuple" ?classes]]] @@ -298,7 +298,7 @@ ["lux;Nil" _]]]]]]]]]]]]]]]]] (&&host/analyse-jvm-invokeinterface analyse ?class ?method ?classes ?object ?args) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-invokespecial"]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_invokespecial"]]]] ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ?class]]]] ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ?method]]]] ["lux;Cons" [["lux;Meta" [_ ["lux;Tuple" ?classes]]] @@ -308,23 +308,23 @@ (&&host/analyse-jvm-invokespecial analyse ?class ?method ?classes ?object ?args) ;; Exceptions - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-try"]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_try"]]]] ["lux;Cons" [?body ?handlers]]]]]]]] (&&host/analyse-jvm-try analyse ?body (&/fold parse-handler [(list) nil] ?handlers)) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-throw"]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_throw"]]]] ["lux;Cons" [?ex ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-throw analyse ?ex) ;; Syncronization/monitos - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-monitorenter"]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_monitorenter"]]]] ["lux;Cons" [?monitor ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-monitorenter analyse ?monitor) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-monitorexit"]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_monitorexit"]]]] ["lux;Cons" [?monitor ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-monitorexit analyse ?monitor) @@ -335,74 +335,74 @@ (defn ^:private aba6 [analyse eval! exo-type token] (matchv ::M/objects [token] ;; Primitive conversions - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-d2f"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_d2f"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-d2f analyse ?value) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-d2i"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_d2i"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-d2i analyse ?value) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-d2l"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_d2l"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-d2l analyse ?value) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-f2d"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_f2d"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-f2d analyse ?value) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-f2i"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_f2i"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-f2i analyse ?value) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-f2l"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_f2l"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-f2l analyse ?value) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-i2b"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_i2b"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-i2b analyse ?value) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-i2c"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_i2c"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-i2c analyse ?value) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-i2d"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_i2d"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-i2d analyse ?value) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-i2f"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_i2f"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-i2f analyse ?value) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-i2l"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_i2l"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-i2l analyse ?value) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-i2s"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_i2s"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-i2s analyse ?value) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-l2d"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_l2d"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-l2d analyse ?value) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-l2f"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_l2f"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-l2f analyse ?value) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-l2i"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_l2i"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-l2i analyse ?value) ;; Bitwise operators - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-iand"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_iand"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-iand analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-ior"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_ior"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-ior analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-land"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_land"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-land analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-lor"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_lor"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-lor analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-lxor"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_lxor"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-lxor analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-lshl"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_lshl"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-lshl analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-lshr"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_lshr"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-lshr analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-lushr"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_lushr"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-lushr analyse ?x ?y) [_] @@ -411,40 +411,40 @@ (defn ^:private aba7 [analyse eval! exo-type token] (matchv ::M/objects [token] ;; Arrays - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-new-array"]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_new-array"]]]] ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ ?class]]]] ["lux;Cons" [["lux;Meta" [_ ["lux;Int" ?length]]] ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-new-array analyse ?class ?length) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-aastore"]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_aastore"]]]] ["lux;Cons" [?array ["lux;Cons" [["lux;Meta" [_ ["lux;Int" ?idx]]] ["lux;Cons" [?elem ["lux;Nil" _]]]]]]]]]]]]] (&&host/analyse-jvm-aastore analyse ?array ?idx ?elem) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-aaload"]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_aaload"]]]] ["lux;Cons" [?array ["lux;Cons" [["lux;Meta" [_ ["lux;Int" ?idx]]] ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-aaload analyse ?array ?idx) ;; Classes & interfaces - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-class"]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_class"]]]] ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ ?name]]]] ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ ?super-class]]]] ["lux;Cons" [["lux;Meta" [_ ["lux;Tuple" ?fields]]] ["lux;Nil" _]]]]]]]]]]]]] (&&host/analyse-jvm-class analyse ?name ?super-class ?fields) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-interface"]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_interface"]]]] ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ ?name]]]] ?members]]]]]]]] (&&host/analyse-jvm-interface analyse ?name ?members) ;; Programs - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-program"]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_program"]]]] ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ ?args]]]] ["lux;Cons" [?body ["lux;Nil" _]]]]]]]]]]] @@ -459,7 +459,7 @@ [["lux;Right" [state* output]]] (return* state* output) - [_] + [["lux;Left" ""]] (matchv ::M/objects [((aba2 analyse eval! exo-type token) state)] [["lux;Right" [state* output]]] (return* state* output) @@ -489,26 +489,26 @@ [["lux;Right" [state* output]]] (return* state* output) - [_] - (fail* (str "[Analyser Error] Unmatched token: " (&/show-ast token)))) + [["lux;Left" msg]] + (fail* msg)) - [_] - (fail* (str "[Analyser Error] Unmatched token: " (&/show-ast token)))) + [["lux;Left" msg]] + (fail* msg)) - [_] - (fail* (str "[Analyser Error] Unmatched token: " (&/show-ast token)))) + [["lux;Left" msg]] + (fail* msg)) - [_] - (fail* (str "[Analyser Error] Unmatched token: " (&/show-ast token)))) + [["lux;Left" msg]] + (fail* msg)) - [_] - (fail* (str "[Analyser Error] Unmatched token: " (&/show-ast token)))) + [["lux;Left" msg]] + (fail* msg)) - [_] - (fail* (str "[Analyser Error] Unmatched token: " (&/show-ast token)))) + [["lux;Left" msg]] + (fail* msg)) - [_] - (fail* (str "[Analyser Error] Unmatched token: " (&/show-ast token)))))) + [["lux;Left" msg]] + (fail* msg)))) (defn ^:private analyse-ast [eval! exo-type token] (matchv ::M/objects [token] diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj index 3631bddb2..527c69dc7 100644 --- a/src/lux/analyser/host.clj +++ b/src/lux/analyser/host.clj @@ -159,7 +159,7 @@ (defn analyse-jvm-interface [analyse ?name ?members] (|do [=members (&/map% (fn [member] (matchv ::M/objects [member] - [["lux;Meta" [_ ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ":'"]]]] + [["lux;Meta" [_ ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ":"]]]] ["lux;Cons" [["lux;Meta" [_ ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "->"]]]] ["lux;Cons" [["lux;Meta" [_ ["lux;Tuple" ?inputs]]] ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ ?output]]]] diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj index e4237d8dd..b65963e4a 100644 --- a/src/lux/analyser/lux.clj +++ b/src/lux/analyser/lux.clj @@ -110,44 +110,44 @@ [inner outer] (&/|split-with no-binding? stack)] (matchv ::M/objects [outer] [["lux;Nil" _]] - (&/run-state (|do [[[r-module r-name] $def] (&&module/find-def (if (= "" ?module) module-name ?module) - ?name) - endo-type (matchv ::M/objects [$def] - [["lux;ValueD" ?type]] - (return ?type) - - [["lux;MacroD" _]] - (return &type/Macro) - - [["lux;TypeD" _]] - (return &type/Type)) - _ (if (and (= &type/Type endo-type) (= &type/Type exo-type)) - (return nil) - (&type/check exo-type endo-type))] - (return (&/|list (&/T (&/V "lux;Global" (&/T r-module r-name)) - endo-type)))) - state) + ((|do [[[r-module r-name] $def] (&&module/find-def (if (= "" ?module) module-name ?module) + ?name) + endo-type (matchv ::M/objects [$def] + [["lux;ValueD" ?type]] + (return ?type) + + [["lux;MacroD" _]] + (return &type/Macro) + + [["lux;TypeD" _]] + (return &type/Type)) + _ (if (and (= &type/Type endo-type) (= &type/Type exo-type)) + (return nil) + (&type/check exo-type endo-type))] + (return (&/|list (&/T (&/V "lux;Global" (&/T r-module r-name)) + endo-type)))) + state) [["lux;Cons" [?genv ["lux;Nil" _]]]] (if-let [global (->> ?genv (&/get$ &/$LOCALS) (&/get$ &/$MAPPINGS) (&/|get local-ident))] (matchv ::M/objects [global] [[["lux;Global" [?module* ?name*]] _]] - (&/run-state (|do [[[r-module r-name] $def] (&&module/find-def ?module* ?name*) - endo-type (matchv ::M/objects [$def] - [["lux;ValueD" ?type]] - (return ?type) - - [["lux;MacroD" _]] - (return &type/Macro) - - [["lux;TypeD" _]] - (return &type/Type)) - _ (if (and (= &type/Type endo-type) (= &type/Type exo-type)) - (return nil) - (&type/check exo-type endo-type))] - (return (&/|list (&/T (&/V "lux;Global" (&/T r-module r-name)) - endo-type)))) - state) + ((|do [[[r-module r-name] $def] (&&module/find-def ?module* ?name*) + endo-type (matchv ::M/objects [$def] + [["lux;ValueD" ?type]] + (return ?type) + + [["lux;MacroD" _]] + (return &type/Macro) + + [["lux;TypeD" _]] + (return &type/Type)) + _ (if (and (= &type/Type endo-type) (= &type/Type exo-type)) + (return nil) + (&type/check exo-type endo-type))] + (return (&/|list (&/T (&/V "lux;Global" (&/T r-module r-name)) + endo-type)))) + state) [_] (fail* "[Analyser Error] Can't have anything other than a global def in the global environment.")) @@ -165,10 +165,10 @@ (->> top-outer (&/get$ &/$CLOSURE) (&/get$ &/$MAPPINGS) (&/|get local-ident))) (&/|list)) (&/|reverse inner) scopes)] - (&/run-state (|do [btype (&&/expr-type =local) - _ (&type/check exo-type btype)] - (return (&/|list =local))) - (&/set$ &/$ENVS (&/|++ inner* outer) state))) + ((|do [btype (&&/expr-type =local) + _ (&type/check exo-type btype)] + (return (&/|list =local))) + (&/set$ &/$ENVS (&/|++ inner* outer) state))) ))) )) @@ -263,12 +263,7 @@ (|do [? (&type/bound? ?id)] (if ? (|do [dtype (&type/deref ?id)] - (matchv ::M/objects [dtype] - [["lux;ExT" _]] - (return (&/T _expr exo-type)) - - [_] - (fail (str "[Analyser Error] Can't use type-var in any type-specific way inside polymorphic functions: " ?id ":" _arg " " (&type/show-type dtype))))) + (fail (str "[Analyser Error] Can't use type-var in any type-specific way inside polymorphic functions: " ?id ":" _arg " " (&type/show-type dtype)))) (return (&/T _expr exo-type)))))))) [_] diff --git a/src/lux/analyser/module.clj b/src/lux/analyser/module.clj index 5960d3080..f36dc044a 100644 --- a/src/lux/analyser/module.clj +++ b/src/lux/analyser/module.clj @@ -71,8 +71,8 @@ (if (or exported? (= current-module module)) (matchv ::M/objects [$$def] [["lux;AliasD" [?r-module ?r-name]]] - (&/run-state (find-def ?r-module ?r-name) - state) + ((find-def ?r-module ?r-name) + state) [_] (return* state (&/T (&/T module name) $$def))) @@ -94,19 +94,19 @@ (if-let [$def (&/|get name $module)] (matchv ::M/objects [$def] [[exported? ["lux;ValueD" ?type]]] - (&/run-state (|do [_ (&type/check &type/Macro ?type) - ^ClassLoader loader &/loader - :let [macro (-> (.loadClass loader (&host/location (&/|list module name))) - (.getField "_datum") - (.get nil))]] - (fn [state*] - (return* (&/update$ &/$MODULES - (fn [$modules] - (&/|put module (&/|put name (&/T exported? (&/V "lux;MacroD" macro)) $module) - $modules)) - state*) - nil))) - state) + ((|do [_ (&type/check &type/Macro ?type) + ^ClassLoader loader &/loader + :let [macro (-> (.loadClass loader (&host/location (&/|list module name))) + (.getField "_datum") + (.get nil))]] + (fn [state*] + (return* (&/update$ &/$MODULES + (fn [$modules] + (&/|put module (&/|put name (&/T exported? (&/V "lux;MacroD" macro)) $module) + $modules)) + state*) + nil))) + state) [[_ ["lux;MacroD" _]]] (fail* (str "[Analyser Error] Can't re-declare a macro: " (str module &/+name-separator+ name))) diff --git a/src/lux/base.clj b/src/lux/base.clj index 9ea255132..3ac994043 100644 --- a/src/lux/base.clj +++ b/src/lux/base.clj @@ -32,12 +32,18 @@ (defn T [& elems] (to-array elems)) +;; (definline T [& elems] +;; `(to-array (list ~@elems))) (defn V [tag value] (to-array [tag value])) +;; (definline V [tag value] +;; `(to-array [~tag ~value])) (defn R [& kvs] (to-array kvs)) +;; (definline R [& kvs] +;; `(to-array (list ~@kvs))) (defn get$ [slot ^objects record] (aget record slot)) diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj index 6739c5529..26b75bec3 100644 --- a/src/lux/compiler.clj +++ b/src/lux/compiler.clj @@ -352,14 +352,15 @@ (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 (&reader/from (str "source/" name ".lux"))) - (&/set$ &/$ENVS (&/|list (&/env name))) - (&/update$ &/$HOST #(&/set$ &/$WRITER (&/V "lux;Some" =class) %)) - (&/update$ &/$MODULES #(&/|put name &a-module/init-module %))))] + (matchv ::M/objects [((&/exhaust% compiler-step) + (->> state + (&/set$ &/$SOURCE (&reader/from (str "source/" name ".lux"))) + (&/set$ &/$ENVS (&/|list (&/env name))) + (&/update$ &/$HOST #(&/set$ &/$WRITER (&/V "lux;Some" =class) %)) + (&/update$ &/$MODULES #(&/|put name &a-module/init-module %))))] [["lux;Right" [?state _]]] (do (.visitEnd =class) - (&/run-state (&&/save-class! name (.toByteArray =class)) ?state)) + ((&&/save-class! name (.toByteArray =class)) ?state)) [["lux;Left" ?message]] (fail* ?message))))))) @@ -367,7 +368,7 @@ ;; [Resources] (defn compile-all [modules] (.mkdir (java.io.File. "output")) - (matchv ::M/objects [(&/run-state (&/map% compile-module (&/|cons "lux" modules)) (&/init-state nil))] + (matchv ::M/objects [((&/map% compile-module (&/|cons "lux" modules)) (&/init-state nil))] [["lux;Right" [?state _]]] (println (str "Compilation complete! " (str "[" (->> modules (&/|interpose " ") diff --git a/src/lux/reader.clj b/src/lux/reader.clj index 6a954d5ff..69c95ea6a 100644 --- a/src/lux/reader.clj +++ b/src/lux/reader.clj @@ -27,12 +27,12 @@ ))) ;; [Exports] -(defn ^:private re-find! [regex line] +(defn ^:private re-find! [^java.util.regex.Pattern regex line] (let [matcher (.matcher regex line)] (when (.find matcher) (.group matcher 0)))) -(defn ^:private re-find3! [regex line] +(defn ^:private re-find3! [^java.util.regex.Pattern regex line] (let [matcher (.matcher regex line)] (when (.find matcher) (list (.group matcher 0) diff --git a/src/lux/type.clj b/src/lux/type.clj index b2ea0ff0d..494d8ebbc 100644 --- a/src/lux/type.clj +++ b/src/lux/type.clj @@ -226,33 +226,33 @@ (|do [ex existential] (set-var id ex)))] (fn [state] - (&/run-state (|do [mappings* (&/map% (fn [binding] - (|let [[?id ?type] binding] - (if (= id ?id) - (return binding) - (matchv ::M/objects [?type] - [["lux;None" _]] - (return binding) - - [["lux;Some" ?type*]] - (matchv ::M/objects [?type*] - [["lux;VarT" ?id*]] - (if (= id ?id*) - (return (&/T ?id (&/V "lux;None" nil))) - (return binding)) - - [_] - (|do [?type** (clean* id ?type*)] - (return (&/T ?id (&/V "lux;Some" ?type**))))) - )))) - (->> state (&/get$ &/$TYPES) (&/get$ &/$MAPPINGS)))] - (fn [state] - (return* (&/update$ &/$TYPES #(->> % - (&/update$ &/$COUNTER dec) - (&/set$ &/$MAPPINGS (&/|remove id mappings*))) - state) - nil))) - state)))) + ((|do [mappings* (&/map% (fn [binding] + (|let [[?id ?type] binding] + (if (= id ?id) + (return binding) + (matchv ::M/objects [?type] + [["lux;None" _]] + (return binding) + + [["lux;Some" ?type*]] + (matchv ::M/objects [?type*] + [["lux;VarT" ?id*]] + (if (= id ?id*) + (return (&/T ?id (&/V "lux;None" nil))) + (return binding)) + + [_] + (|do [?type** (clean* id ?type*)] + (return (&/T ?id (&/V "lux;Some" ?type**))))) + )))) + (->> state (&/get$ &/$TYPES) (&/get$ &/$MAPPINGS)))] + (fn [state] + (return* (&/update$ &/$TYPES #(->> % + (&/update$ &/$COUNTER dec) + (&/set$ &/$MAPPINGS (&/|remove id mappings*))) + state) + nil))) + state)))) (defn with-var [k] (|do [id create-var @@ -585,24 +585,49 @@ (check* fixpoints expected bound)))) [["lux;AppT" [["lux;VarT" ?eid] A1]] ["lux;AppT" [["lux;VarT" ?aid] A2]]] - (|do [_ (check* fixpoints (&/V "lux;VarT" ?eid) (&/V "lux;VarT" ?aid)) - _ (check* fixpoints A1 A2)] - (return (&/T fixpoints nil))) + (&/try-all% (&/|list (|do [F1 (deref ?eid)] + (&/try-all% (&/|list (|do [F2 (deref ?aid)] + (check* fixpoints (&/V "lux;AppT" (&/T F1 A1)) (&/V "lux;AppT" (&/T F2 A2)))) + (check* fixpoints (&/V "lux;AppT" (&/T F1 A1)) actual)))) + (|do [F2 (deref ?aid)] + (check* fixpoints expected (&/V "lux;AppT" (&/T F2 A2)))) + (|do [[fixpoints* _] (check* fixpoints (&/V "lux;VarT" ?eid) (&/V "lux;VarT" ?aid)) + [fixpoints** _] (check* fixpoints* A1 A2)] + (return (&/T fixpoints** nil))))) + ;; (|do [_ (check* fixpoints (&/V "lux;VarT" ?eid) (&/V "lux;VarT" ?aid)) + ;; _ (check* fixpoints A1 A2)] + ;; (return (&/T fixpoints nil))) [["lux;AppT" [["lux;VarT" ?id] A1]] ["lux;AppT" [F2 A2]]] - (|do [[fixpoints* _] (check* fixpoints (&/V "lux;VarT" ?id) F2) - e* (apply-type F2 A1) - a* (apply-type F2 A2) - [fixpoints** _] (check* fixpoints* e* a*)] - (return (&/T fixpoints** nil))) - - [["lux;AppT" [F1 A1]] ["lux;AppT" [["lux;VarT" ?id] A2]]] - (|do [[fixpoints* _] (check* fixpoints F1 (&/V "lux;VarT" ?id)) - e* (apply-type F1 A1) - a* (apply-type F1 A2) - [fixpoints** _] (check* fixpoints* e* a*)] - (return (&/T fixpoints** nil))) + (&/try-all% (&/|list (|do [F1 (deref ?id)] + (check* fixpoints (&/V "lux;AppT" (&/T F1 A1)) actual)) + (|do [[fixpoints* _] (check* fixpoints (&/V "lux;VarT" ?id) F2) + e* (apply-type F2 A1) + a* (apply-type F2 A2) + [fixpoints** _] (check* fixpoints* e* a*)] + (return (&/T fixpoints** nil))))) + ;; [["lux;AppT" [["lux;VarT" ?id] A1]] ["lux;AppT" [F2 A2]]] + ;; (|do [[fixpoints* _] (check* fixpoints (&/V "lux;VarT" ?id) F2) + ;; e* (apply-type F2 A1) + ;; a* (apply-type F2 A2) + ;; [fixpoints** _] (check* fixpoints* e* a*)] + ;; (return (&/T fixpoints** nil))) + [["lux;AppT" [F1 A1]] ["lux;AppT" [["lux;VarT" ?id] A2]]] + (&/try-all% (&/|list (|do [F2 (deref ?id)] + (check* fixpoints expected (&/V "lux;AppT" (&/T F2 A2)))) + (|do [[fixpoints* _] (check* fixpoints F1 (&/V "lux;VarT" ?id)) + e* (apply-type F1 A1) + a* (apply-type F1 A2) + [fixpoints** _] (check* fixpoints* e* a*)] + (return (&/T fixpoints** nil))))) + ;; [["lux;AppT" [F1 A1]] ["lux;AppT" [["lux;VarT" ?id] A2]]] + ;; (|do [[fixpoints* _] (check* fixpoints F1 (&/V "lux;VarT" ?id)) + ;; e* (apply-type F1 A1) + ;; a* (apply-type F1 A2) + ;; [fixpoints** _] (check* fixpoints* e* a*)] + ;; (return (&/T fixpoints** nil))) + [["lux;AppT" [F A]] _] (let [fp-pair (&/T expected actual) _ (when (> (&/|length fixpoints) 40) -- cgit v1.2.3 From 5a13be9d9646819a00c281cea759f5b1c2eb883b Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sun, 10 May 2015 21:12:56 -0400 Subject: - Changed the names of the tags of the Syntax type to differentiate them better from the tags of the Type type. --- src/lux/analyser.clj | 284 +++++++++++++++++++++++----------------------- src/lux/analyser/case.clj | 28 ++--- src/lux/analyser/host.clj | 22 ++-- src/lux/analyser/lux.clj | 2 +- src/lux/host.clj | 2 +- src/lux/parser.clj | 20 ++-- src/lux/type.clj | 20 ++-- 7 files changed, 189 insertions(+), 189 deletions(-) (limited to 'src') diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj index a47360ffb..c37c1acde 100644 --- a/src/lux/analyser.clj +++ b/src/lux/analyser.clj @@ -14,52 +14,52 @@ ;; [Utils] (defn ^:private parse-handler [[catch+ finally+] token] (matchv ::M/objects [token] - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_catch"]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ ?ex-class]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ ?ex-arg]]]] + [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_catch"]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ ?ex-class]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ ?ex-arg]]]] ["lux;Cons" [?catch-body ["lux;Nil" _]]]]]]]]]]]]] (&/T (&/|++ catch+ (|list (&/T ?ex-class ?ex-arg ?catch-body))) finally+) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_finally"]]]] + [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_finally"]]]] ["lux;Cons" [?finally-body ["lux;Nil" _]]]]]]]]] (&/T catch+ ?finally-body))) -(let [unit (&/V "lux;Meta" (&/T (&/T "" -1 -1) (&/V "lux;Tuple" (|list))))] +(let [unit (&/V "lux;Meta" (&/T (&/T "" -1 -1) (&/V "lux;TupleS" (|list))))] (defn ^:private aba1 [analyse eval! exo-type token] (matchv ::M/objects [token] ;; Standard special forms - [["lux;Meta" [meta ["lux;Bool" ?value]]]] + [["lux;Meta" [meta ["lux;BoolS" ?value]]]] (|do [_ (&type/check exo-type &type/Bool)] (return (&/|list (&/T (&/V "bool" ?value) exo-type)))) - [["lux;Meta" [meta ["lux;Int" ?value]]]] + [["lux;Meta" [meta ["lux;IntS" ?value]]]] (|do [_ (&type/check exo-type &type/Int)] (return (&/|list (&/T (&/V "int" ?value) exo-type)))) - [["lux;Meta" [meta ["lux;Real" ?value]]]] + [["lux;Meta" [meta ["lux;RealS" ?value]]]] (|do [_ (&type/check exo-type &type/Real)] (return (&/|list (&/T (&/V "real" ?value) exo-type)))) - [["lux;Meta" [meta ["lux;Char" ?value]]]] + [["lux;Meta" [meta ["lux;CharS" ?value]]]] (|do [_ (&type/check exo-type &type/Char)] (return (&/|list (&/T (&/V "char" ?value) exo-type)))) - [["lux;Meta" [meta ["lux;Text" ?value]]]] + [["lux;Meta" [meta ["lux;TextS" ?value]]]] (|do [_ (&type/check exo-type &type/Text)] (return (&/|list (&/T (&/V "text" ?value) exo-type)))) - [["lux;Meta" [meta ["lux;Tuple" ?elems]]]] + [["lux;Meta" [meta ["lux;TupleS" ?elems]]]] (&&lux/analyse-tuple analyse exo-type ?elems) - [["lux;Meta" [meta ["lux;Record" ?elems]]]] + [["lux;Meta" [meta ["lux;RecordS" ?elems]]]] (&&lux/analyse-record analyse exo-type ?elems) - [["lux;Meta" [meta ["lux;Tag" ?ident]]]] + [["lux;Meta" [meta ["lux;TagS" ?ident]]]] (&&lux/analyse-variant analyse exo-type ?ident unit) - [["lux;Meta" [meta ["lux;Symbol" [_ "_jvm_null"]]]]] + [["lux;Meta" [meta ["lux;SymbolS" [_ "_jvm_null"]]]]] (return (&/|list (&/T (&/V "jvm-null" nil) (&/V "lux;DataT" "null")))) [_] @@ -68,50 +68,50 @@ (defn ^:private aba2 [analyse eval! exo-type token] (matchv ::M/objects [token] - [["lux;Meta" [meta ["lux;Symbol" ?ident]]]] + [["lux;Meta" [meta ["lux;SymbolS" ?ident]]]] (&&lux/analyse-symbol analyse exo-type ?ident) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_lux_case"]]]] + [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_lux_case"]]]] ["lux;Cons" [?value ?branches]]]]]]]] (&&lux/analyse-case analyse exo-type ?value ?branches) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_lux_lambda"]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ?self]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ?arg]]] + [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_lux_lambda"]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ?self]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ?arg]]] ["lux;Cons" [?body ["lux;Nil" _]]]]]]]]]]]]] (&&lux/analyse-lambda analyse exo-type ?self ?arg ?body) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_lux_def"]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ?name]]]] + [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_lux_def"]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?name]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]]]] (&&lux/analyse-def analyse ?name ?value) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_lux_declare-macro"]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ?name]]]] + [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_lux_declare-macro"]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?name]]]] ["lux;Nil" _]]]]]]]]] (&&lux/analyse-declare-macro analyse ?name) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_lux_import"]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;Text" ?path]]] + [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_lux_import"]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?path]]] ["lux;Nil" _]]]]]]]]] (&&lux/analyse-import analyse ?path) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_lux_:"]]]] + [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_lux_:"]]]] ["lux;Cons" [?type ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]]]] (&&lux/analyse-check analyse eval! exo-type ?type ?value) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_lux_:!"]]]] + [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_lux_:!"]]]] ["lux;Cons" [?type ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]]]] (&&lux/analyse-coerce analyse eval! ?type ?value) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_lux_export"]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ?ident]]]] + [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_lux_export"]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?ident]]]] ["lux;Nil" _]]]]]]]]] (&&lux/analyse-export analyse ?ident) @@ -122,53 +122,53 @@ (matchv ::M/objects [token] ;; Host special forms ;; Integer arithmetic - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_iadd"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_iadd"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-iadd analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_isub"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_isub"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-isub analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_imul"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_imul"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-imul analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_idiv"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_idiv"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-idiv analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_irem"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_irem"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-irem analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_ieq"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_ieq"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-ieq analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_ilt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_ilt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-ilt analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_igt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_igt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-igt analyse ?x ?y) ;; Long arithmetic - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_ladd"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_ladd"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-ladd analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_lsub"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_lsub"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-lsub analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_lmul"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_lmul"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-lmul analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_ldiv"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_ldiv"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-ldiv analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_lrem"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_lrem"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-lrem analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_leq"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_leq"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-leq analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_llt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_llt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-llt analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_lgt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_lgt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-lgt analyse ?x ?y) [_] @@ -177,53 +177,53 @@ (defn ^:private aba4 [analyse eval! exo-type token] (matchv ::M/objects [token] ;; Float arithmetic - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_fadd"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_fadd"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-fadd analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_fsub"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_fsub"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-fsub analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_fmul"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_fmul"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-fmul analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_fdiv"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_fdiv"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-fdiv analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_frem"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_frem"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-frem analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_feq"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_feq"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-feq analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_flt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_flt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-flt analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_fgt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_fgt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-fgt analyse ?x ?y) ;; Double arithmetic - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_dadd"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_dadd"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-dadd analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_dsub"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_dsub"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-dsub analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_dmul"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_dmul"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-dmul analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_ddiv"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_ddiv"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-ddiv analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_drem"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_drem"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-drem analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_deq"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_deq"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-deq analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_dlt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_dlt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-dlt analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_dgt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_dgt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-dgt analyse ?x ?y) [_] @@ -232,99 +232,99 @@ (defn ^:private aba5 [analyse eval! exo-type token] (matchv ::M/objects [token] ;; Objects - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_null?"]]]] + [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_null?"]]]] ["lux;Cons" [?object ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-null? analyse ?object) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_new"]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ ?class]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;Tuple" ?classes]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;Tuple" ?args]]] + [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_new"]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ ?class]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?classes]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?args]]] ["lux;Nil" _]]]]]]]]]]]]] (&&host/analyse-jvm-new analyse ?class ?classes ?args) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_getstatic"]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ?class]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ?field]]]] + [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_getstatic"]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?class]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?field]]]] ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-getstatic analyse ?class ?field) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_getfield"]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ?class]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ?field]]]] + [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_getfield"]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?class]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?field]]]] ["lux;Cons" [?object ["lux;Nil" _]]]]]]]]]]]]] (&&host/analyse-jvm-getfield analyse ?class ?field ?object) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_putstatic"]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ?class]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ?field]]]] + [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_putstatic"]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?class]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?field]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]]]]]] (&&host/analyse-jvm-putstatic analyse ?class ?field ?value) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_putfield"]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ?class]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ?field]]]] + [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_putfield"]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?class]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?field]]]] ["lux;Cons" [?object ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]]]]]]]] (&&host/analyse-jvm-putfield analyse ?class ?field ?object ?value) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_invokestatic"]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ?class]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ?method]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;Tuple" ?classes]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;Tuple" ?args]]] + [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_invokestatic"]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?class]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?method]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?classes]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?args]]] ["lux;Nil" _]]]]]]]]]]]]]]] (&&host/analyse-jvm-invokestatic analyse ?class ?method ?classes ?args) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_invokevirtual"]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ?class]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ?method]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;Tuple" ?classes]]] + [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_invokevirtual"]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?class]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?method]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?classes]]] ["lux;Cons" [?object - ["lux;Cons" [["lux;Meta" [_ ["lux;Tuple" ?args]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?args]]] ["lux;Nil" _]]]]]]]]]]]]]]]]] (&&host/analyse-jvm-invokevirtual analyse ?class ?method ?classes ?object ?args) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_invokeinterface"]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ?class]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ?method]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;Tuple" ?classes]]] + [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_invokeinterface"]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?class]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?method]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?classes]]] ["lux;Cons" [?object - ["lux;Cons" [["lux;Meta" [_ ["lux;Tuple" ?args]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?args]]] ["lux;Nil" _]]]]]]]]]]]]]]]]] (&&host/analyse-jvm-invokeinterface analyse ?class ?method ?classes ?object ?args) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_invokespecial"]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ?class]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ?method]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;Tuple" ?classes]]] + [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_invokespecial"]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?class]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?method]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?classes]]] ["lux;Cons" [?object - ["lux;Cons" [["lux;Meta" [_ ["lux;Tuple" ?args]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?args]]] ["lux;Nil" _]]]]]]]]]]]]]]]]] (&&host/analyse-jvm-invokespecial analyse ?class ?method ?classes ?object ?args) ;; Exceptions - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_try"]]]] + [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_try"]]]] ["lux;Cons" [?body ?handlers]]]]]]]] (&&host/analyse-jvm-try analyse ?body (&/fold parse-handler [(list) nil] ?handlers)) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_throw"]]]] + [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_throw"]]]] ["lux;Cons" [?ex ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-throw analyse ?ex) ;; Syncronization/monitos - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_monitorenter"]]]] + [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_monitorenter"]]]] ["lux;Cons" [?monitor ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-monitorenter analyse ?monitor) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_monitorexit"]]]] + [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_monitorexit"]]]] ["lux;Cons" [?monitor ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-monitorexit analyse ?monitor) @@ -335,74 +335,74 @@ (defn ^:private aba6 [analyse eval! exo-type token] (matchv ::M/objects [token] ;; Primitive conversions - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_d2f"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] + [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_d2f"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-d2f analyse ?value) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_d2i"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] + [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_d2i"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-d2i analyse ?value) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_d2l"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] + [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_d2l"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-d2l analyse ?value) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_f2d"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] + [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_f2d"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-f2d analyse ?value) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_f2i"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] + [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_f2i"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-f2i analyse ?value) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_f2l"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] + [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_f2l"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-f2l analyse ?value) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_i2b"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] + [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_i2b"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-i2b analyse ?value) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_i2c"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] + [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_i2c"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-i2c analyse ?value) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_i2d"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] + [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_i2d"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-i2d analyse ?value) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_i2f"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] + [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_i2f"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-i2f analyse ?value) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_i2l"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] + [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_i2l"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-i2l analyse ?value) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_i2s"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] + [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_i2s"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-i2s analyse ?value) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_l2d"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] + [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_l2d"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-l2d analyse ?value) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_l2f"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] + [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_l2f"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-l2f analyse ?value) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_l2i"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] + [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_l2i"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-l2i analyse ?value) ;; Bitwise operators - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_iand"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_iand"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-iand analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_ior"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_ior"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-ior analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_land"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_land"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-land analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_lor"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_lor"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-lor analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_lxor"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_lxor"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-lxor analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_lshl"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_lshl"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-lshl analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_lshr"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_lshr"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-lshr analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_lushr"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_lushr"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-lushr analyse ?x ?y) [_] @@ -411,41 +411,41 @@ (defn ^:private aba7 [analyse eval! exo-type token] (matchv ::M/objects [token] ;; Arrays - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_new-array"]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ ?class]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;Int" ?length]]] + [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_new-array"]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ ?class]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;IntS" ?length]]] ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-new-array analyse ?class ?length) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_aastore"]]]] + [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_aastore"]]]] ["lux;Cons" [?array - ["lux;Cons" [["lux;Meta" [_ ["lux;Int" ?idx]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;IntS" ?idx]]] ["lux;Cons" [?elem ["lux;Nil" _]]]]]]]]]]]]] (&&host/analyse-jvm-aastore analyse ?array ?idx ?elem) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_aaload"]]]] + [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_aaload"]]]] ["lux;Cons" [?array - ["lux;Cons" [["lux;Meta" [_ ["lux;Int" ?idx]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;IntS" ?idx]]] ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-aaload analyse ?array ?idx) ;; Classes & interfaces - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_class"]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ ?name]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ ?super-class]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;Tuple" ?fields]]] + [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_class"]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ ?name]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ ?super-class]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?fields]]] ["lux;Nil" _]]]]]]]]]]]]] (&&host/analyse-jvm-class analyse ?name ?super-class ?fields) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_interface"]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ ?name]]]] + [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_interface"]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ ?name]]]] ?members]]]]]]]] (&&host/analyse-jvm-interface analyse ?name ?members) ;; Programs - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_program"]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ ?args]]]] + [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_program"]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ ?args]]]] ["lux;Cons" [?body ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-program analyse ?args ?body) @@ -512,11 +512,11 @@ (defn ^:private analyse-ast [eval! exo-type token] (matchv ::M/objects [token] - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Tag" ?ident]]] ?values]]]]]] + [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;TagS" ?ident]]] ?values]]]]]] (do (assert (= 1 (&/|length ?values)) "[Analyser Error] Can only tag 1 value.") (&&lux/analyse-variant (partial analyse-ast eval!) exo-type ?ident (&/|head ?values))) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [?fn ?args]]]]]] + [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [?fn ?args]]]]]] (fn [state] (matchv ::M/objects [((&type/with-var #(&&/analyse-1 (partial analyse-ast eval!) % ?fn)) state)] [["lux;Right" [state* =fn]]] diff --git a/src/lux/analyser/case.clj b/src/lux/analyser/case.clj index f18dc7836..f27a541ee 100644 --- a/src/lux/analyser/case.clj +++ b/src/lux/analyser/case.clj @@ -22,38 +22,38 @@ (matchv ::M/objects [pattern] [["lux;Meta" [_ pattern*]]] (matchv ::M/objects [pattern*] - [["lux;Symbol" ?ident]] + [["lux;SymbolS" ?ident]] (|do [=kont (&env/with-local (&/ident->text ?ident) value-type kont) idx &env/next-local-idx] (return (&/T (&/V "StoreTestAC" idx) =kont))) - [["lux;Bool" ?value]] + [["lux;BoolS" ?value]] (|do [_ (&type/check value-type &type/Bool) =kont kont] (return (&/T (&/V "BoolTestAC" ?value) =kont))) - [["lux;Int" ?value]] + [["lux;IntS" ?value]] (|do [_ (&type/check value-type &type/Int) =kont kont] (return (&/T (&/V "IntTestAC" ?value) =kont))) - [["lux;Real" ?value]] + [["lux;RealS" ?value]] (|do [_ (&type/check value-type &type/Real) =kont kont] (return (&/T (&/V "RealTestAC" ?value) =kont))) - [["lux;Char" ?value]] + [["lux;CharS" ?value]] (|do [_ (&type/check value-type &type/Char) =kont kont] (return (&/T (&/V "CharTestAC" ?value) =kont))) - [["lux;Text" ?value]] + [["lux;TextS" ?value]] (|do [_ (&type/check value-type &type/Text) =kont kont] (return (&/T (&/V "TextTestAC" ?value) =kont))) - [["lux;Tuple" ?members]] + [["lux;TupleS" ?members]] (matchv ::M/objects [value-type] [["lux;TupleT" ?member-types]] (if (not (= (&/|length ?member-types) (&/|length ?members))) @@ -70,7 +70,7 @@ [_] (fail "[Analyser Error] Tuple requires tuple-type.")) - [["lux;Record" ?slots]] + [["lux;RecordS" ?slots]] (|do [value-type* (resolve-type value-type)] (matchv ::M/objects [value-type*] [["lux;RecordT" ?slot-types]] @@ -79,7 +79,7 @@ (|do [[=tests =kont] (&/fold (fn [kont* slot] (|let [[sn sv] slot] (matchv ::M/objects [sn] - [["lux;Meta" [_ ["lux;Tag" ?ident]]]] + [["lux;Meta" [_ ["lux;TagS" ?ident]]]] (|do [=tag (&&/resolved-ident ?ident)] (if-let [=slot-type (&/|get =tag ?slot-types)] (|do [[=test [=tests =kont]] (analyse-pattern =slot-type sv kont*)] @@ -96,18 +96,18 @@ [_] (fail "[Analyser Error] Record requires record-type."))) - [["lux;Tag" ?ident]] + [["lux;TagS" ?ident]] (|do [=tag (&&/resolved-ident ?ident) value-type* (resolve-type value-type) case-type (&type/variant-case =tag value-type*) [=test =kont] (analyse-pattern case-type (&/V "lux;Meta" (&/T (&/T "" -1 -1) - (&/V "lux;Tuple" (&/|list)))) + (&/V "lux;TupleS" (&/|list)))) kont)] (return (&/T (&/V "VariantTestAC" (&/T =tag =test)) =kont))) - [["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Tag" ?ident]]] - ["lux;Cons" [?value - ["lux;Nil" _]]]]]]] + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;TagS" ?ident]]] + ["lux;Cons" [?value + ["lux;Nil" _]]]]]]] (|do [=tag (&&/resolved-ident ?ident) value-type* (resolve-type value-type) case-type (&type/variant-case =tag value-type*) diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj index 527c69dc7..9f80c43cc 100644 --- a/src/lux/analyser/host.clj +++ b/src/lux/analyser/host.clj @@ -12,7 +12,7 @@ ;; [Utils] (defn ^:private extract-ident [ident] (matchv ::M/objects [ident] - [["lux;Meta" [_ ["lux;Symbol" [_ ?ident]]]]] + [["lux;Meta" [_ ["lux;SymbolS" [_ ?ident]]]]] (return ?ident) [_] @@ -142,9 +142,9 @@ (defn analyse-jvm-class [analyse ?name ?super-class ?fields] (|do [?fields (&/map% (fn [?field] (matchv ::M/objects [?field] - [["lux;Meta" [_ ["lux;Tuple" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ?class]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ?field-name]]] - ["lux;Nil" _]]]]]]]]] + [["lux;Meta" [_ ["lux;TupleS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ?class]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ?field-name]]] + ["lux;Nil" _]]]]]]]]] (return [?class ?field-name]) [_] @@ -159,13 +159,13 @@ (defn analyse-jvm-interface [analyse ?name ?members] (|do [=members (&/map% (fn [member] (matchv ::M/objects [member] - [["lux;Meta" [_ ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ":"]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "->"]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;Tuple" ?inputs]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ ?output]]]] - ["lux;Nil" _]]]]]]]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ ?member-name]]]] - ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [_ ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ":"]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "->"]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?inputs]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ ?output]]]] + ["lux;Nil" _]]]]]]]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ ?member-name]]]] + ["lux;Nil" _]]]]]]]]]]] (|do [inputs* (&/map% extract-ident ?inputs)] (return [?member-name [inputs* ?output]])) diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj index b65963e4a..1b0c70f77 100644 --- a/src/lux/analyser/lux.clj +++ b/src/lux/analyser/lux.clj @@ -86,7 +86,7 @@ (fail "[Analyser Error] The type of a record must be a record type.")) =slots (&/map% (fn [kv] (matchv ::M/objects [kv] - [[["lux;Meta" [_ ["lux;Tag" ?ident]]] ?value]] + [[["lux;Meta" [_ ["lux;TagS" ?ident]]] ?value]] (|do [?tag (&&/resolved-ident ?ident) slot-type (if-let [slot-type (&/|get ?tag types)] (return slot-type) diff --git a/src/lux/host.clj b/src/lux/host.clj index d159d2608..77687dbef 100644 --- a/src/lux/host.clj +++ b/src/lux/host.clj @@ -69,7 +69,7 @@ (defn extract-jvm-param [token] (matchv ::M/objects [token] - [["lux;Meta" [_ ["lux;Symbol" [_ ?ident]]]]] + [["lux;Meta" [_ ["lux;SymbolS" [_ ?ident]]]]] (return ?ident) [_] diff --git a/src/lux/parser.clj b/src/lux/parser.clj index 6b392ea96..7a3ad18aa 100644 --- a/src/lux/parser.clj +++ b/src/lux/parser.clj @@ -17,8 +17,8 @@ [_] (fail (str "[Parser Error] Unbalanced " "."))))) - ^:private parse-form "Close_Paren" "parantheses" "lux;Form" - ^:private parse-tuple "Close_Bracket" "brackets" "lux;Tuple" + ^:private parse-form "Close_Paren" "parantheses" "lux;FormS" + ^:private parse-tuple "Close_Bracket" "brackets" "lux;TupleS" ) (defn ^:private parse-record [parse] @@ -28,7 +28,7 @@ (matchv ::M/objects [token] [["lux;Meta" [meta ["Close_Brace" _]]]] (if (even? (&/|length elems)) - (return (&/V "lux;Record" (&/|as-pairs elems))) + (return (&/V "lux;RecordS" (&/|as-pairs elems))) (fail (str "[Parser Error] Records must have an even number of elements."))) [_] @@ -47,25 +47,25 @@ (return (&/|list)) [["Bool" ?value]] - (return (&/|list (&/V "lux;Meta" (&/T meta (&/V "lux;Bool" (Boolean/parseBoolean ?value)))))) + (return (&/|list (&/V "lux;Meta" (&/T meta (&/V "lux;BoolS" (Boolean/parseBoolean ?value)))))) [["Int" ?value]] - (return (&/|list (&/V "lux;Meta" (&/T meta (&/V "lux;Int" (Integer/parseInt ?value)))))) + (return (&/|list (&/V "lux;Meta" (&/T meta (&/V "lux;IntS" (Integer/parseInt ?value)))))) [["Real" ?value]] - (return (&/|list (&/V "lux;Meta" (&/T meta (&/V "lux;Real" (Float/parseFloat ?value)))))) + (return (&/|list (&/V "lux;Meta" (&/T meta (&/V "lux;RealS" (Float/parseFloat ?value)))))) [["Char" ^String ?value]] - (return (&/|list (&/V "lux;Meta" (&/T meta (&/V "lux;Char" (.charAt ?value 0)))))) + (return (&/|list (&/V "lux;Meta" (&/T meta (&/V "lux;CharS" (.charAt ?value 0)))))) [["Text" ?value]] - (return (&/|list (&/V "lux;Meta" (&/T meta (&/V "lux;Text" ?value))))) + (return (&/|list (&/V "lux;Meta" (&/T meta (&/V "lux;TextS" ?value))))) [["Symbol" ?ident]] - (return (&/|list (&/V "lux;Meta" (&/T meta (&/V "lux;Symbol" ?ident))))) + (return (&/|list (&/V "lux;Meta" (&/T meta (&/V "lux;SymbolS" ?ident))))) [["Tag" ?ident]] - (return (&/|list (&/V "lux;Meta" (&/T meta (&/V "lux;Tag" ?ident))))) + (return (&/|list (&/V "lux;Meta" (&/T meta (&/V "lux;TagS" ?ident))))) [["Open_Paren" _]] (|do [syntax (parse-form parse)] diff --git a/src/lux/type.clj b/src/lux/type.clj index 494d8ebbc..97b7c1bde 100644 --- a/src/lux/type.clj +++ b/src/lux/type.clj @@ -85,16 +85,16 @@ (&/V "lux;BoundT" "w"))))) Syntax*List (&/V "lux;AppT" (&/T List Syntax*))] (fAll "Syntax'" "w" - (&/V "lux;VariantT" (&/|list (&/T "lux;Bool" Bool) - (&/T "lux;Int" Int) - (&/T "lux;Real" Real) - (&/T "lux;Char" Char) - (&/T "lux;Text" Text) - (&/T "lux;Symbol" Ident) - (&/T "lux;Tag" Ident) - (&/T "lux;Form" Syntax*List) - (&/T "lux;Tuple" Syntax*List) - (&/T "lux;Record" (&/V "lux;AppT" (&/T List (&/V "lux;TupleT" (&/|list Syntax* Syntax*)))))) + (&/V "lux;VariantT" (&/|list (&/T "lux;BoolS" Bool) + (&/T "lux;IntS" Int) + (&/T "lux;RealS" Real) + (&/T "lux;CharS" Char) + (&/T "lux;TextS" Text) + (&/T "lux;SymbolS" Ident) + (&/T "lux;TagS" Ident) + (&/T "lux;FormS" Syntax*List) + (&/T "lux;TupleS" Syntax*List) + (&/T "lux;RecordS" (&/V "lux;AppT" (&/T List (&/V "lux;TupleT" (&/|list Syntax* Syntax*)))))) )))) (def Syntax -- cgit v1.2.3 From 279598fd1d5aace000231e4e85e5f9967634ce81 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Thu, 14 May 2015 07:46:30 -0400 Subject: - Multi-line comments have returned. --- src/lux/base.clj | 6 ------ src/lux/lexer.clj | 27 ++++++++++++++++++--------- src/lux/reader.clj | 48 ++++++++++++++++++++++++++++++++++++++++++++---- 3 files changed, 62 insertions(+), 19 deletions(-) (limited to 'src') diff --git a/src/lux/base.clj b/src/lux/base.clj index 3ac994043..9ea255132 100644 --- a/src/lux/base.clj +++ b/src/lux/base.clj @@ -32,18 +32,12 @@ (defn T [& elems] (to-array elems)) -;; (definline T [& elems] -;; `(to-array (list ~@elems))) (defn V [tag value] (to-array [tag value])) -;; (definline V [tag value] -;; `(to-array [~tag ~value])) (defn R [& kvs] (to-array kvs)) -;; (definline R [& kvs] -;; `(to-array (list ~@kvs))) (defn get$ [slot ^objects record] (aget record slot)) diff --git a/src/lux/lexer.clj b/src/lux/lexer.clj index 31258bc4b..2ee8088d3 100644 --- a/src/lux/lexer.clj +++ b/src/lux/lexer.clj @@ -35,23 +35,32 @@ (return (&/V "lux;Meta" (&/T meta (&/V "White_Space" white-space)))))) (def ^:private lex-single-line-comment - (|do [[_ [meta _]] (&reader/read-text "##") - [_ [_ comment]] (&reader/read-regex #"^(.*)$")] + (|do [_ (&reader/read-text "##") + [_ [meta comment]] (&reader/read-regex #"^(.*)$")] (return (&/V "lux;Meta" (&/T meta (&/V "Comment" comment)))))) (defn ^:private lex-multi-line-comment [_] (|do [_ (&reader/read-text "#(") - [meta comment] (&/try-all% (&/|list (|do [[_ [meta comment]] (&reader/read-regex #"(?is)^((?!#\().)*?(?=\)#)")] - (return comment)) - (|do [[_ [meta pre]] (&reader/read-regex #"(?is)^(.+?(?=#\())") - [_ inner] (lex-multi-line-comment nil) - [_ [_ post]] (&reader/read-regex #"(?is)^(.+?(?=\)#))")] - (return (str pre "#(" inner ")#" post))))) + [meta comment] (&/try-all% (&/|list (|do [[_ [meta comment]] (&reader/read-regex #"(?is)^(?!#\()(.*?(?=\)#))") + ;; :let [_ (prn 'immediate comment)] + _ (&reader/read-text ")#")] + (return (&/T meta comment))) + (|do [;; :let [_ (prn 'pre/_0)] + [_ [meta pre]] (&reader/read-regex+ #"(?is)^(.*?)(#\(|$)") + ;; :let [_ (prn 'pre pre)] + [_ [_ [_ inner]]] (lex-multi-line-comment nil) + ;; :let [_ (prn 'inner inner)] + [_ [_ post]] (&reader/read-regex #"(?is)^(.+?(?=\)#))") + ;; :let [_ (prn 'post post (str pre "#(" inner ")#" post))] + ] + (return (&/T meta (str pre "#(" inner ")#" post)))))) + ;; :let [_ (prn 'lex-multi-line-comment (str comment ")#"))] _ (&reader/read-text ")#")] (return (&/V "lux;Meta" (&/T meta (&/V "Comment" comment)))))) (def ^:private lex-comment - (&/try-all% (&/|list lex-single-line-comment))) + (&/try-all% (&/|list lex-single-line-comment + (lex-multi-line-comment nil)))) (do-template [ ] (def diff --git a/src/lux/reader.clj b/src/lux/reader.clj index 69c95ea6a..c25870168 100644 --- a/src/lux/reader.clj +++ b/src/lux/reader.clj @@ -26,12 +26,28 @@ output)) ))) +(defn ^:private with-lines [body] + (fn [state] + (matchv ::M/objects [(body (&/get$ &/$SOURCE state))] + [["lux;Right" [reader* match]]] + (return* (&/set$ &/$SOURCE reader* state) + match) + + [["lux;Left" msg]] + (fail* msg) + ))) + ;; [Exports] (defn ^:private re-find! [^java.util.regex.Pattern regex line] (let [matcher (.matcher regex line)] (when (.find matcher) (.group matcher 0)))) +(defn ^:private re-find1! [^java.util.regex.Pattern regex line] + (let [matcher (.matcher regex line)] + (when (.find matcher) + (.group matcher 1)))) + (defn ^:private re-find3! [^java.util.regex.Pattern regex line] (let [matcher (.matcher regex line)] (when (.find matcher) @@ -42,10 +58,12 @@ (defn read-regex [regex] (with-line (fn [file-name line-num column-num ^String line] - (if-let [^String match (re-find! regex line)] - (let [match-length (.length match) + (if-let [^String match (do ;; (prn '[regex line] [regex line]) + (re-find! regex line))] + (let [;; _ (prn 'match match) + match-length (.length match) line* (.substring line match-length)] - (if (empty? line*) + (if (.isEmpty line*) (&/V "Done" (&/V "lux;Meta" (&/T (&/T file-name line-num column-num) match))) (&/V "Yes" (&/T (&/V "lux;Meta" (&/T (&/T file-name line-num column-num) match)) (&/V "lux;Meta" (&/T (&/T file-name line-num (+ column-num match-length)) line*)))))) @@ -57,12 +75,34 @@ (if-let [[^String match tok1 tok2] (re-find3! regex line)] (let [match-length (.length match) line* (.substring line match-length)] - (if (empty? line*) + (if (.isEmpty line*) (&/V "Done" (&/V "lux;Meta" (&/T (&/T file-name line-num column-num) (&/T tok1 tok2)))) (&/V "Yes" (&/T (&/V "lux;Meta" (&/T (&/T file-name line-num column-num) (&/T tok1 tok2))) (&/V "lux;Meta" (&/T (&/T file-name line-num (+ column-num match-length)) line*)))))) (&/V "No" (str "[Reader Error] Pattern failed: " regex)))))) +(defn read-regex+ [regex] + (with-lines + (fn [reader] + (loop [prefix "" + reader* reader] + (matchv ::M/objects [reader*] + [["lux;Nil" _]] + (&/V "lux;Left" "[Reader Error] EOF") + + [["lux;Cons" [[_ [[file-name line-num column-num] ^String line]] + reader**]]] + (if-let [^String match (do ;; (prn 'read-regex+ regex line) + (re-find1! regex line))] + (let [match-length (.length match) + line* (.substring line match-length)] + (if (.isEmpty line*) + (recur (str prefix match "\n") reader**) + (&/V "lux;Right" (&/T (&/|cons (&/V "lux;Meta" (&/T (&/T file-name line-num (+ column-num match-length)) line*)) + reader**) + (&/V "lux;Meta" (&/T (&/T file-name line-num column-num) (str prefix match))))))) + (&/V "lux;Left" (str "[Reader Error] Pattern failed: " regex)))))))) + (defn read-text [^String text] (with-line (fn [file-name line-num column-num ^String line] -- cgit v1.2.3 From c4ac3e692ae96d6898d8efb42faf4dfadd43f4ae Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Thu, 14 May 2015 08:23:10 -0400 Subject: - Removed the apparently unnecessary total-locals. --- src/lux.clj | 2 - src/lux/compiler/base.clj | 101 -------------------------------------------- src/lux/compiler/lambda.clj | 9 +--- 3 files changed, 2 insertions(+), 110 deletions(-) (limited to 'src') diff --git a/src/lux.clj b/src/lux.clj index 62e9d14f9..5b32955a3 100644 --- a/src/lux.clj +++ b/src/lux.clj @@ -9,7 +9,5 @@ (System/exit 0)) (comment - ;; TODO: Finish total-locals - ;; cd output && jar cvf program.jar * && java -cp "program.jar" program && cd .. ) diff --git a/src/lux/compiler/base.clj b/src/lux/compiler/base.clj index c0a54ba53..a7886ab48 100644 --- a/src/lux/compiler/base.clj +++ b/src/lux/compiler/base.clj @@ -30,104 +30,3 @@ :let [_ (write-class name bytecode) _ (load-class! loader (string/replace name #"/" "."))]] (return nil))) - -(defn total-locals [expr] - (matchv ::M/objects [expr] - [[?struct ?type]] - (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) - - [["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))) - - [["|do" ?exprs]] - (&/fold max 0 (&/|map total-locals ?exprs)) - - [["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-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-aaload" [?array ?idx]]] - (total-locals ?array) - - ;; [["lambda" _]] - ;; 0 - - [_] - 0 - ))) diff --git a/src/lux/compiler/lambda.clj b/src/lux/compiler/lambda.clj index 625599617..42ed5459e 100644 --- a/src/lux/compiler/lambda.clj +++ b/src/lux/compiler/lambda.clj @@ -59,13 +59,8 @@ (&/with-writer (doto (.visitMethod ^ClassWriter class Opcodes/ACC_PUBLIC "impl" impl-signature nil nil) (.visitCode)) (|do [^MethodVisitor *writer* &/get-writer - :let [num-locals (&&/total-locals impl-body) - $start (new Label) - $end (new Label) - _ (doto *writer* - (-> (.visitLocalVariable (str &&/local-prefix idx) "Ljava/lang/Object;" nil $start $end (+ 2 idx)) - (->> (dotimes [idx num-locals]))) - (.visitLabel $start))] + :let [$start (new Label) + $end (new Label)] ret (compile impl-body) :let [_ (doto *writer* (.visitLabel $end) -- cgit v1.2.3 From f52eb6df2e57f67e7cf30d85c6340ce00f923d6f Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Fri, 22 May 2015 20:07:08 -0400 Subject: - Corrected the indentation issues in the lux files. - Temporarily reverted back to forward apply-analysis. - Fixed an error in lux.base/show-ast. - Reader now only returns a tuple instead of a full-blown #Meta variant. - Reader now doesn't cut the strings that it reads. Instead, the "cursor" just moves around, indicating where to read. - Inlined some calculations that previously relied on try-all%. --- src/lux.clj | 5 +- src/lux/analyser.clj | 1 + src/lux/analyser/lux.clj | 86 ++++++++++++++++--------------- src/lux/base.clj | 20 ++++---- src/lux/compiler.clj | 4 +- src/lux/compiler/lux.clj | 9 ++-- src/lux/lexer.clj | 56 ++++++++++----------- src/lux/reader.clj | 75 +++++++++++++++------------ src/lux/type.clj | 128 +++++++++++++++++++++++++++++++++-------------- 9 files changed, 227 insertions(+), 157 deletions(-) (limited to 'src') diff --git a/src/lux.clj b/src/lux.clj index 5b32955a3..eb025f55e 100644 --- a/src/lux.clj +++ b/src/lux.clj @@ -2,10 +2,13 @@ (:gen-class) (:require [lux.base :as &] [lux.compiler :as &compiler] + [lux.type :as &type] :reload-all)) (defn -main [& _] - (time (&compiler/compile-all (&/|list "program"))) + (do (time (&compiler/compile-all (&/|list "program"))) + ;; (prn @&type/counter) + ) (System/exit 0)) (comment diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj index c37c1acde..3c5c5c956 100644 --- a/src/lux/analyser.clj +++ b/src/lux/analyser.clj @@ -454,6 +454,7 @@ (fail ""))) (defn ^:private analyse-basic-ast [analyse eval! exo-type token] + ;; (prn 'analyse-basic-ast (&/show-ast token)) (fn [state] (matchv ::M/objects [((aba1 analyse eval! exo-type token) state)] [["lux;Right" [state* output]]] diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj index 1b0c70f77..7600f34ff 100644 --- a/src/lux/analyser/lux.clj +++ b/src/lux/analyser/lux.clj @@ -151,7 +151,7 @@ [_] (fail* "[Analyser Error] Can't have anything other than a global def in the global environment.")) - (fail* "")) + (fail* "_{_ analyse-symbol _}_")) [["lux;Cons" [top-outer _]]] (|let [scopes (&/|tail (&/folds #(&/|cons (&/get$ &/$NAME %2) %1) @@ -172,39 +172,42 @@ ))) )) -(defn ^:private analyse-apply* [analyse exo-type fun-type args] - (matchv ::M/objects [args] - [["lux;Nil" _]] - (|do [_ (&type/check exo-type fun-type)] - (return (&/T (&/|list) fun-type))) - - [["lux;Cons" [?arg ?args*]]] - (|do [?fun-type* (&type/actual-type fun-type)] - (matchv ::M/objects [?fun-type*] - [["lux;AllT" _]] - (&type/with-var - (fn [$var] - (|do [type* (&type/apply-type ?fun-type* $var) - [?args** ?type**] (analyse-apply* analyse exo-type type* args)] - (matchv ::M/objects [$var] - [["lux;VarT" ?id]] - (|do [? (&type/bound? ?id) - _ (if ? - (return nil) - (|do [ex &type/existential] - (&type/set-var ?id ex))) - type*** (&type/clean $var ?type**)] - (return (&/T ?args** type***))) - )))) - - [["lux;LambdaT" [?input-t ?output-t]]] - (|do [[=args ?output-t*] (analyse-apply* analyse exo-type ?output-t ?args*) - =arg (&&/analyse-1 analyse ?input-t ?arg)] - (return (&/T (&/|cons =arg =args) ?output-t*))) +(defn ^:private analyse-apply* [analyse exo-type =fn ?args] + (matchv ::M/objects [=fn] + [[?fun-expr ?fun-type]] + (matchv ::M/objects [?args] + [["lux;Nil" _]] + (|do [_ (&type/check exo-type ?fun-type)] + (return =fn)) + + [["lux;Cons" [?arg ?args*]]] + (|do [?fun-type* (&type/actual-type ?fun-type)] + (matchv ::M/objects [?fun-type*] + [["lux;AllT" _]] + (&type/with-var + (fn [$var] + (|do [type* (&type/apply-type ?fun-type* $var) + output (analyse-apply* analyse exo-type (&/T ?fun-expr type*) ?args)] + (matchv ::M/objects [output $var] + [[?expr* ?type*] ["lux;VarT" ?id]] + (|do [? (&type/bound? ?id) + _ (if ? + (return nil) + (|do [ex &type/existential] + (&type/set-var ?id ex))) + type** (&type/clean $var ?type*)] + (return (&/T ?expr* type**))) + )))) + + [["lux;LambdaT" [?input-t ?output-t]]] + (|do [=arg (&&/analyse-1 analyse ?input-t ?arg)] + (analyse-apply* analyse exo-type (&/T (&/V "apply" (&/T =fn =arg)) + ?output-t) + ?args*)) - [_] - (fail (str "[Analyser Error] Can't apply a non-function: " (&type/show-type ?fun-type*))))) - )) + [_] + (fail (str "[Analyser Error] Can't apply a non-function: " (&type/show-type ?fun-type*))))) + ))) (defn analyse-apply [analyse exo-type =fn ?args] (|do [loader &/loader] @@ -219,14 +222,12 @@ (&/flat-map% (partial analyse exo-type) macro-expansion)) [_] - (|do [[=args =app-type] (analyse-apply* analyse exo-type =fn-type ?args)] - (return (&/|list (&/T (&/V "apply" (&/T =fn =args)) - =app-type)))))) + (|do [output (analyse-apply* analyse exo-type =fn ?args)] + (return (&/|list output))))) [_] - (|do [[=args =app-type] (analyse-apply* analyse exo-type =fn-type ?args)] - (return (&/|list (&/T (&/V "apply" (&/T =fn =args)) - =app-type))))) + (|do [output (analyse-apply* analyse exo-type =fn ?args)] + (return (&/|list output)))) ))) (defn analyse-case [analyse exo-type ?value ?branches] @@ -263,7 +264,12 @@ (|do [? (&type/bound? ?id)] (if ? (|do [dtype (&type/deref ?id)] - (fail (str "[Analyser Error] Can't use type-var in any type-specific way inside polymorphic functions: " ?id ":" _arg " " (&type/show-type dtype)))) + (matchv ::M/objects [dtype] + [["lux;ExT" _]] + (return (&/T _expr exo-type)) + + [_] + (fail (str "[Analyser Error] Can't use type-var in any type-specific way inside polymorphic functions: " ?id ":" _arg " " (&type/show-type dtype))))) (return (&/T _expr exo-type)))))))) [_] diff --git a/src/lux/base.clj b/src/lux/base.clj index 9ea255132..edf6781ea 100644 --- a/src/lux/base.clj +++ b/src/lux/base.clj @@ -551,40 +551,40 @@ (defn show-ast [ast] (matchv ::M/objects [ast] - [["lux;Meta" [_ ["lux;Bool" ?value]]]] + [["lux;Meta" [_ ["lux;BoolS" ?value]]]] (pr-str ?value) - [["lux;Meta" [_ ["lux;Int" ?value]]]] + [["lux;Meta" [_ ["lux;IntS" ?value]]]] (pr-str ?value) - [["lux;Meta" [_ ["lux;Real" ?value]]]] + [["lux;Meta" [_ ["lux;RealS" ?value]]]] (pr-str ?value) - [["lux;Meta" [_ ["lux;Char" ?value]]]] + [["lux;Meta" [_ ["lux;CharS" ?value]]]] (pr-str ?value) - [["lux;Meta" [_ ["lux;Text" ?value]]]] + [["lux;Meta" [_ ["lux;TextS" ?value]]]] (str "\"" ?value "\"") - [["lux;Meta" [_ ["lux;Tag" [?module ?tag]]]]] + [["lux;Meta" [_ ["lux;TagS" [?module ?tag]]]]] (str "#" ?module ";" ?tag) - [["lux;Meta" [_ ["lux;Symbol" [?module ?ident]]]]] + [["lux;Meta" [_ ["lux;SymbolS" [?module ?ident]]]]] (if (= "" ?module) ?ident (str ?module ";" ?ident)) - [["lux;Meta" [_ ["lux;Tuple" ?elems]]]] + [["lux;Meta" [_ ["lux;TupleS" ?elems]]]] (str "[" (->> ?elems (|map show-ast) (|interpose " ") (fold str "")) "]") - [["lux;Meta" [_ ["lux;Record" ?elems]]]] + [["lux;Meta" [_ ["lux;RecordS" ?elems]]]] (str "{" (->> ?elems (|map (fn [elem] (|let [[k v] elem] (str (show-ast k) " " (show-ast v))))) (|interpose " ") (fold str "")) "}") - [["lux;Meta" [_ ["lux;Form" ?elems]]]] + [["lux;Meta" [_ ["lux;FormS" ?elems]]]] (str "(" (->> ?elems (|map show-ast) (|interpose " ") (fold str "")) ")") )) diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj index 26b75bec3..6fb9e2c6d 100644 --- a/src/lux/compiler.clj +++ b/src/lux/compiler.clj @@ -60,8 +60,8 @@ [["lux;Global" [?owner-class ?name]]] (&&lux/compile-global compile-expression ?type ?owner-class ?name) - [["apply" [?fn ?args]]] - (&&lux/compile-apply compile-expression ?type ?fn ?args) + [["apply" [?fn ?arg]]] + (&&lux/compile-apply compile-expression ?type ?fn ?arg) [["variant" [?tag ?members]]] (&&lux/compile-variant compile-expression ?type ?tag ?members) diff --git a/src/lux/compiler/lux.clj b/src/lux/compiler/lux.clj index 2c5073a4d..cf4a65f04 100644 --- a/src/lux/compiler/lux.clj +++ b/src/lux/compiler/lux.clj @@ -117,14 +117,11 @@ :let [_ (.visitFieldInsn *writer* Opcodes/GETSTATIC (&host/->class (&host/location (&/|list ?owner-class ?name))) "_datum" "Ljava/lang/Object;")]] (return nil))) -(defn compile-apply [compile *type* ?fn ?args] +(defn compile-apply [compile *type* ?fn ?arg] (|do [^MethodVisitor *writer* &/get-writer _ (compile ?fn) - _ (&/map% (fn [?arg] - (|do [_ (compile ?arg) - :let [_ (.visitMethodInsn *writer* Opcodes/INVOKEINTERFACE "lux/Function" "apply" &&/apply-signature)]] - (return nil))) - ?args)] + _ (compile ?arg) + :let [_ (.visitMethodInsn *writer* Opcodes/INVOKEINTERFACE "lux/Function" "apply" &&/apply-signature)]] (return nil))) (defn compile-def [compile ?name ?body ?def-data] diff --git a/src/lux/lexer.clj b/src/lux/lexer.clj index 2ee8088d3..d2ab4a5d7 100644 --- a/src/lux/lexer.clj +++ b/src/lux/lexer.clj @@ -18,11 +18,11 @@ (fail (str "[Lexer Error] Unknown escape character: " escaped)))) (defn ^:private lex-text-body [_] - (&/try-all% (&/|list (|do [[_ [_ [prefix escaped]]] (&reader/read-regex2 #"(?s)^([^\"\\]*)(\\.)") + (&/try-all% (&/|list (|do [[_ [prefix escaped]] (&reader/read-regex2 #"(?s)^([^\"\\]*)(\\.)") unescaped (escape-char escaped) postfix (lex-text-body nil)] (return (str prefix unescaped postfix))) - (|do [[_ [_ body]] (&reader/read-regex #"(?s)^([^\"\\]*)")] + (|do [[_ body] (&reader/read-regex #"(?s)^([^\"\\]*)")] (return body))))) (def ^:private +ident-re+ #"^([a-zA-Z\-\+\_\=!@$%^&*<>\.,/\\\|'`:\~\?][0-9a-zA-Z\-\+\_\=!@$%^&*<>\.,/\\\|'`:\~\?]*)" @@ -31,26 +31,26 @@ ;; [Lexers] (def ^:private lex-white-space - (|do [[_ [meta white-space]] (&reader/read-regex #"^(\s+)")] + (|do [[meta white-space] (&reader/read-regex #"^(\s+)")] (return (&/V "lux;Meta" (&/T meta (&/V "White_Space" white-space)))))) (def ^:private lex-single-line-comment (|do [_ (&reader/read-text "##") - [_ [meta comment]] (&reader/read-regex #"^(.*)$")] + [meta comment] (&reader/read-regex #"^(.*)$")] (return (&/V "lux;Meta" (&/T meta (&/V "Comment" comment)))))) (defn ^:private lex-multi-line-comment [_] (|do [_ (&reader/read-text "#(") - [meta comment] (&/try-all% (&/|list (|do [[_ [meta comment]] (&reader/read-regex #"(?is)^(?!#\()(.*?(?=\)#))") + [meta comment] (&/try-all% (&/|list (|do [[meta comment] (&reader/read-regex #"(?is)^(?!#\()(.*?(?=\)#))") ;; :let [_ (prn 'immediate comment)] _ (&reader/read-text ")#")] (return (&/T meta comment))) (|do [;; :let [_ (prn 'pre/_0)] - [_ [meta pre]] (&reader/read-regex+ #"(?is)^(.*?)(#\(|$)") + [meta pre] (&reader/read-regex+ #"(?is)^(.*?)(#\(|$)") ;; :let [_ (prn 'pre pre)] - [_ [_ [_ inner]]] (lex-multi-line-comment nil) + [_ inner] (lex-multi-line-comment nil) ;; :let [_ (prn 'inner inner)] - [_ [_ post]] (&reader/read-regex #"(?is)^(.+?(?=\)#))") + [_ post] (&reader/read-regex #"(?is)^(.+?(?=\)#))") ;; :let [_ (prn 'post post (str pre "#(" inner ")#" post))] ] (return (&/T meta (str pre "#(" inner ")#" post)))))) @@ -64,7 +64,7 @@ (do-template [ ] (def - (|do [[_ [meta token]] (&reader/read-regex )] + (|do [[meta token] (&reader/read-regex )] (return (&/V "lux;Meta" (&/T meta (&/V token)))))) ^:private lex-bool "Bool" #"^(true|false)" @@ -73,54 +73,54 @@ ) (def ^:private lex-char - (|do [[_ [meta _]] (&reader/read-text "#\"") - token (&/try-all% (&/|list (|do [[_ [_ escaped]] (&reader/read-regex #"^(\\.)")] + (|do [[meta _] (&reader/read-text "#\"") + token (&/try-all% (&/|list (|do [[_ escaped] (&reader/read-regex #"^(\\.)")] (escape-char escaped)) - (|do [[_ [_ char]] (&reader/read-regex #"^(.)")] + (|do [[_ char] (&reader/read-regex #"^(.)")] (return char)))) _ (&reader/read-text "\"")] (return (&/V "lux;Meta" (&/T meta (&/V "Char" token)))))) (def ^:private lex-text - (|do [[_ [meta _]] (&reader/read-text "\"") + (|do [[meta _] (&reader/read-text "\"") token (lex-text-body nil) _ (&reader/read-text "\"")] (return (&/V "lux;Meta" (&/T meta (&/V "Text" token)))))) (def ^:private lex-ident - (&/try-all% (&/|list (|do [[_ [meta token]] (&reader/read-regex +ident-re+)] + (&/try-all% (&/|list (|do [[meta token] (&reader/read-regex +ident-re+)] (&/try-all% (&/|list (|do [_ (&reader/read-text ";") - [_ [_ local-token]] (&reader/read-regex +ident-re+)] + [_ local-token] (&reader/read-regex +ident-re+)] (&/try-all% (&/|list (|do [unaliased (&module/dealias token)] - (return (&/V "lux;Meta" (&/T meta (&/T unaliased local-token))))) + (return (&/T meta (&/T unaliased local-token)))) (|do [? (&module/exists? token)] (if ? - (return (&/V "lux;Meta" (&/T meta (&/T token local-token)))) + (return (&/T meta (&/T token local-token))) (fail (str "[Lexer Error] Unknown module: " token)))) ))) - (return (&/V "lux;Meta" (&/T meta (&/T "" token)))) + (return (&/T meta (&/T "" token))) ))) - (|do [[_ [meta _]] (&reader/read-text ";;") - [_ [_ token]] (&reader/read-regex +ident-re+) + (|do [[meta _] (&reader/read-text ";;") + [_ token] (&reader/read-regex +ident-re+) module-name &/get-module-name] - (return (&/V "lux;Meta" (&/T meta (&/T module-name token))))) - (|do [[_ [meta _]] (&reader/read-text ";") - [_ [_ token]] (&reader/read-regex +ident-re+)] - (return (&/V "lux;Meta" (&/T meta (&/T "lux" token))))) + (return (&/T meta (&/T module-name token)))) + (|do [[meta _] (&reader/read-text ";") + [_ token] (&reader/read-regex +ident-re+)] + (return (&/T meta (&/T "lux" token)))) ))) (def ^:private lex-symbol - (|do [[_ [meta ident]] lex-ident] + (|do [[meta ident] lex-ident] (return (&/V "lux;Meta" (&/T meta (&/V "Symbol" ident)))))) (def ^:private lex-tag - (|do [[_ [meta _]] (&reader/read-text "#") - [_ [_ ident]] lex-ident] + (|do [[meta _] (&reader/read-text "#") + [_ ident] lex-ident] (return (&/V "lux;Meta" (&/T meta (&/V "Tag" ident)))))) (do-template [ ] (def - (|do [[_ [meta _]] (&reader/read-text )] + (|do [[meta _] (&reader/read-text )] (return (&/V "lux;Meta" (&/T meta (&/V nil)))))) ^:private lex-open-paren "(" "Open_Paren" diff --git a/src/lux/reader.clj b/src/lux/reader.clj index c25870168..b1fcc4740 100644 --- a/src/lux/reader.clj +++ b/src/lux/reader.clj @@ -11,7 +11,7 @@ [["lux;Nil" _]] (fail* "[Reader Error] EOF") - [["lux;Cons" [["lux;Meta" [[file-name line-num column-num] line]] + [["lux;Cons" [[[file-name line-num column-num] line] more]]] (matchv ::M/objects [(body file-name line-num column-num line)] [["No" msg]] @@ -38,18 +38,24 @@ ))) ;; [Exports] -(defn ^:private re-find! [^java.util.regex.Pattern regex line] - (let [matcher (.matcher regex line)] +(defn ^:private re-find! [^java.util.regex.Pattern regex column ^String line] + (let [matcher (doto (.matcher regex line) + (.region column (.length line)) + (.useAnchoringBounds true))] (when (.find matcher) (.group matcher 0)))) -(defn ^:private re-find1! [^java.util.regex.Pattern regex line] - (let [matcher (.matcher regex line)] +(defn ^:private re-find1! [^java.util.regex.Pattern regex column ^String line] + (let [matcher (doto (.matcher regex line) + (.region column (.length line)) + (.useAnchoringBounds true))] (when (.find matcher) (.group matcher 1)))) -(defn ^:private re-find3! [^java.util.regex.Pattern regex line] - (let [matcher (.matcher regex line)] +(defn ^:private re-find3! [^java.util.regex.Pattern regex column ^String line] + (let [matcher (doto (.matcher regex line) + (.region column (.length line)) + (.useAnchoringBounds true))] (when (.find matcher) (list (.group matcher 0) (.group matcher 1) @@ -58,27 +64,29 @@ (defn read-regex [regex] (with-line (fn [file-name line-num column-num ^String line] + ;; (prn 'read-regex [file-name line-num column-num regex line]) (if-let [^String match (do ;; (prn '[regex line] [regex line]) - (re-find! regex line))] + (re-find! regex column-num line))] (let [;; _ (prn 'match match) match-length (.length match) - line* (.substring line match-length)] - (if (.isEmpty line*) - (&/V "Done" (&/V "lux;Meta" (&/T (&/T file-name line-num column-num) match))) - (&/V "Yes" (&/T (&/V "lux;Meta" (&/T (&/T file-name line-num column-num) match)) - (&/V "lux;Meta" (&/T (&/T file-name line-num (+ column-num match-length)) line*)))))) + column-num* (+ column-num match-length)] + (if (= column-num* (.length line)) + (&/V "Done" (&/T (&/T file-name line-num column-num) match)) + (&/V "Yes" (&/T (&/T (&/T file-name line-num column-num) match) + (&/T (&/T file-name line-num column-num*) line))))) (&/V "No" (str "[Reader Error] Pattern failed: " regex)))))) (defn read-regex2 [regex] (with-line (fn [file-name line-num column-num ^String line] - (if-let [[^String match tok1 tok2] (re-find3! regex line)] + ;; (prn 'read-regex2 [file-name line-num column-num regex line]) + (if-let [[^String match tok1 tok2] (re-find3! regex column-num line)] (let [match-length (.length match) - line* (.substring line match-length)] - (if (.isEmpty line*) - (&/V "Done" (&/V "lux;Meta" (&/T (&/T file-name line-num column-num) (&/T tok1 tok2)))) - (&/V "Yes" (&/T (&/V "lux;Meta" (&/T (&/T file-name line-num column-num) (&/T tok1 tok2))) - (&/V "lux;Meta" (&/T (&/T file-name line-num (+ column-num match-length)) line*)))))) + column-num* (+ column-num match-length)] + (if (= column-num* (.length line)) + (&/V "Done" (&/T (&/T file-name line-num column-num) (&/T tok1 tok2))) + (&/V "Yes" (&/T (&/T (&/T file-name line-num column-num) (&/T tok1 tok2)) + (&/T (&/T file-name line-num column-num*) line))))) (&/V "No" (str "[Reader Error] Pattern failed: " regex)))))) (defn read-regex+ [regex] @@ -90,37 +98,38 @@ [["lux;Nil" _]] (&/V "lux;Left" "[Reader Error] EOF") - [["lux;Cons" [[_ [[file-name line-num column-num] ^String line]] + [["lux;Cons" [[[file-name line-num column-num] ^String line] reader**]]] (if-let [^String match (do ;; (prn 'read-regex+ regex line) - (re-find1! regex line))] + (re-find1! regex column-num line))] (let [match-length (.length match) - line* (.substring line match-length)] - (if (.isEmpty line*) + column-num* (+ column-num match-length)] + (if (= column-num* (.length line)) (recur (str prefix match "\n") reader**) - (&/V "lux;Right" (&/T (&/|cons (&/V "lux;Meta" (&/T (&/T file-name line-num (+ column-num match-length)) line*)) + (&/V "lux;Right" (&/T (&/|cons (&/T (&/T file-name line-num column-num*) line) reader**) - (&/V "lux;Meta" (&/T (&/T file-name line-num column-num) (str prefix match))))))) + (&/T (&/T file-name line-num column-num) (str prefix match)))))) (&/V "lux;Left" (str "[Reader Error] Pattern failed: " regex)))))))) (defn read-text [^String text] (with-line (fn [file-name line-num column-num ^String line] - (if (.startsWith line text) + ;; (prn 'read-text [file-name line-num column-num text line]) + (if (.startsWith line text column-num) (let [match-length (.length text) - line* (.substring line match-length)] - (if (empty? line*) - (&/V "Done" (&/V "lux;Meta" (&/T (&/T file-name line-num column-num) text))) - (&/V "Yes" (&/T (&/V "lux;Meta" (&/T (&/T file-name line-num column-num) text)) - (&/V "lux;Meta" (&/T (&/T file-name line-num (+ column-num match-length)) line*)))))) + column-num* (+ column-num match-length)] + (if (= column-num* (.length line)) + (&/V "Done" (&/T (&/T file-name line-num column-num) text)) + (&/V "Yes" (&/T (&/T (&/T file-name line-num column-num) text) + (&/T (&/T file-name line-num column-num*) line))))) (&/V "No" (str "[Reader Error] Text failed: " text)))))) (defn from [file-name] (let [lines (&/->list (string/split-lines (slurp file-name)))] (&/|map (fn [line+line-num] (|let [[line-num line] line+line-num] - (&/V "lux;Meta" (&/T (&/T file-name line-num 0) - line)))) + (&/T (&/T file-name line-num 0) + line))) (&/|filter (fn [line+line-num] (|let [[line-num line] line+line-num] (not= "" line))) diff --git a/src/lux/type.clj b/src/lux/type.clj index 97b7c1bde..105528b8a 100644 --- a/src/lux/type.clj +++ b/src/lux/type.clj @@ -547,17 +547,28 @@ (def init-fixpoints (&/|list)) +(def counter (atom {})) (defn ^:private check* [fixpoints expected actual] + ;; (swap! counter update-in [[(aget expected 0) (aget actual 0)]] + ;; #(inc (or % 0))) (matchv ::M/objects [expected actual] [["lux;VarT" ?eid] ["lux;VarT" ?aid]] (if (= ?eid ?aid) (return (&/T fixpoints nil)) - (|do [ebound (&/try-all% (&/|list (|do [ebound (deref ?eid)] - (return (&/V "lux;Some" ebound))) - (return (&/V "lux;None" nil)))) - abound (&/try-all% (&/|list (|do [abound (deref ?aid)] - (return (&/V "lux;Some" abound))) - (return (&/V "lux;None" nil))))] + (|do [ebound (fn [state] + (matchv ::M/objects [((deref ?eid) state)] + [["lux;Right" [state* ebound]]] + (return* state* (&/V "lux;Some" ebound)) + + [["lux;Left" _]] + (return* state (&/V "lux;None" nil)))) + abound (fn [state] + (matchv ::M/objects [((deref ?aid) state)] + [["lux;Right" [state* abound]]] + (return* state* (&/V "lux;Some" abound)) + + [["lux;Left" _]] + (return* state (&/V "lux;None" nil))))] (matchv ::M/objects [ebound abound] [["lux;None" _] ["lux;None" _]] (|do [_ (set-var ?eid actual)] @@ -573,39 +584,75 @@ (check* fixpoints etype atype)))) [["lux;VarT" ?id] _] - (&/try-all% (&/|list (|do [_ (set-var ?id actual)] - (return (&/T fixpoints nil))) - (|do [bound (deref ?id)] - (check* fixpoints bound actual)))) + (fn [state] + (matchv ::M/objects [((set-var ?id actual) state)] + [["lux;Right" [state* _]]] + (return* state* (&/T fixpoints nil)) + + [["lux;Left" _]] + ((|do [bound (deref ?id)] + (check* fixpoints bound actual)) + state))) [_ ["lux;VarT" ?id]] - (&/try-all% (&/|list (|do [_ (set-var ?id expected)] - (return (&/T fixpoints nil))) - (|do [bound (deref ?id)] - (check* fixpoints expected bound)))) + (fn [state] + (matchv ::M/objects [((set-var ?id expected) state)] + [["lux;Right" [state* _]]] + (return* state* (&/T fixpoints nil)) + + [["lux;Left" _]] + ((|do [bound (deref ?id)] + (check* fixpoints expected bound)) + state))) [["lux;AppT" [["lux;VarT" ?eid] A1]] ["lux;AppT" [["lux;VarT" ?aid] A2]]] - (&/try-all% (&/|list (|do [F1 (deref ?eid)] - (&/try-all% (&/|list (|do [F2 (deref ?aid)] - (check* fixpoints (&/V "lux;AppT" (&/T F1 A1)) (&/V "lux;AppT" (&/T F2 A2)))) - (check* fixpoints (&/V "lux;AppT" (&/T F1 A1)) actual)))) - (|do [F2 (deref ?aid)] - (check* fixpoints expected (&/V "lux;AppT" (&/T F2 A2)))) - (|do [[fixpoints* _] (check* fixpoints (&/V "lux;VarT" ?eid) (&/V "lux;VarT" ?aid)) - [fixpoints** _] (check* fixpoints* A1 A2)] - (return (&/T fixpoints** nil))))) + (fn [state] + (matchv ::M/objects [((|do [F1 (deref ?eid)] + (fn [state] + (matchv ::M/objects [((|do [F2 (deref ?aid)] + (check* fixpoints (&/V "lux;AppT" (&/T F1 A1)) (&/V "lux;AppT" (&/T F2 A2)))) + state)] + [["lux;Right" [state* output]]] + (return* state* output) + + [["lux;Left" _]] + ((check* fixpoints (&/V "lux;AppT" (&/T F1 A1)) actual) + state)))) + state)] + [["lux;Right" [state* output]]] + (return* state* output) + + [["lux;Left" _]] + (matchv ::M/objects [((|do [F2 (deref ?aid)] + (check* fixpoints expected (&/V "lux;AppT" (&/T F2 A2)))) + state)] + [["lux;Right" [state* output]]] + (return* state* output) + + [["lux;Left" _]] + ((|do [[fixpoints* _] (check* fixpoints (&/V "lux;VarT" ?eid) (&/V "lux;VarT" ?aid)) + [fixpoints** _] (check* fixpoints* A1 A2)] + (return (&/T fixpoints** nil))) + state)))) ;; (|do [_ (check* fixpoints (&/V "lux;VarT" ?eid) (&/V "lux;VarT" ?aid)) ;; _ (check* fixpoints A1 A2)] ;; (return (&/T fixpoints nil))) [["lux;AppT" [["lux;VarT" ?id] A1]] ["lux;AppT" [F2 A2]]] - (&/try-all% (&/|list (|do [F1 (deref ?id)] - (check* fixpoints (&/V "lux;AppT" (&/T F1 A1)) actual)) - (|do [[fixpoints* _] (check* fixpoints (&/V "lux;VarT" ?id) F2) - e* (apply-type F2 A1) - a* (apply-type F2 A2) - [fixpoints** _] (check* fixpoints* e* a*)] - (return (&/T fixpoints** nil))))) + (fn [state] + (matchv ::M/objects [((|do [F1 (deref ?id)] + (check* fixpoints (&/V "lux;AppT" (&/T F1 A1)) actual)) + state)] + [["lux;Right" [state* output]]] + (return* state* output) + + [["lux;Left" _]] + ((|do [[fixpoints* _] (check* fixpoints (&/V "lux;VarT" ?id) F2) + e* (apply-type F2 A1) + a* (apply-type F2 A2) + [fixpoints** _] (check* fixpoints* e* a*)] + (return (&/T fixpoints** nil))) + state))) ;; [["lux;AppT" [["lux;VarT" ?id] A1]] ["lux;AppT" [F2 A2]]] ;; (|do [[fixpoints* _] (check* fixpoints (&/V "lux;VarT" ?id) F2) ;; e* (apply-type F2 A1) @@ -614,13 +661,20 @@ ;; (return (&/T fixpoints** nil))) [["lux;AppT" [F1 A1]] ["lux;AppT" [["lux;VarT" ?id] A2]]] - (&/try-all% (&/|list (|do [F2 (deref ?id)] - (check* fixpoints expected (&/V "lux;AppT" (&/T F2 A2)))) - (|do [[fixpoints* _] (check* fixpoints F1 (&/V "lux;VarT" ?id)) - e* (apply-type F1 A1) - a* (apply-type F1 A2) - [fixpoints** _] (check* fixpoints* e* a*)] - (return (&/T fixpoints** nil))))) + (fn [state] + (matchv ::M/objects [((|do [F2 (deref ?id)] + (check* fixpoints expected (&/V "lux;AppT" (&/T F2 A2)))) + state)] + [["lux;Right" [state* output]]] + (return* state* output) + + [["lux;Left" _]] + ((|do [[fixpoints* _] (check* fixpoints F1 (&/V "lux;VarT" ?id)) + e* (apply-type F1 A1) + a* (apply-type F1 A2) + [fixpoints** _] (check* fixpoints* e* a*)] + (return (&/T fixpoints** nil))) + state))) ;; [["lux;AppT" [F1 A1]] ["lux;AppT" [["lux;VarT" ?id] A2]]] ;; (|do [[fixpoints* _] (check* fixpoints F1 (&/V "lux;VarT" ?id)) ;; e* (apply-type F1 A1) -- cgit v1.2.3 From 1f0be2351bc76b0de15d97691f8ea0728d9ab321 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Fri, 22 May 2015 23:06:19 -0400 Subject: - Added a simple optimization based on the idea of avoiding to compare 2 type-functions which are most-likely the same, due to their name (remembering that when you define types using deftype, the type-function's name will correspond to the def's). - Gave empty environments to top-level type-functions, instead of leaving them with unset environments. --- src/lux/type.clj | 68 +++++++++++++++++++++++++++++--------------------------- 1 file changed, 35 insertions(+), 33 deletions(-) (limited to 'src') diff --git a/src/lux/type.clj b/src/lux/type.clj index 105528b8a..a2cf83624 100644 --- a/src/lux/type.clj +++ b/src/lux/type.clj @@ -16,14 +16,14 @@ (def $Void (&/V "lux;VariantT" (&/|list))) (def List - (&/V "lux;AllT" (&/T (&/V "lux;None" nil) "List" "a" + (&/V "lux;AllT" (&/T (&/V "lux;Some" (&/V "lux;Nil" nil)) "lux;List" "a" (&/V "lux;VariantT" (&/|list (&/T "lux;Nil" Unit) (&/T "lux;Cons" (&/V "lux;TupleT" (&/|list (&/V "lux;BoundT" "a") - (&/V "lux;AppT" (&/T (&/V "lux;BoundT" "List") + (&/V "lux;AppT" (&/T (&/V "lux;BoundT" "lux;List") (&/V "lux;BoundT" "a"))))))))))) (def Maybe - (&/V "lux;AllT" (&/T (&/V "lux;None" nil) "Maybe" "a" + (&/V "lux;AllT" (&/T (&/V "lux;Some" (&/V "lux;Nil" nil)) "lux;Maybe" "a" (&/V "lux;VariantT" (&/|list (&/T "lux;None" Unit) (&/T "lux;Some" (&/V "lux;BoundT" "a"))))))) @@ -31,7 +31,7 @@ (let [Type (&/V "lux;AppT" (&/T (&/V "lux;BoundT" "Type") (&/V "lux;BoundT" "_"))) TypeEnv (&/V "lux;AppT" (&/T List (&/V "lux;TupleT" (&/|list Text Type)))) TypePair (&/V "lux;TupleT" (&/|list Type Type))] - (&/V "lux;AppT" (&/T (&/V "lux;AllT" (&/T (&/V "lux;None" nil) "Type" "_" + (&/V "lux;AppT" (&/T (&/V "lux;AllT" (&/T (&/V "lux;Some" (&/V "lux;Nil" nil)) "Type" "_" (&/V "lux;VariantT" (&/|list (&/T "lux;DataT" Text) (&/T "lux;TupleT" (&/V "lux;AppT" (&/T List Type))) (&/T "lux;VariantT" TypeEnv) @@ -49,7 +49,7 @@ (&/V "lux;AllT" (&/T (&/V "lux;None" nil) name arg body))) (def Bindings - (fAll "Bindings" "k" + (fAll "lux;Bindings" "k" (fAll "" "v" (&/V "lux;RecordT" (&/|list (&/T "lux;counter" Int) (&/T "lux;mappings" (&/V "lux;AppT" (&/T List @@ -59,7 +59,7 @@ (def Env (let [bindings (&/V "lux;AppT" (&/T (&/V "lux;AppT" (&/T Bindings (&/V "lux;BoundT" "k"))) (&/V "lux;BoundT" "v")))] - (fAll "Env" "k" + (fAll "lux;Env" "k" (fAll "" "v" (&/V "lux;RecordT" (&/|list (&/T "lux;name" Text) @@ -72,7 +72,7 @@ (&/V "lux;TupleT" (&/|list Text Int Int))) (def Meta - (fAll "Meta" "m" + (fAll "lux;Meta" "m" (fAll "" "v" (&/V "lux;VariantT" (&/|list (&/T "lux;Meta" (&/V "lux;TupleT" (&/|list (&/V "lux;BoundT" "m") (&/V "lux;BoundT" "v"))))))))) @@ -81,10 +81,10 @@ (def Syntax* (let [Syntax* (&/V "lux;AppT" (&/T (&/V "lux;BoundT" "w") - (&/V "lux;AppT" (&/T (&/V "lux;BoundT" "Syntax'") + (&/V "lux;AppT" (&/T (&/V "lux;BoundT" "lux;Syntax'") (&/V "lux;BoundT" "w"))))) Syntax*List (&/V "lux;AppT" (&/T List Syntax*))] - (fAll "Syntax'" "w" + (fAll "lux;Syntax'" "w" (&/V "lux;VariantT" (&/|list (&/T "lux;BoolS" Bool) (&/T "lux;IntS" Int) (&/T "lux;RealS" Real) @@ -104,13 +104,13 @@ (def ^:private SyntaxList (&/V "lux;AppT" (&/T List Syntax))) (def Either - (fAll "_" "l" + (fAll "lux;Either" "l" (fAll "" "r" (&/V "lux;VariantT" (&/|list (&/T "lux;Left" (&/V "lux;BoundT" "l")) (&/T "lux;Right" (&/V "lux;BoundT" "r"))))))) (def StateE - (fAll "StateE" "s" + (fAll "lux;StateE" "s" (fAll "" "a" (&/V "lux;LambdaT" (&/T (&/V "lux;BoundT" "s") (&/V "lux;AppT" (&/T (&/V "lux;AppT" (&/T Either Text)) @@ -129,7 +129,7 @@ ))) (def DefData* - (fAll "DefData'" "" + (fAll "lux;DefData'" "" (&/V "lux;VariantT" (&/|list (&/T "lux;TypeD" Unit) (&/T "lux;ValueD" Type) (&/T "lux;MacroD" (&/V "lux;BoundT" "")) @@ -139,8 +139,8 @@ (&/V "lux;VariantT" (&/|list (&/T "lux;Local" Int) (&/T "lux;Global" Ident)))) -(def CompilerState - (&/V "lux;AppT" (&/T (fAll "CompilerState" "" +(def $Compiler + (&/V "lux;AppT" (&/T (fAll "lux;Compiler" "" (&/V "lux;RecordT" (&/|list (&/T "lux;source" Reader) (&/T "lux;modules" (&/V "lux;AppT" (&/T List (&/V "lux;TupleT" @@ -150,7 +150,7 @@ (&/V "lux;TupleT" (&/|list Bool (&/V "lux;AppT" (&/T DefData* (&/V "lux;LambdaT" (&/T SyntaxList - (&/V "lux;AppT" (&/T (&/V "lux;AppT" (&/T StateE (&/V "lux;AppT" (&/T (&/V "lux;BoundT" "CompilerState") + (&/V "lux;AppT" (&/T (&/V "lux;AppT" (&/T StateE (&/V "lux;AppT" (&/T (&/V "lux;BoundT" "lux;Compiler") (&/V "lux;BoundT" ""))))) SyntaxList))))))))))))))))) (&/T "lux;module-aliases" (&/V "lux;AppT" (&/T List $Void))) @@ -164,7 +164,7 @@ (def Macro (&/V "lux;LambdaT" (&/T SyntaxList - (&/V "lux;AppT" (&/T (&/V "lux;AppT" (&/T StateE CompilerState)) + (&/V "lux;AppT" (&/T (&/V "lux;AppT" (&/T StateE $Compiler)) SyntaxList))))) (defn bound? [id] @@ -433,23 +433,25 @@ (and (type= xlambda ylambda) (type= xparam yparam)) [["lux;AllT" [xenv xname xarg xbody]] ["lux;AllT" [yenv yname yarg ybody]]] - (and (= xname yname) - (= xarg yarg) - ;; (matchv ::M/objects [xenv yenv] - ;; [["lux;None" _] ["lux;None" _]] - ;; true - - ;; [["lux;Some" xenv*] ["lux;Some" yenv*]] - ;; (&/fold (fn [old bname] - ;; (and old - ;; (type= (&/|get bname xenv*) (&/|get bname yenv*)))) - ;; (= (&/|length xenv*) (&/|length yenv*)) - ;; (&/|keys xenv*)) - - ;; [_ _] - ;; false) - (type= xbody ybody) - ) + (or (and (not= "" xname) + (= xname yname)) + (and (= xname yname) + (= xarg yarg) + ;; (matchv ::M/objects [xenv yenv] + ;; [["lux;None" _] ["lux;None" _]] + ;; true + + ;; [["lux;Some" xenv*] ["lux;Some" yenv*]] + ;; (&/fold (fn [old bname] + ;; (and old + ;; (type= (&/|get bname xenv*) (&/|get bname yenv*)))) + ;; (= (&/|length xenv*) (&/|length yenv*)) + ;; (&/|keys xenv*)) + + ;; [_ _] + ;; false) + (type= xbody ybody) + )) [_ _] false -- cgit v1.2.3 From e86b31726a19b0706f3618467775ba8ce6030393 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sun, 24 May 2015 18:55:08 -0400 Subject: - Cleaned-up a few things in lux.lux - Replace most instances of "=" with ".equals". - Added an optimization to lux.type/type= that drastically speeds-up type comparisons. --- src/lux/analyser.clj | 2 +- src/lux/analyser/base.clj | 2 +- src/lux/analyser/case.clj | 10 +- src/lux/analyser/lux.clj | 8 +- src/lux/analyser/module.clj | 2 +- src/lux/base.clj | 14 +- src/lux/compiler.clj | 2 +- src/lux/host.clj | 12 +- src/lux/lexer.clj | 19 +- src/lux/type.clj | 591 ++++++++++++++++++++++---------------------- 10 files changed, 332 insertions(+), 330 deletions(-) (limited to 'src') diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj index 3c5c5c956..ba0fe4e66 100644 --- a/src/lux/analyser.clj +++ b/src/lux/analyser.clj @@ -514,7 +514,7 @@ (defn ^:private analyse-ast [eval! exo-type token] (matchv ::M/objects [token] [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;TagS" ?ident]]] ?values]]]]]] - (do (assert (= 1 (&/|length ?values)) "[Analyser Error] Can only tag 1 value.") + (do (assert (.equals ^Object (&/|length ?values) 1) "[Analyser Error] Can only tag 1 value.") (&&lux/analyse-variant (partial analyse-ast eval!) exo-type ?ident (&/|head ?values))) [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [?fn ?args]]]]]] diff --git a/src/lux/analyser/base.clj b/src/lux/analyser/base.clj index a4c96c350..11e92f7b7 100644 --- a/src/lux/analyser/base.clj +++ b/src/lux/analyser/base.clj @@ -21,7 +21,7 @@ (defn resolved-ident [ident] (|let [[?module ?name] ident] - (|do [module* (if (= "" ?module) + (|do [module* (if (.equals "" ?module) &/get-module-name (return ?module))] (return (&/ident->text (&/T module* ?name)))))) diff --git a/src/lux/analyser/case.clj b/src/lux/analyser/case.clj index f27a541ee..43e5ee5e7 100644 --- a/src/lux/analyser/case.clj +++ b/src/lux/analyser/case.clj @@ -56,7 +56,7 @@ [["lux;TupleS" ?members]] (matchv ::M/objects [value-type] [["lux;TupleT" ?member-types]] - (if (not (= (&/|length ?member-types) (&/|length ?members))) + (if (not (.equals ^Object (&/|length ?member-types) (&/|length ?members))) (fail (str "[Analyser error] Pattern-matching mismatch. Require tuple[" (&/|length ?member-types) "]. Given tuple [" (&/|length ?members) "]")) (|do [[=tests =kont] (&/fold (fn [kont* vm] (|let [[v m] vm] @@ -74,7 +74,7 @@ (|do [value-type* (resolve-type value-type)] (matchv ::M/objects [value-type*] [["lux;RecordT" ?slot-types]] - (if (not (= (&/|length ?slot-types) (&/|length ?slots))) + (if (not (.equals ^Object (&/|length ?slot-types) (&/|length ?slots))) (fail (str "[Analyser error] Pattern-matching mismatch. Require record[" (&/|length ?slot-types) "]. Given record[" (&/|length ?slots) "]")) (|do [[=tests =kont] (&/fold (fn [kont* slot] (|let [[sn sv] slot] @@ -168,7 +168,7 @@ (return (&/V "TupleTotal" (&/T total? structs)))) [["TupleTotal" [total? ?values]] ["TupleTestAC" ?tests]] - (if (= (&/|length ?values) (&/|length ?tests)) + (if (.equals ^Object (&/|length ?values) (&/|length ?tests)) (|do [structs (&/map2% (fn [v t] (merge-total v (&/T t ?body))) ?values ?tests)] @@ -187,11 +187,11 @@ (return (&/V "RecordTotal" (&/T total? structs)))) [["RecordTotal" [total? ?values]] ["RecordTestAC" ?tests]] - (if (= (&/|length ?values) (&/|length ?tests)) + (if (.equals ^Object (&/|length ?values) (&/|length ?tests)) (|do [structs (&/map2% (fn [left right] (|let [[lslot sub-struct] left [rslot value]right] - (if (= lslot rslot) + (if (.equals ^Object lslot rslot) (|do [sub-struct* (merge-total sub-struct (&/T value ?body))] (return (&/T lslot sub-struct*))) (fail "[Pattern-matching error] Record slots mismatch.")))) diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj index 7600f34ff..dff936fbe 100644 --- a/src/lux/analyser/lux.clj +++ b/src/lux/analyser/lux.clj @@ -110,7 +110,7 @@ [inner outer] (&/|split-with no-binding? stack)] (matchv ::M/objects [outer] [["lux;Nil" _]] - ((|do [[[r-module r-name] $def] (&&module/find-def (if (= "" ?module) module-name ?module) + ((|do [[[r-module r-name] $def] (&&module/find-def (if (.equals "" ?module) module-name ?module) ?name) endo-type (matchv ::M/objects [$def] [["lux;ValueD" ?type]] @@ -121,7 +121,8 @@ [["lux;TypeD" _]] (return &type/Type)) - _ (if (and (= &type/Type endo-type) (= &type/Type exo-type)) + _ (if (and (clojure.lang.Util/identical &type/Type endo-type) + (clojure.lang.Util/identical &type/Type exo-type)) (return nil) (&type/check exo-type endo-type))] (return (&/|list (&/T (&/V "lux;Global" (&/T r-module r-name)) @@ -142,7 +143,8 @@ [["lux;TypeD" _]] (return &type/Type)) - _ (if (and (= &type/Type endo-type) (= &type/Type exo-type)) + _ (if (and (clojure.lang.Util/identical &type/Type endo-type) + (clojure.lang.Util/identical &type/Type exo-type)) (return nil) (&type/check exo-type endo-type))] (return (&/|list (&/T (&/V "lux;Global" (&/T r-module r-name)) diff --git a/src/lux/analyser/module.clj b/src/lux/analyser/module.clj index f36dc044a..f882f1275 100644 --- a/src/lux/analyser/module.clj +++ b/src/lux/analyser/module.clj @@ -68,7 +68,7 @@ (if-let [$def (&/|get name $module)] (matchv ::M/objects [$def] [[exported? $$def]] - (if (or exported? (= current-module module)) + (if (or exported? (.equals ^Object current-module module)) (matchv ::M/objects [$$def] [["lux;AliasD" [?r-module ?r-name]]] ((find-def ?r-module ?r-name) diff --git a/src/lux/base.clj b/src/lux/base.clj index edf6781ea..7f551cdb0 100644 --- a/src/lux/base.clj +++ b/src/lux/base.clj @@ -85,7 +85,7 @@ nil [["lux;Cons" [[k v] table*]]] - (if (= k slot) + (if (.equals ^Object k slot) v (|get slot table*)))) @@ -95,7 +95,7 @@ (V "lux;Cons" (T (T slot value) (V "lux;Nil" nil))) [["lux;Cons" [[k v] table*]]] - (if (= k slot) + (if (.equals ^Object k slot) (V "lux;Cons" (T (T slot value) table*)) (V "lux;Cons" (T (T k v) (|put slot value table*)))))) @@ -105,7 +105,7 @@ table [["lux;Cons" [[k v] table*]]] - (if (= k slot) + (if (.equals ^Object k slot) table* (V "lux;Cons" (T (T k v) (|remove slot table*)))))) @@ -115,7 +115,7 @@ table [["lux;Cons" [[k* v] table*]]] - (if (= k k*) + (if (.equals ^Object k k*) (V "lux;Cons" (T (T k* (f v)) table*)) (V "lux;Cons" (T (T k* v) (|update k f table*)))))) @@ -233,7 +233,7 @@ false [["lux;Cons" [[k* _] table*]]] - (or (= k k*) + (or (.equals ^Object k k*) (|contains? k table*)))) (defn fold [f init xs] @@ -384,7 +384,7 @@ ((exhaust% step) state*) [["lux;Left" msg]] - (if (= "[Reader Error] EOF" msg) + (if (.equals "[Reader Error] EOF" msg) (return* state nil) (fail* msg))))) @@ -570,7 +570,7 @@ (str "#" ?module ";" ?tag) [["lux;Meta" [_ ["lux;SymbolS" [?module ?ident]]]]] - (if (= "" ?module) + (if (.equals "" ?module) ?ident (str ?module ";" ?ident)) diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj index 6fb9e2c6d..e491fbdfe 100644 --- a/src/lux/compiler.clj +++ b/src/lux/compiler.clj @@ -346,7 +346,7 @@ (defn ^:private compile-module [name] (fn [state] (if (->> state (&/get$ &/$MODULES) (&/|contains? name)) - (if (= name "lux") + (if (.equals ^Object name "lux") (return* state nil) (fail* "[Compiler Error] Can't redefine a module!")) (let [=class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS) diff --git a/src/lux/host.clj b/src/lux/host.clj index 77687dbef..8817ea338 100644 --- a/src/lux/host.clj +++ b/src/lux/host.clj @@ -18,7 +18,7 @@ (str (.getName pkg) ".") "") (.getSimpleName class)))] - (if (= "void" base) + (if (.equals "void" base) (return &type/$Void) (return (&/V "lux;DataT" (str (reduce str "" (repeat (int (/ (count arr-level) 2)) "[")) base))) @@ -78,8 +78,8 @@ (do-template [ ] (defn [target field] (if-let [type* (first (for [^Field =field (.getDeclaredFields (Class/forName target)) - :when (and (= field (.getName =field)) - (= (Modifier/isStatic (.getModifiers =field))))] + :when (and (.equals ^Object field (.getName =field)) + (.equals ^Object (Modifier/isStatic (.getModifiers =field))))] (.getType =field)))] (|do [=type (class->type type*)] (return =type)) @@ -92,9 +92,9 @@ (do-template [ ] (defn [target method-name args] (if-let [method (first (for [^Method =method (.getDeclaredMethods (Class/forName target)) - :when (and (= method-name (.getName =method)) - (= (Modifier/isStatic (.getModifiers =method))) - (&/fold2 #(and %1 (= %2 %3)) + :when (and (.equals ^Object method-name (.getName =method)) + (.equals ^Object (Modifier/isStatic (.getModifiers =method))) + (&/fold2 #(and %1 (.equals ^Object %2 %3)) true args (&/|map #(.getName ^Class %) (&/->list (seq (.getParameterTypes =method))))))] diff --git a/src/lux/lexer.clj b/src/lux/lexer.clj index d2ab4a5d7..a137ca863 100644 --- a/src/lux/lexer.clj +++ b/src/lux/lexer.clj @@ -6,16 +6,15 @@ ;; [Utils] (defn ^:private escape-char [escaped] - (condp = escaped - "\\t" (return "\t") - "\\b" (return "\b") - "\\n" (return "\n") - "\\r" (return "\r") - "\\f" (return "\f") - "\\\"" (return "\"") - "\\\\" (return "\\") - ;; else - (fail (str "[Lexer Error] Unknown escape character: " escaped)))) + (cond (.equals ^Object escaped "\\t") (return "\t") + (.equals ^Object escaped "\\b") (return "\b") + (.equals ^Object escaped "\\n") (return "\n") + (.equals ^Object escaped "\\r") (return "\r") + (.equals ^Object escaped "\\f") (return "\f") + (.equals ^Object escaped "\\\"") (return "\"") + (.equals ^Object escaped "\\\\") (return "\\") + :else + (fail (str "[Lexer Error] Unknown escape character: " escaped)))) (defn ^:private lex-text-body [_] (&/try-all% (&/|list (|do [[_ [prefix escaped]] (&reader/read-regex2 #"(?s)^([^\"\\]*)(\\.)") diff --git a/src/lux/type.clj b/src/lux/type.clj index a2cf83624..25e3e1053 100644 --- a/src/lux/type.clj +++ b/src/lux/type.clj @@ -228,7 +228,7 @@ (fn [state] ((|do [mappings* (&/map% (fn [binding] (|let [[?id ?type] binding] - (if (= id ?id) + (if (.equals ^Object id ?id) (return binding) (matchv ::M/objects [?type] [["lux;None" _]] @@ -237,7 +237,7 @@ [["lux;Some" ?type*]] (matchv ::M/objects [?type*] [["lux;VarT" ?id*]] - (if (= id ?id*) + (if (.equals ^Object id ?id*) (return (&/T ?id (&/V "lux;None" nil))) (return binding)) @@ -269,7 +269,7 @@ (defn ^:private clean* [?tid type] (matchv ::M/objects [type] [["lux;VarT" ?id]] - (if (= ?tid ?id) + (if (.equals ^Object ?tid ?id) (deref ?id) (return type)) @@ -390,53 +390,52 @@ )) (defn type= [x y] - (let [output (matchv ::M/objects [x y] - [["lux;DataT" xname] ["lux;DataT" yname]] - (= xname yname) - - [["lux;TupleT" xelems] ["lux;TupleT" yelems]] - (&/fold2 (fn [old x y] - (and old (type= x y))) - true - xelems yelems) - - [["lux;VariantT" xcases] ["lux;VariantT" ycases]] - (&/fold2 (fn [old xcase ycase] - (|let [[xname xtype] xcase - [yname ytype] ycase] - (and old (= xname yname) (type= xtype ytype)))) - true - xcases ycases) - - [["lux;RecordT" xslots] ["lux;RecordT" yslots]] - (&/fold2 (fn [old xslot yslot] - (|let [[xname xtype] xslot - [yname ytype] yslot] - (and old (= xname yname) (type= xtype ytype)))) - true - xslots yslots) - - [["lux;LambdaT" [xinput xoutput]] ["lux;LambdaT" [yinput youtput]]] - (and (type= xinput yinput) - (type= xoutput youtput)) - - [["lux;VarT" xid] ["lux;VarT" yid]] - (= xid yid) - - [["lux;BoundT" xname] ["lux;BoundT" yname]] - (= xname yname) - - [["lux;ExT" xid] ["lux;ExT" yid]] - (= xid yid) - - [["lux;AppT" [xlambda xparam]] ["lux;AppT" [ylambda yparam]]] - (and (type= xlambda ylambda) (type= xparam yparam)) - - [["lux;AllT" [xenv xname xarg xbody]] ["lux;AllT" [yenv yname yarg ybody]]] - (or (and (not= "" xname) - (= xname yname)) - (and (= xname yname) - (= xarg yarg) + (or (clojure.lang.Util/identical x y) + (let [output (matchv ::M/objects [x y] + [["lux;DataT" xname] ["lux;DataT" yname]] + (.equals ^Object xname yname) + + [["lux;TupleT" xelems] ["lux;TupleT" yelems]] + (&/fold2 (fn [old x y] + (and old (type= x y))) + true + xelems yelems) + + [["lux;VariantT" xcases] ["lux;VariantT" ycases]] + (&/fold2 (fn [old xcase ycase] + (|let [[xname xtype] xcase + [yname ytype] ycase] + (and old (.equals ^Object xname yname) (type= xtype ytype)))) + true + xcases ycases) + + [["lux;RecordT" xslots] ["lux;RecordT" yslots]] + (&/fold2 (fn [old xslot yslot] + (|let [[xname xtype] xslot + [yname ytype] yslot] + (and old (.equals ^Object xname yname) (type= xtype ytype)))) + true + xslots yslots) + + [["lux;LambdaT" [xinput xoutput]] ["lux;LambdaT" [yinput youtput]]] + (and (type= xinput yinput) + (type= xoutput youtput)) + + [["lux;VarT" xid] ["lux;VarT" yid]] + (.equals ^Object xid yid) + + [["lux;BoundT" xname] ["lux;BoundT" yname]] + (.equals ^Object xname yname) + + [["lux;ExT" xid] ["lux;ExT" yid]] + (.equals ^Object xid yid) + + [["lux;AppT" [xlambda xparam]] ["lux;AppT" [ylambda yparam]]] + (and (type= xlambda ylambda) (type= xparam yparam)) + + [["lux;AllT" [xenv xname xarg xbody]] ["lux;AllT" [yenv yname yarg ybody]]] + (and (.equals ^Object xname yname) + (.equals ^Object xarg yarg) ;; (matchv ::M/objects [xenv yenv] ;; [["lux;None" _] ["lux;None" _]] ;; true @@ -451,12 +450,12 @@ ;; [_ _] ;; false) (type= xbody ybody) - )) + ) - [_ _] - false - )] - output)) + [_ _] + false + )] + output))) (defn ^:private fp-get [k fixpoints] (|let [[e a] k] @@ -553,272 +552,274 @@ (defn ^:private check* [fixpoints expected actual] ;; (swap! counter update-in [[(aget expected 0) (aget actual 0)]] ;; #(inc (or % 0))) - (matchv ::M/objects [expected actual] - [["lux;VarT" ?eid] ["lux;VarT" ?aid]] - (if (= ?eid ?aid) - (return (&/T fixpoints nil)) - (|do [ebound (fn [state] - (matchv ::M/objects [((deref ?eid) state)] - [["lux;Right" [state* ebound]]] - (return* state* (&/V "lux;Some" ebound)) - - [["lux;Left" _]] - (return* state (&/V "lux;None" nil)))) - abound (fn [state] - (matchv ::M/objects [((deref ?aid) state)] - [["lux;Right" [state* abound]]] - (return* state* (&/V "lux;Some" abound)) - - [["lux;Left" _]] - (return* state (&/V "lux;None" nil))))] - (matchv ::M/objects [ebound abound] - [["lux;None" _] ["lux;None" _]] - (|do [_ (set-var ?eid actual)] - (return (&/T fixpoints nil))) - - [["lux;Some" etype] ["lux;None" _]] - (check* fixpoints etype actual) - - [["lux;None" _] ["lux;Some" atype]] - (check* fixpoints expected atype) - - [["lux;Some" etype] ["lux;Some" atype]] - (check* fixpoints etype atype)))) - - [["lux;VarT" ?id] _] - (fn [state] - (matchv ::M/objects [((set-var ?id actual) state)] - [["lux;Right" [state* _]]] - (return* state* (&/T fixpoints nil)) - - [["lux;Left" _]] - ((|do [bound (deref ?id)] - (check* fixpoints bound actual)) - state))) - - [_ ["lux;VarT" ?id]] - (fn [state] - (matchv ::M/objects [((set-var ?id expected) state)] - [["lux;Right" [state* _]]] - (return* state* (&/T fixpoints nil)) + (if (clojure.lang.Util/identical expected actual) + (return (&/T fixpoints nil)) + (matchv ::M/objects [expected actual] + [["lux;VarT" ?eid] ["lux;VarT" ?aid]] + (if (.equals ^Object ?eid ?aid) + (return (&/T fixpoints nil)) + (|do [ebound (fn [state] + (matchv ::M/objects [((deref ?eid) state)] + [["lux;Right" [state* ebound]]] + (return* state* (&/V "lux;Some" ebound)) + + [["lux;Left" _]] + (return* state (&/V "lux;None" nil)))) + abound (fn [state] + (matchv ::M/objects [((deref ?aid) state)] + [["lux;Right" [state* abound]]] + (return* state* (&/V "lux;Some" abound)) + + [["lux;Left" _]] + (return* state (&/V "lux;None" nil))))] + (matchv ::M/objects [ebound abound] + [["lux;None" _] ["lux;None" _]] + (|do [_ (set-var ?eid actual)] + (return (&/T fixpoints nil))) + + [["lux;Some" etype] ["lux;None" _]] + (check* fixpoints etype actual) + + [["lux;None" _] ["lux;Some" atype]] + (check* fixpoints expected atype) + + [["lux;Some" etype] ["lux;Some" atype]] + (check* fixpoints etype atype)))) + + [["lux;VarT" ?id] _] + (fn [state] + (matchv ::M/objects [((set-var ?id actual) state)] + [["lux;Right" [state* _]]] + (return* state* (&/T fixpoints nil)) - [["lux;Left" _]] - ((|do [bound (deref ?id)] - (check* fixpoints expected bound)) - state))) + [["lux;Left" _]] + ((|do [bound (deref ?id)] + (check* fixpoints bound actual)) + state))) + + [_ ["lux;VarT" ?id]] + (fn [state] + (matchv ::M/objects [((set-var ?id expected) state)] + [["lux;Right" [state* _]]] + (return* state* (&/T fixpoints nil)) - [["lux;AppT" [["lux;VarT" ?eid] A1]] ["lux;AppT" [["lux;VarT" ?aid] A2]]] - (fn [state] - (matchv ::M/objects [((|do [F1 (deref ?eid)] - (fn [state] - (matchv ::M/objects [((|do [F2 (deref ?aid)] - (check* fixpoints (&/V "lux;AppT" (&/T F1 A1)) (&/V "lux;AppT" (&/T F2 A2)))) - state)] - [["lux;Right" [state* output]]] - (return* state* output) - - [["lux;Left" _]] - ((check* fixpoints (&/V "lux;AppT" (&/T F1 A1)) actual) - state)))) - state)] - [["lux;Right" [state* output]]] - (return* state* output) - - [["lux;Left" _]] - (matchv ::M/objects [((|do [F2 (deref ?aid)] - (check* fixpoints expected (&/V "lux;AppT" (&/T F2 A2)))) + [["lux;Left" _]] + ((|do [bound (deref ?id)] + (check* fixpoints expected bound)) + state))) + + [["lux;AppT" [["lux;VarT" ?eid] A1]] ["lux;AppT" [["lux;VarT" ?aid] A2]]] + (fn [state] + (matchv ::M/objects [((|do [F1 (deref ?eid)] + (fn [state] + (matchv ::M/objects [((|do [F2 (deref ?aid)] + (check* fixpoints (&/V "lux;AppT" (&/T F1 A1)) (&/V "lux;AppT" (&/T F2 A2)))) + state)] + [["lux;Right" [state* output]]] + (return* state* output) + + [["lux;Left" _]] + ((check* fixpoints (&/V "lux;AppT" (&/T F1 A1)) actual) + state)))) state)] [["lux;Right" [state* output]]] (return* state* output) [["lux;Left" _]] - ((|do [[fixpoints* _] (check* fixpoints (&/V "lux;VarT" ?eid) (&/V "lux;VarT" ?aid)) - [fixpoints** _] (check* fixpoints* A1 A2)] - (return (&/T fixpoints** nil))) - state)))) - ;; (|do [_ (check* fixpoints (&/V "lux;VarT" ?eid) (&/V "lux;VarT" ?aid)) - ;; _ (check* fixpoints A1 A2)] - ;; (return (&/T fixpoints nil))) - - [["lux;AppT" [["lux;VarT" ?id] A1]] ["lux;AppT" [F2 A2]]] - (fn [state] - (matchv ::M/objects [((|do [F1 (deref ?id)] - (check* fixpoints (&/V "lux;AppT" (&/T F1 A1)) actual)) - state)] - [["lux;Right" [state* output]]] - (return* state* output) - - [["lux;Left" _]] - ((|do [[fixpoints* _] (check* fixpoints (&/V "lux;VarT" ?id) F2) - e* (apply-type F2 A1) - a* (apply-type F2 A2) - [fixpoints** _] (check* fixpoints* e* a*)] - (return (&/T fixpoints** nil))) - state))) - ;; [["lux;AppT" [["lux;VarT" ?id] A1]] ["lux;AppT" [F2 A2]]] - ;; (|do [[fixpoints* _] (check* fixpoints (&/V "lux;VarT" ?id) F2) - ;; e* (apply-type F2 A1) - ;; a* (apply-type F2 A2) - ;; [fixpoints** _] (check* fixpoints* e* a*)] - ;; (return (&/T fixpoints** nil))) - - [["lux;AppT" [F1 A1]] ["lux;AppT" [["lux;VarT" ?id] A2]]] - (fn [state] - (matchv ::M/objects [((|do [F2 (deref ?id)] - (check* fixpoints expected (&/V "lux;AppT" (&/T F2 A2)))) - state)] - [["lux;Right" [state* output]]] - (return* state* output) - - [["lux;Left" _]] - ((|do [[fixpoints* _] (check* fixpoints F1 (&/V "lux;VarT" ?id)) - e* (apply-type F1 A1) - a* (apply-type F1 A2) - [fixpoints** _] (check* fixpoints* e* a*)] - (return (&/T fixpoints** nil))) - state))) - ;; [["lux;AppT" [F1 A1]] ["lux;AppT" [["lux;VarT" ?id] A2]]] - ;; (|do [[fixpoints* _] (check* fixpoints F1 (&/V "lux;VarT" ?id)) - ;; e* (apply-type F1 A1) - ;; a* (apply-type F1 A2) - ;; [fixpoints** _] (check* fixpoints* e* a*)] - ;; (return (&/T fixpoints** nil))) - - [["lux;AppT" [F A]] _] - (let [fp-pair (&/T expected actual) - _ (when (> (&/|length fixpoints) 40) - (println 'FIXPOINTS (->> (&/|keys fixpoints) - (&/|map (fn [pair] - (|let [[e a] pair] - (str (show-type e) ":+:" - (show-type a))))) - (&/|interpose "\n\n") - (&/fold str ""))) - (assert false))] - (matchv ::M/objects [(fp-get fp-pair fixpoints)] - [["lux;Some" ?]] - (if ? - (return (&/T fixpoints nil)) - (fail (check-error expected actual))) - - [["lux;None" _]] - (|do [expected* (apply-type F A)] - (check* (fp-put fp-pair true fixpoints) expected* actual)))) - - [_ ["lux;AppT" [F A]]] - (|do [actual* (apply-type F A)] - (check* fixpoints expected actual*)) - - [["lux;AllT" _] _] - (with-var - (fn [$arg] - (|do [expected* (apply-type expected $arg)] - (check* fixpoints expected* actual)))) - - [_ ["lux;AllT" _]] - (with-var - (fn [$arg] - (|do [actual* (apply-type actual $arg)] - (check* fixpoints expected actual*)))) - - [["lux;DataT" "boolean"] ["lux;DataT" "java.lang.Boolean"]] - (return (&/T fixpoints nil)) + (matchv ::M/objects [((|do [F2 (deref ?aid)] + (check* fixpoints expected (&/V "lux;AppT" (&/T F2 A2)))) + state)] + [["lux;Right" [state* output]]] + (return* state* output) + + [["lux;Left" _]] + ((|do [[fixpoints* _] (check* fixpoints (&/V "lux;VarT" ?eid) (&/V "lux;VarT" ?aid)) + [fixpoints** _] (check* fixpoints* A1 A2)] + (return (&/T fixpoints** nil))) + state)))) + ;; (|do [_ (check* fixpoints (&/V "lux;VarT" ?eid) (&/V "lux;VarT" ?aid)) + ;; _ (check* fixpoints A1 A2)] + ;; (return (&/T fixpoints nil))) + + [["lux;AppT" [["lux;VarT" ?id] A1]] ["lux;AppT" [F2 A2]]] + (fn [state] + (matchv ::M/objects [((|do [F1 (deref ?id)] + (check* fixpoints (&/V "lux;AppT" (&/T F1 A1)) actual)) + state)] + [["lux;Right" [state* output]]] + (return* state* output) - [["lux;DataT" "byte"] ["lux;DataT" "java.lang.Byte"]] - (return (&/T fixpoints nil)) + [["lux;Left" _]] + ((|do [[fixpoints* _] (check* fixpoints (&/V "lux;VarT" ?id) F2) + e* (apply-type F2 A1) + a* (apply-type F2 A2) + [fixpoints** _] (check* fixpoints* e* a*)] + (return (&/T fixpoints** nil))) + state))) + ;; [["lux;AppT" [["lux;VarT" ?id] A1]] ["lux;AppT" [F2 A2]]] + ;; (|do [[fixpoints* _] (check* fixpoints (&/V "lux;VarT" ?id) F2) + ;; e* (apply-type F2 A1) + ;; a* (apply-type F2 A2) + ;; [fixpoints** _] (check* fixpoints* e* a*)] + ;; (return (&/T fixpoints** nil))) + + [["lux;AppT" [F1 A1]] ["lux;AppT" [["lux;VarT" ?id] A2]]] + (fn [state] + (matchv ::M/objects [((|do [F2 (deref ?id)] + (check* fixpoints expected (&/V "lux;AppT" (&/T F2 A2)))) + state)] + [["lux;Right" [state* output]]] + (return* state* output) - [["lux;DataT" "short"] ["lux;DataT" "java.lang.Short"]] - (return (&/T fixpoints nil)) + [["lux;Left" _]] + ((|do [[fixpoints* _] (check* fixpoints F1 (&/V "lux;VarT" ?id)) + e* (apply-type F1 A1) + a* (apply-type F1 A2) + [fixpoints** _] (check* fixpoints* e* a*)] + (return (&/T fixpoints** nil))) + state))) + ;; [["lux;AppT" [F1 A1]] ["lux;AppT" [["lux;VarT" ?id] A2]]] + ;; (|do [[fixpoints* _] (check* fixpoints F1 (&/V "lux;VarT" ?id)) + ;; e* (apply-type F1 A1) + ;; a* (apply-type F1 A2) + ;; [fixpoints** _] (check* fixpoints* e* a*)] + ;; (return (&/T fixpoints** nil))) + + [["lux;AppT" [F A]] _] + (let [fp-pair (&/T expected actual) + _ (when (> (&/|length fixpoints) 40) + (println 'FIXPOINTS (->> (&/|keys fixpoints) + (&/|map (fn [pair] + (|let [[e a] pair] + (str (show-type e) ":+:" + (show-type a))))) + (&/|interpose "\n\n") + (&/fold str ""))) + (assert false))] + (matchv ::M/objects [(fp-get fp-pair fixpoints)] + [["lux;Some" ?]] + (if ? + (return (&/T fixpoints nil)) + (fail (check-error expected actual))) + + [["lux;None" _]] + (|do [expected* (apply-type F A)] + (check* (fp-put fp-pair true fixpoints) expected* actual)))) + + [_ ["lux;AppT" [F A]]] + (|do [actual* (apply-type F A)] + (check* fixpoints expected actual*)) + + [["lux;AllT" _] _] + (with-var + (fn [$arg] + (|do [expected* (apply-type expected $arg)] + (check* fixpoints expected* actual)))) + + [_ ["lux;AllT" _]] + (with-var + (fn [$arg] + (|do [actual* (apply-type actual $arg)] + (check* fixpoints expected actual*)))) + + [["lux;DataT" "boolean"] ["lux;DataT" "java.lang.Boolean"]] + (return (&/T fixpoints nil)) - [["lux;DataT" "int"] ["lux;DataT" "java.lang.Integer"]] - (return (&/T fixpoints nil)) + [["lux;DataT" "byte"] ["lux;DataT" "java.lang.Byte"]] + (return (&/T fixpoints nil)) - [["lux;DataT" "long"] ["lux;DataT" "java.lang.Long"]] - (return (&/T fixpoints nil)) + [["lux;DataT" "short"] ["lux;DataT" "java.lang.Short"]] + (return (&/T fixpoints nil)) - [["lux;DataT" "float"] ["lux;DataT" "java.lang.Float"]] - (return (&/T fixpoints nil)) + [["lux;DataT" "int"] ["lux;DataT" "java.lang.Integer"]] + (return (&/T fixpoints nil)) - [["lux;DataT" "double"] ["lux;DataT" "java.lang.Double"]] - (return (&/T fixpoints nil)) + [["lux;DataT" "long"] ["lux;DataT" "java.lang.Long"]] + (return (&/T fixpoints nil)) - [["lux;DataT" "char"] ["lux;DataT" "java.lang.Character"]] - (return (&/T fixpoints nil)) + [["lux;DataT" "float"] ["lux;DataT" "java.lang.Float"]] + (return (&/T fixpoints nil)) - [["lux;DataT" "java.lang.Boolean"] ["lux;DataT" "boolean"]] - (return (&/T fixpoints nil)) + [["lux;DataT" "double"] ["lux;DataT" "java.lang.Double"]] + (return (&/T fixpoints nil)) - [["lux;DataT" "java.lang.Byte"] ["lux;DataT" "byte"]] - (return (&/T fixpoints nil)) + [["lux;DataT" "char"] ["lux;DataT" "java.lang.Character"]] + (return (&/T fixpoints nil)) - [["lux;DataT" "java.lang.Short"] ["lux;DataT" "short"]] - (return (&/T fixpoints nil)) + [["lux;DataT" "java.lang.Boolean"] ["lux;DataT" "boolean"]] + (return (&/T fixpoints nil)) - [["lux;DataT" "java.lang.Integer"] ["lux;DataT" "int"]] - (return (&/T fixpoints nil)) + [["lux;DataT" "java.lang.Byte"] ["lux;DataT" "byte"]] + (return (&/T fixpoints nil)) - [["lux;DataT" "java.lang.Long"] ["lux;DataT" "long"]] - (return (&/T fixpoints nil)) + [["lux;DataT" "java.lang.Short"] ["lux;DataT" "short"]] + (return (&/T fixpoints nil)) - [["lux;DataT" "java.lang.Float"] ["lux;DataT" "float"]] - (return (&/T fixpoints nil)) + [["lux;DataT" "java.lang.Integer"] ["lux;DataT" "int"]] + (return (&/T fixpoints nil)) - [["lux;DataT" "java.lang.Double"] ["lux;DataT" "double"]] - (return (&/T fixpoints nil)) + [["lux;DataT" "java.lang.Long"] ["lux;DataT" "long"]] + (return (&/T fixpoints nil)) - [["lux;DataT" "java.lang.Character"] ["lux;DataT" "char"]] - (return (&/T fixpoints nil)) + [["lux;DataT" "java.lang.Float"] ["lux;DataT" "float"]] + (return (&/T fixpoints nil)) - [["lux;DataT" e!name] ["lux;DataT" a!name]] - (if (or (= e!name a!name) - (.isAssignableFrom (Class/forName e!name) (Class/forName a!name))) + [["lux;DataT" "java.lang.Double"] ["lux;DataT" "double"]] (return (&/T fixpoints nil)) - (fail (str "[Type Error] Names don't match: " e!name " & " a!name))) - - [["lux;LambdaT" [eI eO]] ["lux;LambdaT" [aI aO]]] - (|do [[fixpoints* _] (check* fixpoints aI eI)] - (check* fixpoints* eO aO)) - - [["lux;TupleT" e!members] ["lux;TupleT" a!members]] - (|do [fixpoints* (&/fold2% (fn [fp e a] - (|do [[fp* _] (check* fp e a)] - (return fp*))) - fixpoints - e!members a!members)] - (return (&/T fixpoints* nil))) - - [["lux;VariantT" e!cases] ["lux;VariantT" a!cases]] - (|do [fixpoints* (&/fold2% (fn [fp e!case a!case] - (|let [[e!name e!type] e!case - [a!name a!type] a!case] - (if (= e!name a!name) - (|do [[fp* _] (check* fp e!type a!type)] - (return fp*)) - (fail (check-error expected actual))))) - fixpoints - e!cases a!cases)] - (return (&/T fixpoints* nil))) - - [["lux;RecordT" e!slots] ["lux;RecordT" a!slots]] - (|do [fixpoints* (&/fold2% (fn [fp e!slot a!slot] - (|let [[e!name e!type] e!slot - [a!name a!type] a!slot] - (if (= e!name a!name) - (|do [[fp* _] (check* fp e!type a!type)] - (return fp*)) - (fail (check-error expected actual))))) - fixpoints - e!slots a!slots)] - (return (&/T fixpoints* nil))) - - [["lux;ExT" e!id] ["lux;ExT" a!id]] - (if (= e!id a!id) + + [["lux;DataT" "java.lang.Character"] ["lux;DataT" "char"]] (return (&/T fixpoints nil)) - (check-error expected actual)) - [_ _] - (fail (println-str "[Type Error] Can't type-check: " (show-type expected) (show-type actual))) - )) + [["lux;DataT" e!name] ["lux;DataT" a!name]] + (if (or (.equals ^Object e!name a!name) + (.isAssignableFrom (Class/forName e!name) (Class/forName a!name))) + (return (&/T fixpoints nil)) + (fail (str "[Type Error] Names don't match: " e!name " & " a!name))) + + [["lux;LambdaT" [eI eO]] ["lux;LambdaT" [aI aO]]] + (|do [[fixpoints* _] (check* fixpoints aI eI)] + (check* fixpoints* eO aO)) + + [["lux;TupleT" e!members] ["lux;TupleT" a!members]] + (|do [fixpoints* (&/fold2% (fn [fp e a] + (|do [[fp* _] (check* fp e a)] + (return fp*))) + fixpoints + e!members a!members)] + (return (&/T fixpoints* nil))) + + [["lux;VariantT" e!cases] ["lux;VariantT" a!cases]] + (|do [fixpoints* (&/fold2% (fn [fp e!case a!case] + (|let [[e!name e!type] e!case + [a!name a!type] a!case] + (if (.equals ^Object e!name a!name) + (|do [[fp* _] (check* fp e!type a!type)] + (return fp*)) + (fail (check-error expected actual))))) + fixpoints + e!cases a!cases)] + (return (&/T fixpoints* nil))) + + [["lux;RecordT" e!slots] ["lux;RecordT" a!slots]] + (|do [fixpoints* (&/fold2% (fn [fp e!slot a!slot] + (|let [[e!name e!type] e!slot + [a!name a!type] a!slot] + (if (.equals ^Object e!name a!name) + (|do [[fp* _] (check* fp e!type a!type)] + (return fp*)) + (fail (check-error expected actual))))) + fixpoints + e!slots a!slots)] + (return (&/T fixpoints* nil))) + + [["lux;ExT" e!id] ["lux;ExT" a!id]] + (if (.equals ^Object e!id a!id) + (return (&/T fixpoints nil)) + (check-error expected actual)) + + [_ _] + (fail (println-str "[Type Error] Can't type-check: " (show-type expected) (show-type actual))) + ))) (defn check [expected actual] (|do [_ (check* init-fixpoints expected actual)] -- cgit v1.2.3 From 639c9385219e143fd7a6161c57fda34293b81055 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Tue, 26 May 2015 22:35:58 -0400 Subject: - Now using an in-memory class-loader. --- src/lux/base.clj | 35 +++++++++++++++++++++++++++++------ src/lux/compiler/base.clj | 26 +++++++++++++++++--------- src/lux/type.clj | 2 +- 3 files changed, 47 insertions(+), 16 deletions(-) (limited to 'src') diff --git a/src/lux/base.clj b/src/lux/base.clj index 7f551cdb0..c4aab9ec6 100644 --- a/src/lux/base.clj +++ b/src/lux/base.clj @@ -15,8 +15,9 @@ (def $NAME 3) ;; Host -(def $LOADER 0) -(def $WRITER 1) +(def $CLASSES 0) +(def $LOADER 1) +(def $WRITER 2) ;; CompilerState (def $ENVS 0) @@ -422,6 +423,10 @@ (fn [state] (return* state (->> state (get$ $HOST) (get$ $LOADER))))) +(def classes + (fn [state] + (return* state (->> state (get$ $HOST) (get$ $CLASSES))))) + (def +init-bindings+ (R ;; "lux;counter" 0 @@ -439,11 +444,29 @@ name )) +(let [define-class (doto (.getDeclaredMethod java.lang.ClassLoader "defineClass" (into-array [String + (class (byte-array [])) + Integer/TYPE + Integer/TYPE])) + (.setAccessible true))] + (defn memory-class-loader [store] + (proxy [java.lang.ClassLoader] + [] + (findClass [^String class-name] + ;; (prn 'findClass class-name) + (if-let [bytecode (get @store class-name)] + (.invoke define-class this (to-array [class-name bytecode (int 0) (int (alength bytecode))])) + (throw (IllegalStateException. (str "[Class Loader] Unknown class: " class-name)))))))) + (defn host [_] - (R ;; "lux;loader" - (-> (java.io.File. "./output/") .toURL vector into-array java.net.URLClassLoader.) - ;; "lux;writer" - (V "lux;None" nil))) + (let [store (atom {})] + (R ;; "lux;classes" + store + ;; "lux;loader" + (memory-class-loader store) + ;; (-> (java.io.File. "./output/") .toURL vector into-array java.net.URLClassLoader.) + ;; "lux;writer" + (V "lux;None" nil)))) (defn init-state [_] (R ;; "lux;envs" diff --git a/src/lux/compiler/base.clj b/src/lux/compiler/base.clj index a7886ab48..24f342469 100644 --- a/src/lux/compiler/base.clj +++ b/src/lux/compiler/base.clj @@ -15,18 +15,26 @@ (def closure-prefix "c") (def apply-signature "(Ljava/lang/Object;)Ljava/lang/Object;") -(defn write-file [^String file ^bytes data] - (with-open [stream (java.io.BufferedOutputStream. (java.io.FileOutputStream. file))] - (.write stream data))) +;; (defn write-file [^String file ^bytes data] +;; (with-open [stream (java.io.BufferedOutputStream. (java.io.FileOutputStream. file))] +;; (.write stream data))) -(defn write-class [name data] - (write-file (str "output/" name ".class") data)) +;; (defn write-class [name data] +;; (write-file (str "output/" name ".class") data)) (defn load-class! [^ClassLoader loader name] (.loadClass loader name)) +;; (defn save-class! [name bytecode] +;; (|do [loader &/loader +;; :let [_ (write-class name bytecode) +;; _ (load-class! loader (string/replace name #"/" "."))]] +;; (return nil))) + (defn save-class! [name bytecode] - (|do [loader &/loader - :let [_ (write-class name bytecode) - _ (load-class! loader (string/replace name #"/" "."))]] - (return nil))) + (let [real-name (string/replace name #"/" ".")] + (|do [loader &/loader + !classes &/classes + :let [_ (swap! !classes assoc real-name bytecode) + _ (load-class! loader real-name)]] + (return nil)))) diff --git a/src/lux/type.clj b/src/lux/type.clj index 25e3e1053..d5be5a7c6 100644 --- a/src/lux/type.clj +++ b/src/lux/type.clj @@ -126,7 +126,7 @@ (&/V "lux;RecordT" (&/|list (&/T "lux;writer" (&/V "lux;DataT" "org.objectweb.asm.ClassWriter")) (&/T "lux;loader" (&/V "lux;DataT" "java.lang.ClassLoader")) - ))) + (&/T "lux;classes" (&/V "lux;DataT" "clojure.lang.Atom"))))) (def DefData* (fAll "lux;DefData'" "" -- cgit v1.2.3 From 5e45ec0419293fdde30cc9e3f0326e44ddd7442a Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 27 May 2015 00:57:57 -0400 Subject: - _jvm_program now relies on the (IO (,)) type. - The command-line params argument in jvm_program is now transformed from a String array into (List Text). --- src/lux/analyser/host.clj | 2 +- src/lux/compiler/host.clj | 83 +++++++++++++++++++++++++++++++++++++++++++---- src/lux/type.clj | 4 +++ 3 files changed, 82 insertions(+), 7 deletions(-) (limited to 'src') diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj index 9f80c43cc..182eb9ebb 100644 --- a/src/lux/analyser/host.clj +++ b/src/lux/analyser/host.clj @@ -246,5 +246,5 @@ (defn analyse-jvm-program [analyse ?args ?body] (|do [=body (&/with-scope "" (&&env/with-local "" (&/V "lux;AppT" (&/T &type/List &type/Text)) - (analyse-1+ analyse ?body)))] + (&&/analyse-1 analyse (&/V "lux;AppT" (&/T &type/IO &type/Unit)) ?body)))] (return (&/|list (&/V "jvm-program" =body))))) diff --git a/src/lux/compiler/host.clj b/src/lux/compiler/host.clj index 8782acfa5..87753dce3 100644 --- a/src/lux/compiler/host.clj +++ b/src/lux/compiler/host.clj @@ -474,11 +474,82 @@ (|do [^ClassWriter *writer* &/get-writer] (&/with-writer (doto (.visitMethod *writer* (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "main" "([Ljava/lang/String;)V" nil nil) (.visitCode)) - (|do [main-writer &/get-writer + (|do [^MethodVisitor main-writer &/get-writer + :let [$loop (new Label) + $end (new Label) + _ (doto main-writer + ;; Tail: Begin + (.visitLdcInsn (int 2)) ;; S + (.visitTypeInsn Opcodes/ANEWARRAY "java/lang/Object") ;; V + (.visitInsn Opcodes/DUP) ;; VV + (.visitLdcInsn (int 0)) ;; VVI + (.visitLdcInsn "lux;Nil") ;; VVIT + (.visitInsn Opcodes/AASTORE) ;; V + (.visitInsn Opcodes/DUP) ;; VV + (.visitLdcInsn (int 1)) ;; VVI + (.visitInsn Opcodes/ACONST_NULL) ;; VVIN + (.visitInsn Opcodes/AASTORE) ;; V + ;; Tail: End + ;; Size: Begin + (.visitVarInsn Opcodes/ALOAD 0) ;; VA + (.visitInsn Opcodes/ARRAYLENGTH) ;; VI + ;; Size: End + ;; Loop: Begin + (.visitLabel $loop) + (.visitLdcInsn (int 1)) ;; VII + (.visitInsn Opcodes/ISUB) ;; VI + (.visitInsn Opcodes/DUP) ;; VII + (.visitJumpInsn Opcodes/IFLT $end) ;; VI + ;; Head: Begin + (.visitInsn Opcodes/DUP) ;; VII + (.visitVarInsn Opcodes/ALOAD 0) ;; VIIA + (.visitInsn Opcodes/SWAP) ;; VIAI + (.visitInsn Opcodes/AALOAD) ;; VIO + (.visitInsn Opcodes/SWAP) ;; VOI + (.visitInsn Opcodes/DUP_X2) ;; IVOI + (.visitInsn Opcodes/POP) ;; IVO + ;; Head: End + ;; Tuple: Begin + (.visitLdcInsn (int 2)) ;; IVOS + (.visitTypeInsn Opcodes/ANEWARRAY "java/lang/Object") ;; IVO2 + (.visitInsn Opcodes/DUP_X1) ;; IV2O2 + (.visitInsn Opcodes/SWAP) ;; IV22O + (.visitLdcInsn (int 0)) ;; IV22OI + (.visitInsn Opcodes/SWAP) ;; IV22IO + (.visitInsn Opcodes/AASTORE) ;; IV2 + (.visitInsn Opcodes/DUP_X1) ;; I2V2 + (.visitInsn Opcodes/SWAP) ;; I22V + (.visitLdcInsn (int 1)) ;; I22VI + (.visitInsn Opcodes/SWAP) ;; I22IV + (.visitInsn Opcodes/AASTORE) ;; I2 + ;; Tuple: End + ;; Cons: Begin + (.visitLdcInsn (int 2)) ;; I2I + (.visitTypeInsn Opcodes/ANEWARRAY "java/lang/Object") ;; I2V + (.visitInsn Opcodes/DUP) ;; I2VV + (.visitLdcInsn (int 0)) ;; I2VVI + (.visitLdcInsn "lux;Cons") ;; I2VVIT + (.visitInsn Opcodes/AASTORE) ;; I2V + (.visitInsn Opcodes/DUP_X1) ;; IV2V + (.visitInsn Opcodes/SWAP) ;; IVV2 + (.visitLdcInsn (int 1)) ;; IVV2I + (.visitInsn Opcodes/SWAP) ;; IVVI2 + (.visitInsn Opcodes/AASTORE) ;; IV + ;; Cons: End + (.visitInsn Opcodes/SWAP) ;; VI + (.visitJumpInsn Opcodes/GOTO $loop) + ;; Loop: End + (.visitLabel $end) ;; VI + (.visitInsn Opcodes/POP) ;; V + (.visitVarInsn Opcodes/ASTORE (int 0)) ;; + )] _ (compile ?body) - :let [_ (doto ^MethodVisitor main-writer - (.visitInsn Opcodes/POP) - (.visitInsn Opcodes/RETURN) - (.visitMaxs 0 0) - (.visitEnd))]] + :let [_ (doto main-writer + (.visitInsn Opcodes/ACONST_NULL) + (.visitMethodInsn Opcodes/INVOKEINTERFACE "lux/Function" "apply" &&/apply-signature))] + :let [_ (doto main-writer + (.visitInsn Opcodes/POP) + (.visitInsn Opcodes/RETURN) + (.visitMaxs 0 0) + (.visitEnd))]] (return nil))))) diff --git a/src/lux/type.clj b/src/lux/type.clj index d5be5a7c6..9034abb53 100644 --- a/src/lux/type.clj +++ b/src/lux/type.clj @@ -15,6 +15,10 @@ (def Unit (&/V "lux;TupleT" (&/|list))) (def $Void (&/V "lux;VariantT" (&/|list))) +(def IO + (&/V "lux;AllT" (&/T (&/V "lux;Some" (&/V "lux;Nil" nil)) "IO" "a" + (&/V "lux;LambdaT" (&/T Unit (&/V "lux;BoundT" "a")))))) + (def List (&/V "lux;AllT" (&/T (&/V "lux;Some" (&/V "lux;Nil" nil)) "lux;List" "a" (&/V "lux;VariantT" (&/|list (&/T "lux;Nil" Unit) -- cgit v1.2.3 From 20889fab030a5ad8de94ae26afffbc4488c44a16 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 27 May 2015 01:17:41 -0400 Subject: - Now storing the hash of the source file as a final, static field of the generated class. --- src/lux/compiler.clj | 10 +++++++--- src/lux/reader.clj | 4 ++-- 2 files changed, 9 insertions(+), 5 deletions(-) (limited to 'src') diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj index e491fbdfe..db2c92c42 100644 --- a/src/lux/compiler.clj +++ b/src/lux/compiler.clj @@ -349,12 +349,16 @@ (if (.equals ^Object name "lux") (return* state nil) (fail* "[Compiler Error] Can't redefine a module!")) - (let [=class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS) + (let [file-name (str "source/" name ".lux") + file-content (slurp file-name) + =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))] + (&host/->class name) nil "java/lang/Object" nil)) + _ (doto (.visitField =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_hash" "I" nil (hash file-content)) + .visitEnd)] (matchv ::M/objects [((&/exhaust% compiler-step) (->> state - (&/set$ &/$SOURCE (&reader/from (str "source/" name ".lux"))) + (&/set$ &/$SOURCE (&reader/from file-name file-content)) (&/set$ &/$ENVS (&/|list (&/env name))) (&/update$ &/$HOST #(&/set$ &/$WRITER (&/V "lux;Some" =class) %)) (&/update$ &/$MODULES #(&/|put name &a-module/init-module %))))] diff --git a/src/lux/reader.clj b/src/lux/reader.clj index b1fcc4740..fa5d659bf 100644 --- a/src/lux/reader.clj +++ b/src/lux/reader.clj @@ -124,8 +124,8 @@ (&/T (&/T file-name line-num column-num*) line))))) (&/V "No" (str "[Reader Error] Text failed: " text)))))) -(defn from [file-name] - (let [lines (&/->list (string/split-lines (slurp file-name)))] +(defn from [file-name file-content] + (let [lines (&/->list (string/split-lines file-content))] (&/|map (fn [line+line-num] (|let [[line-num line] line+line-num] (&/T (&/T file-name line-num 0) -- cgit v1.2.3 From 0952d5906d90f305e0604447d6b292204ba53711 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sun, 31 May 2015 00:45:35 -0400 Subject: - Finished _jvm-interface_ & _jvm-class_. - The version of the compiler is now stored as a field in the compiled definitions. --- src/lux/analyser.clj | 44 ++++++------ src/lux/analyser/host.clj | 172 +++++++++++++++++++++++++++++++++++++--------- src/lux/analyser/lux.clj | 10 ++- src/lux/base.clj | 4 +- src/lux/compiler.clj | 29 ++++++-- src/lux/compiler/host.clj | 84 +++++++++++++--------- src/lux/compiler/lux.clj | 10 ++- src/lux/host.clj | 3 +- 8 files changed, 254 insertions(+), 102 deletions(-) (limited to 'src') diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj index ba0fe4e66..01a562bfe 100644 --- a/src/lux/analyser.clj +++ b/src/lux/analyser.clj @@ -412,42 +412,44 @@ (matchv ::M/objects [token] ;; Arrays [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_new-array"]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ ?class]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;IntS" ?length]]] - ["lux;Nil" _]]]]]]]]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ ?class]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;IntS" ?length]]] + ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-new-array analyse ?class ?length) [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_aastore"]]]] - ["lux;Cons" [?array - ["lux;Cons" [["lux;Meta" [_ ["lux;IntS" ?idx]]] - ["lux;Cons" [?elem - ["lux;Nil" _]]]]]]]]]]]]] + ["lux;Cons" [?array + ["lux;Cons" [["lux;Meta" [_ ["lux;IntS" ?idx]]] + ["lux;Cons" [?elem + ["lux;Nil" _]]]]]]]]]]]]] (&&host/analyse-jvm-aastore analyse ?array ?idx ?elem) [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_aaload"]]]] - ["lux;Cons" [?array - ["lux;Cons" [["lux;Meta" [_ ["lux;IntS" ?idx]]] - ["lux;Nil" _]]]]]]]]]]] + ["lux;Cons" [?array + ["lux;Cons" [["lux;Meta" [_ ["lux;IntS" ?idx]]] + ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-aaload analyse ?array ?idx) ;; Classes & interfaces [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_class"]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ ?name]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ ?super-class]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?fields]]] - ["lux;Nil" _]]]]]]]]]]]]] - (&&host/analyse-jvm-class analyse ?name ?super-class ?fields) + ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?name]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?super-class]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?interfaces]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?fields]]] + ?methods]]]]]]]]]]]]]] + (&&host/analyse-jvm-class analyse ?name ?super-class ?interfaces ?fields ?methods) [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_interface"]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ ?name]]]] - ?members]]]]]]]] - (&&host/analyse-jvm-interface analyse ?name ?members) + ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?name]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?supers]]] + ?methods]]]]]]]]]] + (&&host/analyse-jvm-interface analyse ?name ?supers ?methods) ;; Programs [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_program"]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ ?args]]]] - ["lux;Cons" [?body - ["lux;Nil" _]]]]]]]]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ ?args]]]] + ["lux;Cons" [?body + ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-program analyse ?args ?body) [_] diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj index 182eb9ebb..1aa683ea6 100644 --- a/src/lux/analyser/host.clj +++ b/src/lux/analyser/host.clj @@ -18,6 +18,14 @@ [_] (fail "[Analyser Error] Can't extract Symbol."))) +(defn ^:private extract-text [text] + (matchv ::M/objects [text] + [["lux;Meta" [_ ["lux;TextS" ?text]]]] + (return ?text) + + [_] + (fail "[Analyser Error] Can't extract Text."))) + (defn ^:private analyse-1+ [analyse ?token] (&type/with-var (fn [$var] @@ -112,9 +120,19 @@ analyse-jvm-invokevirtual "jvm-invokevirtual" analyse-jvm-invokeinterface "jvm-invokeinterface" - analyse-jvm-invokespecial "jvm-invokespecial" ) +(defn analyse-jvm-invokespecial [analyse ?class ?method ?classes ?object ?args] + (|do [=classes (&/map% &host/extract-jvm-param ?classes) + =return (if (= "" ?method) + (return &type/$Void) + (&host/lookup-virtual-method ?class ?method =classes)) + =object (&&/analyse-1 analyse (&/V "lux;DataT" ?class) ?object) + =args (&/map2% (fn [?c ?o] + (&&/analyse-1 analyse (&/V "lux;DataT" ?c) ?o)) + =classes ?args)] + (return (&/|list (&/T (&/V "jvm-invokespecial" (&/T ?class ?method =classes =object =args)) =return))))) + (defn analyse-jvm-null? [analyse ?object] (|do [=object (&&/analyse-1 analyse ?object)] (return (&/|list (&/T (&/V "jvm-null?" =object) (&/V "lux;DataT" "java.lang.Boolean")))))) @@ -139,44 +157,134 @@ =array-type (&&/expr-type =array)] (return (&/|list (&/T (&/V "jvm-aaload" (&/T =array ?idx)) =array-type))))) -(defn analyse-jvm-class [analyse ?name ?super-class ?fields] - (|do [?fields (&/map% (fn [?field] +(defn ^:private analyse-modifiers [modifiers] + (&/fold% (fn [so-far modif] + (matchv ::M/objects [modif] + [["lux;Meta" [_ ["lux;TextS" "public"]]]] + (return (assoc so-far :visibility "public")) + + [["lux;Meta" [_ ["lux;TextS" "private"]]]] + (return (assoc so-far :visibility "private")) + + [["lux;Meta" [_ ["lux;TextS" "protected"]]]] + (return (assoc so-far :visibility "protected")) + + [["lux;Meta" [_ ["lux;TextS" "static"]]]] + (return (assoc so-far :static? true)) + + [["lux;Meta" [_ ["lux;TextS" "final"]]]] + (return (assoc so-far :final? true)) + + [["lux;Meta" [_ ["lux;TextS" "abstract"]]]] + (return (assoc so-far :abstract? true)) + + [["lux;Meta" [_ ["lux;TextS" "synchronized"]]]] + (return (assoc so-far :concurrency "synchronized")) + + [["lux;Meta" [_ ["lux;TextS" "volatile"]]]] + (return (assoc so-far :concurrency "volatile")) + + [_] + (fail (str "[Analyser Error] Unknown modifier: " (&/show-ast modif))))) + {:visibility "default" + :static? false + :final? false + :abstract? false + :concurrency nil} + modifiers)) + +(defn ^:private as-otype [tname] + (case tname + "boolean" "java.lang.Boolean" + "byte" "java.lang.Byte" + "short" "java.lang.Short" + "int" "java.lang.Integer" + "long" "java.lang.Long" + "float" "java.lang.Float" + "double" "java.lang.Double" + "char" "java.lang.Character" + ;; else + tname + )) + +(defn analyse-jvm-class [analyse ?name ?super-class ?interfaces ?fields ?methods] + (|do [=interfaces (&/map% extract-text ?interfaces) + =fields (&/map% (fn [?field] (matchv ::M/objects [?field] - [["lux;Meta" [_ ["lux;TupleS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ?class]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ?field-name]]] - ["lux;Nil" _]]]]]]]]] - (return [?class ?field-name]) + [["lux;Meta" [_ ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ ?field-name]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?field-type]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?field-modifiers]]] + ["lux;Nil" _]]]]]]]]]]] + (|do [=field-modifiers (analyse-modifiers ?field-modifiers)] + (return {:name ?field-name + :modifiers =field-modifiers + :type ?field-type})) [_] - (fail "[Analyser Error] Fields must be Tuple2 of [Symbol, Symbol]"))) + (fail "[Analyser Error] Wrong syntax for field."))) ?fields) - :let [=fields (into {} (for [[class field] ?fields] - [field {:access :public - :type class}]))] - $module &/get-module-name] - (return (&/|list (&/V "jvm-class" (&/T $module ?name ?super-class =fields {})))))) - -(defn analyse-jvm-interface [analyse ?name ?members] - (|do [=members (&/map% (fn [member] - (matchv ::M/objects [member] - [["lux;Meta" [_ ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ":"]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "->"]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?inputs]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ ?output]]]] - ["lux;Nil" _]]]]]]]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ ?member-name]]]] - ["lux;Nil" _]]]]]]]]]]] - (|do [inputs* (&/map% extract-ident ?inputs)] - (return [?member-name [inputs* ?output]])) + =methods (&/map% (fn [?method] + (matchv ::M/objects [?method] + [[?idx ["lux;Meta" [_ ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ ?method-name]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?method-inputs]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?method-output]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?method-modifiers]]] + ["lux;Cons" [?method-body + ["lux;Nil" _]]]]]]]]]]]]]]]] + (|do [=method-inputs (&/map% (fn [minput] + (matchv ::M/objects [minput] + [["lux;Meta" [_ ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ?input-name]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?input-type]]] + ["lux;Nil" _]]]]]]]]] + (return (&/T (&/ident->text ?input-name) ?input-type)) + + [_] + (fail "[Analyser Error] Wrong syntax for method."))) + ?method-inputs) + =method-modifiers (analyse-modifiers ?method-modifiers) + =method-body (&/with-scope (str ?name "_" ?idx) + (&/fold (fn [body* input*] + (|let [[iname itype] input*] + (&&env/with-local iname (&/V "lux;DataT" (as-otype itype)) + body*))) + (if (= "void" ?method-output) + (analyse-1+ analyse ?method-body) + (&&/analyse-1 analyse (&/V "lux;DataT" (as-otype ?method-output)) ?method-body)) + (&/|reverse (if (:static? =method-modifiers) + =method-inputs + (&/|cons (&/T ";this" ?super-class) + =method-inputs)))))] + (return {:name ?method-name + :modifiers =method-modifiers + :inputs (&/|map &/|second =method-inputs) + :output ?method-output + :body =method-body})) + + [_] + (fail "[Analyser Error] Wrong syntax for method."))) + (&/enumerate ?methods))] + (return (&/|list (&/V "jvm-class" (&/T ?name ?super-class =interfaces =fields =methods)))))) + +(defn analyse-jvm-interface [analyse ?name ?supers ?methods] + (|do [=supers (&/map% extract-text ?supers) + =methods (&/map% (fn [method] + (matchv ::M/objects [method] + [["lux;Meta" [_ ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ ?method-name]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?inputs]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?output]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?modifiers]]] + ["lux;Nil" _]]]]]]]]]]]]] + (|do [=inputs (&/map% extract-text ?inputs) + =modifiers (analyse-modifiers ?modifiers)] + (return {:name ?method-name + :modifiers =modifiers + :inputs =inputs + :output ?output})) [_] (fail "[Analyser Error] Invalid method signature!"))) - ?members) - :let [=methods (into {} (for [[method [inputs output]] (&/->seq =members)] - [method {:access :public - :type [inputs output]}]))] - $module &/get-module-name] - (return (&/|list (&/V "jvm-interface" (&/T $module ?name =methods)))))) + ?methods)] + (return (&/|list (&/V "jvm-interface" (&/T ?name =supers =methods)))))) (defn analyse-jvm-try [analyse ?body [?catches ?finally]] (|do [=body (&&/analyse-1 analyse ?body) diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj index dff936fbe..cdecd234f 100644 --- a/src/lux/analyser/lux.clj +++ b/src/lux/analyser/lux.clj @@ -329,14 +329,12 @@ ==type (eval! =type) _ (&type/check exo-type ==type) =value (&&/analyse-1 analyse ==type ?value)] - (matchv ::M/objects [=value] - [[?expr ?expr-type]] - (return (&/|list (&/T ?expr ==type)))))) + (return (&/|list (&/T (&/V "ann" (&/T =value =type)) + ==type))))) (defn analyse-coerce [analyse eval! exo-type ?type ?value] (|do [=type (&&/analyse-1 analyse &type/Type ?type) ==type (eval! =type) =value (&&/analyse-1 analyse ==type ?value)] - (matchv ::M/objects [=value] - [[?expr ?expr-type]] - (return (&/|list (&/T ?expr ==type)))))) + (return (&/|list (&/T (&/V "ann" (&/T =value =type)) + ==type))))) diff --git a/src/lux/base.clj b/src/lux/base.clj index c4aab9ec6..57b25f47e 100644 --- a/src/lux/base.clj +++ b/src/lux/base.clj @@ -454,7 +454,7 @@ [] (findClass [^String class-name] ;; (prn 'findClass class-name) - (if-let [bytecode (get @store class-name)] + (if-let [^bytes bytecode (get @store class-name)] (.invoke define-class this (to-array [class-name bytecode (int 0) (int (alength bytecode))])) (throw (IllegalStateException. (str "[Class Loader] Unknown class: " class-name)))))))) @@ -652,7 +652,7 @@ [_ _] false)) -(defn enumerate* [idx xs] +(defn ^:private enumerate* [idx xs] (matchv ::M/objects [xs] [["lux;Cons" [x xs*]]] (V "lux;Cons" (T (T idx x) diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj index db2c92c42..a0425cdbe 100644 --- a/src/lux/compiler.clj +++ b/src/lux/compiler.clj @@ -25,6 +25,9 @@ ClassWriter MethodVisitor))) +;; [Constants] +(def ^:private version "0.2") + ;; [Utils/Compilers] (defn ^:private compile-expression [syntax] (matchv ::M/objects [syntax] @@ -72,6 +75,9 @@ [["lambda" [?scope ?env ?body]]] (&&lambda/compile-lambda compile-expression ?scope ?env ?body) + [["ann" [?value-ex ?type-ex]]] + (&&lux/compile-ann compile-expression ?type ?value-ex ?type-ex) + ;; Integer arithmetic [["jvm-iadd" [?x ?y]]] (&&host/compile-jvm-iadd compile-expression ?type ?x ?y) @@ -308,11 +314,11 @@ [["jvm-program" ?body]] (&&host/compile-jvm-program compile-expression ?body) - [["jvm-interface" [?package ?name ?methods]]] - (&&host/compile-jvm-interface compile-expression ?package ?name ?methods) + [["jvm-interface" [?name ?supers ?methods]]] + (&&host/compile-jvm-interface compile-expression ?name ?supers ?methods) - [["jvm-class" [?package ?name ?super-class ?fields ?methods]]] - (&&host/compile-jvm-class compile-expression ?package ?name ?super-class ?fields ?methods))) + [["jvm-class" [?name ?super-class ?interfaces ?fields ?methods]]] + (&&host/compile-jvm-class compile-expression ?name ?super-class ?interfaces ?fields ?methods))) (defn ^:private eval! [expr] (|do [id &/gen-id @@ -353,9 +359,18 @@ file-content (slurp file-name) =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)) - _ (doto (.visitField =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_hash" "I" nil (hash file-content)) - .visitEnd)] + (&host/->class name) nil "java/lang/Object" nil) + (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_hash" "I" nil (hash file-content)) + .visitEnd) + (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_compiler" "Ljava/lang/String;" nil version) + .visitEnd) + ;; (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_imports" "Ljava/lang/String;" nil ...) + ;; .visitEnd) + ;; (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_exports" "Ljava/lang/String;" nil ...) + ;; .visitEnd) + ;; (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_macros" "Ljava/lang/String;" nil ...) + ;; .visitEnd) + )] (matchv ::M/objects [((&/exhaust% compiler-step) (->> state (&/set$ &/$SOURCE (&reader/from file-name file-content)) diff --git a/src/lux/compiler/host.clj b/src/lux/compiler/host.clj index 87753dce3..e825ca0ad 100644 --- a/src/lux/compiler/host.clj +++ b/src/lux/compiler/host.clj @@ -238,7 +238,7 @@ (defn compile-jvm-new [compile *type* ?class ?classes ?args] (|do [^MethodVisitor *writer* &/get-writer - :let [init-sig (str "(" (reduce str "" (map &host/->type-signature ?classes)) ")V") + :let [init-sig (str "(" (&/fold str "" (&/|map &host/->type-signature ?classes)) ")V") class* (&host/->class ?class) _ (doto *writer* (.visitTypeInsn Opcodes/NEW class*) @@ -247,7 +247,7 @@ (|do [ret (compile arg) :let [_ (prepare-arg! *writer* class-name)]] (return ret))) - (map vector ?classes ?args)) + (&/zip2 ?classes ?args)) :let [_ (doto *writer* (.visitMethodInsn Opcodes/INVOKESPECIAL class* "" init-sig))]] (return nil))) @@ -303,40 +303,62 @@ :let [_ (.visitFieldInsn *writer* Opcodes/PUTFIELD (&host/->class ?class) ?field (&host/->java-sig *type*))]] (return nil))) -(defn compile-jvm-class [compile ?package ?name ?super-class ?fields ?methods] - (let [parent-dir (&host/->package ?package) - full-name (str parent-dir "/" ?name) +(defn ^:private modifiers->int [mods] + (+ (case (:visibility mods) + "default" 0 + "public" Opcodes/ACC_PUBLIC + "private" Opcodes/ACC_PRIVATE + "protected" Opcodes/ACC_PROTECTED) + (if (:static? mods) Opcodes/ACC_STATIC 0) + (if (:final? mods) Opcodes/ACC_FINAL 0) + (if (:abstract? mods) Opcodes/ACC_ABSTRACT 0) + (case (:concurrency mods) + "synchronized" Opcodes/ACC_SYNCHRONIZED + "volatile" Opcodes/ACC_VOLATILE + ;; else + 0))) + +(defn compile-jvm-class [compile ?name ?super-class ?interfaces ?fields ?methods] + (let [name* (&host/->class ?name) super-class* (&host/->class ?super-class) =class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS) (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER) - full-name nil super-class* nil)) - _ (do (doseq [[field props] ?fields] - (doto (.visitField =class Opcodes/ACC_PUBLIC field (&host/->type-signature (:type props)) nil nil) - (.visitEnd))) - (doto (.visitMethod =class Opcodes/ACC_PUBLIC "" "()V" nil nil) - (.visitCode) - (.visitVarInsn Opcodes/ALOAD 0) - (.visitMethodInsn Opcodes/INVOKESPECIAL super-class* "" "()V") - (.visitInsn Opcodes/RETURN) - (.visitMaxs 0 0) - (.visitEnd)) - (.visitEnd =class) - (.mkdirs (java.io.File. (str "output/" parent-dir))))] - (&&/save-class! full-name (.toByteArray =class)))) - -(defn compile-jvm-interface [compile ?package ?name ?methods] - (let [parent-dir (&host/->package ?package) - full-name (str parent-dir "/" ?name) + name* nil super-class* (->> ?interfaces (&/|map &host/->class) &/->seq (into-array String)))) + _ (&/|map (fn [field] + (doto (.visitField =class (modifiers->int (:modifiers field)) (:name field) + (&host/->type-signature (:type field)) nil nil) + (.visitEnd))) + ?fields)] + (|do [_ (&/map% (fn [method] + (|let [signature (str "(" (&/fold str "" (&/|map &host/->type-signature (:inputs method))) ")" + (&host/->type-signature (:output method)))] + (&/with-writer (.visitMethod =class (modifiers->int (:modifiers method)) + (:name method) + signature nil nil) + (|do [^MethodVisitor =method &/get-writer + :let [_ (.visitCode =method)] + _ (compile (:body method)) + :let [_ (doto =method + (.visitInsn (if (= "void" (:output method)) Opcodes/RETURN Opcodes/ARETURN)) + (.visitMaxs 0 0) + (.visitEnd))]] + (return nil))))) + ?methods)] + (&&/save-class! name* (.toByteArray (doto =class .visitEnd)))))) + +(defn compile-jvm-interface [compile ?name ?supers ?methods] + (prn 'compile-jvm-interface (->> ?supers &/->seq pr-str)) + (let [name* (&host/->class ?name) =interface (doto (new ClassWriter ClassWriter/COMPUTE_MAXS) (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_INTERFACE) - full-name nil "java/lang/Object" nil)) - _ (do (doseq [[?method ?props] ?methods - :let [[?args ?return] (:type ?props) - signature (str "(" (&/fold str "" (&/|map &host/->type-signature ?args)) ")" (&host/->type-signature ?return))]] - (.visitMethod =interface (+ Opcodes/ACC_PUBLIC Opcodes/ACC_ABSTRACT) ?method signature nil nil)) - (.visitEnd =interface) - (.mkdirs (java.io.File. (str "output/" parent-dir))))] - (&&/save-class! full-name (.toByteArray =interface)))) + name* nil "java/lang/Object" (->> ?supers (&/|map &host/->class) &/->seq (into-array String)))) + _ (do (&/|map (fn [method] + (|let [signature (str "(" (&/fold str "" (&/|map &host/->type-signature (:inputs method))) ")" + (&host/->type-signature (:output method)))] + (.visitMethod =interface (modifiers->int (:modifiers method)) (:name method) signature nil nil))) + ?methods) + (.visitEnd =interface))] + (&&/save-class! name* (.toByteArray =interface)))) (defn compile-jvm-try [compile *type* ?body ?catches ?finally] (|do [^MethodVisitor *writer* &/get-writer diff --git a/src/lux/compiler/lux.clj b/src/lux/compiler/lux.clj index cf4a65f04..d0caff173 100644 --- a/src/lux/compiler/lux.clj +++ b/src/lux/compiler/lux.clj @@ -135,7 +135,12 @@ (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_SUPER) current-class nil "java/lang/Object" (into-array ["lux/Function"])) (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_datum" datum-sig nil nil) - (doto (.visitEnd))))] + (doto (.visitEnd))) + ;; (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_mode" datum-sig nil ...) + ;; (doto (.visitEnd))) + ;; (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_type" datum-sig nil nil) + ;; (doto (.visitEnd))) + )] _ (&/with-writer (.visitMethod =class Opcodes/ACC_PUBLIC "" "()V" nil nil) (|do [^MethodVisitor **writer** &/get-writer :let [_ (.visitCode **writer**)] @@ -150,6 +155,9 @@ _ (&&/save-class! current-class (.toByteArray =class))] (return nil))) +(defn compile-ann [compile *type* ?value-ex ?type-ex] + (compile ?value-ex)) + (defn compile-declare-macro [compile module name] (|do [_ (&a-module/declare-macro module name)] (return nil))) diff --git a/src/lux/host.clj b/src/lux/host.clj index 8817ea338..e2efd92e9 100644 --- a/src/lux/host.clj +++ b/src/lux/host.clj @@ -25,8 +25,7 @@ ))) (defn ^:private method->type [^Method method] - (|do [=return (class->type (.getReturnType method))] - (return =return))) + (class->type (.getReturnType method))) ;; [Resources] (defn ^String ->class [class] -- cgit v1.2.3 From 81e1a4f10ad7aa7cfd76f9877e5e7deacb2d441e Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Tue, 9 Jun 2015 22:37:56 -0400 Subject: - Put definition metadata into the generated .class files. --- src/lux/compiler/lux.clj | 152 +++++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 146 insertions(+), 6 deletions(-) (limited to 'src') diff --git a/src/lux/compiler/lux.clj b/src/lux/compiler/lux.clj index d0caff173..b47267d25 100644 --- a/src/lux/compiler/lux.clj +++ b/src/lux/compiler/lux.clj @@ -124,6 +124,147 @@ :let [_ (.visitMethodInsn *writer* Opcodes/INVOKEINTERFACE "lux/Function" "apply" &&/apply-signature)]] (return nil))) +(defn ^:private type->analysis [type] + (matchv ::M/objects [type] + [["lux;DataT" ?class]] + (&/T (&/V "variant" (&/T "lux;DataT" + (&/T (&/V "text" ?class) &type/$Void))) + &type/$Void) + + [["lux;TupleT" ?members]] + (&/T (&/V "variant" (&/T "lux;TupleT" + (&/fold (fn [tail head] + (&/V "variant" (&/T "lux;Cons" + (&/T (&/V "tuple" (&/|list (type->analysis head) + tail)) + &type/$Void)))) + (&/V "variant" (&/T "lux;Nil" + (&/T (&/V "tuple" (&/|list)) + &type/$Void))) + (&/|reverse ?members)))) + &type/$Void) + + [["lux;VariantT" ?cases]] + (&/T (&/V "variant" (&/T "lux;VariantT" + (&/fold (fn [tail head] + (|let [[hlabel htype] head] + (&/V "variant" (&/T "lux;Cons" + (&/T (&/V "tuple" (&/|list (&/T (&/V "tuple" (&/|list (&/T (&/V "text" hlabel) &type/$Void) + (type->analysis htype))) + &type/$Void) + tail)) + &type/$Void))))) + (&/V "variant" (&/T "lux;Nil" + (&/T (&/V "tuple" (&/|list)) + &type/$Void))) + (&/|reverse ?cases)))) + &type/$Void) + + [["lux;RecordT" ?slots]] + (&/T (&/V "variant" (&/T "lux;RecordT" + (&/fold (fn [tail head] + (|let [[hlabel htype] head] + (&/V "variant" (&/T "lux;Cons" + (&/T (&/V "tuple" (&/|list (&/T (&/V "tuple" (&/|list (&/T (&/V "text" hlabel) &type/$Void) + (type->analysis htype))) + &type/$Void) + tail)) + &type/$Void))))) + (&/V "variant" (&/T "lux;Nil" + (&/T (&/V "tuple" (&/|list)) + &type/$Void))) + (&/|reverse ?slots)))) + &type/$Void) + + [["lux;LambdaT" [?input ?output]]] + (&/T (&/V "variant" (&/T "lux;LambdaT" + (&/T (&/V "tuple" (&/|map type->analysis (&/|list ?input ?output))) + &type/$Void))) + &type/$Void) + + [["lux;AllT" [?env ?name ?arg ?body]]] + (&/T (&/V "variant" (&/T "lux;AllT" + (&/T (&/V "tuple" (&/|list (matchv ::M/objects [?env] + [["lux;None" _]] + (&/V "variant" (&/T "lux;Some" + (&/T (&/V "tuple" (&/|list)) + &type/$Void))) + + [["lux;Some" ??env]] + (&/V "variant" (&/T "lux;Some" + (&/T (&/fold (fn [tail head] + (|let [[hlabel htype] head] + (&/V "variant" (&/T "lux;Cons" + (&/T (&/V "tuple" (&/|list (&/T (&/V "tuple" (&/|list (&/T (&/V "text" hlabel) &type/$Void) + (type->analysis htype))) + &type/$Void) + tail)) + &type/$Void))))) + (&/V "variant" (&/T "lux;Nil" + (&/T (&/V "tuple" (&/|list)) + &type/$Void))) + (&/|reverse ??env)) + &type/$Void)))) + (&/T (&/V "text" ?name) &type/$Void) + (&/T (&/V "text" ?arg) &type/$Void) + (type->analysis ?body))) + &type/$Void))) + &type/$Void) + + [["lux;BoundT" ?name]] + (&/T (&/V "variant" (&/T "lux;BoundT" + (&/T (&/V "text" ?name) &type/$Void))) + &type/$Void) + + [["lux;AppT" [?fun ?arg]]] + (&/T (&/V "variant" (&/T "lux;AppT" + (&/T (&/V "tuple" (&/|map type->analysis (&/|list ?fun ?arg))) + &type/$Void))) + &type/$Void) + )) + +(defn ^:private compile-def-type [compile ?body ?def-data] + (|do [^MethodVisitor **writer** &/get-writer] + (matchv ::M/objects [?def-data] + [["lux;TypeD" _]] + (let [_ (doto **writer** + ;; Tail: Begin + (.visitLdcInsn (int 2)) ;; S + (.visitTypeInsn Opcodes/ANEWARRAY "java/lang/Object") ;; V + (.visitInsn Opcodes/DUP) ;; VV + (.visitLdcInsn (int 0)) ;; VVI + (.visitLdcInsn "lux;TypeD") ;; VVIT + (.visitInsn Opcodes/AASTORE) ;; V + (.visitInsn Opcodes/DUP) ;; VV + (.visitLdcInsn (int 1)) ;; VVI + (.visitInsn Opcodes/ACONST_NULL) ;; VVIN + (.visitInsn Opcodes/AASTORE) ;; V + )] + (return nil)) + + [["lux;ValueD" _]] + (|let [;; _ (prn '?body (aget ?body 0) (aget ?body 1 0)) + [?def-value ?def-type] (matchv ::M/objects [?body] + [[["ann" [?def-value ?type-expr]] ?def-type]] + (&/T ?def-value ?type-expr) + + [[?def-value ?def-type]] + (&/T ?body (type->analysis ?def-type)))] + (|do [:let [_ (doto **writer** + (.visitLdcInsn (int 2)) ;; S + (.visitTypeInsn Opcodes/ANEWARRAY "java/lang/Object") ;; V + (.visitInsn Opcodes/DUP) ;; VV + (.visitLdcInsn (int 0)) ;; VVI + (.visitLdcInsn "lux;ValueD") ;; VVIT + (.visitInsn Opcodes/AASTORE) ;; V + (.visitInsn Opcodes/DUP) ;; VV + (.visitLdcInsn (int 1)) ;; VVI + )] + _ (compile ?def-type) + :let [_ (.visitInsn **writer** Opcodes/AASTORE)]] + (return nil))) + ))) + (defn compile-def [compile ?name ?body ?def-data] (|do [^ClassWriter *writer* &/get-writer module-name &/get-module-name @@ -136,17 +277,16 @@ current-class nil "java/lang/Object" (into-array ["lux/Function"])) (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_datum" datum-sig nil nil) (doto (.visitEnd))) - ;; (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_mode" datum-sig nil ...) - ;; (doto (.visitEnd))) - ;; (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_type" datum-sig nil nil) - ;; (doto (.visitEnd))) - )] + (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_meta" datum-sig nil nil) + (doto (.visitEnd))))] _ (&/with-writer (.visitMethod =class Opcodes/ACC_PUBLIC "" "()V" nil nil) (|do [^MethodVisitor **writer** &/get-writer :let [_ (.visitCode **writer**)] _ (compile ?body) + :let [_ (.visitFieldInsn **writer** Opcodes/PUTSTATIC current-class "_datum" datum-sig)] + _ (compile-def-type compile ?body ?def-data) + :let [_ (.visitFieldInsn **writer** Opcodes/PUTSTATIC current-class "_meta" datum-sig)] :let [_ (doto **writer** - (.visitFieldInsn Opcodes/PUTSTATIC current-class "_datum" datum-sig) (.visitInsn Opcodes/RETURN) (.visitMaxs 0 0) (.visitEnd))]] -- cgit v1.2.3 From cf337fae7217a85ae7700349f5f0967b09a86c28 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Tue, 9 Jun 2015 22:58:29 -0400 Subject: - Now displaying the location where the analyser finds error (file-name, line & column). --- src/lux/analyser.clj | 440 ++++++++++++++++++++++++++------------------------- src/lux/reader.clj | 6 +- src/lux/type.clj | 2 +- 3 files changed, 229 insertions(+), 219 deletions(-) (limited to 'src') diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj index 01a562bfe..a89d37ee5 100644 --- a/src/lux/analyser.clj +++ b/src/lux/analyser.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 [|do return fail return* fail* |list]] + (lux [base :as & :refer [|let |do return fail return* fail* |list]] [reader :as &reader] [parser :as &parser] [type :as &type] @@ -15,51 +15,51 @@ (defn ^:private parse-handler [[catch+ finally+] token] (matchv ::M/objects [token] [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_catch"]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ ?ex-class]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ ?ex-arg]]]] - ["lux;Cons" [?catch-body - ["lux;Nil" _]]]]]]]]]]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ ?ex-class]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ ?ex-arg]]]] + ["lux;Cons" [?catch-body + ["lux;Nil" _]]]]]]]]]]]]] (&/T (&/|++ catch+ (|list (&/T ?ex-class ?ex-arg ?catch-body))) finally+) [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_finally"]]]] - ["lux;Cons" [?finally-body - ["lux;Nil" _]]]]]]]]] + ["lux;Cons" [?finally-body + ["lux;Nil" _]]]]]]]]] (&/T catch+ ?finally-body))) (let [unit (&/V "lux;Meta" (&/T (&/T "" -1 -1) (&/V "lux;TupleS" (|list))))] (defn ^:private aba1 [analyse eval! exo-type token] (matchv ::M/objects [token] ;; Standard special forms - [["lux;Meta" [meta ["lux;BoolS" ?value]]]] + [["lux;BoolS" ?value]] (|do [_ (&type/check exo-type &type/Bool)] (return (&/|list (&/T (&/V "bool" ?value) exo-type)))) - [["lux;Meta" [meta ["lux;IntS" ?value]]]] + [["lux;IntS" ?value]] (|do [_ (&type/check exo-type &type/Int)] (return (&/|list (&/T (&/V "int" ?value) exo-type)))) - [["lux;Meta" [meta ["lux;RealS" ?value]]]] + [["lux;RealS" ?value]] (|do [_ (&type/check exo-type &type/Real)] (return (&/|list (&/T (&/V "real" ?value) exo-type)))) - [["lux;Meta" [meta ["lux;CharS" ?value]]]] + [["lux;CharS" ?value]] (|do [_ (&type/check exo-type &type/Char)] (return (&/|list (&/T (&/V "char" ?value) exo-type)))) - [["lux;Meta" [meta ["lux;TextS" ?value]]]] + [["lux;TextS" ?value]] (|do [_ (&type/check exo-type &type/Text)] (return (&/|list (&/T (&/V "text" ?value) exo-type)))) - [["lux;Meta" [meta ["lux;TupleS" ?elems]]]] + [["lux;TupleS" ?elems]] (&&lux/analyse-tuple analyse exo-type ?elems) - [["lux;Meta" [meta ["lux;RecordS" ?elems]]]] + [["lux;RecordS" ?elems]] (&&lux/analyse-record analyse exo-type ?elems) - [["lux;Meta" [meta ["lux;TagS" ?ident]]]] + [["lux;TagS" ?ident]] (&&lux/analyse-variant analyse exo-type ?ident unit) - [["lux;Meta" [meta ["lux;SymbolS" [_ "_jvm_null"]]]]] + [["lux;SymbolS" [_ "_jvm_null"]]] (return (&/|list (&/T (&/V "jvm-null" nil) (&/V "lux;DataT" "null")))) [_] @@ -68,51 +68,51 @@ (defn ^:private aba2 [analyse eval! exo-type token] (matchv ::M/objects [token] - [["lux;Meta" [meta ["lux;SymbolS" ?ident]]]] + [["lux;SymbolS" ?ident]] (&&lux/analyse-symbol analyse exo-type ?ident) - [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_lux_case"]]]] - ["lux;Cons" [?value ?branches]]]]]]]] + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_lux_case"]]]] + ["lux;Cons" [?value ?branches]]]]]] (&&lux/analyse-case analyse exo-type ?value ?branches) - [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_lux_lambda"]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ?self]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ?arg]]] - ["lux;Cons" [?body - ["lux;Nil" _]]]]]]]]]]]]] + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_lux_lambda"]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ?self]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ?arg]]] + ["lux;Cons" [?body + ["lux;Nil" _]]]]]]]]]]] (&&lux/analyse-lambda analyse exo-type ?self ?arg ?body) - [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_lux_def"]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?name]]]] - ["lux;Cons" [?value - ["lux;Nil" _]]]]]]]]]]] + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_lux_def"]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?name]]]] + ["lux;Cons" [?value + ["lux;Nil" _]]]]]]]]] (&&lux/analyse-def analyse ?name ?value) - [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_lux_declare-macro"]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?name]]]] - ["lux;Nil" _]]]]]]]]] + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_lux_declare-macro"]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?name]]]] + ["lux;Nil" _]]]]]]] (&&lux/analyse-declare-macro analyse ?name) - [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_lux_import"]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?path]]] - ["lux;Nil" _]]]]]]]]] + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_lux_import"]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?path]]] + ["lux;Nil" _]]]]]]] (&&lux/analyse-import analyse ?path) - [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_lux_:"]]]] - ["lux;Cons" [?type - ["lux;Cons" [?value - ["lux;Nil" _]]]]]]]]]]] + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_lux_:"]]]] + ["lux;Cons" [?type + ["lux;Cons" [?value + ["lux;Nil" _]]]]]]]]] (&&lux/analyse-check analyse eval! exo-type ?type ?value) - [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_lux_:!"]]]] - ["lux;Cons" [?type - ["lux;Cons" [?value - ["lux;Nil" _]]]]]]]]]]] + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_lux_:!"]]]] + ["lux;Cons" [?type + ["lux;Cons" [?value + ["lux;Nil" _]]]]]]]]] (&&lux/analyse-coerce analyse eval! ?type ?value) - [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_lux_export"]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?ident]]]] - ["lux;Nil" _]]]]]]]]] + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_lux_export"]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?ident]]]] + ["lux;Nil" _]]]]]]] (&&lux/analyse-export analyse ?ident) [_] @@ -122,53 +122,53 @@ (matchv ::M/objects [token] ;; Host special forms ;; Integer arithmetic - [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_iadd"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_iadd"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-iadd analyse ?x ?y) - [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_isub"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_isub"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-isub analyse ?x ?y) - [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_imul"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_imul"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-imul analyse ?x ?y) - [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_idiv"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_idiv"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-idiv analyse ?x ?y) - [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_irem"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_irem"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-irem analyse ?x ?y) - [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_ieq"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_ieq"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-ieq analyse ?x ?y) - [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_ilt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_ilt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-ilt analyse ?x ?y) - [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_igt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_igt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-igt analyse ?x ?y) ;; Long arithmetic - [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_ladd"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_ladd"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-ladd analyse ?x ?y) - [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_lsub"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_lsub"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-lsub analyse ?x ?y) - [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_lmul"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_lmul"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-lmul analyse ?x ?y) - [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_ldiv"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_ldiv"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-ldiv analyse ?x ?y) - [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_lrem"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_lrem"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-lrem analyse ?x ?y) - [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_leq"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_leq"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-leq analyse ?x ?y) - [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_llt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_llt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-llt analyse ?x ?y) - [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_lgt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_lgt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-lgt analyse ?x ?y) [_] @@ -177,53 +177,53 @@ (defn ^:private aba4 [analyse eval! exo-type token] (matchv ::M/objects [token] ;; Float arithmetic - [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_fadd"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_fadd"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-fadd analyse ?x ?y) - [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_fsub"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_fsub"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-fsub analyse ?x ?y) - [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_fmul"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_fmul"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-fmul analyse ?x ?y) - [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_fdiv"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_fdiv"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-fdiv analyse ?x ?y) - [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_frem"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_frem"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-frem analyse ?x ?y) - [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_feq"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_feq"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-feq analyse ?x ?y) - [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_flt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_flt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-flt analyse ?x ?y) - [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_fgt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_fgt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-fgt analyse ?x ?y) ;; Double arithmetic - [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_dadd"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_dadd"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-dadd analyse ?x ?y) - [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_dsub"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_dsub"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-dsub analyse ?x ?y) - [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_dmul"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_dmul"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-dmul analyse ?x ?y) - [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_ddiv"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_ddiv"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-ddiv analyse ?x ?y) - [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_drem"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_drem"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-drem analyse ?x ?y) - [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_deq"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_deq"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-deq analyse ?x ?y) - [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_dlt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_dlt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-dlt analyse ?x ?y) - [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_dgt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_dgt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-dgt analyse ?x ?y) [_] @@ -232,101 +232,101 @@ (defn ^:private aba5 [analyse eval! exo-type token] (matchv ::M/objects [token] ;; Objects - [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_null?"]]]] - ["lux;Cons" [?object - ["lux;Nil" _]]]]]]]]] + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_null?"]]]] + ["lux;Cons" [?object + ["lux;Nil" _]]]]]]] (&&host/analyse-jvm-null? analyse ?object) - [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_new"]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ ?class]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?classes]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?args]]] - ["lux;Nil" _]]]]]]]]]]]]] + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_new"]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ ?class]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?classes]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?args]]] + ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-new analyse ?class ?classes ?args) - [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_getstatic"]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?class]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?field]]]] - ["lux;Nil" _]]]]]]]]]]] + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_getstatic"]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?class]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?field]]]] + ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-getstatic analyse ?class ?field) - [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_getfield"]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?class]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?field]]]] - ["lux;Cons" [?object - ["lux;Nil" _]]]]]]]]]]]]] + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_getfield"]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?class]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?field]]]] + ["lux;Cons" [?object + ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-getfield analyse ?class ?field ?object) - [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_putstatic"]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?class]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?field]]]] - ["lux;Cons" [?value - ["lux;Nil" _]]]]]]]]]]]]] + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_putstatic"]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?class]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?field]]]] + ["lux;Cons" [?value + ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-putstatic analyse ?class ?field ?value) - [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_putfield"]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?class]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?field]]]] - ["lux;Cons" [?object - ["lux;Cons" [?value - ["lux;Nil" _]]]]]]]]]]]]]]] + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_putfield"]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?class]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?field]]]] + ["lux;Cons" [?object + ["lux;Cons" [?value + ["lux;Nil" _]]]]]]]]]]]]] (&&host/analyse-jvm-putfield analyse ?class ?field ?object ?value) - [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_invokestatic"]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?class]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?method]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?classes]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?args]]] - ["lux;Nil" _]]]]]]]]]]]]]]] + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_invokestatic"]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?class]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?method]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?classes]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?args]]] + ["lux;Nil" _]]]]]]]]]]]]] (&&host/analyse-jvm-invokestatic analyse ?class ?method ?classes ?args) - [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_invokevirtual"]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?class]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?method]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?classes]]] - ["lux;Cons" [?object - ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?args]]] - ["lux;Nil" _]]]]]]]]]]]]]]]]] + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_invokevirtual"]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?class]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?method]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?classes]]] + ["lux;Cons" [?object + ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?args]]] + ["lux;Nil" _]]]]]]]]]]]]]]] (&&host/analyse-jvm-invokevirtual analyse ?class ?method ?classes ?object ?args) - [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_invokeinterface"]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?class]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?method]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?classes]]] - ["lux;Cons" [?object - ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?args]]] - ["lux;Nil" _]]]]]]]]]]]]]]]]] + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_invokeinterface"]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?class]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?method]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?classes]]] + ["lux;Cons" [?object + ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?args]]] + ["lux;Nil" _]]]]]]]]]]]]]]] (&&host/analyse-jvm-invokeinterface analyse ?class ?method ?classes ?object ?args) - [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_invokespecial"]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?class]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?method]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?classes]]] - ["lux;Cons" [?object - ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?args]]] - ["lux;Nil" _]]]]]]]]]]]]]]]]] + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_invokespecial"]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?class]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?method]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?classes]]] + ["lux;Cons" [?object + ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?args]]] + ["lux;Nil" _]]]]]]]]]]]]]]] (&&host/analyse-jvm-invokespecial analyse ?class ?method ?classes ?object ?args) ;; Exceptions - [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_try"]]]] - ["lux;Cons" [?body - ?handlers]]]]]]]] + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_try"]]]] + ["lux;Cons" [?body + ?handlers]]]]]] (&&host/analyse-jvm-try analyse ?body (&/fold parse-handler [(list) nil] ?handlers)) - [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_throw"]]]] - ["lux;Cons" [?ex - ["lux;Nil" _]]]]]]]]] + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_throw"]]]] + ["lux;Cons" [?ex + ["lux;Nil" _]]]]]]] (&&host/analyse-jvm-throw analyse ?ex) ;; Syncronization/monitos - [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_monitorenter"]]]] - ["lux;Cons" [?monitor - ["lux;Nil" _]]]]]]]]] + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_monitorenter"]]]] + ["lux;Cons" [?monitor + ["lux;Nil" _]]]]]]] (&&host/analyse-jvm-monitorenter analyse ?monitor) - [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_monitorexit"]]]] - ["lux;Cons" [?monitor - ["lux;Nil" _]]]]]]]]] + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_monitorexit"]]]] + ["lux;Cons" [?monitor + ["lux;Nil" _]]]]]]] (&&host/analyse-jvm-monitorexit analyse ?monitor) [_] @@ -335,74 +335,74 @@ (defn ^:private aba6 [analyse eval! exo-type token] (matchv ::M/objects [token] ;; Primitive conversions - [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_d2f"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_d2f"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]] (&&host/analyse-jvm-d2f analyse ?value) - [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_d2i"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_d2i"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]] (&&host/analyse-jvm-d2i analyse ?value) - [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_d2l"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_d2l"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]] (&&host/analyse-jvm-d2l analyse ?value) - [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_f2d"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_f2d"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]] (&&host/analyse-jvm-f2d analyse ?value) - [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_f2i"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_f2i"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]] (&&host/analyse-jvm-f2i analyse ?value) - [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_f2l"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_f2l"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]] (&&host/analyse-jvm-f2l analyse ?value) - [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_i2b"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_i2b"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]] (&&host/analyse-jvm-i2b analyse ?value) - [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_i2c"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_i2c"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]] (&&host/analyse-jvm-i2c analyse ?value) - [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_i2d"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_i2d"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]] (&&host/analyse-jvm-i2d analyse ?value) - [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_i2f"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_i2f"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]] (&&host/analyse-jvm-i2f analyse ?value) - [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_i2l"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_i2l"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]] (&&host/analyse-jvm-i2l analyse ?value) - [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_i2s"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_i2s"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]] (&&host/analyse-jvm-i2s analyse ?value) - [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_l2d"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_l2d"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]] (&&host/analyse-jvm-l2d analyse ?value) - [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_l2f"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_l2f"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]] (&&host/analyse-jvm-l2f analyse ?value) - [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_l2i"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_l2i"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]] (&&host/analyse-jvm-l2i analyse ?value) ;; Bitwise operators - [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_iand"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]]]] + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_iand"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-iand analyse ?x ?y) - [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_ior"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]]]] + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_ior"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-ior analyse ?x ?y) - [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_land"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]]]] + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_land"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-land analyse ?x ?y) - [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_lor"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]]]] + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_lor"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-lor analyse ?x ?y) - [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_lxor"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]]]] + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_lxor"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-lxor analyse ?x ?y) - [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_lshl"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]]]] + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_lshl"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-lshl analyse ?x ?y) - [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_lshr"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]]]] + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_lshr"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-lshr analyse ?x ?y) - [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_lushr"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]]]] + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_lushr"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-lushr analyse ?x ?y) [_] @@ -411,107 +411,115 @@ (defn ^:private aba7 [analyse eval! exo-type token] (matchv ::M/objects [token] ;; Arrays - [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_new-array"]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ ?class]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;IntS" ?length]]] - ["lux;Nil" _]]]]]]]]]]] + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_new-array"]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ ?class]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;IntS" ?length]]] + ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-new-array analyse ?class ?length) - [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_aastore"]]]] - ["lux;Cons" [?array - ["lux;Cons" [["lux;Meta" [_ ["lux;IntS" ?idx]]] - ["lux;Cons" [?elem - ["lux;Nil" _]]]]]]]]]]]]] + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_aastore"]]]] + ["lux;Cons" [?array + ["lux;Cons" [["lux;Meta" [_ ["lux;IntS" ?idx]]] + ["lux;Cons" [?elem + ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-aastore analyse ?array ?idx ?elem) - [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_aaload"]]]] - ["lux;Cons" [?array - ["lux;Cons" [["lux;Meta" [_ ["lux;IntS" ?idx]]] - ["lux;Nil" _]]]]]]]]]]] + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_aaload"]]]] + ["lux;Cons" [?array + ["lux;Cons" [["lux;Meta" [_ ["lux;IntS" ?idx]]] + ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-aaload analyse ?array ?idx) ;; Classes & interfaces - [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_class"]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?name]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?super-class]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?interfaces]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?fields]]] - ?methods]]]]]]]]]]]]]] + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_class"]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?name]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?super-class]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?interfaces]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?fields]]] + ?methods]]]]]]]]]]]] (&&host/analyse-jvm-class analyse ?name ?super-class ?interfaces ?fields ?methods) - [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_interface"]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?name]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?supers]]] - ?methods]]]]]]]]]] + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_interface"]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?name]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?supers]]] + ?methods]]]]]]]] (&&host/analyse-jvm-interface analyse ?name ?supers ?methods) ;; Programs - [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_program"]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ ?args]]]] - ["lux;Cons" [?body - ["lux;Nil" _]]]]]]]]]]] + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_program"]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ ?args]]]] + ["lux;Cons" [?body + ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-program analyse ?args ?body) [_] (fail ""))) +(defn ^:private add-loc [meta msg] + (if (.startsWith msg "@") + msg + (|let [[file line col] meta] + (str "@ " file " : " line " , " col "\n" msg)))) + (defn ^:private analyse-basic-ast [analyse eval! exo-type token] ;; (prn 'analyse-basic-ast (&/show-ast token)) - (fn [state] - (matchv ::M/objects [((aba1 analyse eval! exo-type token) state)] - [["lux;Right" [state* output]]] - (return* state* output) - - [["lux;Left" ""]] - (matchv ::M/objects [((aba2 analyse eval! exo-type token) state)] + (matchv ::M/objects [token] + [["lux;Meta" [meta ?token]]] + (fn [state] + (matchv ::M/objects [((aba1 analyse eval! exo-type ?token) state)] [["lux;Right" [state* output]]] (return* state* output) [["lux;Left" ""]] - (matchv ::M/objects [((aba3 analyse eval! exo-type token) state)] + (matchv ::M/objects [((aba2 analyse eval! exo-type ?token) state)] [["lux;Right" [state* output]]] (return* state* output) [["lux;Left" ""]] - (matchv ::M/objects [((aba4 analyse eval! exo-type token) state)] + (matchv ::M/objects [((aba3 analyse eval! exo-type ?token) state)] [["lux;Right" [state* output]]] (return* state* output) [["lux;Left" ""]] - (matchv ::M/objects [((aba5 analyse eval! exo-type token) state)] + (matchv ::M/objects [((aba4 analyse eval! exo-type ?token) state)] [["lux;Right" [state* output]]] (return* state* output) [["lux;Left" ""]] - (matchv ::M/objects [((aba6 analyse eval! exo-type token) state)] + (matchv ::M/objects [((aba5 analyse eval! exo-type ?token) state)] [["lux;Right" [state* output]]] (return* state* output) - + [["lux;Left" ""]] - (matchv ::M/objects [((aba7 analyse eval! exo-type token) state)] + (matchv ::M/objects [((aba6 analyse eval! exo-type ?token) state)] [["lux;Right" [state* output]]] (return* state* output) + + [["lux;Left" ""]] + (matchv ::M/objects [((aba7 analyse eval! exo-type ?token) state)] + [["lux;Right" [state* output]]] + (return* state* output) + + [["lux;Left" msg]] + (fail* (add-loc meta msg))) [["lux;Left" msg]] - (fail* msg)) + (fail* (add-loc meta msg))) [["lux;Left" msg]] - (fail* msg)) + (fail* (add-loc meta msg))) [["lux;Left" msg]] - (fail* msg)) + (fail* (add-loc meta msg))) [["lux;Left" msg]] - (fail* msg)) + (fail* (add-loc meta msg))) [["lux;Left" msg]] - (fail* msg)) + (fail* (add-loc meta msg))) [["lux;Left" msg]] - (fail* msg)) - - [["lux;Left" msg]] - (fail* msg)))) + (fail* (add-loc meta msg)))))) (defn ^:private analyse-ast [eval! exo-type token] (matchv ::M/objects [token] diff --git a/src/lux/reader.clj b/src/lux/reader.clj index fa5d659bf..08b053a85 100644 --- a/src/lux/reader.clj +++ b/src/lux/reader.clj @@ -124,11 +124,13 @@ (&/T (&/T file-name line-num column-num*) line))))) (&/V "No" (str "[Reader Error] Text failed: " text)))))) +(def ^:private +source-dir+ "source/") (defn from [file-name file-content] - (let [lines (&/->list (string/split-lines file-content))] + (let [lines (&/->list (string/split-lines file-content)) + file-name (.substring file-name (.length +source-dir+))] (&/|map (fn [line+line-num] (|let [[line-num line] line+line-num] - (&/T (&/T file-name line-num 0) + (&/T (&/T file-name (inc line-num) 0) line))) (&/|filter (fn [line+line-num] (|let [[line-num line] line+line-num] diff --git a/src/lux/type.clj b/src/lux/type.clj index 9034abb53..fa598daf1 100644 --- a/src/lux/type.clj +++ b/src/lux/type.clj @@ -778,7 +778,7 @@ (if (or (.equals ^Object e!name a!name) (.isAssignableFrom (Class/forName e!name) (Class/forName a!name))) (return (&/T fixpoints nil)) - (fail (str "[Type Error] Names don't match: " e!name " & " a!name))) + (fail (str "[Type Error] Names don't match: " e!name " =/= " a!name))) [["lux;LambdaT" [eI eO]] ["lux;LambdaT" [aI aO]]] (|do [[fixpoints* _] (check* fixpoints aI eI)] -- cgit v1.2.3 From c6a120dd8324a306190b593ff1541046e1963e2d Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 10 Jun 2015 00:41:02 -0400 Subject: - Reimplemented module-aliasing. --- src/lux/analyser/module.clj | 73 ++++++++++++++++++++++++++++++++++----------- src/lux/base.clj | 11 +++---- src/lux/type.clj | 22 ++++++++------ 3 files changed, 73 insertions(+), 33 deletions(-) (limited to 'src') diff --git a/src/lux/analyser/module.clj b/src/lux/analyser/module.clj index f882f1275..cfa39f008 100644 --- a/src/lux/analyser/module.clj +++ b/src/lux/analyser/module.clj @@ -6,18 +6,31 @@ [host :as &host]) [lux.analyser.base :as &&])) +;; [Utils] +(def ^:private $ALIASES 0) +(def ^:private $DEFS 1) + ;; [Exports] (def init-module - (&/|table)) + (&/R ;; "lux;aliases" + (&/|table) + ;; "lux;defs" + (&/|table) + )) (defn define [module name def-data type] (fn [state] (matchv ::M/objects [(&/get$ &/$ENVS state)] [["lux;Cons" [?env ["lux;Nil" _]]]] (return* (->> state - (&/update$ &/$MODULES (fn [ms] - (&/|update module #(&/|put name (&/T false def-data) %) - ms))) + (&/update$ &/$MODULES + (fn [ms] + (&/|update module + (fn [m] + (&/update$ $DEFS + #(&/|put name (&/T false def-data) %) + m)) + ms))) (&/set$ &/$ENVS (&/|list (&/update$ &/$LOCALS (fn [locals] (&/update$ &/$MAPPINGS (fn [mappings] (&/|put (str "" &/+name-separator+ name) @@ -35,9 +48,14 @@ (matchv ::M/objects [(&/get$ &/$ENVS state)] [["lux;Cons" [?env ["lux;Nil" _]]]] (return* (->> state - (&/update$ &/$MODULES (fn [ms] - (&/|update a-module #(&/|put a-name (&/T false (&/V "lux;AliasD" (&/T r-module r-name))) %) - ms))) + (&/update$ &/$MODULES + (fn [ms] + (&/|update a-module + (fn [m] + (&/update$ $DEFS + #(&/|put a-name (&/T false (&/V "lux;AliasD" (&/T r-module r-name))) %) + m)) + ms))) (&/set$ &/$ENVS (&/|list (&/update$ &/$LOCALS (fn [locals] (&/update$ &/$MAPPINGS (fn [mappings] (&/|put (str "" &/+name-separator+ a-name) @@ -55,16 +73,30 @@ (return* state (->> state (&/get$ &/$MODULES) (&/|contains? name))))) -(defn dealias [name] +(defn alias-module [module reference alias] (fn [state] - (if-let [real-name (->> state (&/get$ &/$MODULE-ALIASES) (&/|get name))] - (return* state real-name) - (fail* (str "Unknown alias: " name))))) + (return* (->> state + (&/update$ &/$MODULES + (fn [ms] + (&/|update module + #(&/update$ $ALIASES + (fn [aliases] + (&/|put alias reference aliases)) + %) + ms)))) + nil))) + +(defn dealias [name] + (|do [current-module &/get-module-name] + (fn [state] + (if-let [real-name (->> state (&/get$ &/$MODULES) (&/|get current-module) (&/get$ $ALIASES) (&/|get name))] + (return* state real-name) + (fail* (str "Unknown alias: " name)))))) (defn find-def [module name] (|do [current-module &/get-module-name] (fn [state] - (if-let [$module (->> state (&/get$ &/$MODULES) (&/|get module))] + (if-let [$module (->> state (&/get$ &/$MODULES) (&/|get module) (&/get$ $DEFS))] (if-let [$def (&/|get name $module)] (matchv ::M/objects [$def] [[exported? $$def]] @@ -90,7 +122,7 @@ (defn declare-macro [module name] (fn [state] - (if-let [$module (->> state (&/get$ &/$MODULES) (&/|get module))] + (if-let [$module (->> state (&/get$ &/$MODULES) (&/|get module) (&/get$ $DEFS))] (if-let [$def (&/|get name $module)] (matchv ::M/objects [$def] [[exported? ["lux;ValueD" ?type]]] @@ -102,8 +134,12 @@ (fn [state*] (return* (&/update$ &/$MODULES (fn [$modules] - (&/|put module (&/|put name (&/T exported? (&/V "lux;MacroD" macro)) $module) - $modules)) + (&/|update module + (fn [m] + (&/update$ $DEFS + #(&/|put name (&/T exported? (&/V "lux;MacroD" macro)) %) + m)) + $modules)) state*) nil))) state) @@ -120,7 +156,7 @@ (fn [state] (matchv ::M/objects [(&/get$ &/$ENVS state)] [["lux;Cons" [?env ["lux;Nil" _]]]] - (if-let [$def (->> state (&/get$ &/$MODULES) (&/|get module) (&/|get name))] + (if-let [$def (->> state (&/get$ &/$MODULES) (&/|get module) (&/get$ $DEFS) (&/|get name))] (matchv ::M/objects [$def] [[true _]] (fail* (str "[Analyser Error] Definition has already been exported: " module ";" name)) @@ -128,7 +164,10 @@ [[false ?data]] (return* (->> state (&/update$ &/$MODULES (fn [ms] - (&/|update module #(&/|put name (&/T true ?data) %) + (&/|update module (fn [m] + (&/update$ $DEFS + #(&/|put name (&/T true ?data) %) + m)) ms)))) nil)) (fail* (str "[Analyser Error] Can't export an inexistent definition: " module ";" name))) diff --git a/src/lux/base.clj b/src/lux/base.clj index 57b25f47e..9087028bb 100644 --- a/src/lux/base.clj +++ b/src/lux/base.clj @@ -22,11 +22,10 @@ ;; CompilerState (def $ENVS 0) (def $HOST 1) -(def $MODULE-ALIASES 2) -(def $MODULES 3) -(def $SEED 4) -(def $SOURCE 5) -(def $TYPES 6) +(def $MODULES 2) +(def $SEED 3) +(def $SOURCE 4) +(def $TYPES 5) ;; [Exports] (def +name-separator+ ";") @@ -473,8 +472,6 @@ (|list) ;; "lux;host" (host nil) - ;; "lux;module-aliases" - (|table) ;; "lux;modules" (|table) ;; "lux;seed" diff --git a/src/lux/type.clj b/src/lux/type.clj index fa598daf1..d34433f01 100644 --- a/src/lux/type.clj +++ b/src/lux/type.clj @@ -143,21 +143,25 @@ (&/V "lux;VariantT" (&/|list (&/T "lux;Local" Int) (&/T "lux;Global" Ident)))) +(def $Module + (fAll "lux;$Module" "Compiler" + (&/V "lux;RecordT" + (&/|list (&/T "lux;aliases" (&/V "lux;AppT" (&/T List (&/V "lux;TupleT" (&/|list Text Text))))) + (&/T "lux;defs" (&/V "lux;AppT" (&/T List (&/V "lux;TupleT" + (&/|list Text + (&/V "lux;TupleT" (&/|list Bool + (&/V "lux;AppT" (&/T DefData* + (&/V "lux;LambdaT" (&/T SyntaxList + (&/V "lux;AppT" (&/T (&/V "lux;AppT" (&/T StateE (&/V "lux;BoundT" "Compiler"))) + SyntaxList))))))))))))))))) + (def $Compiler (&/V "lux;AppT" (&/T (fAll "lux;Compiler" "" (&/V "lux;RecordT" (&/|list (&/T "lux;source" Reader) (&/T "lux;modules" (&/V "lux;AppT" (&/T List (&/V "lux;TupleT" (&/|list Text - (&/V "lux;AppT" (&/T List (&/V "lux;TupleT" - (&/|list Text - (&/V "lux;TupleT" (&/|list Bool - (&/V "lux;AppT" (&/T DefData* - (&/V "lux;LambdaT" (&/T SyntaxList - (&/V "lux;AppT" (&/T (&/V "lux;AppT" (&/T StateE (&/V "lux;AppT" (&/T (&/V "lux;BoundT" "lux;Compiler") - (&/V "lux;BoundT" ""))))) - SyntaxList))))))))))))))))) - (&/T "lux;module-aliases" (&/V "lux;AppT" (&/T List $Void))) + (&/V "lux;AppT" (&/T $Module (&/V "lux;AppT" (&/T (&/V "lux;BoundT" "lux;Compiler") (&/V "lux;BoundT" "")))))))))) (&/T "lux;envs" (&/V "lux;AppT" (&/T List (&/V "lux;AppT" (&/T (&/V "lux;AppT" (&/T Env Text)) (&/V "lux;TupleT" (&/|list LuxVar Type))))))) -- cgit v1.2.3 From 082ef348efef7c4f1941c48f94b58e22fea724a4 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Fri, 12 Jun 2015 08:04:59 -0400 Subject: - Added imports. - Now storing information about definitions & imports inside the .class files. --- src/lux/analyser.clj | 50 +++++++++++++++++++++--------------------- src/lux/analyser/lux.clj | 14 ++++++++++-- src/lux/analyser/module.clj | 53 ++++++++++++++++++++++++++++++++++++++++----- src/lux/base.clj | 7 ++++-- src/lux/compiler.clj | 36 ++++++++++++++++++------------ src/lux/optimizer.clj | 4 ++-- src/lux/reader.clj | 4 ++-- src/lux/type.clj | 8 ++++--- 8 files changed, 121 insertions(+), 55 deletions(-) (limited to 'src') diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj index a89d37ee5..4cb1a4900 100644 --- a/src/lux/analyser.clj +++ b/src/lux/analyser.clj @@ -27,7 +27,7 @@ (&/T catch+ ?finally-body))) (let [unit (&/V "lux;Meta" (&/T (&/T "" -1 -1) (&/V "lux;TupleS" (|list))))] - (defn ^:private aba1 [analyse eval! exo-type token] + (defn ^:private aba1 [analyse eval! compile-module exo-type token] (matchv ::M/objects [token] ;; Standard special forms [["lux;BoolS" ?value]] @@ -66,7 +66,7 @@ (fail "") ))) -(defn ^:private aba2 [analyse eval! exo-type token] +(defn ^:private aba2 [analyse eval! compile-module exo-type token] (matchv ::M/objects [token] [["lux;SymbolS" ?ident]] (&&lux/analyse-symbol analyse exo-type ?ident) @@ -96,7 +96,7 @@ [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_lux_import"]]]] ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?path]]] ["lux;Nil" _]]]]]]] - (&&lux/analyse-import analyse ?path) + (&&lux/analyse-import analyse compile-module ?path) [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_lux_:"]]]] ["lux;Cons" [?type @@ -118,7 +118,7 @@ [_] (fail ""))) -(defn ^:private aba3 [analyse eval! exo-type token] +(defn ^:private aba3 [analyse eval! compile-module exo-type token] (matchv ::M/objects [token] ;; Host special forms ;; Integer arithmetic @@ -174,7 +174,7 @@ [_] (fail ""))) -(defn ^:private aba4 [analyse eval! exo-type token] +(defn ^:private aba4 [analyse eval! compile-module exo-type token] (matchv ::M/objects [token] ;; Float arithmetic [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_fadd"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] @@ -229,7 +229,7 @@ [_] (fail ""))) -(defn ^:private aba5 [analyse eval! exo-type token] +(defn ^:private aba5 [analyse eval! compile-module exo-type token] (matchv ::M/objects [token] ;; Objects [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_null?"]]]] @@ -332,7 +332,7 @@ [_] (fail ""))) -(defn ^:private aba6 [analyse eval! exo-type token] +(defn ^:private aba6 [analyse eval! compile-module exo-type token] (matchv ::M/objects [token] ;; Primitive conversions [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_d2f"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]] @@ -408,7 +408,7 @@ [_] (fail ""))) -(defn ^:private aba7 [analyse eval! exo-type token] +(defn ^:private aba7 [analyse eval! compile-module exo-type token] (matchv ::M/objects [token] ;; Arrays [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_new-array"]]]] @@ -455,48 +455,48 @@ [_] (fail ""))) -(defn ^:private add-loc [meta msg] +(defn ^:private add-loc [meta ^String msg] (if (.startsWith msg "@") msg (|let [[file line col] meta] (str "@ " file " : " line " , " col "\n" msg)))) -(defn ^:private analyse-basic-ast [analyse eval! exo-type token] +(defn ^:private analyse-basic-ast [analyse eval! compile-module exo-type token] ;; (prn 'analyse-basic-ast (&/show-ast token)) (matchv ::M/objects [token] [["lux;Meta" [meta ?token]]] (fn [state] - (matchv ::M/objects [((aba1 analyse eval! exo-type ?token) state)] + (matchv ::M/objects [((aba1 analyse eval! compile-module exo-type ?token) state)] [["lux;Right" [state* output]]] (return* state* output) [["lux;Left" ""]] - (matchv ::M/objects [((aba2 analyse eval! exo-type ?token) state)] + (matchv ::M/objects [((aba2 analyse eval! compile-module exo-type ?token) state)] [["lux;Right" [state* output]]] (return* state* output) [["lux;Left" ""]] - (matchv ::M/objects [((aba3 analyse eval! exo-type ?token) state)] + (matchv ::M/objects [((aba3 analyse eval! compile-module exo-type ?token) state)] [["lux;Right" [state* output]]] (return* state* output) [["lux;Left" ""]] - (matchv ::M/objects [((aba4 analyse eval! exo-type ?token) state)] + (matchv ::M/objects [((aba4 analyse eval! compile-module exo-type ?token) state)] [["lux;Right" [state* output]]] (return* state* output) [["lux;Left" ""]] - (matchv ::M/objects [((aba5 analyse eval! exo-type ?token) state)] + (matchv ::M/objects [((aba5 analyse eval! compile-module exo-type ?token) state)] [["lux;Right" [state* output]]] (return* state* output) [["lux;Left" ""]] - (matchv ::M/objects [((aba6 analyse eval! exo-type ?token) state)] + (matchv ::M/objects [((aba6 analyse eval! compile-module exo-type ?token) state)] [["lux;Right" [state* output]]] (return* state* output) [["lux;Left" ""]] - (matchv ::M/objects [((aba7 analyse eval! exo-type ?token) state)] + (matchv ::M/objects [((aba7 analyse eval! compile-module exo-type ?token) state)] [["lux;Right" [state* output]]] (return* state* output) @@ -521,25 +521,25 @@ [["lux;Left" msg]] (fail* (add-loc meta msg)))))) -(defn ^:private analyse-ast [eval! exo-type token] +(defn ^:private analyse-ast [eval! compile-module exo-type token] (matchv ::M/objects [token] [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;TagS" ?ident]]] ?values]]]]]] (do (assert (.equals ^Object (&/|length ?values) 1) "[Analyser Error] Can only tag 1 value.") - (&&lux/analyse-variant (partial analyse-ast eval!) exo-type ?ident (&/|head ?values))) + (&&lux/analyse-variant (partial analyse-ast eval! compile-module) exo-type ?ident (&/|head ?values))) [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [?fn ?args]]]]]] (fn [state] - (matchv ::M/objects [((&type/with-var #(&&/analyse-1 (partial analyse-ast eval!) % ?fn)) state)] + (matchv ::M/objects [((&type/with-var #(&&/analyse-1 (partial analyse-ast eval! compile-module) % ?fn)) state)] [["lux;Right" [state* =fn]]] - ((&&lux/analyse-apply (partial analyse-ast eval!) exo-type =fn ?args) state*) + ((&&lux/analyse-apply (partial analyse-ast eval! compile-module) exo-type =fn ?args) state*) [_] - ((analyse-basic-ast (partial analyse-ast eval!) eval! exo-type token) state))) + ((analyse-basic-ast (partial analyse-ast eval! compile-module) eval! compile-module exo-type token) state))) [_] - (analyse-basic-ast (partial analyse-ast eval!) eval! exo-type token))) + (analyse-basic-ast (partial analyse-ast eval! compile-module) eval! compile-module exo-type token))) ;; [Resources] -(defn analyse [eval!] +(defn analyse [eval! compile-module] (|do [asts &parser/parse] - (&/flat-map% (partial analyse-ast eval! &type/$Void) asts))) + (&/flat-map% (partial analyse-ast eval! compile-module &type/$Void) asts))) diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj index cdecd234f..242539b65 100644 --- a/src/lux/analyser/lux.clj +++ b/src/lux/analyser/lux.clj @@ -316,8 +316,18 @@ (|do [module-name &/get-module-name] (return (&/|list (&/V "declare-macro" (&/T module-name ?name)))))) -(defn analyse-import [analyse exo-type ?path] - (return (&/|list))) +(defn analyse-import [analyse compile-module ?path] + (prn 'analyse-import ?path) + (fn [state] + (let [already-compiled? (&/fold false #(or %1 (= %2 ?path)) (&/get$ &/$SEEN-SOURCES state))] + (&/run-state (|do [_ (&&module/add-import ?path) + _ (if already-compiled? + (return nil) + (compile-module ?path))] + (return (&/|list))) + (if already-compiled? + state + (&/update$ &/$SEEN-SOURCES (partial &/|cons ?path) state)))))) (defn analyse-export [analyse name] (|do [module-name &/get-module-name diff --git a/src/lux/analyser/module.clj b/src/lux/analyser/module.clj index cfa39f008..1fd96ce0a 100644 --- a/src/lux/analyser/module.clj +++ b/src/lux/analyser/module.clj @@ -1,23 +1,38 @@ (ns lux.analyser.module (:require [clojure.core.match :as M :refer [matchv]] clojure.core.match.array - (lux [base :as & :refer [|do return return* fail fail*]] + (lux [base :as & :refer [|let |do return return* fail fail*]] [type :as &type] [host :as &host]) [lux.analyser.base :as &&])) ;; [Utils] -(def ^:private $ALIASES 0) -(def ^:private $DEFS 1) +(def ^:private $DEFS 0) +(def ^:private $ALIASES 1) +(def ^:private $IMPORTS 2) ;; [Exports] (def init-module - (&/R ;; "lux;aliases" + (&/R ;; "lux;defs" (&/|table) - ;; "lux;defs" + ;; "lux;module-aliases" (&/|table) + ;; "lux;imports" + (&/|list) )) +(defn add-import [module] + "(-> Text (Lux (,)))" + (|do [current-module &/get-module-name] + (fn [state] + (return* (&/update$ &/$MODULES + (fn [ms] + (&/|update current-module + (fn [m] (&/update$ $IMPORTS (partial &/|cons module) m)) + ms)) + state) + nil)))) + (defn define [module name def-data type] (fn [state] (matchv ::M/objects [(&/get$ &/$ENVS state)] @@ -69,6 +84,7 @@ (fail* "[Analyser Error] Can't alias a global definition outside of a global environment.")))) (defn exists? [name] + "(-> Text (Lux Bool))" (fn [state] (return* state (->> state (&/get$ &/$MODULES) (&/|contains? name))))) @@ -174,3 +190,30 @@ [_] (fail* "[Analyser Error] Can't export a global definition outside of a global environment.")))) + +(def defs + (|do [module &/get-module-name] + (fn [state] + (return* state + (&/|map (fn [kv] + (|let [[k v] kv] + (matchv ::M/objects [v] + [[?exported? ?def]] + (matchv ::M/objects [?def] + [["lux;AliasD" [?r-module ?r-name]]] + (&/T ?exported? k (str "A" ?r-module ";" ?r-name)) + + [["lux;MacroD" _]] + (&/T ?exported? k "M") + + [["lux;TypeD" _]] + (&/T ?exported? k "T") + + [_] + (&/T ?exported? k "V"))))) + (->> state (&/get$ &/$MODULES) (&/|get module) (&/get$ $DEFS))))))) + +(def imports + (|do [module &/get-module-name] + (fn [state] + (return* state (->> state (&/get$ &/$MODULES) (&/|get module) (&/get$ $IMPORTS)))))) diff --git a/src/lux/base.clj b/src/lux/base.clj index 9087028bb..657ebd51e 100644 --- a/src/lux/base.clj +++ b/src/lux/base.clj @@ -24,8 +24,9 @@ (def $HOST 1) (def $MODULES 2) (def $SEED 3) -(def $SOURCE 4) -(def $TYPES 5) +(def $SEEN-SOURCES 4) +(def $SOURCE 5) +(def $TYPES 6) ;; [Exports] (def +name-separator+ ";") @@ -476,6 +477,8 @@ (|table) ;; "lux;seed" 0 + ;; "lux;seen-sources" + (|list) ;; "lux;source" (V "lux;None" nil) ;; "lux;types" diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj index a0425cdbe..90a382ed5 100644 --- a/src/lux/compiler.clj +++ b/src/lux/compiler.clj @@ -5,7 +5,7 @@ [template :refer [do-template]]) [clojure.core.match :as M :refer [matchv]] clojure.core.match.array - (lux [base :as & :refer [|do return* return fail fail*]] + (lux [base :as & :refer [|let |do return* return fail fail*]] [type :as &type] [reader :as &reader] [lexer :as &lexer] @@ -347,9 +347,9 @@ (.get nil) return))) -(let [compiler-step (|do [analysis+ (&optimizer/optimize eval!)] - (&/map% compile-statement analysis+))] - (defn ^:private compile-module [name] +(defn ^:private compile-module [name] + (let [compiler-step (|do [analysis+ (&optimizer/optimize eval! compile-module)] + (&/map% compile-statement analysis+))] (fn [state] (if (->> state (&/get$ &/$MODULES) (&/|contains? name)) (if (.equals ^Object name "lux") @@ -363,14 +363,7 @@ (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_hash" "I" nil (hash file-content)) .visitEnd) (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_compiler" "Ljava/lang/String;" nil version) - .visitEnd) - ;; (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_imports" "Ljava/lang/String;" nil ...) - ;; .visitEnd) - ;; (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_exports" "Ljava/lang/String;" nil ...) - ;; .visitEnd) - ;; (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_macros" "Ljava/lang/String;" nil ...) - ;; .visitEnd) - )] + .visitEnd))] (matchv ::M/objects [((&/exhaust% compiler-step) (->> state (&/set$ &/$SOURCE (&reader/from file-name file-content)) @@ -378,8 +371,23 @@ (&/update$ &/$HOST #(&/set$ &/$WRITER (&/V "lux;Some" =class) %)) (&/update$ &/$MODULES #(&/|put name &a-module/init-module %))))] [["lux;Right" [?state _]]] - (do (.visitEnd =class) - ((&&/save-class! name (.toByteArray =class)) ?state)) + (&/run-state (|do [defs &a-module/defs + imports &a-module/imports + :let [_ (doto =class + (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_defs" "Ljava/lang/String;" nil + (->> defs + (&/|map (fn [_def] + (|let [[?exported ?name ?ann] _def] + (str (if ?exported "1" "0") " " ?name " " ?ann)))) + (&/|interpose "\t") + (&/fold str ""))) + .visitEnd) + (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_imports" "Ljava/lang/String;" nil + (->> imports (&/|interpose ";") (&/fold str ""))) + .visitEnd) + (.visitEnd))]] + (&&/save-class! name (.toByteArray =class))) + ?state) [["lux;Left" ?message]] (fail* ?message))))))) diff --git a/src/lux/optimizer.clj b/src/lux/optimizer.clj index e50d2aae9..8b97b6ebb 100644 --- a/src/lux/optimizer.clj +++ b/src/lux/optimizer.clj @@ -15,5 +15,5 @@ ;; Global var aliasing. ;; [Exports] -(defn optimize [eval!] - (&analyser/analyse eval!)) +(defn optimize [eval! compile-module] + (&analyser/analyse eval! compile-module)) diff --git a/src/lux/reader.clj b/src/lux/reader.clj index 08b053a85..0e8c1b710 100644 --- a/src/lux/reader.clj +++ b/src/lux/reader.clj @@ -124,8 +124,8 @@ (&/T (&/T file-name line-num column-num*) line))))) (&/V "No" (str "[Reader Error] Text failed: " text)))))) -(def ^:private +source-dir+ "source/") -(defn from [file-name file-content] +(def ^:private ^String +source-dir+ "source/") +(defn from [^String file-name ^String file-content] (let [lines (&/->list (string/split-lines file-content)) file-name (.substring file-name (.length +source-dir+))] (&/|map (fn [line+line-num] diff --git a/src/lux/type.clj b/src/lux/type.clj index d34433f01..d82eae8fd 100644 --- a/src/lux/type.clj +++ b/src/lux/type.clj @@ -146,14 +146,15 @@ (def $Module (fAll "lux;$Module" "Compiler" (&/V "lux;RecordT" - (&/|list (&/T "lux;aliases" (&/V "lux;AppT" (&/T List (&/V "lux;TupleT" (&/|list Text Text))))) + (&/|list (&/T "lux;module-aliases" (&/V "lux;AppT" (&/T List (&/V "lux;TupleT" (&/|list Text Text))))) (&/T "lux;defs" (&/V "lux;AppT" (&/T List (&/V "lux;TupleT" (&/|list Text (&/V "lux;TupleT" (&/|list Bool (&/V "lux;AppT" (&/T DefData* (&/V "lux;LambdaT" (&/T SyntaxList (&/V "lux;AppT" (&/T (&/V "lux;AppT" (&/T StateE (&/V "lux;BoundT" "Compiler"))) - SyntaxList))))))))))))))))) + SyntaxList))))))))))))) + (&/T "lux;imports" (&/V "lux;AppT" (&/T List Text))))))) (def $Compiler (&/V "lux;AppT" (&/T (fAll "lux;Compiler" "" @@ -167,7 +168,8 @@ (&/V "lux;TupleT" (&/|list LuxVar Type))))))) (&/T "lux;types" (&/V "lux;AppT" (&/T (&/V "lux;AppT" (&/T Bindings Int)) Type))) (&/T "lux;host" HostState) - (&/T "lux;seed" Int)))) + (&/T "lux;seed" Int) + (&/T "lux;seen-sources" (&/V "lux;AppT" (&/T List Text)))))) $Void))) (def Macro -- cgit v1.2.3 From 5e9e876131901204dd34ce1548a4df3cb6cba95f Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sat, 20 Jun 2015 20:19:02 -0400 Subject: - The directory for source-code is now named "input". - Implemented module-caching to avoid the waiting too much during program compilation. --- src/lux/analyser.clj | 10 ++- src/lux/analyser/host.clj | 2 +- src/lux/analyser/lux.clj | 128 ++++++++++++++++-------------- src/lux/analyser/module.clj | 82 +++++++++++++------- src/lux/base.clj | 37 ++++++--- src/lux/compiler.clj | 165 ++++++++++++++++++++++----------------- src/lux/compiler/base.clj | 184 +++++++++++++++++++++++++++++++++++++++----- src/lux/compiler/host.clj | 76 +++++++++--------- src/lux/compiler/lambda.clj | 5 +- src/lux/compiler/lux.clj | 12 +-- src/lux/reader.clj | 2 +- src/lux/type.clj | 3 +- 12 files changed, 466 insertions(+), 240 deletions(-) (limited to 'src') diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj index 4cb1a4900..039db810a 100644 --- a/src/lux/analyser.clj +++ b/src/lux/analyser.clj @@ -108,7 +108,7 @@ ["lux;Cons" [?type ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] - (&&lux/analyse-coerce analyse eval! ?type ?value) + (&&lux/analyse-coerce analyse eval! exo-type ?type ?value) [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_lux_export"]]]] ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?ident]]]] @@ -459,7 +459,7 @@ (if (.startsWith msg "@") msg (|let [[file line col] meta] - (str "@ " file " : " line " , " col "\n" msg)))) + (str "@ " file "," line "," col "\n" msg)))) (defn ^:private analyse-basic-ast [analyse eval! compile-module exo-type token] ;; (prn 'analyse-basic-ast (&/show-ast token)) @@ -519,7 +519,8 @@ (fail* (add-loc meta msg))) [["lux;Left" msg]] - (fail* (add-loc meta msg)))))) + (fail* (add-loc meta msg)) + )))) (defn ^:private analyse-ast [eval! compile-module exo-type token] (matchv ::M/objects [token] @@ -531,7 +532,8 @@ (fn [state] (matchv ::M/objects [((&type/with-var #(&&/analyse-1 (partial analyse-ast eval! compile-module) % ?fn)) state)] [["lux;Right" [state* =fn]]] - ((&&lux/analyse-apply (partial analyse-ast eval! compile-module) exo-type =fn ?args) state*) + (do ;; (prn 'GOT_FUN (&/show-ast ?fn) (&/show-ast token) (aget =fn 0 0) (aget =fn 1 0)) + ((&&lux/analyse-apply (partial analyse-ast eval! compile-module) exo-type =fn ?args) state*)) [_] ((analyse-basic-ast (partial analyse-ast eval! compile-module) eval! compile-module exo-type token) state))) diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj index 1aa683ea6..b9361b8c3 100644 --- a/src/lux/analyser/host.clj +++ b/src/lux/analyser/host.clj @@ -353,6 +353,6 @@ (defn analyse-jvm-program [analyse ?args ?body] (|do [=body (&/with-scope "" - (&&env/with-local "" (&/V "lux;AppT" (&/T &type/List &type/Text)) + (&&env/with-local ?args (&/V "lux;AppT" (&/T &type/List &type/Text)) (&&/analyse-1 analyse (&/V "lux;AppT" (&/T &type/IO &type/Unit)) ?body)))] (return (&/|list (&/V "jvm-program" =body))))) diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj index 242539b65..90811c77e 100644 --- a/src/lux/analyser/lux.clj +++ b/src/lux/analyser/lux.clj @@ -103,6 +103,7 @@ (|do [module-name &/get-module-name] (fn [state] (|let [[?module ?name] ident + ;; _ (prn 'analyse-symbol/_0 ?module ?name) local-ident (str ?module ";" ?name) stack (&/get$ &/$ENVS state) no-binding? #(and (->> % (&/get$ &/$LOCALS) (&/get$ &/$MAPPINGS) (&/|contains? local-ident) not) @@ -110,67 +111,77 @@ [inner outer] (&/|split-with no-binding? stack)] (matchv ::M/objects [outer] [["lux;Nil" _]] - ((|do [[[r-module r-name] $def] (&&module/find-def (if (.equals "" ?module) module-name ?module) - ?name) - endo-type (matchv ::M/objects [$def] - [["lux;ValueD" ?type]] - (return ?type) - - [["lux;MacroD" _]] - (return &type/Macro) - - [["lux;TypeD" _]] - (return &type/Type)) - _ (if (and (clojure.lang.Util/identical &type/Type endo-type) - (clojure.lang.Util/identical &type/Type exo-type)) - (return nil) - (&type/check exo-type endo-type))] - (return (&/|list (&/T (&/V "lux;Global" (&/T r-module r-name)) - endo-type)))) - state) + (do ;; (prn 'analyse-symbol/_1 + ;; [?module ?name] + ;; [(if (.equals "" ?module) module-name ?module) + ;; ?name]) + ((|do [[[r-module r-name] $def] (&&module/find-def (if (.equals "" ?module) module-name ?module) + ?name) + ;; :let [_ (prn 'analyse-symbol/_1.1 r-module r-name)] + endo-type (matchv ::M/objects [$def] + [["lux;ValueD" ?type]] + (return ?type) + + [["lux;MacroD" _]] + (return &type/Macro) + + [["lux;TypeD" _]] + (return &type/Type)) + _ (if (and (clojure.lang.Util/identical &type/Type endo-type) + (clojure.lang.Util/identical &type/Type exo-type)) + (return nil) + (&type/check exo-type endo-type))] + (return (&/|list (&/T (&/V "lux;Global" (&/T r-module r-name)) + endo-type)))) + state)) [["lux;Cons" [?genv ["lux;Nil" _]]]] - (if-let [global (->> ?genv (&/get$ &/$LOCALS) (&/get$ &/$MAPPINGS) (&/|get local-ident))] - (matchv ::M/objects [global] - [[["lux;Global" [?module* ?name*]] _]] - ((|do [[[r-module r-name] $def] (&&module/find-def ?module* ?name*) - endo-type (matchv ::M/objects [$def] - [["lux;ValueD" ?type]] - (return ?type) - - [["lux;MacroD" _]] - (return &type/Macro) - - [["lux;TypeD" _]] - (return &type/Type)) - _ (if (and (clojure.lang.Util/identical &type/Type endo-type) - (clojure.lang.Util/identical &type/Type exo-type)) - (return nil) - (&type/check exo-type endo-type))] - (return (&/|list (&/T (&/V "lux;Global" (&/T r-module r-name)) - endo-type)))) - state) - - [_] - (fail* "[Analyser Error] Can't have anything other than a global def in the global environment.")) - (fail* "_{_ analyse-symbol _}_")) - + (do ;; (prn 'analyse-symbol/_2 ?module ?name local-ident (->> ?genv (&/get$ &/$LOCALS) (&/get$ &/$MAPPINGS) &/|keys &/->seq)) + (if-let [global (->> ?genv (&/get$ &/$LOCALS) (&/get$ &/$MAPPINGS) (&/|get local-ident))] + (do ;; (prn 'analyse-symbol/_2.1 ?module ?name local-ident (aget global 0)) + (matchv ::M/objects [global] + [[["lux;Global" [?module* ?name*]] _]] + ((|do [[[r-module r-name] $def] (&&module/find-def ?module* ?name*) + ;; :let [_ (prn 'analyse-symbol/_2.1.1 r-module r-name)] + endo-type (matchv ::M/objects [$def] + [["lux;ValueD" ?type]] + (return ?type) + + [["lux;MacroD" _]] + (return &type/Macro) + + [["lux;TypeD" _]] + (return &type/Type)) + _ (if (and (clojure.lang.Util/identical &type/Type endo-type) + (clojure.lang.Util/identical &type/Type exo-type)) + (return nil) + (&type/check exo-type endo-type))] + (return (&/|list (&/T (&/V "lux;Global" (&/T r-module r-name)) + endo-type)))) + state) + + [_] + (do ;; (prn 'analyse-symbol/_2.1.2 ?module ?name local-ident) + (fail* "[Analyser Error] Can't have anything other than a global def in the global environment.")))) + (fail* "_{_ analyse-symbol _}_"))) + [["lux;Cons" [top-outer _]]] - (|let [scopes (&/|tail (&/folds #(&/|cons (&/get$ &/$NAME %2) %1) - (&/|map #(&/get$ &/$NAME %) outer) - (&/|reverse inner))) - [=local inner*] (&/fold2 (fn [register+new-inner frame in-scope] - (|let [[register new-inner] register+new-inner - [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 local-ident)) - (->> top-outer (&/get$ &/$CLOSURE) (&/get$ &/$MAPPINGS) (&/|get local-ident))) - (&/|list)) - (&/|reverse inner) scopes)] - ((|do [btype (&&/expr-type =local) - _ (&type/check exo-type btype)] - (return (&/|list =local))) - (&/set$ &/$ENVS (&/|++ inner* outer) state))) + (do ;; (prn 'analyse-symbol/_3 ?module ?name) + (|let [scopes (&/|tail (&/folds #(&/|cons (&/get$ &/$NAME %2) %1) + (&/|map #(&/get$ &/$NAME %) outer) + (&/|reverse inner))) + [=local inner*] (&/fold2 (fn [register+new-inner frame in-scope] + (|let [[register new-inner] register+new-inner + [register* frame*] (&&lambda/close-over (&/|reverse in-scope) ident register frame)] + (&/T register* (&/|cons frame* new-inner)))) + (&/T (or (->> top-outer (&/get$ &/$LOCALS) (&/get$ &/$MAPPINGS) (&/|get local-ident)) + (->> top-outer (&/get$ &/$CLOSURE) (&/get$ &/$MAPPINGS) (&/|get local-ident))) + (&/|list)) + (&/|reverse inner) scopes)] + ((|do [btype (&&/expr-type =local) + _ (&type/check exo-type btype)] + (return (&/|list =local))) + (&/set$ &/$ENVS (&/|++ inner* outer) state)))) ))) )) @@ -345,6 +356,7 @@ (defn analyse-coerce [analyse eval! exo-type ?type ?value] (|do [=type (&&/analyse-1 analyse &type/Type ?type) ==type (eval! =type) + _ (&type/check exo-type ==type) =value (&&/analyse-1 analyse ==type ?value)] (return (&/|list (&/T (&/V "ann" (&/T =value =type)) ==type))))) diff --git a/src/lux/analyser/module.clj b/src/lux/analyser/module.clj index 1fd96ce0a..f0e5b82b4 100644 --- a/src/lux/analyser/module.clj +++ b/src/lux/analyser/module.clj @@ -56,9 +56,31 @@ nil) [_] - (fail* "[Analyser Error] Can't create a new global definition outside of a global environment.")))) + (fail* (str "[Analyser Error] Can't create a new global definition outside of a global environment: " module ";" name))))) + +(defn def-type [module name] + "(-> Text Text (Lux Type))" + (fn [state] + (if-let [$module (->> state (&/get$ &/$MODULES) (&/|get module))] + (if-let [$def (->> $module (&/get$ $DEFS) (&/|get name))] + (matchv ::M/objects [$def] + [["lux;TypeD" _]] + (return* state &type/Type) + + [["lux;MacroD" _]] + (return* state &type/Macro) + + [["lux;ValueD" _type]] + (return* state _type) + + [["lux;AliasD" [?r-module ?r-name]]] + (&/run-state (def-type ?r-module ?r-name) + state)) + (fail* (str "[Analyser Error] Unknown definition: " (str module ";" name)))) + (fail* (str "[Analyser Error] Unknown module: " module))))) (defn def-alias [a-module a-name r-module r-name type] + ;; (prn 'def-alias [a-module a-name] [r-module r-name] (&type/show-type type)) (fn [state] (matchv ::M/objects [(&/get$ &/$ENVS state)] [["lux;Cons" [?env ["lux;Nil" _]]]] @@ -75,6 +97,7 @@ (&/update$ &/$MAPPINGS (fn [mappings] (&/|put (str "" &/+name-separator+ a-name) (&/T (&/V "lux;Global" (&/T r-module r-name)) type) + ;; (aget (->> state (&/get$ &/$MODULES) (&/|get r-module) (&/get$ $DEFS) (&/|get r-name)) 1) mappings)) locals)) ?env)))) @@ -112,20 +135,24 @@ (defn find-def [module name] (|do [current-module &/get-module-name] (fn [state] + ;; (prn 'find-def/_0 module name 'current-module current-module) (if-let [$module (->> state (&/get$ &/$MODULES) (&/|get module) (&/get$ $DEFS))] - (if-let [$def (&/|get name $module)] - (matchv ::M/objects [$def] - [[exported? $$def]] - (if (or exported? (.equals ^Object current-module module)) - (matchv ::M/objects [$$def] - [["lux;AliasD" [?r-module ?r-name]]] - ((find-def ?r-module ?r-name) - state) - - [_] - (return* state (&/T (&/T module name) $$def))) - (fail* (str "[Analyser Error] Can't use unexported definition: " (str module &/+name-separator+ name))))) - (fail* (str "[Analyser Error] Definition doesn't exist: " (str module &/+name-separator+ name)))) + (do ;; (prn 'find-def/_0.1 module (&/->seq (&/|keys $module))) + (if-let [$def (&/|get name $module)] + (matchv ::M/objects [$def] + [[exported? $$def]] + (do ;; (prn 'find-def/_1 module name 'exported? exported? (.equals ^Object current-module module)) + (if (or exported? (.equals ^Object current-module module)) + (matchv ::M/objects [$$def] + [["lux;AliasD" [?r-module ?r-name]]] + (do ;; (prn 'find-def/_2 [module name] [?r-module ?r-name]) + ((find-def ?r-module ?r-name) + state)) + + [_] + (return* state (&/T (&/T module name) $$def))) + (fail* (str "[Analyser Error] Can't use unexported definition: " (str module &/+name-separator+ name)))))) + (fail* (str "[Analyser Error] Definition doesn't exist: " (str module &/+name-separator+ name))))) (do (prn [module name] (str "[Analyser Error] Module doesn't exist: " module) (->> state (&/get$ &/$MODULES) &/|keys &/->seq)) @@ -144,7 +171,7 @@ [[exported? ["lux;ValueD" ?type]]] ((|do [_ (&type/check &type/Macro ?type) ^ClassLoader loader &/loader - :let [macro (-> (.loadClass loader (&host/location (&/|list module name))) + :let [macro (-> (.loadClass loader (str module ".$" (&/normalize-ident name))) (.getField "_datum") (.get nil))]] (fn [state*] @@ -199,18 +226,19 @@ (|let [[k v] kv] (matchv ::M/objects [v] [[?exported? ?def]] - (matchv ::M/objects [?def] - [["lux;AliasD" [?r-module ?r-name]]] - (&/T ?exported? k (str "A" ?r-module ";" ?r-name)) - - [["lux;MacroD" _]] - (&/T ?exported? k "M") - - [["lux;TypeD" _]] - (&/T ?exported? k "T") - - [_] - (&/T ?exported? k "V"))))) + (do ;; (prn 'defs k ?exported?) + (matchv ::M/objects [?def] + [["lux;AliasD" [?r-module ?r-name]]] + (&/T ?exported? k (str "A" ?r-module ";" ?r-name)) + + [["lux;MacroD" _]] + (&/T ?exported? k "M") + + [["lux;TypeD" _]] + (&/T ?exported? k "T") + + [_] + (&/T ?exported? k "V")))))) (->> state (&/get$ &/$MODULES) (&/|get module) (&/get$ $DEFS))))))) (def imports diff --git a/src/lux/base.clj b/src/lux/base.clj index 657ebd51e..aecb3fd13 100644 --- a/src/lux/base.clj +++ b/src/lux/base.clj @@ -21,12 +21,13 @@ ;; CompilerState (def $ENVS 0) -(def $HOST 1) -(def $MODULES 2) -(def $SEED 3) -(def $SEEN-SOURCES 4) -(def $SOURCE 5) -(def $TYPES 6) +(def $EVAL? 1) +(def $HOST 2) +(def $MODULES 3) +(def $SEED 4) +(def $SEEN-SOURCES 5) +(def $SOURCE 6) +(def $TYPES 7) ;; [Exports] (def +name-separator+ ";") @@ -413,6 +414,7 @@ \< "_LT_" \> "_GT_" \~ "_TILDE_" + \| "_PIPE_" ;; default char)) @@ -456,7 +458,8 @@ ;; (prn 'findClass class-name) (if-let [^bytes bytecode (get @store class-name)] (.invoke define-class this (to-array [class-name bytecode (int 0) (int (alength bytecode))])) - (throw (IllegalStateException. (str "[Class Loader] Unknown class: " class-name)))))))) + (do (prn 'memory-class-loader/store (keys @store)) + (throw (IllegalStateException. (str "[Class Loader] Unknown class: " class-name))))))))) (defn host [_] (let [store (atom {})] @@ -471,6 +474,8 @@ (defn init-state [_] (R ;; "lux;envs" (|list) + ;; "lux;eval?" + false ;; "lux;host" (host nil) ;; "lux;modules" @@ -485,6 +490,19 @@ +init-bindings+ )) +(defn with-eval [body] + (fn [state] + (matchv ::M/objects [(body (set$ $EVAL? true state))] + [["lux;Right" [state* output]]] + (return* (set$ $EVAL? (get$ $EVAL? state) state*) output) + + [["lux;Left" msg]] + (fail* msg)))) + +(def get-eval + (fn [state] + (return* state (get$ $EVAL? state)))) + (def get-writer (fn [state] (let [writer* (->> state (get$ $HOST) (get$ $WRITER))] @@ -557,9 +575,8 @@ state)))))) (def get-scope-name - (|do [module-name get-module-name] - (fn [state] - (return* state (->> state (get$ $ENVS) (|map #(get$ $NAME %)) |reverse (|cons module-name)))))) + (fn [state] + (return* state (->> state (get$ $ENVS) (|map #(get$ $NAME %)) |reverse)))) (defn with-writer [writer body] (fn [state] diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj index 90a382ed5..d88c33437 100644 --- a/src/lux/compiler.clj +++ b/src/lux/compiler.clj @@ -25,9 +25,6 @@ ClassWriter MethodVisitor))) -;; [Constants] -(def ^:private version "0.2") - ;; [Utils/Compilers] (defn ^:private compile-expression [syntax] (matchv ::M/objects [syntax] @@ -321,80 +318,104 @@ (&&host/compile-jvm-class compile-expression ?name ?super-class ?interfaces ?fields ?methods))) (defn ^:private eval! [expr] - (|do [id &/gen-id - :let [class-name (str id) - =class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS) - (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER) - class-name nil "java/lang/Object" nil) - (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_eval" "Ljava/lang/Object;" nil nil) - (doto (.visitEnd))))] - _ (&/with-writer (.visitMethod =class Opcodes/ACC_PUBLIC "" "()V" nil nil) - (|do [^MethodVisitor *writer* &/get-writer - :let [_ (.visitCode *writer*)] - _ (compile-expression expr) - :let [_ (doto *writer* - (.visitFieldInsn Opcodes/PUTSTATIC class-name "_eval" "Ljava/lang/Object;") - (.visitInsn Opcodes/RETURN) - (.visitMaxs 0 0) - (.visitEnd))]] - (return nil))) - :let [bytecode (.toByteArray (doto =class - .visitEnd))] - _ (&&/save-class! class-name bytecode) - loader &/loader] - (-> (.loadClass ^ClassLoader loader class-name) - (.getField "_eval") - (.get nil) - return))) + (&/with-eval + (|do [module &/get-module-name + id &/gen-id + :let [class-name (str module "/" id) + ;; _ (prn 'eval! id class-name) + =class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS) + (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER) + class-name nil "java/lang/Object" nil) + (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_eval" "Ljava/lang/Object;" nil nil) + (doto (.visitEnd))))] + _ (&/with-writer (.visitMethod =class Opcodes/ACC_PUBLIC "" "()V" nil nil) + (|do [^MethodVisitor *writer* &/get-writer + :let [_ (.visitCode *writer*)] + _ (compile-expression expr) + :let [_ (doto *writer* + (.visitFieldInsn Opcodes/PUTSTATIC class-name "_eval" "Ljava/lang/Object;") + (.visitInsn Opcodes/RETURN) + (.visitMaxs 0 0) + (.visitEnd))]] + (return nil))) + :let [bytecode (.toByteArray (doto =class + .visitEnd))] + _ (&&/save-class! (str id) bytecode) + loader &/loader] + (-> (.loadClass ^ClassLoader loader (str module "." id)) + (.getField "_eval") + (.get nil) + return)))) (defn ^:private compile-module [name] - (let [compiler-step (|do [analysis+ (&optimizer/optimize eval! compile-module)] - (&/map% compile-statement analysis+))] - (fn [state] - (if (->> state (&/get$ &/$MODULES) (&/|contains? name)) - (if (.equals ^Object name "lux") - (return* state nil) - (fail* "[Compiler Error] Can't redefine a module!")) - (let [file-name (str "source/" name ".lux") - file-content (slurp file-name) - =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) - (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_hash" "I" nil (hash file-content)) - .visitEnd) - (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_compiler" "Ljava/lang/String;" nil version) - .visitEnd))] - (matchv ::M/objects [((&/exhaust% compiler-step) - (->> state - (&/set$ &/$SOURCE (&reader/from file-name file-content)) - (&/set$ &/$ENVS (&/|list (&/env name))) - (&/update$ &/$HOST #(&/set$ &/$WRITER (&/V "lux;Some" =class) %)) - (&/update$ &/$MODULES #(&/|put name &a-module/init-module %))))] - [["lux;Right" [?state _]]] - (&/run-state (|do [defs &a-module/defs - imports &a-module/imports - :let [_ (doto =class - (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_defs" "Ljava/lang/String;" nil - (->> defs - (&/|map (fn [_def] - (|let [[?exported ?name ?ann] _def] - (str (if ?exported "1" "0") " " ?name " " ?ann)))) - (&/|interpose "\t") - (&/fold str ""))) - .visitEnd) - (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_imports" "Ljava/lang/String;" nil - (->> imports (&/|interpose ";") (&/fold str ""))) - .visitEnd) - (.visitEnd))]] - (&&/save-class! name (.toByteArray =class))) - ?state) - - [["lux;Left" ?message]] - (fail* ?message))))))) + ;; (prn 'compile-module name) + (if (&&/cached? name) + (do ;; (println "YOLO") + (let [file-name (str "input/" name ".lux") + file-content (slurp file-name)] + (&&/load-cache name (hash file-content) compile-module))) + (let [compiler-step (|do [analysis+ (&optimizer/optimize eval! compile-module)] + (&/map% compile-statement analysis+))] + (fn [state] + (if (->> state (&/get$ &/$MODULES) (&/|contains? name)) + (if (.equals ^Object name "lux") + (return* state nil) + (fail* "[Compiler Error] Can't redefine a module!")) + (let [file-name (str "input/" name ".lux") + file-content (slurp file-name) + =class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS) + (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER) + (str name "/_") nil "java/lang/Object" nil) + (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_hash" "I" nil (hash file-content)) + .visitEnd) + (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_compiler" "Ljava/lang/String;" nil &&/version) + .visitEnd))] + (matchv ::M/objects [((&/exhaust% compiler-step) + (->> state + (&/set$ &/$SOURCE (&reader/from file-name file-content)) + (&/set$ &/$ENVS (&/|list (&/env name))) + (&/update$ &/$HOST #(&/set$ &/$WRITER (&/V "lux;Some" =class) %)) + (&/update$ &/$MODULES #(&/|put name &a-module/init-module %))))] + [["lux;Right" [?state _]]] + (&/run-state (|do [defs &a-module/defs + imports &a-module/imports + :let [_ (doto =class + (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_defs" "Ljava/lang/String;" nil + (->> defs + (&/|map (fn [_def] + (|let [[?exported ?name ?ann] _def] + (str (if ?exported "1" "0") " " ?name " " ?ann)))) + (&/|interpose "\t") + (&/fold str ""))) + .visitEnd) + (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_imports" "Ljava/lang/String;" nil + (->> imports (&/|interpose "\t") (&/fold str ""))) + .visitEnd) + (.visitEnd))]] + (&&/save-class! "_" (.toByteArray =class))) + ?state) + + [["lux;Left" ?message]] + (fail* ?message)))))))) + +(defn ^:private clean-file [^java.io.File file] + (if (.isDirectory file) + (do (doseq [f (seq (.listFiles file))] + (clean-file f)) + (.delete file)) + (.delete file))) + +(defn ^:private setup-dirs! [] + (.mkdir (java.io.File. "cache")) + (.mkdir (java.io.File. "cache/jvm")) + (.mkdir (java.io.File. "output")) + (.mkdir (java.io.File. "output/jvm")) + (doseq [f (seq (.listFiles (java.io.File. "output/jvm")))] + (clean-file f))) ;; [Resources] (defn compile-all [modules] - (.mkdir (java.io.File. "output")) + (setup-dirs!) (matchv ::M/objects [((&/map% compile-module (&/|cons "lux" modules)) (&/init-state nil))] [["lux;Right" [?state _]]] (println (str "Compilation complete! " (str "[" (->> modules diff --git a/src/lux/compiler/base.clj b/src/lux/compiler/base.clj index 24f342469..7ac48e67e 100644 --- a/src/lux/compiler/base.clj +++ b/src/lux/compiler/base.clj @@ -1,40 +1,182 @@ (ns lux.compiler.base (:require [clojure.string :as string] + [clojure.java.io :as io] [clojure.core.match :as M :refer [matchv]] clojure.core.match.array - (lux [base :as & :refer [|do return* return fail fail*]]) - [lux.analyser.base :as &a]) + (lux [base :as & :refer [|do return* return fail fail*]] + [type :as &type]) + (lux.analyser [base :as &a] + [module :as &a-module])) (:import (org.objectweb.asm Opcodes Label ClassWriter MethodVisitor))) +;; [Utils] +(defn ^:private write-file [^String file ^bytes data] + (with-open [stream (java.io.BufferedOutputStream. (java.io.FileOutputStream. file))] + (.write stream data))) + +(defn ^:private write-output [module name data] + (let [module* module] + (.mkdirs (java.io.File. (str "output/jvm/" module*))) + (write-file (str "output/jvm/" module* "/" name ".class") data))) + +(defn ^:private write-cache [module name data] + (let [module* (string/replace module #"/" " ")] + (.mkdirs (java.io.File. (str "cache/jvm/" module*))) + (write-file (str "cache/jvm/" module* "/" name ".class") data))) + +(defn ^:private clean-file [^java.io.File file] + (if (.isDirectory file) + (do (doseq [f (seq (.listFiles file))] + (clean-file f)) + (.delete file)) + (.delete file))) + +(defn ^:private read-file [file] + (with-open [reader (io/input-stream file)] + (let [length (.length file) + buffer (byte-array length)] + (.read reader buffer 0 length) + buffer))) + ;; [Exports] +(def version "0.2") + (def local-prefix "l") (def partial-prefix "p") (def closure-prefix "c") (def apply-signature "(Ljava/lang/Object;)Ljava/lang/Object;") -;; (defn write-file [^String file ^bytes data] -;; (with-open [stream (java.io.BufferedOutputStream. (java.io.FileOutputStream. file))] -;; (.write stream data))) - -;; (defn write-class [name data] -;; (write-file (str "output/" name ".class") data)) - (defn load-class! [^ClassLoader loader name] (.loadClass loader name)) -;; (defn save-class! [name bytecode] -;; (|do [loader &/loader -;; :let [_ (write-class name bytecode) -;; _ (load-class! loader (string/replace name #"/" "."))]] -;; (return nil))) - (defn save-class! [name bytecode] - (let [real-name (string/replace name #"/" ".")] - (|do [loader &/loader - !classes &/classes - :let [_ (swap! !classes assoc real-name bytecode) - _ (load-class! loader real-name)]] - (return nil)))) + (|do [eval? &/get-eval + module &/get-module-name + loader &/loader + !classes &/classes + :let [real-name (str (string/replace module #"/" ".") "." name) + _ (swap! !classes assoc real-name bytecode) + _ (load-class! loader real-name) + _ (when (not eval?) + (do (write-output module name bytecode) + (write-cache module name bytecode)))]] + (return nil))) + +(defn cached? [module] + (.exists (java.io.File. (str "cache/jvm/" (string/replace module #"/" " ") "/_.class")))) + +(defn delete-cache [module] + (fn [state] + (do (clean-file (java.io.File. (str "cache/jvm/" (string/replace module #"/" " ")))) + (return* state nil)))) + +(defn ^:private replace-several [content & replacements] + (let [replacement-list (partition 2 replacements)] + (reduce #(try (let [[_pattern _rep] %2] + (string/replace %1 _pattern (string/re-quote-replacement _rep))) + (catch Exception e + (prn 'replace-several content %1 %2) + (throw e))) + content replacement-list))) + +(defn ^:private replace-cache [cache-name] + (if (.startsWith cache-name "$") + (replace-several cache-name + #"_ASTER_" "*" + #"_PLUS_" "+" + #"_DASH_" "-" + #"_SLASH_" "/" + #"_BSLASH_" "\\" + #"_UNDERS_" "_" + #"_PERCENT_" "%" + #"_DOLLAR_" "$" + #"_QUOTE_" "'" + #"_BQUOTE_" "`" + #"_AT_" "@" + #"_CARET_" "^" + #"_AMPERS_" "&" + #"_EQ_" "=" + #"_BANG_" "!" + #"_QM_" "?" + #"_COLON_" ":" + #"_PERIOD_" "." + #"_COMMA_" "," + #"_LT_" "<" + #"_GT_" ">" + #"_TILDE_" "~" + #"_PIPE_" "|") + cache-name)) + +(defn load-cache [module module-hash compile-module] + (|do [loader &/loader + !classes &/classes] + (let [module-path (str "cache/jvm/" (string/replace module #"/" " ")) + module* (string/replace module #"/" ".") + class-name (str module* "._") + module-meta (do (swap! !classes assoc class-name (read-file (java.io.File. (str module-path "/_.class")))) + (load-class! loader class-name))] + (if (and (= module-hash (-> module-meta (.getField "_hash") (.get nil))) + (= version (-> module-meta (.getField "_compiler") (.get nil)))) + (let [imports (string/split (-> module-meta (.getField "_imports") (.get nil)) #"\t") + ;; _ (prn module 'imports imports) + ] + (|do [loads (&/map% (fn [_import] + (load-cache _import (-> (str "input/" _import ".lux") slurp hash) compile-module)) + (if (= [""] imports) + (&/|list) + (&/->list imports)))] + (if (->> loads &/->seq (every? true?)) + (do (doseq [file (seq (.listFiles (java.io.File. module-path))) + :when (not= "_.class" (.getName file))] + (let [real-name (second (re-find #"^(.*)\.class$" (.getName file))) + bytecode (read-file file) + ;; _ (prn 'load-cache module real-name) + ] + ;; (swap! !classes assoc (str module* "." (replace-cache real-name)) bytecode) + (swap! !classes assoc (str module* "." real-name) bytecode) + ;; (swap! !classes assoc "__temp__" bytecode) + ;; (swap! !classes assoc (-> (load-class! loader "__temp__") (.getField "_name") (.get nil)) bytecode) + (write-output module real-name bytecode))) + ;; (swap! !classes dissoc "__temp__") + (let [defs (string/split (-> module-meta (.getField "_defs") (.get nil)) #"\t")] + (|do [_ (fn [state] + (&/run-state (&/map% (fn [_def] + (let [[_exported? _name _ann] (string/split _def #" ") + ;; _ (prn '[_exported? _name _ann] [_exported? _name _ann]) + def-class (load-class! loader (str module* ".$" (&/normalize-ident _name))) + def-name (-> def-class (.getField "_name") (.get nil))] + (|do [_ (case _ann + "T" (&a-module/define module def-name (&/V "lux;TypeD" nil) &type/Type) + "M" (|do [_ (&a-module/define module def-name (&/V "lux;ValueD" &type/Macro) &type/Macro)] + (&a-module/declare-macro module def-name)) + "V" (let [def-type (-> def-class (.getField "_meta") (.get nil))] + (matchv ::M/objects [def-type] + [["lux;ValueD" _def-type]] + (&a-module/define module def-name def-type _def-type))) + ;; else + (let [[_ __module __name] (re-find #"^A(.*);(.*)$" _ann)] + (|do [__type (&a-module/def-type __module __name)] + (do ;; (prn '__type [__module __name] (&type/show-type __type)) + (&a-module/def-alias module def-name __module __name __type)))))] + (if (= "1" _exported?) + (&a-module/export module def-name) + (return nil))) + )) + (if (= [""] defs) + (&/|list) + (&/->list defs))) + (->> state + (&/set$ &/$ENVS (&/|list (&/env module))) + (&/update$ &/$MODULES #(&/|put module &a-module/init-module %)))))] + (return true)))) + (|do [_ (delete-cache module) + _ (compile-module module)] + (return false))))) + + (|do [_ (delete-cache module) + _ (compile-module module)] + (return false))) + ))) diff --git a/src/lux/compiler/host.clj b/src/lux/compiler/host.clj index e825ca0ad..bc1ab23f1 100644 --- a/src/lux/compiler/host.clj +++ b/src/lux/compiler/host.clj @@ -319,46 +319,46 @@ 0))) (defn compile-jvm-class [compile ?name ?super-class ?interfaces ?fields ?methods] - (let [name* (&host/->class ?name) - super-class* (&host/->class ?super-class) - =class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS) - (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER) - name* nil super-class* (->> ?interfaces (&/|map &host/->class) &/->seq (into-array String)))) - _ (&/|map (fn [field] - (doto (.visitField =class (modifiers->int (:modifiers field)) (:name field) - (&host/->type-signature (:type field)) nil nil) - (.visitEnd))) - ?fields)] - (|do [_ (&/map% (fn [method] - (|let [signature (str "(" (&/fold str "" (&/|map &host/->type-signature (:inputs method))) ")" - (&host/->type-signature (:output method)))] - (&/with-writer (.visitMethod =class (modifiers->int (:modifiers method)) - (:name method) - signature nil nil) - (|do [^MethodVisitor =method &/get-writer - :let [_ (.visitCode =method)] - _ (compile (:body method)) - :let [_ (doto =method - (.visitInsn (if (= "void" (:output method)) Opcodes/RETURN Opcodes/ARETURN)) - (.visitMaxs 0 0) - (.visitEnd))]] - (return nil))))) - ?methods)] - (&&/save-class! name* (.toByteArray (doto =class .visitEnd)))))) - -(defn compile-jvm-interface [compile ?name ?supers ?methods] - (prn 'compile-jvm-interface (->> ?supers &/->seq pr-str)) - (let [name* (&host/->class ?name) - =interface (doto (new ClassWriter ClassWriter/COMPUTE_MAXS) - (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_INTERFACE) - name* nil "java/lang/Object" (->> ?supers (&/|map &host/->class) &/->seq (into-array String)))) - _ (do (&/|map (fn [method] + (|do [module &/get-module-name] + (let [super-class* (&host/->class ?super-class) + =class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS) + (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER) + (str module "/" ?name) nil super-class* (->> ?interfaces (&/|map &host/->class) &/->seq (into-array String)))) + _ (&/|map (fn [field] + (doto (.visitField =class (modifiers->int (:modifiers field)) (:name field) + (&host/->type-signature (:type field)) nil nil) + (.visitEnd))) + ?fields)] + (|do [_ (&/map% (fn [method] (|let [signature (str "(" (&/fold str "" (&/|map &host/->type-signature (:inputs method))) ")" (&host/->type-signature (:output method)))] - (.visitMethod =interface (modifiers->int (:modifiers method)) (:name method) signature nil nil))) - ?methods) - (.visitEnd =interface))] - (&&/save-class! name* (.toByteArray =interface)))) + (&/with-writer (.visitMethod =class (modifiers->int (:modifiers method)) + (:name method) + signature nil nil) + (|do [^MethodVisitor =method &/get-writer + :let [_ (.visitCode =method)] + _ (compile (:body method)) + :let [_ (doto =method + (.visitInsn (if (= "void" (:output method)) Opcodes/RETURN Opcodes/ARETURN)) + (.visitMaxs 0 0) + (.visitEnd))]] + (return nil))))) + ?methods)] + (&&/save-class! ?name (.toByteArray (doto =class .visitEnd))))))) + +(defn compile-jvm-interface [compile ?name ?supers ?methods] + ;; (prn 'compile-jvm-interface (->> ?supers &/->seq pr-str)) + (|do [module &/get-module-name] + (let [=interface (doto (new ClassWriter ClassWriter/COMPUTE_MAXS) + (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_INTERFACE) + (str module "/" ?name) nil "java/lang/Object" (->> ?supers (&/|map &host/->class) &/->seq (into-array String)))) + _ (do (&/|map (fn [method] + (|let [signature (str "(" (&/fold str "" (&/|map &host/->type-signature (:inputs method))) ")" + (&host/->type-signature (:output method)))] + (.visitMethod =interface (modifiers->int (:modifiers method)) (:name method) signature nil nil))) + ?methods) + (.visitEnd =interface))] + (&&/save-class! ?name (.toByteArray =interface))))) (defn compile-jvm-try [compile *type* ?body ?catches ?finally] (|do [^MethodVisitor *writer* &/get-writer diff --git a/src/lux/compiler/lambda.clj b/src/lux/compiler/lambda.clj index 42ed5459e..7b08532fe 100644 --- a/src/lux/compiler/lambda.clj +++ b/src/lux/compiler/lambda.clj @@ -84,7 +84,8 @@ ;; [Exports] (defn compile-lambda [compile ?scope ?env ?body] - (|do [:let [lambda-class (&host/location ?scope) + ;; (prn 'compile-lambda (->> ?scope &/->seq)) + (|do [:let [lambda-class (str (&/|head ?scope) "/$" (&host/location (&/|tail ?scope))) =class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS) (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_SUPER) lambda-class nil "java/lang/Object" (into-array ["lux/Function"])) @@ -99,5 +100,5 @@ )] _ (add-lambda-impl =class compile lambda-impl-signature ?body) :let [_ (.visitEnd =class)] - _ (&&/save-class! lambda-class (.toByteArray =class))] + _ (&&/save-class! (str "$" (&host/location (&/|tail ?scope))) (.toByteArray =class))] (instance-closure compile lambda-class ?env (lambda--signature ?env)))) diff --git a/src/lux/compiler/lux.clj b/src/lux/compiler/lux.clj index b47267d25..c8197da66 100644 --- a/src/lux/compiler/lux.clj +++ b/src/lux/compiler/lux.clj @@ -107,14 +107,14 @@ :let [_ (doto *writer* (.visitVarInsn Opcodes/ALOAD 0) (.visitFieldInsn Opcodes/GETFIELD - (&host/location ?scope) + (str (&/|head ?scope) "/$" (&host/location (&/|tail ?scope))) (str &&/closure-prefix ?captured-id) "Ljava/lang/Object;"))]] (return nil))) (defn compile-global [compile *type* ?owner-class ?name] (|do [^MethodVisitor *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 (str ?owner-class "/$" (&/normalize-ident ?name)) "_datum" "Ljava/lang/Object;")]] (return nil))) (defn compile-apply [compile *type* ?fn ?arg] @@ -270,11 +270,13 @@ module-name &/get-module-name :let [outer-class (&host/->class module-name) datum-sig "Ljava/lang/Object;" - current-class (&host/location (&/|list outer-class ?name)) - _ (.visitInnerClass *writer* current-class outer-class nil (+ Opcodes/ACC_STATIC Opcodes/ACC_SYNTHETIC)) + current-class (str outer-class "/" (str "$" (&/normalize-ident ?name))) + ;; _ (prn 'compile-def 'outer-class outer-class '?name ?name 'current-class current-class) =class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS) (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_SUPER) current-class nil "java/lang/Object" (into-array ["lux/Function"])) + (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_name" "Ljava/lang/String;" nil ?name) + (doto (.visitEnd))) (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_datum" datum-sig nil nil) (doto (.visitEnd))) (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_meta" datum-sig nil nil) @@ -292,7 +294,7 @@ (.visitEnd))]] (return nil))) :let [_ (.visitEnd *writer*)] - _ (&&/save-class! current-class (.toByteArray =class))] + _ (&&/save-class! (str "$" (&/normalize-ident ?name)) (.toByteArray =class))] (return nil))) (defn compile-ann [compile *type* ?value-ex ?type-ex] diff --git a/src/lux/reader.clj b/src/lux/reader.clj index 0e8c1b710..bef093247 100644 --- a/src/lux/reader.clj +++ b/src/lux/reader.clj @@ -124,7 +124,7 @@ (&/T (&/T file-name line-num column-num*) line))))) (&/V "No" (str "[Reader Error] Text failed: " text)))))) -(def ^:private ^String +source-dir+ "source/") +(def ^:private ^String +source-dir+ "input/") (defn from [^String file-name ^String file-content] (let [lines (&/->list (string/split-lines file-content)) file-name (.substring file-name (.length +source-dir+))] diff --git a/src/lux/type.clj b/src/lux/type.clj index d82eae8fd..e0315f8e7 100644 --- a/src/lux/type.clj +++ b/src/lux/type.clj @@ -169,7 +169,8 @@ (&/T "lux;types" (&/V "lux;AppT" (&/T (&/V "lux;AppT" (&/T Bindings Int)) Type))) (&/T "lux;host" HostState) (&/T "lux;seed" Int) - (&/T "lux;seen-sources" (&/V "lux;AppT" (&/T List Text)))))) + (&/T "lux;seen-sources" (&/V "lux;AppT" (&/T List Text))) + (&/T "lux;eval?" Bool)))) $Void))) (def Macro -- cgit v1.2.3 From e351122010b5eb5bf8793382a4a4ddcf5fb3a386 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sun, 21 Jun 2015 01:30:27 -0400 Subject: - The backwards analysis of function application is back. --- src/lux/analyser/lux.clj | 200 +++++++++++++++++++++++------------------------ src/lux/compiler.clj | 4 +- src/lux/compiler/lux.clj | 9 ++- 3 files changed, 108 insertions(+), 105 deletions(-) (limited to 'src') diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj index 90811c77e..6bbcd0fcf 100644 --- a/src/lux/analyser/lux.clj +++ b/src/lux/analyser/lux.clj @@ -115,112 +115,110 @@ ;; [?module ?name] ;; [(if (.equals "" ?module) module-name ?module) ;; ?name]) - ((|do [[[r-module r-name] $def] (&&module/find-def (if (.equals "" ?module) module-name ?module) - ?name) - ;; :let [_ (prn 'analyse-symbol/_1.1 r-module r-name)] - endo-type (matchv ::M/objects [$def] - [["lux;ValueD" ?type]] - (return ?type) - - [["lux;MacroD" _]] - (return &type/Macro) - - [["lux;TypeD" _]] - (return &type/Type)) - _ (if (and (clojure.lang.Util/identical &type/Type endo-type) - (clojure.lang.Util/identical &type/Type exo-type)) - (return nil) - (&type/check exo-type endo-type))] - (return (&/|list (&/T (&/V "lux;Global" (&/T r-module r-name)) - endo-type)))) - state)) + ((|do [[[r-module r-name] $def] (&&module/find-def (if (.equals "" ?module) module-name ?module) + ?name) + ;; :let [_ (prn 'analyse-symbol/_1.1 r-module r-name)] + endo-type (matchv ::M/objects [$def] + [["lux;ValueD" ?type]] + (return ?type) + + [["lux;MacroD" _]] + (return &type/Macro) + + [["lux;TypeD" _]] + (return &type/Type)) + _ (if (and (clojure.lang.Util/identical &type/Type endo-type) + (clojure.lang.Util/identical &type/Type exo-type)) + (return nil) + (&type/check exo-type endo-type))] + (return (&/|list (&/T (&/V "lux;Global" (&/T r-module r-name)) + endo-type)))) + state)) [["lux;Cons" [?genv ["lux;Nil" _]]]] (do ;; (prn 'analyse-symbol/_2 ?module ?name local-ident (->> ?genv (&/get$ &/$LOCALS) (&/get$ &/$MAPPINGS) &/|keys &/->seq)) - (if-let [global (->> ?genv (&/get$ &/$LOCALS) (&/get$ &/$MAPPINGS) (&/|get local-ident))] - (do ;; (prn 'analyse-symbol/_2.1 ?module ?name local-ident (aget global 0)) - (matchv ::M/objects [global] - [[["lux;Global" [?module* ?name*]] _]] - ((|do [[[r-module r-name] $def] (&&module/find-def ?module* ?name*) - ;; :let [_ (prn 'analyse-symbol/_2.1.1 r-module r-name)] - endo-type (matchv ::M/objects [$def] - [["lux;ValueD" ?type]] - (return ?type) - - [["lux;MacroD" _]] - (return &type/Macro) - - [["lux;TypeD" _]] - (return &type/Type)) - _ (if (and (clojure.lang.Util/identical &type/Type endo-type) - (clojure.lang.Util/identical &type/Type exo-type)) - (return nil) - (&type/check exo-type endo-type))] - (return (&/|list (&/T (&/V "lux;Global" (&/T r-module r-name)) - endo-type)))) - state) - - [_] - (do ;; (prn 'analyse-symbol/_2.1.2 ?module ?name local-ident) - (fail* "[Analyser Error] Can't have anything other than a global def in the global environment.")))) - (fail* "_{_ analyse-symbol _}_"))) + (if-let [global (->> ?genv (&/get$ &/$LOCALS) (&/get$ &/$MAPPINGS) (&/|get local-ident))] + (do ;; (prn 'analyse-symbol/_2.1 ?module ?name local-ident (aget global 0)) + (matchv ::M/objects [global] + [[["lux;Global" [?module* ?name*]] _]] + ((|do [[[r-module r-name] $def] (&&module/find-def ?module* ?name*) + ;; :let [_ (prn 'analyse-symbol/_2.1.1 r-module r-name)] + endo-type (matchv ::M/objects [$def] + [["lux;ValueD" ?type]] + (return ?type) + + [["lux;MacroD" _]] + (return &type/Macro) + + [["lux;TypeD" _]] + (return &type/Type)) + _ (if (and (clojure.lang.Util/identical &type/Type endo-type) + (clojure.lang.Util/identical &type/Type exo-type)) + (return nil) + (&type/check exo-type endo-type))] + (return (&/|list (&/T (&/V "lux;Global" (&/T r-module r-name)) + endo-type)))) + state) + + [_] + (do ;; (prn 'analyse-symbol/_2.1.2 ?module ?name local-ident) + (fail* "[Analyser Error] Can't have anything other than a global def in the global environment.")))) + (fail* "_{_ analyse-symbol _}_"))) [["lux;Cons" [top-outer _]]] (do ;; (prn 'analyse-symbol/_3 ?module ?name) - (|let [scopes (&/|tail (&/folds #(&/|cons (&/get$ &/$NAME %2) %1) - (&/|map #(&/get$ &/$NAME %) outer) - (&/|reverse inner))) - [=local inner*] (&/fold2 (fn [register+new-inner frame in-scope] - (|let [[register new-inner] register+new-inner - [register* frame*] (&&lambda/close-over (&/|reverse in-scope) ident register frame)] - (&/T register* (&/|cons frame* new-inner)))) - (&/T (or (->> top-outer (&/get$ &/$LOCALS) (&/get$ &/$MAPPINGS) (&/|get local-ident)) - (->> top-outer (&/get$ &/$CLOSURE) (&/get$ &/$MAPPINGS) (&/|get local-ident))) - (&/|list)) - (&/|reverse inner) scopes)] - ((|do [btype (&&/expr-type =local) - _ (&type/check exo-type btype)] - (return (&/|list =local))) - (&/set$ &/$ENVS (&/|++ inner* outer) state)))) + (|let [scopes (&/|tail (&/folds #(&/|cons (&/get$ &/$NAME %2) %1) + (&/|map #(&/get$ &/$NAME %) outer) + (&/|reverse inner))) + [=local inner*] (&/fold2 (fn [register+new-inner frame in-scope] + (|let [[register new-inner] register+new-inner + [register* frame*] (&&lambda/close-over (&/|reverse in-scope) ident register frame)] + (&/T register* (&/|cons frame* new-inner)))) + (&/T (or (->> top-outer (&/get$ &/$LOCALS) (&/get$ &/$MAPPINGS) (&/|get local-ident)) + (->> top-outer (&/get$ &/$CLOSURE) (&/get$ &/$MAPPINGS) (&/|get local-ident))) + (&/|list)) + (&/|reverse inner) scopes)] + ((|do [btype (&&/expr-type =local) + _ (&type/check exo-type btype)] + (return (&/|list =local))) + (&/set$ &/$ENVS (&/|++ inner* outer) state)))) ))) )) -(defn ^:private analyse-apply* [analyse exo-type =fn ?args] - (matchv ::M/objects [=fn] - [[?fun-expr ?fun-type]] - (matchv ::M/objects [?args] - [["lux;Nil" _]] - (|do [_ (&type/check exo-type ?fun-type)] - (return =fn)) - - [["lux;Cons" [?arg ?args*]]] - (|do [?fun-type* (&type/actual-type ?fun-type)] - (matchv ::M/objects [?fun-type*] - [["lux;AllT" _]] - (&type/with-var - (fn [$var] - (|do [type* (&type/apply-type ?fun-type* $var) - output (analyse-apply* analyse exo-type (&/T ?fun-expr type*) ?args)] - (matchv ::M/objects [output $var] - [[?expr* ?type*] ["lux;VarT" ?id]] - (|do [? (&type/bound? ?id) - _ (if ? - (return nil) - (|do [ex &type/existential] - (&type/set-var ?id ex))) - type** (&type/clean $var ?type*)] - (return (&/T ?expr* type**))) - )))) - - [["lux;LambdaT" [?input-t ?output-t]]] - (|do [=arg (&&/analyse-1 analyse ?input-t ?arg)] - (analyse-apply* analyse exo-type (&/T (&/V "apply" (&/T =fn =arg)) - ?output-t) - ?args*)) +(defn ^:private analyse-apply* [analyse exo-type fun-type ?args] + ;; (prn 'analyse-apply* (aget fun-type 0)) + (matchv ::M/objects [?args] + [["lux;Nil" _]] + (|do [_ (&type/check exo-type fun-type)] + (return (&/T fun-type (&/|list)))) + + [["lux;Cons" [?arg ?args*]]] + (|do [?fun-type* (&type/actual-type fun-type)] + (matchv ::M/objects [?fun-type*] + [["lux;AllT" _]] + (&type/with-var + (fn [$var] + (|do [type* (&type/apply-type ?fun-type* $var) + [=output-t =args] (analyse-apply* analyse exo-type type* ?args)] + (matchv ::M/objects [$var] + [["lux;VarT" ?id]] + (|do [? (&type/bound? ?id) + _ (if ? + (return nil) + (|do [ex &type/existential] + (&type/set-var ?id ex))) + type** (&type/clean $var =output-t)] + (return (&/T type** =args))) + )))) + + [["lux;LambdaT" [?input-t ?output-t]]] + (|do [[=output-t =args] (analyse-apply* analyse exo-type ?output-t ?args*) + =arg (&&/analyse-1 analyse ?input-t ?arg)] + (return (&/T =output-t (&/|cons =arg =args)))) - [_] - (fail (str "[Analyser Error] Can't apply a non-function: " (&type/show-type ?fun-type*))))) - ))) + [_] + (fail (str "[Analyser Error] Can't apply a non-function: " (&type/show-type ?fun-type*))))) + )) (defn analyse-apply [analyse exo-type =fn ?args] (|do [loader &/loader] @@ -235,12 +233,14 @@ (&/flat-map% (partial analyse exo-type) macro-expansion)) [_] - (|do [output (analyse-apply* analyse exo-type =fn ?args)] - (return (&/|list output))))) + (|do [[=output-t =args] (analyse-apply* analyse exo-type =fn-type ?args)] + (return (&/|list (&/T (&/V "apply" (&/T =fn =args)) + =output-t)))))) [_] - (|do [output (analyse-apply* analyse exo-type =fn ?args)] - (return (&/|list output)))) + (|do [[=output-t =args] (analyse-apply* analyse exo-type =fn-type ?args)] + (return (&/|list (&/T (&/V "apply" (&/T =fn =args)) + =output-t))))) ))) (defn analyse-case [analyse exo-type ?value ?branches] diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj index d88c33437..1970c548a 100644 --- a/src/lux/compiler.clj +++ b/src/lux/compiler.clj @@ -60,8 +60,8 @@ [["lux;Global" [?owner-class ?name]]] (&&lux/compile-global compile-expression ?type ?owner-class ?name) - [["apply" [?fn ?arg]]] - (&&lux/compile-apply compile-expression ?type ?fn ?arg) + [["apply" [?fn ?args]]] + (&&lux/compile-apply compile-expression ?type ?fn ?args) [["variant" [?tag ?members]]] (&&lux/compile-variant compile-expression ?type ?tag ?members) diff --git a/src/lux/compiler/lux.clj b/src/lux/compiler/lux.clj index c8197da66..ecb614732 100644 --- a/src/lux/compiler/lux.clj +++ b/src/lux/compiler/lux.clj @@ -117,11 +117,14 @@ :let [_ (.visitFieldInsn *writer* Opcodes/GETSTATIC (str ?owner-class "/$" (&/normalize-ident ?name)) "_datum" "Ljava/lang/Object;")]] (return nil))) -(defn compile-apply [compile *type* ?fn ?arg] +(defn compile-apply [compile *type* ?fn ?args] (|do [^MethodVisitor *writer* &/get-writer _ (compile ?fn) - _ (compile ?arg) - :let [_ (.visitMethodInsn *writer* Opcodes/INVOKEINTERFACE "lux/Function" "apply" &&/apply-signature)]] + _ (&/map% (fn [?arg] + (|do [=arg (compile ?arg) + :let [_ (.visitMethodInsn *writer* Opcodes/INVOKEINTERFACE "lux/Function" "apply" &&/apply-signature)]] + (return =arg))) + ?args)] (return nil))) (defn ^:private type->analysis [type] -- cgit v1.2.3 From 658ff3e1e7d90ce72c8a02ef4cf7e177d8ac6f86 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sun, 12 Jul 2015 21:04:56 -0400 Subject: - Added the beginnings of the standard library. - Fixed several bugs. --- src/lux/analyser.clj | 32 +++++++++++-- src/lux/analyser/case.clj | 11 ++++- src/lux/analyser/env.clj | 16 ++++--- src/lux/analyser/host.clj | 9 ++-- src/lux/analyser/lux.clj | 109 ++++++++++++++++++++++++++++++++------------ src/lux/analyser/module.clj | 79 +++++++++++++++++--------------- src/lux/base.clj | 14 +++++- src/lux/compiler.clj | 2 +- src/lux/compiler/host.clj | 27 +++++------ src/lux/compiler/lux.clj | 13 +++++- src/lux/lexer.clj | 20 ++++---- src/lux/type.clj | 37 +++++++++------ 12 files changed, 247 insertions(+), 122 deletions(-) (limited to 'src') diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj index 039db810a..8c8be29d2 100644 --- a/src/lux/analyser.clj +++ b/src/lux/analyser.clj @@ -115,6 +115,12 @@ ["lux;Nil" _]]]]]]] (&&lux/analyse-export analyse ?ident) + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_lux_alias"]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?alias]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?module]]] + ["lux;Nil" _]]]]]]]]] + (&&lux/analyse-alias analyse ?alias ?module) + [_] (fail ""))) @@ -447,7 +453,7 @@ ;; Programs [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_program"]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ ?args]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ?args]]] ["lux;Cons" [?body ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-program analyse ?args ?body) @@ -500,6 +506,9 @@ [["lux;Right" [state* output]]] (return* state* output) + [["lux;Left" ""]] + (fail* (add-loc meta (str "[Analyser Error] Unrecognized token: " (&/show-ast token)))) + [["lux;Left" msg]] (fail* (add-loc meta msg))) @@ -522,6 +531,21 @@ (fail* (add-loc meta msg)) )))) +(defn ^:private just-analyse [analyse-ast eval! compile-module syntax] + (&type/with-var + (fn [?var] + (|do [[?output-term ?output-type] (&&/analyse-1 (partial analyse-ast eval! compile-module) ?var syntax)] + (matchv ::M/objects [?var ?output-type] + [["lux;VarT" ?e-id] ["lux;VarT" ?a-id]] + (if (= ?e-id ?a-id) + (|do [?output-type* (&type/deref ?e-id)] + (return (&/T ?output-term ?output-type*))) + (return (&/T ?output-term ?output-type))) + + [_ _] + (return (&/T ?output-term ?output-type))) + )))) + (defn ^:private analyse-ast [eval! compile-module exo-type token] (matchv ::M/objects [token] [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;TagS" ?ident]]] ?values]]]]]] @@ -530,10 +554,12 @@ [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [?fn ?args]]]]]] (fn [state] - (matchv ::M/objects [((&type/with-var #(&&/analyse-1 (partial analyse-ast eval! compile-module) % ?fn)) state)] + (matchv ::M/objects [((just-analyse analyse-ast eval! compile-module ?fn) state) + ;; ((&type/with-var #(&&/analyse-1 (partial analyse-ast eval! compile-module) % ?fn)) state) + ] [["lux;Right" [state* =fn]]] (do ;; (prn 'GOT_FUN (&/show-ast ?fn) (&/show-ast token) (aget =fn 0 0) (aget =fn 1 0)) - ((&&lux/analyse-apply (partial analyse-ast eval! compile-module) exo-type =fn ?args) state*)) + ((&&lux/analyse-apply (partial analyse-ast eval! compile-module) exo-type =fn ?args) state*)) [_] ((analyse-basic-ast (partial analyse-ast eval! compile-module) eval! compile-module exo-type token) state))) diff --git a/src/lux/analyser/case.clj b/src/lux/analyser/case.clj index 43e5ee5e7..6efe7fd5f 100644 --- a/src/lux/analyser/case.clj +++ b/src/lux/analyser/case.clj @@ -15,6 +15,15 @@ (fail "##9##")))] (resolve-type type*)) + [["lux;AllT" ?id]] + (|do [$var &type/existential + =type (&type/apply-type type $var)] + (&type/actual-type =type)) + ;; (&type/with-var + ;; (fn [$var] + ;; (|do [=type (&type/apply-type type $var)] + ;; (&type/actual-type =type)))) + [_] (&type/actual-type type))) @@ -68,7 +77,7 @@ (return (&/T (&/V "TupleTestAC" =tests) =kont)))) [_] - (fail "[Analyser Error] Tuple requires tuple-type.")) + (fail "[Analyser Error] Tuples require tuple-type.")) [["lux;RecordS" ?slots]] (|do [value-type* (resolve-type value-type)] diff --git a/src/lux/analyser/env.clj b/src/lux/analyser/env.clj index fa7b9aa1a..de6bdb036 100644 --- a/src/lux/analyser/env.clj +++ b/src/lux/analyser/env.clj @@ -16,18 +16,20 @@ =return (body (&/update$ &/$ENVS (fn [stack] (let [bound-unit (&/V "lux;Local" (->> (&/|head stack) (&/get$ &/$LOCALS) (&/get$ &/$COUNTER)))] - (&/|cons (->> (&/|head stack) - (&/update$ &/$LOCALS #(&/update$ &/$COUNTER inc %)) - (&/update$ &/$LOCALS #(&/update$ &/$MAPPINGS (fn [m] (&/|put name (&/T bound-unit type) m)) %))) + (&/|cons (&/update$ &/$LOCALS #(->> % + (&/update$ &/$COUNTER inc) + (&/update$ &/$MAPPINGS (fn [m] (&/|put name (&/T bound-unit type) m)))) + (&/|head stack)) (&/|tail stack)))) state))] (matchv ::M/objects [=return] [["lux;Right" [?state ?value]]] (return* (&/update$ &/$ENVS (fn [stack*] - (&/|cons (->> (&/|head stack*) - (&/update$ &/$LOCALS #(&/update$ &/$COUNTER dec %)) - (&/update$ &/$LOCALS #(&/set$ &/$MAPPINGS old-mappings %))) - (&/|tail stack*))) + (&/|cons (&/update$ &/$LOCALS #(->> % + (&/update$ &/$COUNTER dec) + (&/set$ &/$MAPPINGS old-mappings)) + (&/|head stack*)) + (&/|tail stack*))) ?state) ?value) diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj index b9361b8c3..3db4bd16d 100644 --- a/src/lux/analyser/host.clj +++ b/src/lux/analyser/host.clj @@ -352,7 +352,8 @@ ) (defn analyse-jvm-program [analyse ?args ?body] - (|do [=body (&/with-scope "" - (&&env/with-local ?args (&/V "lux;AppT" (&/T &type/List &type/Text)) - (&&/analyse-1 analyse (&/V "lux;AppT" (&/T &type/IO &type/Unit)) ?body)))] - (return (&/|list (&/V "jvm-program" =body))))) + (|let [[_module _name] ?args] + (|do [=body (&/with-scope "" + (&&env/with-local (str _module ";" _name) (&/V "lux;AppT" (&/T &type/List &type/Text)) + (&&/analyse-1 analyse (&/V "lux;AppT" (&/T &type/IO &type/Unit)) ?body)))] + (return (&/|list (&/V "jvm-program" =body)))))) diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj index 6bbcd0fcf..d02599f10 100644 --- a/src/lux/analyser/lux.clj +++ b/src/lux/analyser/lux.clj @@ -76,6 +76,15 @@ (|do [exo-type* (&type/deref ?id)] (&type/actual-type exo-type*)) + [["lux;AllT" _]] + (|do [$var &type/existential + =type (&type/apply-type exo-type $var)] + (&type/actual-type =type)) + ;; (&type/with-var + ;; (fn [$var] + ;; (|do [=type (&type/apply-type exo-type $var)] + ;; (&type/actual-type =type)))) + [_] (&type/actual-type exo-type)) types (matchv ::M/objects [exo-type*] @@ -83,7 +92,9 @@ (return ?table) [_] - (fail "[Analyser Error] The type of a record must be a record type.")) + (fail (str "[Analyser Error] The type of a record must be a record type:\n" + (&type/show-type exo-type*) + "\n"))) =slots (&/map% (fn [kv] (matchv ::M/objects [kv] [[["lux;Meta" [_ ["lux;TagS" ?ident]]] ?value]] @@ -196,6 +207,9 @@ (|do [?fun-type* (&type/actual-type fun-type)] (matchv ::M/objects [?fun-type*] [["lux;AllT" _]] + ;; (|do [$var &type/existential + ;; type* (&type/apply-type ?fun-type* $var)] + ;; (analyse-apply* analyse exo-type type* ?args)) (&type/with-var (fn [$var] (|do [type* (&type/apply-type ?fun-type* $var) @@ -216,6 +230,9 @@ =arg (&&/analyse-1 analyse ?input-t ?arg)] (return (&/T =output-t (&/|cons =arg =args)))) + ;; [["lux;VarT" ?id-t]] + ;; (|do [ (&type/deref ?id-t)]) + [_] (fail (str "[Analyser Error] Can't apply a non-function: " (&type/show-type ?fun-type*))))) )) @@ -229,7 +246,14 @@ (|do [[[r-module r-name] $def] (&&module/find-def ?module ?name)] (matchv ::M/objects [$def] [["lux;MacroD" macro]] - (|do [macro-expansion #(-> macro (.apply ?args) (.apply %))] + (|do [macro-expansion #(-> macro (.apply ?args) (.apply %)) + :let [_ (when (and ;; (= "lux/control/monad" ?module) + (= "do" ?name)) + (->> (&/|map &/show-ast macro-expansion) + (&/|interpose "\n") + (&/fold str "") + (prn ?module "do")))] + ] (&/flat-map% (partial analyse exo-type) macro-expansion)) [_] @@ -254,16 +278,26 @@ exo-type))))) (defn analyse-lambda* [analyse exo-type ?self ?arg ?body] - (matchv ::M/objects [exo-type] - [["lux;LambdaT" [?arg-t ?return-t]]] - (|do [[=scope =captured =body] (&&lambda/with-lambda ?self exo-type - ?arg ?arg-t - (&&/analyse-1 analyse ?return-t ?body))] - (return (&/T (&/V "lambda" (&/T =scope =captured =body)) exo-type))) - - [_] - (fail (str "[Analyser Error] Functions require function types: " - (&type/show-type exo-type))))) + (|do [exo-type* (&type/actual-type exo-type)] + (matchv ::M/objects [exo-type] + [["lux;AllT" _]] + (&type/with-var + (fn [$var] + (|do [exo-type** (&type/apply-type exo-type* $var)] + (analyse-lambda* analyse exo-type** ?self ?arg ?body)))) + ;; (|do [$var &type/existential + ;; exo-type** (&type/apply-type exo-type* $var)] + ;; (analyse-lambda* analyse exo-type** ?self ?arg ?body)) + + [["lux;LambdaT" [?arg-t ?return-t]]] + (|do [[=scope =captured =body] (&&lambda/with-lambda ?self exo-type* + ?arg ?arg-t + (&&/analyse-1 analyse ?return-t ?body))] + (return (&/T (&/V "lambda" (&/T =scope =captured =body)) exo-type*))) + + [_] + (fail (str "[Analyser Error] Functions require function types: " + (&type/show-type exo-type*)))))) (defn analyse-lambda** [analyse exo-type ?self ?arg ?body] (matchv ::M/objects [exo-type] @@ -281,6 +315,14 @@ [["lux;ExT" _]] (return (&/T _expr exo-type)) + [["lux;VarT" ?_id]] + (|do [?? (&type/bound? ?_id)] + ;; (return (&/T _expr exo-type)) + (if ?? + (fail (str "[Analyser Error] Can't use type-var in any type-specific way inside polymorphic functions: " ?id ":" _arg " " (&type/show-type dtype))) + (return (&/T _expr exo-type))) + ) + [_] (fail (str "[Analyser Error] Can't use type-var in any type-specific way inside polymorphic functions: " ?id ":" _arg " " (&type/show-type dtype))))) (return (&/T _expr exo-type)))))))) @@ -295,7 +337,7 @@ (return (&/|list output)))) (defn analyse-def [analyse ?name ?value] - (prn 'analyse-def/BEGIN ?name) + ;; (prn 'analyse-def/BEGIN ?name) (|do [module-name &/get-module-name ? (&&module/defined? module-name ?name)] (if ? @@ -306,14 +348,16 @@ (matchv ::M/objects [=value] [[["lux;Global" [?r-module ?r-name]] _]] (|do [_ (&&module/def-alias module-name ?name ?r-module ?r-name =value-type) - :let [_ (println 'analyse-def/ALIAS (str module-name ";" ?name) '=> (str ?r-module ";" ?r-name)) - _ (println)]] + ;; :let [_ (println 'analyse-def/ALIAS (str module-name ";" ?name) '=> (str ?r-module ";" ?r-name)) + ;; _ (println)] + ] (return (&/|list))) [_] (|do [=value-type (&&/expr-type =value) - :let [_ (prn 'analyse-def/END ?name) - _ (println) + :let [;; _ (prn 'analyse-def/END ?name) + _ (println 'DEF (str module-name ";" ?name)) + ;; _ (println) def-data (cond (&type/type= &type/Type =value-type) (&/V "lux;TypeD" nil) @@ -328,23 +372,32 @@ (return (&/|list (&/V "declare-macro" (&/T module-name ?name)))))) (defn analyse-import [analyse compile-module ?path] - (prn 'analyse-import ?path) - (fn [state] - (let [already-compiled? (&/fold false #(or %1 (= %2 ?path)) (&/get$ &/$SEEN-SOURCES state))] - (&/run-state (|do [_ (&&module/add-import ?path) - _ (if already-compiled? - (return nil) - (compile-module ?path))] - (return (&/|list))) - (if already-compiled? - state - (&/update$ &/$SEEN-SOURCES (partial &/|cons ?path) state)))))) + (|do [module-name &/get-module-name] + (if (= module-name ?path) + (fail (str "[Analyser Error] Module can't import itself: " ?path)) + (&/save-module + (fn [state] + (let [already-compiled? (&/fold #(or %1 (= %2 ?path)) false (&/get$ &/$SEEN-SOURCES state))] + (prn 'analyse-import module-name ?path already-compiled?) + (&/run-state (|do [_ (&&module/add-import ?path) + _ (if already-compiled? + (return nil) + (compile-module ?path))] + (return (&/|list))) + (if already-compiled? + state + (&/update$ &/$SEEN-SOURCES (partial &/|cons ?path) state))))))))) (defn analyse-export [analyse name] (|do [module-name &/get-module-name _ (&&module/export module-name name)] (return (&/|list)))) +(defn analyse-alias [analyse ex-alias ex-module] + (|do [module-name &/get-module-name + _ (&&module/alias module-name ex-alias ex-module)] + (return (&/|list)))) + (defn analyse-check [analyse eval! exo-type ?type ?value] (|do [=type (&&/analyse-1 analyse &type/Type ?type) ==type (eval! =type) diff --git a/src/lux/analyser/module.clj b/src/lux/analyser/module.clj index f0e5b82b4..27aa7374c 100644 --- a/src/lux/analyser/module.clj +++ b/src/lux/analyser/module.clj @@ -1,5 +1,6 @@ (ns lux.analyser.module - (:require [clojure.core.match :as M :refer [matchv]] + (:require [clojure.string :as string] + [clojure.core.match :as M :refer [matchv]] clojure.core.match.array (lux [base :as & :refer [|let |do return return* fail fail*]] [type :as &type] @@ -46,13 +47,14 @@ #(&/|put name (&/T false def-data) %) m)) ms))) - (&/set$ &/$ENVS (&/|list (&/update$ &/$LOCALS (fn [locals] - (&/update$ &/$MAPPINGS (fn [mappings] - (&/|put (str "" &/+name-separator+ name) - (&/T (&/V "lux;Global" (&/T module name)) type) - mappings)) - locals)) - ?env)))) + ;; (&/set$ &/$ENVS (&/|list (&/update$ &/$LOCALS (fn [locals] + ;; (&/update$ &/$MAPPINGS (fn [mappings] + ;; (&/|put (str "" &/+name-separator+ name) + ;; (&/T (&/V "lux;Global" (&/T module name)) type) + ;; mappings)) + ;; locals)) + ;; ?env))) + ) nil) [_] @@ -93,14 +95,15 @@ #(&/|put a-name (&/T false (&/V "lux;AliasD" (&/T r-module r-name))) %) m)) ms))) - (&/set$ &/$ENVS (&/|list (&/update$ &/$LOCALS (fn [locals] - (&/update$ &/$MAPPINGS (fn [mappings] - (&/|put (str "" &/+name-separator+ a-name) - (&/T (&/V "lux;Global" (&/T r-module r-name)) type) - ;; (aget (->> state (&/get$ &/$MODULES) (&/|get r-module) (&/get$ $DEFS) (&/|get r-name)) 1) - mappings)) - locals)) - ?env)))) + ;; (&/set$ &/$ENVS (&/|list (&/update$ &/$LOCALS (fn [locals] + ;; (&/update$ &/$MAPPINGS (fn [mappings] + ;; (&/|put (str "" &/+name-separator+ a-name) + ;; (&/T (&/V "lux;Global" (&/T r-module r-name)) type) + ;; ;; (aget (->> state (&/get$ &/$MODULES) (&/|get r-module) (&/get$ $DEFS) (&/|get r-name)) 1) + ;; mappings)) + ;; locals)) + ;; ?env))) + ) nil) [_] @@ -112,7 +115,7 @@ (return* state (->> state (&/get$ &/$MODULES) (&/|contains? name))))) -(defn alias-module [module reference alias] +(defn alias [module alias reference] (fn [state] (return* (->> state (&/update$ &/$MODULES @@ -136,23 +139,23 @@ (|do [current-module &/get-module-name] (fn [state] ;; (prn 'find-def/_0 module name 'current-module current-module) - (if-let [$module (->> state (&/get$ &/$MODULES) (&/|get module) (&/get$ $DEFS))] + (if-let [$module (->> state (&/get$ &/$MODULES) (&/|get module))] (do ;; (prn 'find-def/_0.1 module (&/->seq (&/|keys $module))) - (if-let [$def (&/|get name $module)] - (matchv ::M/objects [$def] - [[exported? $$def]] - (do ;; (prn 'find-def/_1 module name 'exported? exported? (.equals ^Object current-module module)) - (if (or exported? (.equals ^Object current-module module)) - (matchv ::M/objects [$$def] - [["lux;AliasD" [?r-module ?r-name]]] - (do ;; (prn 'find-def/_2 [module name] [?r-module ?r-name]) - ((find-def ?r-module ?r-name) - state)) - - [_] - (return* state (&/T (&/T module name) $$def))) - (fail* (str "[Analyser Error] Can't use unexported definition: " (str module &/+name-separator+ name)))))) - (fail* (str "[Analyser Error] Definition doesn't exist: " (str module &/+name-separator+ name))))) + (if-let [$def (->> $module (&/get$ $DEFS) (&/|get name))] + (matchv ::M/objects [$def] + [[exported? $$def]] + (do ;; (prn 'find-def/_1 module name 'exported? exported? (.equals ^Object current-module module)) + (if (or exported? (.equals ^Object current-module module)) + (matchv ::M/objects [$$def] + [["lux;AliasD" [?r-module ?r-name]]] + (do ;; (prn 'find-def/_2 [module name] [?r-module ?r-name]) + ((find-def ?r-module ?r-name) + state)) + + [_] + (return* state (&/T (&/T module name) $$def))) + (fail* (str "[Analyser Error] Can't use unexported definition: " (str module &/+name-separator+ name)))))) + (fail* (str "[Analyser Error] Definition does not exist: " (str module &/+name-separator+ name))))) (do (prn [module name] (str "[Analyser Error] Module doesn't exist: " module) (->> state (&/get$ &/$MODULES) &/|keys &/->seq)) @@ -171,7 +174,7 @@ [[exported? ["lux;ValueD" ?type]]] ((|do [_ (&type/check &type/Macro ?type) ^ClassLoader loader &/loader - :let [macro (-> (.loadClass loader (str module ".$" (&/normalize-ident name))) + :let [macro (-> (.loadClass loader (str (string/replace module #"/" ".") ".$" (&/normalize-ident name))) (.getField "_datum") (.get nil))]] (fn [state*] @@ -191,9 +194,9 @@ (fail* (str "[Analyser Error] Can't re-declare a macro: " (str module &/+name-separator+ name))) [[_ ["lux;TypeD" _]]] - (fail* (str "[Analyser Error] Definition doesn't have macro type: " module ";" name))) - (fail* (str "[Analyser Error] Definition doesn't exist: " (str module &/+name-separator+ name)))) - (fail* (str "[Analyser Error] Module doesn't exist: " module))))) + (fail* (str "[Analyser Error] Definition does not have macro type: " (str module &/+name-separator+ name)))) + (fail* (str "[Analyser Error] Definition does not exist: " (str module &/+name-separator+ name)))) + (fail* (str "[Analyser Error] Module does not exist: " module))))) (defn export [module name] (fn [state] @@ -213,7 +216,7 @@ m)) ms)))) nil)) - (fail* (str "[Analyser Error] Can't export an inexistent definition: " module ";" name))) + (fail* (str "[Analyser Error] Can't export an inexistent definition: " (str module &/+name-separator+ name)))) [_] (fail* "[Analyser Error] Can't export a global definition outside of a global environment.")))) diff --git a/src/lux/base.clj b/src/lux/base.clj index aecb3fd13..d88bb2ec1 100644 --- a/src/lux/base.clj +++ b/src/lux/base.clj @@ -483,13 +483,25 @@ ;; "lux;seed" 0 ;; "lux;seen-sources" - (|list) + (|list "lux") ;; "lux;source" (V "lux;None" nil) ;; "lux;types" +init-bindings+ )) +(defn save-module [body] + (fn [state] + (matchv ::M/objects [(body state)] + [["lux;Right" [state* output]]] + (return* (->> state* + (set$ $ENVS (get$ $ENVS state)) + (set$ $SOURCE (get$ $SOURCE state))) + output) + + [["lux;Left" msg]] + (fail* msg)))) + (defn with-eval [body] (fn [state] (matchv ::M/objects [(body (set$ $EVAL? true state))] diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj index 1970c548a..04f4fb4c2 100644 --- a/src/lux/compiler.clj +++ b/src/lux/compiler.clj @@ -342,7 +342,7 @@ .visitEnd))] _ (&&/save-class! (str id) bytecode) loader &/loader] - (-> (.loadClass ^ClassLoader loader (str module "." id)) + (-> (.loadClass ^ClassLoader loader (str (string/replace module #"/" ".") "." id)) (.getField "_eval") (.get nil) return)))) diff --git a/src/lux/compiler/host.clj b/src/lux/compiler/host.clj index bc1ab23f1..2a8bdac89 100644 --- a/src/lux/compiler/host.clj +++ b/src/lux/compiler/host.clj @@ -146,7 +146,7 @@ compile-jvm-igt Opcodes/IF_ICMPGT "java.lang.Integer" "intValue" "()I" ) -(do-template [ ] +(do-template [ ] (defn [compile *type* ?x ?y] (|do [:let [+wrapper-class+ (&host/->class )] ^MethodVisitor *writer* &/get-writer @@ -162,25 +162,26 @@ $end (new Label) _ (doto *writer* (.visitInsn ) - (.visitJumpInsn $then) - (.visitFieldInsn Opcodes/GETSTATIC (&host/->class "java.lang.Boolean") "TRUE" (&host/->type-signature "java.lang.Boolean")) + (.visitLdcInsn (int )) + (.visitJumpInsn Opcodes/IF_ICMPEQ $then) + (.visitFieldInsn Opcodes/GETSTATIC (&host/->class "java.lang.Boolean") "FALSE" (&host/->type-signature "java.lang.Boolean")) (.visitJumpInsn Opcodes/GOTO $end) (.visitLabel $then) - (.visitFieldInsn Opcodes/GETSTATIC (&host/->class "java.lang.Boolean") "FALSE" (&host/->type-signature "java.lang.Boolean")) + (.visitFieldInsn Opcodes/GETSTATIC (&host/->class "java.lang.Boolean") "TRUE" (&host/->type-signature "java.lang.Boolean")) (.visitLabel $end))]] (return nil))) - compile-jvm-leq Opcodes/LCMP Opcodes/IFEQ "java.lang.Long" "longValue" "()J" - compile-jvm-llt Opcodes/LCMP Opcodes/IFLT "java.lang.Long" "longValue" "()J" - compile-jvm-lgt Opcodes/LCMP Opcodes/IFGT "java.lang.Long" "longValue" "()J" + compile-jvm-leq Opcodes/LCMP 0 "java.lang.Long" "longValue" "()J" + compile-jvm-llt Opcodes/LCMP 1 "java.lang.Long" "longValue" "()J" + compile-jvm-lgt Opcodes/LCMP -1 "java.lang.Long" "longValue" "()J" - compile-jvm-feq Opcodes/FCMPG Opcodes/IFEQ "java.lang.Float" "floatValue" "()F" - compile-jvm-flt Opcodes/FCMPG Opcodes/IFLT "java.lang.Float" "floatValue" "()F" - compile-jvm-fgt Opcodes/FCMPG Opcodes/IFGT "java.lang.Float" "floatValue" "()F" + compile-jvm-feq Opcodes/FCMPG 0 "java.lang.Float" "floatValue" "()F" + compile-jvm-flt Opcodes/FCMPG 1 "java.lang.Float" "floatValue" "()F" + compile-jvm-fgt Opcodes/FCMPG -1 "java.lang.Float" "floatValue" "()F" - compile-jvm-deq Opcodes/DCMPG Opcodes/IFEQ "java.lang.Double" "doubleValue" "()I" - compile-jvm-dlt Opcodes/DCMPG Opcodes/IFLT "java.lang.Double" "doubleValue" "()I" - compile-jvm-dgt Opcodes/FCMPG Opcodes/IFGT "java.lang.Double" "doubleValue" "()I" + compile-jvm-deq Opcodes/DCMPG 0 "java.lang.Double" "doubleValue" "()I" + compile-jvm-dlt Opcodes/DCMPG 1 "java.lang.Double" "doubleValue" "()I" + compile-jvm-dgt Opcodes/FCMPG -1 "java.lang.Double" "doubleValue" "()I" ) (defn compile-jvm-invokestatic [compile *type* ?class ?method ?classes ?args] diff --git a/src/lux/compiler/lux.clj b/src/lux/compiler/lux.clj index ecb614732..7d6b2b502 100644 --- a/src/lux/compiler/lux.clj +++ b/src/lux/compiler/lux.clj @@ -25,6 +25,17 @@ :let [_ (.visitFieldInsn *writer* Opcodes/GETSTATIC "java/lang/Boolean" (if ?value "TRUE" "FALSE") "Ljava/lang/Boolean;")]] (return nil))) +(defn compile-int [compile *type* value] + (|do [^MethodVisitor *writer* &/get-writer + :let [_ (doto *writer* + (.visitTypeInsn Opcodes/NEW "java/lang/Long") + (.visitInsn Opcodes/DUP) + (.visitLdcInsn (bit-shift-left (long value) 0) + ;; (bit-shift-left (long value) 32) + ) + (.visitMethodInsn Opcodes/INVOKESPECIAL "java/lang/Long" "" "(J)V"))]] + (return nil))) + (do-template [ ] (defn [compile *type* value] (|do [^MethodVisitor *writer* &/get-writer @@ -35,7 +46,7 @@ (.visitMethodInsn Opcodes/INVOKESPECIAL "" ))]] (return nil))) - compile-int "java/lang/Long" "(J)V" long + ;; compile-int "java/lang/Long" "(J)V" long compile-real "java/lang/Double" "(D)V" double compile-char "java/lang/Character" "(C)V" char ) diff --git a/src/lux/lexer.clj b/src/lux/lexer.clj index a137ca863..fbfe1f757 100644 --- a/src/lux/lexer.clj +++ b/src/lux/lexer.clj @@ -67,8 +67,8 @@ (return (&/V "lux;Meta" (&/T meta (&/V token)))))) ^:private lex-bool "Bool" #"^(true|false)" - ^:private lex-int "Int" #"^-?(0|[1-9][0-9]*)" - ^:private lex-real "Real" #"^-?(0|[1-9][0-9]*)\.[0-9]+" + ^:private lex-int "Int" #"^(-?0|-?[1-9][0-9]*)" + ^:private lex-real "Real" #"^-?(-?0\.[0-9]+|-?[1-9][0-9]*\.[0-9]+)" ) (def ^:private lex-char @@ -89,14 +89,14 @@ (def ^:private lex-ident (&/try-all% (&/|list (|do [[meta token] (&reader/read-regex +ident-re+)] (&/try-all% (&/|list (|do [_ (&reader/read-text ";") - [_ local-token] (&reader/read-regex +ident-re+)] - (&/try-all% (&/|list (|do [unaliased (&module/dealias token)] - (return (&/T meta (&/T unaliased local-token)))) - (|do [? (&module/exists? token)] - (if ? - (return (&/T meta (&/T token local-token))) - (fail (str "[Lexer Error] Unknown module: " token)))) - ))) + [_ local-token] (&reader/read-regex +ident-re+) + ? (&module/exists? token)] + (if ? + (return (&/T meta (&/T token local-token))) + (|do [unaliased (do ;; (prn "Unaliasing: " token ";" local-token) + (&module/dealias token))] + (do ;; (prn "Unaliased: " unaliased ";" local-token) + (return (&/T meta (&/T unaliased local-token))))))) (return (&/T meta (&/T "" token))) ))) (|do [[meta _] (&reader/read-text ";;") diff --git a/src/lux/type.clj b/src/lux/type.clj index e0315f8e7..e7d6353e8 100644 --- a/src/lux/type.clj +++ b/src/lux/type.clj @@ -349,16 +349,18 @@ (str "(, " (->> elems (&/|map show-type) (&/|interpose " ") (&/fold str "")) ")")) [["lux;VariantT" cases]] - (str "(| " (->> cases - (&/|map (fn [kv] - (matchv ::M/objects [kv] - [[k ["Tuple" ["Nil" _]]]] - (str "#" k) - - [[k v]] - (str "(#" k " " (show-type v) ")")))) - (&/|interpose " ") - (&/fold str "")) ")") + (if (&/|empty? cases) + "(|)" + (str "(| " (->> cases + (&/|map (fn [kv] + (matchv ::M/objects [kv] + [[k ["lux;TupleT" ["lux;Nil" _]]]] + (str "#" k) + + [[k v]] + (str "(#" k " " (show-type v) ")")))) + (&/|interpose " ") + (&/fold str "")) ")")) [["lux;RecordT" fields]] @@ -485,7 +487,9 @@ (&/|cons (&/T k v) fixpoints)) (defn ^:private check-error [expected actual] - (str "Type " (show-type expected) " does not subsume type " (show-type actual))) + (str "[Type Checker]\nExpected: " (show-type expected) + "\n\nActual: " (show-type actual) + "\n")) (defn beta-reduce [env type] (matchv ::M/objects [type] @@ -555,7 +559,7 @@ (apply-type type-fn* param)) [_] - (fail (str "[Type System] Can't apply type function " (show-type type-fn) " to type " (show-type param))))) + (fail (str "[Type System] Not type function:\n" (show-type type-fn) "\n")))) (def init-fixpoints (&/|list)) @@ -826,10 +830,10 @@ [["lux;ExT" e!id] ["lux;ExT" a!id]] (if (.equals ^Object e!id a!id) (return (&/T fixpoints nil)) - (check-error expected actual)) + (fail (check-error expected actual))) [_ _] - (fail (println-str "[Type Error] Can't type-check: " (show-type expected) (show-type actual))) + (fail (check-error expected actual)) ))) (defn check [expected actual] @@ -850,7 +854,7 @@ (clean $var =return)))) [_] - (fail (str "[Type System] Can't apply type " (show-type func) " to type " (show-type param))) + (fail (str "[Type System] Not a function type:\n" (show-type func) "\n")) )) (defn actual-type [type] @@ -859,6 +863,9 @@ (|do [type* (apply-type ?all ?param)] (actual-type type*)) + [["lux;VarT" ?id]] + (deref ?id) + [_] (return type) )) -- cgit v1.2.3 From eb424eeb33d8fc9bb7ad2acda0c58fcb037717d3 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Tue, 14 Jul 2015 22:47:10 -0400 Subject: - Added a ' (quote) macro that works like ` (backquote), without unquote or unquote splice working and not automatic prefixing of unprefixed symbols/tags. - Added (slightly) better type-error messages. --- src/lux/analyser/case.clj | 2 +- src/lux/type.clj | 97 +++++++++++++++++++++++++++++++++++++++++------ 2 files changed, 87 insertions(+), 12 deletions(-) (limited to 'src') diff --git a/src/lux/analyser/case.clj b/src/lux/analyser/case.clj index 6efe7fd5f..6dfa234bd 100644 --- a/src/lux/analyser/case.clj +++ b/src/lux/analyser/case.clj @@ -77,7 +77,7 @@ (return (&/T (&/V "TupleTestAC" =tests) =kont)))) [_] - (fail "[Analyser Error] Tuples require tuple-type.")) + (fail (str "[Analyser Error] Tuples require tuple-types: " (&type/show-type value-type)))) [["lux;RecordS" ?slots]] (|do [value-type* (resolve-type value-type)] diff --git a/src/lux/type.clj b/src/lux/type.clj index e7d6353e8..c3a27ce2b 100644 --- a/src/lux/type.clj +++ b/src/lux/type.clj @@ -338,6 +338,15 @@ [_] (fail (str "[Type Error] Not type-var: " (show-type tvar))))) +(defn ^:private unravel-app [fun-type] + (matchv ::M/objects [fun-type] + [["lux;AppT" [?left ?right]]] + (|let [[?fun-type ?args] (unravel-app ?left)] + (&/T ?fun-type (&/|++ ?args (&/|list ?right)))) + + [_] + (&/T fun-type (&/|list)))) + (defn show-type [^objects type] (matchv ::M/objects [type] [["lux;DataT" name]] @@ -384,23 +393,89 @@ [["lux;ExT" ?id]] (str "⟨" ?id "⟩") - [["lux;AppT" [?lambda ?param]]] - (str "(" (show-type ?lambda) " " (show-type ?param) ")") + [["lux;AppT" [_ _]]] + (|let [[?call-fun ?call-args] (unravel-app type)] + (str "(" (show-type ?call-fun) " " (->> ?call-args (&/|map show-type) (&/|interpose " ") (&/fold str "")) ")")) [["lux;AllT" [?env ?name ?arg ?body]]] - (let [[args body] (loop [args (list ?arg) - body* ?body] - (matchv ::M/objects [body*] - [["lux;AllT" [?env* ?name* ?arg* ?body*]]] - (recur (cons ?arg* args) ?body*) - - [_] - [args body*]))] - (str "(All " ?name " [" (->> args reverse (interpose " ") (reduce str "")) "] " (show-type body) ")")) + (if (= "" ?name) + (let [[args body] (loop [args (list ?arg) + body* ?body] + (matchv ::M/objects [body*] + [["lux;AllT" [?env* ?name* ?arg* ?body*]]] + (recur (cons ?arg* args) ?body*) + + [_] + [args body*]))] + (str "(All " ?name " [" (->> args reverse (interpose " ") (reduce str "")) "] " (show-type body) ")")) + ?name) [_] (assert false (prn-str 'show-type (aget type 0) (class (aget type 1)))) )) +;; (defn show-type [^objects type] +;; (matchv ::M/objects [type] +;; [["lux;DataT" name]] +;; (str "(^ " name ")") + +;; [["lux;TupleT" elems]] +;; (if (&/|empty? elems) +;; "(,)" +;; (str "(, " (->> elems (&/|map show-type) (&/|interpose " ") (&/fold str "")) ")")) + +;; [["lux;VariantT" cases]] +;; (if (&/|empty? cases) +;; "(|)" +;; (str "(| " (->> cases +;; (&/|map (fn [kv] +;; (matchv ::M/objects [kv] +;; [[k ["lux;TupleT" ["lux;Nil" _]]]] +;; (str "#" k) + +;; [[k v]] +;; (str "(#" k " " (show-type v) ")")))) +;; (&/|interpose " ") +;; (&/fold str "")) ")")) + + +;; [["lux;RecordT" fields]] +;; (str "(& " (->> fields +;; (&/|map (fn [kv] +;; (matchv ::M/objects [kv] +;; [[k v]] +;; (str "#" k " " (show-type v))))) +;; (&/|interpose " ") +;; (&/fold str "")) ")") + +;; [["lux;LambdaT" [input output]]] +;; (str "(-> " (show-type input) " " (show-type output) ")") + +;; [["lux;VarT" id]] +;; (str "⌈" id "⌋") + +;; [["lux;BoundT" name]] +;; name + +;; [["lux;ExT" ?id]] +;; (str "⟨" ?id "⟩") + +;; [["lux;AppT" [?lambda ?param]]] +;; (str "(" (show-type ?lambda) " " (show-type ?param) ")") + +;; [["lux;AllT" [?env ?name ?arg ?body]]] +;; (let [[args body] (loop [args (list ?arg) +;; body* ?body] +;; (matchv ::M/objects [body*] +;; [["lux;AllT" [?env* ?name* ?arg* ?body*]]] +;; (recur (cons ?arg* args) ?body*) + +;; [_] +;; [args body*]))] +;; (str "(All " ?name " [" (->> args reverse (interpose " ") (reduce str "")) "] " (show-type body) ")")) + +;; [_] +;; (assert false (prn-str 'show-type (aget type 0) (class (aget type 1)))) +;; )) (defn type= [x y] (or (clojure.lang.Util/identical x y) -- cgit v1.2.3 From 50366bad3ecf961fdfdbb1e4d8436794d97ae763 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sun, 19 Jul 2015 22:24:48 -0400 Subject: - Some bug fixes. - More additions to the standard library. --- src/lux/analyser.clj | 578 ++++++++++++++++++++++------------------------ src/lux/analyser/case.clj | 70 +++--- src/lux/analyser/host.clj | 26 ++- src/lux/analyser/lux.clj | 10 +- src/lux/base.clj | 12 +- src/lux/compiler.clj | 13 ++ src/lux/compiler/host.clj | 24 +- src/lux/compiler/lux.clj | 13 +- 8 files changed, 382 insertions(+), 364 deletions(-) (limited to 'src') diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj index 8c8be29d2..782ae4685 100644 --- a/src/lux/analyser.clj +++ b/src/lux/analyser.clj @@ -26,214 +26,128 @@ ["lux;Nil" _]]]]]]]]] (&/T catch+ ?finally-body))) -(let [unit (&/V "lux;Meta" (&/T (&/T "" -1 -1) (&/V "lux;TupleS" (|list))))] - (defn ^:private aba1 [analyse eval! compile-module exo-type token] - (matchv ::M/objects [token] - ;; Standard special forms - [["lux;BoolS" ?value]] - (|do [_ (&type/check exo-type &type/Bool)] - (return (&/|list (&/T (&/V "bool" ?value) exo-type)))) - - [["lux;IntS" ?value]] - (|do [_ (&type/check exo-type &type/Int)] - (return (&/|list (&/T (&/V "int" ?value) exo-type)))) - - [["lux;RealS" ?value]] - (|do [_ (&type/check exo-type &type/Real)] - (return (&/|list (&/T (&/V "real" ?value) exo-type)))) - - [["lux;CharS" ?value]] - (|do [_ (&type/check exo-type &type/Char)] - (return (&/|list (&/T (&/V "char" ?value) exo-type)))) - - [["lux;TextS" ?value]] - (|do [_ (&type/check exo-type &type/Text)] - (return (&/|list (&/T (&/V "text" ?value) exo-type)))) - - [["lux;TupleS" ?elems]] - (&&lux/analyse-tuple analyse exo-type ?elems) - - [["lux;RecordS" ?elems]] - (&&lux/analyse-record analyse exo-type ?elems) - - [["lux;TagS" ?ident]] - (&&lux/analyse-variant analyse exo-type ?ident unit) - - [["lux;SymbolS" [_ "_jvm_null"]]] - (return (&/|list (&/T (&/V "jvm-null" nil) (&/V "lux;DataT" "null")))) - - [_] - (fail "") - ))) - -(defn ^:private aba2 [analyse eval! compile-module exo-type token] +(defn ^:private aba7 [analyse eval! compile-module exo-type token] (matchv ::M/objects [token] - [["lux;SymbolS" ?ident]] - (&&lux/analyse-symbol analyse exo-type ?ident) - - [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_lux_case"]]]] - ["lux;Cons" [?value ?branches]]]]]] - (&&lux/analyse-case analyse exo-type ?value ?branches) - - [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_lux_lambda"]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ?self]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ?arg]]] - ["lux;Cons" [?body - ["lux;Nil" _]]]]]]]]]]] - (&&lux/analyse-lambda analyse exo-type ?self ?arg ?body) - - [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_lux_def"]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?name]]]] - ["lux;Cons" [?value + ;; Arrays + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_new-array"]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ ?class]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;IntS" ?length]]] ["lux;Nil" _]]]]]]]]] - (&&lux/analyse-def analyse ?name ?value) - - [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_lux_declare-macro"]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?name]]]] - ["lux;Nil" _]]]]]]] - (&&lux/analyse-declare-macro analyse ?name) + (&&host/analyse-jvm-new-array analyse ?class ?length) - [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_lux_import"]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?path]]] - ["lux;Nil" _]]]]]]] - (&&lux/analyse-import analyse compile-module ?path) + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_aastore"]]]] + ["lux;Cons" [?array + ["lux;Cons" [["lux;Meta" [_ ["lux;IntS" ?idx]]] + ["lux;Cons" [?elem + ["lux;Nil" _]]]]]]]]]]] + (&&host/analyse-jvm-aastore analyse ?array ?idx ?elem) - [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_lux_:"]]]] - ["lux;Cons" [?type - ["lux;Cons" [?value + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_aaload"]]]] + ["lux;Cons" [?array + ["lux;Cons" [["lux;Meta" [_ ["lux;IntS" ?idx]]] ["lux;Nil" _]]]]]]]]] - (&&lux/analyse-check analyse eval! exo-type ?type ?value) + (&&host/analyse-jvm-aaload analyse ?array ?idx) - [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_lux_:!"]]]] - ["lux;Cons" [?type - ["lux;Cons" [?value - ["lux;Nil" _]]]]]]]]] - (&&lux/analyse-coerce analyse eval! exo-type ?type ?value) + ;; Classes & interfaces + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_class"]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?name]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?super-class]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?interfaces]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?fields]]] + ?methods]]]]]]]]]]]] + (&&host/analyse-jvm-class analyse ?name ?super-class ?interfaces ?fields ?methods) - [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_lux_export"]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?ident]]]] - ["lux;Nil" _]]]]]]] - (&&lux/analyse-export analyse ?ident) + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_interface"]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?name]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?supers]]] + ?methods]]]]]]]] + (&&host/analyse-jvm-interface analyse ?name ?supers ?methods) - [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_lux_alias"]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?alias]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?module]]] + ;; Programs + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_program"]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ?args]]] + ["lux;Cons" [?body ["lux;Nil" _]]]]]]]]] - (&&lux/analyse-alias analyse ?alias ?module) + (&&host/analyse-jvm-program analyse ?args ?body) [_] (fail ""))) -(defn ^:private aba3 [analyse eval! compile-module exo-type token] +(defn ^:private aba6 [analyse eval! compile-module exo-type token] (matchv ::M/objects [token] - ;; Host special forms - ;; Integer arithmetic - [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_iadd"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] - (&&host/analyse-jvm-iadd analyse ?x ?y) - - [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_isub"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] - (&&host/analyse-jvm-isub analyse ?x ?y) - - [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_imul"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] - (&&host/analyse-jvm-imul analyse ?x ?y) - - [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_idiv"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] - (&&host/analyse-jvm-idiv analyse ?x ?y) - - [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_irem"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] - (&&host/analyse-jvm-irem analyse ?x ?y) - - [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_ieq"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] - (&&host/analyse-jvm-ieq analyse ?x ?y) - - [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_ilt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] - (&&host/analyse-jvm-ilt analyse ?x ?y) - - [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_igt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] - (&&host/analyse-jvm-igt analyse ?x ?y) - - ;; Long arithmetic - [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_ladd"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] - (&&host/analyse-jvm-ladd analyse ?x ?y) - - [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_lsub"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] - (&&host/analyse-jvm-lsub analyse ?x ?y) - - [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_lmul"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] - (&&host/analyse-jvm-lmul analyse ?x ?y) + ;; Primitive conversions + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_d2f"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]] + (&&host/analyse-jvm-d2f analyse ?value) - [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_ldiv"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] - (&&host/analyse-jvm-ldiv analyse ?x ?y) + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_d2i"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]] + (&&host/analyse-jvm-d2i analyse ?value) - [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_lrem"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] - (&&host/analyse-jvm-lrem analyse ?x ?y) + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_d2l"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]] + (&&host/analyse-jvm-d2l analyse ?value) - [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_leq"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] - (&&host/analyse-jvm-leq analyse ?x ?y) + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_f2d"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]] + (&&host/analyse-jvm-f2d analyse ?value) - [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_llt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] - (&&host/analyse-jvm-llt analyse ?x ?y) + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_f2i"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]] + (&&host/analyse-jvm-f2i analyse ?value) - [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_lgt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] - (&&host/analyse-jvm-lgt analyse ?x ?y) + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_f2l"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]] + (&&host/analyse-jvm-f2l analyse ?value) - [_] - (fail ""))) + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_i2b"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]] + (&&host/analyse-jvm-i2b analyse ?value) -(defn ^:private aba4 [analyse eval! compile-module exo-type token] - (matchv ::M/objects [token] - ;; Float arithmetic - [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_fadd"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] - (&&host/analyse-jvm-fadd analyse ?x ?y) + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_i2c"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]] + (&&host/analyse-jvm-i2c analyse ?value) - [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_fsub"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] - (&&host/analyse-jvm-fsub analyse ?x ?y) + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_i2d"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]] + (&&host/analyse-jvm-i2d analyse ?value) - [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_fmul"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] - (&&host/analyse-jvm-fmul analyse ?x ?y) + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_i2f"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]] + (&&host/analyse-jvm-i2f analyse ?value) - [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_fdiv"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] - (&&host/analyse-jvm-fdiv analyse ?x ?y) + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_i2l"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]] + (&&host/analyse-jvm-i2l analyse ?value) - [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_frem"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] - (&&host/analyse-jvm-frem analyse ?x ?y) + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_i2s"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]] + (&&host/analyse-jvm-i2s analyse ?value) - [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_feq"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] - (&&host/analyse-jvm-feq analyse ?x ?y) + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_l2d"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]] + (&&host/analyse-jvm-l2d analyse ?value) - [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_flt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] - (&&host/analyse-jvm-flt analyse ?x ?y) + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_l2f"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]] + (&&host/analyse-jvm-l2f analyse ?value) - [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_fgt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] - (&&host/analyse-jvm-fgt analyse ?x ?y) + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_l2i"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]] + (&&host/analyse-jvm-l2i analyse ?value) - ;; Double arithmetic - [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_dadd"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] - (&&host/analyse-jvm-dadd analyse ?x ?y) + ;; Bitwise operators + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_iand"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]] + (&&host/analyse-jvm-iand analyse ?x ?y) - [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_dsub"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] - (&&host/analyse-jvm-dsub analyse ?x ?y) + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_ior"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]] + (&&host/analyse-jvm-ior analyse ?x ?y) - [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_dmul"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] - (&&host/analyse-jvm-dmul analyse ?x ?y) + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_land"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]] + (&&host/analyse-jvm-land analyse ?x ?y) - [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_ddiv"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] - (&&host/analyse-jvm-ddiv analyse ?x ?y) + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_lor"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]] + (&&host/analyse-jvm-lor analyse ?x ?y) - [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_drem"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] - (&&host/analyse-jvm-drem analyse ?x ?y) + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_lxor"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]] + (&&host/analyse-jvm-lxor analyse ?x ?y) - [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_deq"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] - (&&host/analyse-jvm-deq analyse ?x ?y) + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_lshl"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]] + (&&host/analyse-jvm-lshl analyse ?x ?y) - [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_dlt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] - (&&host/analyse-jvm-dlt analyse ?x ?y) + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_lshr"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]] + (&&host/analyse-jvm-lshr analyse ?x ?y) - [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_dgt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] - (&&host/analyse-jvm-dgt analyse ?x ?y) + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_lushr"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]] + (&&host/analyse-jvm-lushr analyse ?x ?y) [_] - (fail ""))) + (aba7 analyse eval! compile-module exo-type token))) (defn ^:private aba5 [analyse eval! compile-module exo-type token] (matchv ::M/objects [token] @@ -242,6 +156,12 @@ ["lux;Cons" [?object ["lux;Nil" _]]]]]]] (&&host/analyse-jvm-null? analyse ?object) + + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_instanceof"]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?class]]]] + ["lux;Cons" [?object + ["lux;Nil" _]]]]]]]]] + (&&host/analyse-jvm-instanceof analyse ?class ?object) [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_new"]]]] ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ ?class]]]] @@ -336,130 +256,226 @@ (&&host/analyse-jvm-monitorexit analyse ?monitor) [_] - (fail ""))) + (aba6 analyse eval! compile-module exo-type token))) -(defn ^:private aba6 [analyse eval! compile-module exo-type token] +(defn ^:private aba4 [analyse eval! compile-module exo-type token] (matchv ::M/objects [token] - ;; Primitive conversions - [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_d2f"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]] - (&&host/analyse-jvm-d2f analyse ?value) + ;; Float arithmetic + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_fadd"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] + (&&host/analyse-jvm-fadd analyse ?x ?y) - [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_d2i"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]] - (&&host/analyse-jvm-d2i analyse ?value) + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_fsub"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] + (&&host/analyse-jvm-fsub analyse ?x ?y) - [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_d2l"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]] - (&&host/analyse-jvm-d2l analyse ?value) + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_fmul"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] + (&&host/analyse-jvm-fmul analyse ?x ?y) - [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_f2d"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]] - (&&host/analyse-jvm-f2d analyse ?value) + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_fdiv"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] + (&&host/analyse-jvm-fdiv analyse ?x ?y) - [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_f2i"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]] - (&&host/analyse-jvm-f2i analyse ?value) + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_frem"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] + (&&host/analyse-jvm-frem analyse ?x ?y) - [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_f2l"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]] - (&&host/analyse-jvm-f2l analyse ?value) + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_feq"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] + (&&host/analyse-jvm-feq analyse ?x ?y) - [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_i2b"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]] - (&&host/analyse-jvm-i2b analyse ?value) + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_flt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] + (&&host/analyse-jvm-flt analyse ?x ?y) - [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_i2c"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]] - (&&host/analyse-jvm-i2c analyse ?value) + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_fgt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] + (&&host/analyse-jvm-fgt analyse ?x ?y) - [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_i2d"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]] - (&&host/analyse-jvm-i2d analyse ?value) + ;; Double arithmetic + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_dadd"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] + (&&host/analyse-jvm-dadd analyse ?x ?y) - [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_i2f"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]] - (&&host/analyse-jvm-i2f analyse ?value) + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_dsub"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] + (&&host/analyse-jvm-dsub analyse ?x ?y) - [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_i2l"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]] - (&&host/analyse-jvm-i2l analyse ?value) + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_dmul"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] + (&&host/analyse-jvm-dmul analyse ?x ?y) - [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_i2s"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]] - (&&host/analyse-jvm-i2s analyse ?value) + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_ddiv"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] + (&&host/analyse-jvm-ddiv analyse ?x ?y) - [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_l2d"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]] - (&&host/analyse-jvm-l2d analyse ?value) + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_drem"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] + (&&host/analyse-jvm-drem analyse ?x ?y) - [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_l2f"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]] - (&&host/analyse-jvm-l2f analyse ?value) + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_deq"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] + (&&host/analyse-jvm-deq analyse ?x ?y) - [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_l2i"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]] - (&&host/analyse-jvm-l2i analyse ?value) + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_dlt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] + (&&host/analyse-jvm-dlt analyse ?x ?y) - ;; Bitwise operators - [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_iand"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]] - (&&host/analyse-jvm-iand analyse ?x ?y) + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_dgt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] + (&&host/analyse-jvm-dgt analyse ?x ?y) - [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_ior"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]] - (&&host/analyse-jvm-ior analyse ?x ?y) + [_] + (aba5 analyse eval! compile-module exo-type token))) - [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_land"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]] - (&&host/analyse-jvm-land analyse ?x ?y) +(defn ^:private aba3 [analyse eval! compile-module exo-type token] + (matchv ::M/objects [token] + ;; Host special forms + ;; Characters + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_ceq"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] + (&&host/analyse-jvm-ceq analyse ?x ?y) - [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_lor"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]] - (&&host/analyse-jvm-lor analyse ?x ?y) + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_clt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] + (&&host/analyse-jvm-clt analyse ?x ?y) - [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_lxor"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]] - (&&host/analyse-jvm-lxor analyse ?x ?y) + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_cgt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] + (&&host/analyse-jvm-cgt analyse ?x ?y) + + ;; Integer arithmetic + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_iadd"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] + (&&host/analyse-jvm-iadd analyse ?x ?y) - [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_lshl"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]] - (&&host/analyse-jvm-lshl analyse ?x ?y) + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_isub"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] + (&&host/analyse-jvm-isub analyse ?x ?y) - [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_lshr"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]] - (&&host/analyse-jvm-lshr analyse ?x ?y) + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_imul"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] + (&&host/analyse-jvm-imul analyse ?x ?y) - [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_lushr"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]] - (&&host/analyse-jvm-lushr analyse ?x ?y) + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_idiv"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] + (&&host/analyse-jvm-idiv analyse ?x ?y) + + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_irem"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] + (&&host/analyse-jvm-irem analyse ?x ?y) + + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_ieq"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] + (&&host/analyse-jvm-ieq analyse ?x ?y) + + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_ilt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] + (&&host/analyse-jvm-ilt analyse ?x ?y) + + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_igt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] + (&&host/analyse-jvm-igt analyse ?x ?y) + + ;; Long arithmetic + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_ladd"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] + (&&host/analyse-jvm-ladd analyse ?x ?y) + + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_lsub"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] + (&&host/analyse-jvm-lsub analyse ?x ?y) + + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_lmul"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] + (&&host/analyse-jvm-lmul analyse ?x ?y) + + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_ldiv"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] + (&&host/analyse-jvm-ldiv analyse ?x ?y) + + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_lrem"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] + (&&host/analyse-jvm-lrem analyse ?x ?y) + + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_leq"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] + (&&host/analyse-jvm-leq analyse ?x ?y) + + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_llt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] + (&&host/analyse-jvm-llt analyse ?x ?y) + + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_lgt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] + (&&host/analyse-jvm-lgt analyse ?x ?y) [_] - (fail ""))) + (aba4 analyse eval! compile-module exo-type token))) -(defn ^:private aba7 [analyse eval! compile-module exo-type token] +(defn ^:private aba2 [analyse eval! compile-module exo-type token] (matchv ::M/objects [token] - ;; Arrays - [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_new-array"]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ ?class]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;IntS" ?length]]] - ["lux;Nil" _]]]]]]]]] - (&&host/analyse-jvm-new-array analyse ?class ?length) + [["lux;SymbolS" ?ident]] + (&&lux/analyse-symbol analyse exo-type ?ident) - [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_aastore"]]]] - ["lux;Cons" [?array - ["lux;Cons" [["lux;Meta" [_ ["lux;IntS" ?idx]]] - ["lux;Cons" [?elem + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_lux_case"]]]] + ["lux;Cons" [?value ?branches]]]]]] + (&&lux/analyse-case analyse exo-type ?value ?branches) + + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_lux_lambda"]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ?self]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ?arg]]] + ["lux;Cons" [?body ["lux;Nil" _]]]]]]]]]]] - (&&host/analyse-jvm-aastore analyse ?array ?idx ?elem) + (&&lux/analyse-lambda analyse exo-type ?self ?arg ?body) - [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_aaload"]]]] - ["lux;Cons" [?array - ["lux;Cons" [["lux;Meta" [_ ["lux;IntS" ?idx]]] + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_lux_def"]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?name]]]] + ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] - (&&host/analyse-jvm-aaload analyse ?array ?idx) + (&&lux/analyse-def analyse ?name ?value) - ;; Classes & interfaces - [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_class"]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?name]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?super-class]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?interfaces]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?fields]]] - ?methods]]]]]]]]]]]] - (&&host/analyse-jvm-class analyse ?name ?super-class ?interfaces ?fields ?methods) + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_lux_declare-macro"]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?name]]]] + ["lux;Nil" _]]]]]]] + (&&lux/analyse-declare-macro analyse ?name) - [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_interface"]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?name]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?supers]]] - ?methods]]]]]]]] - (&&host/analyse-jvm-interface analyse ?name ?supers ?methods) + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_lux_import"]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?path]]] + ["lux;Nil" _]]]]]]] + (&&lux/analyse-import analyse compile-module ?path) - ;; Programs - [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_program"]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ?args]]] - ["lux;Cons" [?body + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_lux_:"]]]] + ["lux;Cons" [?type + ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] - (&&host/analyse-jvm-program analyse ?args ?body) + (&&lux/analyse-check analyse eval! exo-type ?type ?value) + + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_lux_:!"]]]] + ["lux;Cons" [?type + ["lux;Cons" [?value + ["lux;Nil" _]]]]]]]]] + (&&lux/analyse-coerce analyse eval! exo-type ?type ?value) + + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_lux_export"]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?ident]]]] + ["lux;Nil" _]]]]]]] + (&&lux/analyse-export analyse ?ident) + + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_lux_alias"]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?alias]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?module]]] + ["lux;Nil" _]]]]]]]]] + (&&lux/analyse-alias analyse ?alias ?module) [_] - (fail ""))) + (aba3 analyse eval! compile-module exo-type token))) + +(let [unit (&/V "lux;Meta" (&/T (&/T "" -1 -1) (&/V "lux;TupleS" (|list))))] + (defn ^:private aba1 [analyse eval! compile-module exo-type token] + (matchv ::M/objects [token] + ;; Standard special forms + [["lux;BoolS" ?value]] + (|do [_ (&type/check exo-type &type/Bool)] + (return (&/|list (&/T (&/V "bool" ?value) exo-type)))) + + [["lux;IntS" ?value]] + (|do [_ (&type/check exo-type &type/Int)] + (return (&/|list (&/T (&/V "int" ?value) exo-type)))) + + [["lux;RealS" ?value]] + (|do [_ (&type/check exo-type &type/Real)] + (return (&/|list (&/T (&/V "real" ?value) exo-type)))) + + [["lux;CharS" ?value]] + (|do [_ (&type/check exo-type &type/Char)] + (return (&/|list (&/T (&/V "char" ?value) exo-type)))) + + [["lux;TextS" ?value]] + (|do [_ (&type/check exo-type &type/Text)] + (return (&/|list (&/T (&/V "text" ?value) exo-type)))) + + [["lux;TupleS" ?elems]] + (&&lux/analyse-tuple analyse exo-type ?elems) + + [["lux;RecordS" ?elems]] + (&&lux/analyse-record analyse exo-type ?elems) + + [["lux;TagS" ?ident]] + (&&lux/analyse-variant analyse exo-type ?ident unit) + + [["lux;SymbolS" [_ "_jvm_null"]]] + (return (&/|list (&/T (&/V "jvm-null" nil) (&/V "lux;DataT" "null")))) + + [_] + (aba2 analyse eval! compile-module exo-type token) + ))) (defn ^:private add-loc [meta ^String msg] (if (.startsWith msg "@") @@ -477,55 +493,7 @@ (return* state* output) [["lux;Left" ""]] - (matchv ::M/objects [((aba2 analyse eval! compile-module exo-type ?token) state)] - [["lux;Right" [state* output]]] - (return* state* output) - - [["lux;Left" ""]] - (matchv ::M/objects [((aba3 analyse eval! compile-module exo-type ?token) state)] - [["lux;Right" [state* output]]] - (return* state* output) - - [["lux;Left" ""]] - (matchv ::M/objects [((aba4 analyse eval! compile-module exo-type ?token) state)] - [["lux;Right" [state* output]]] - (return* state* output) - - [["lux;Left" ""]] - (matchv ::M/objects [((aba5 analyse eval! compile-module exo-type ?token) state)] - [["lux;Right" [state* output]]] - (return* state* output) - - [["lux;Left" ""]] - (matchv ::M/objects [((aba6 analyse eval! compile-module exo-type ?token) state)] - [["lux;Right" [state* output]]] - (return* state* output) - - [["lux;Left" ""]] - (matchv ::M/objects [((aba7 analyse eval! compile-module exo-type ?token) state)] - [["lux;Right" [state* output]]] - (return* state* output) - - [["lux;Left" ""]] - (fail* (add-loc meta (str "[Analyser Error] Unrecognized token: " (&/show-ast token)))) - - [["lux;Left" msg]] - (fail* (add-loc meta msg))) - - [["lux;Left" msg]] - (fail* (add-loc meta msg))) - - [["lux;Left" msg]] - (fail* (add-loc meta msg))) - - [["lux;Left" msg]] - (fail* (add-loc meta msg))) - - [["lux;Left" msg]] - (fail* (add-loc meta msg))) - - [["lux;Left" msg]] - (fail* (add-loc meta msg))) + (fail* (add-loc meta (str "[Analyser Error] Unrecognized token: " (&/show-ast token)))) [["lux;Left" msg]] (fail* (add-loc meta msg)) diff --git a/src/lux/analyser/case.clj b/src/lux/analyser/case.clj index 6dfa234bd..267bd1269 100644 --- a/src/lux/analyser/case.clj +++ b/src/lux/analyser/case.clj @@ -63,28 +63,31 @@ (return (&/T (&/V "TextTestAC" ?value) =kont))) [["lux;TupleS" ?members]] - (matchv ::M/objects [value-type] - [["lux;TupleT" ?member-types]] - (if (not (.equals ^Object (&/|length ?member-types) (&/|length ?members))) - (fail (str "[Analyser error] Pattern-matching mismatch. Require tuple[" (&/|length ?member-types) "]. Given tuple [" (&/|length ?members) "]")) - (|do [[=tests =kont] (&/fold (fn [kont* vm] - (|let [[v m] vm] - (|do [[=test [=tests =kont]] (analyse-pattern v m kont*)] - (return (&/T (&/|cons =test =tests) =kont))))) - (|do [=kont kont] - (return (&/T (&/|list) =kont))) - (&/|reverse (&/zip2 ?member-types ?members)))] - (return (&/T (&/V "TupleTestAC" =tests) =kont)))) - - [_] - (fail (str "[Analyser Error] Tuples require tuple-types: " (&type/show-type value-type)))) + (|do [value-type* (resolve-type value-type)] + (do ;; (prn 'PM/TUPLE-1 (&type/show-type value-type*)) + (matchv ::M/objects [value-type*] + [["lux;TupleT" ?member-types]] + (do ;; (prn 'PM/TUPLE-2 (&/|length ?member-types) (&/|length ?members)) + (if (not (.equals ^Object (&/|length ?member-types) (&/|length ?members))) + (fail (str "[Pattern-matching Error] Pattern-matching mismatch. Require tuple[" (&/|length ?member-types) "]. Given tuple [" (&/|length ?members) "]")) + (|do [[=tests =kont] (&/fold (fn [kont* vm] + (|let [[v m] vm] + (|do [[=test [=tests =kont]] (analyse-pattern v m kont*)] + (return (&/T (&/|cons =test =tests) =kont))))) + (|do [=kont kont] + (return (&/T (&/|list) =kont))) + (&/|reverse (&/zip2 ?member-types ?members)))] + (return (&/T (&/V "TupleTestAC" =tests) =kont))))) + + [_] + (fail (str "[Pattern-matching Error] Tuples require tuple-types: " (&type/show-type value-type*)))))) [["lux;RecordS" ?slots]] (|do [value-type* (resolve-type value-type)] (matchv ::M/objects [value-type*] [["lux;RecordT" ?slot-types]] (if (not (.equals ^Object (&/|length ?slot-types) (&/|length ?slots))) - (fail (str "[Analyser error] Pattern-matching mismatch. Require record[" (&/|length ?slot-types) "]. Given record[" (&/|length ?slots) "]")) + (fail (str "[Analyser Error] Pattern-matching mismatch. Require record[" (&/|length ?slot-types) "]. Given record[" (&/|length ?slots) "]")) (|do [[=tests =kont] (&/fold (fn [kont* slot] (|let [[sn sv] slot] (matchv ::M/objects [sn] @@ -93,17 +96,17 @@ (if-let [=slot-type (&/|get =tag ?slot-types)] (|do [[=test [=tests =kont]] (analyse-pattern =slot-type sv kont*)] (return (&/T (&/|put =tag =test =tests) =kont))) - (fail (str "[Pattern-Matching Error] Record-type lacks slot: " =tag)))) + (fail (str "[Pattern-matching Error] Record-type lacks slot: " =tag)))) [_] - (fail (str "[Pattern-Matching Error] Record must use tags as slot-names: " (&/show-ast sn)))))) + (fail (str "[Pattern-matching Error] Record must use tags as slot-names: " (&/show-ast sn)))))) (|do [=kont kont] (return (&/T (&/|table) =kont))) (&/|reverse ?slots))] (return (&/T (&/V "RecordTestAC" =tests) =kont)))) [_] - (fail "[Analyser Error] Record requires record-type."))) + (fail "[Pattern-matching Error] Record requires record-type."))) [["lux;TagS" ?ident]] (|do [=tag (&&/resolved-ident ?ident) @@ -182,7 +185,7 @@ (merge-total v (&/T t ?body))) ?values ?tests)] (return (&/V "TupleTotal" (&/T total? structs)))) - (fail "[Pattern-matching error] Inconsistent tuple-size.")) + (fail "[Pattern-matching Error] Inconsistent tuple-size.")) [["DefaultTotal" total?] ["RecordTestAC" ?tests]] (|do [structs (&/map% (fn [t] @@ -203,14 +206,14 @@ (if (.equals ^Object lslot rslot) (|do [sub-struct* (merge-total sub-struct (&/T value ?body))] (return (&/T lslot sub-struct*))) - (fail "[Pattern-matching error] Record slots mismatch.")))) + (fail "[Pattern-matching Error] Record slots mismatch.")))) ?values (->> ?tests &/->seq (sort compare-kv) &/->list))] (return (&/V "RecordTotal" (&/T total? structs)))) - (fail "[Pattern-matching error] Inconsistent record-size.")) + (fail "[Pattern-matching Error] Inconsistent record-size.")) [["DefaultTotal" total?] ["VariantTestAC" [?tag ?test]]] (|do [sub-struct (merge-total (&/V "DefaultTotal" total?) @@ -245,15 +248,16 @@ [["TupleTotal" [?total ?structs]]] (if ?total (return true) - (matchv ::M/objects [value-type] - [["lux;TupleT" ?members]] - (|do [totals (&/map2% (fn [sub-struct ?member] - (check-totality ?member sub-struct)) - ?structs ?members)] - (return (&/fold #(and %1 %2) true totals))) + (|do [value-type* (resolve-type value-type)] + (matchv ::M/objects [value-type*] + [["lux;TupleT" ?members]] + (|do [totals (&/map2% (fn [sub-struct ?member] + (check-totality ?member sub-struct)) + ?structs ?members)] + (return (&/fold #(and %1 %2) true totals))) - [_] - (fail ""))) + [_] + (fail "[Pattern-maching Error] Tuple is not total.")))) [["RecordTotal" [?total ?structs]]] (if ?total @@ -270,7 +274,7 @@ (return (&/fold #(and %1 %2) true totals))) [_] - (fail "")))) + (fail "[Pattern-maching Error] Record is not total.")))) [["VariantTotal" [?total ?structs]]] (if ?total @@ -287,7 +291,7 @@ (return (&/fold #(and %1 %2) true totals))) [_] - (fail "")))) + (fail "[Pattern-maching Error] Variant is not total.")))) [["DefaultTotal" ?total]] (return ?total) @@ -304,4 +308,4 @@ ? (check-totality value-type struct)] (if ? (return patterns) - (fail "[Pattern-maching error] Pattern-matching is non-total.")))) + (fail "[Pattern-maching Error] Pattern-matching is non-total.")))) diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj index 3db4bd16d..918bcb8f1 100644 --- a/src/lux/analyser/host.clj +++ b/src/lux/analyser/host.clj @@ -54,6 +54,10 @@ analyse-jvm-ilt "jvm-ilt" "java.lang.Integer" "java.lang.Boolean" analyse-jvm-igt "jvm-igt" "java.lang.Integer" "java.lang.Boolean" + analyse-jvm-ceq "jvm-ceq" "java.lang.Character" "java.lang.Boolean" + analyse-jvm-clt "jvm-clt" "java.lang.Character" "java.lang.Boolean" + analyse-jvm-cgt "jvm-cgt" "java.lang.Character" "java.lang.Boolean" + analyse-jvm-ladd "jvm-ladd" "java.lang.Long" "java.lang.Long" analyse-jvm-lsub "jvm-lsub" "java.lang.Long" "java.lang.Long" analyse-jvm-lmul "jvm-lmul" "java.lang.Long" "java.lang.Long" @@ -93,21 +97,37 @@ (defn analyse-jvm-putstatic [analyse ?class ?field ?value] (|do [=type (&host/lookup-static-field ?class ?field) - =value (&&/analyse-1 analyse ?value)] + =value (&&/analyse-1 analyse =type ?value)] (return (&/|list (&/T (&/V "jvm-putstatic" (&/T ?class ?field =value)) =type))))) (defn analyse-jvm-putfield [analyse ?class ?field ?object ?value] (|do [=type (&host/lookup-static-field ?class ?field) =object (&&/analyse-1 analyse ?object) - =value (&&/analyse-1 analyse ?value)] + =value (&&/analyse-1 analyse =type ?value)] (return (&/|list (&/T (&/V "jvm-putfield" (&/T ?class ?field =object =value)) =type))))) (defn analyse-jvm-invokestatic [analyse ?class ?method ?classes ?args] (|do [=classes (&/map% &host/extract-jvm-param ?classes) =return (&host/lookup-static-method ?class ?method =classes) - =args (&/flat-map% analyse ?args)] + :let [_ (matchv ::M/objects [=return] + [["lux;DataT" _return-class]] + (prn 'analyse-jvm-invokestatic ?class ?method _return-class))] + =args (&/map2% (fn [_class _arg] + (&&/analyse-1 analyse (&/V "lux;DataT" _class) _arg)) + =classes + ?args)] (return (&/|list (&/T (&/V "jvm-invokestatic" (&/T ?class ?method =classes =args)) =return))))) +(defn analyse-jvm-instanceof [analyse ?class ?object] + (|do [=object (analyse-1+ analyse ?object) + :let [[_obj _type] =object]] + (matchv ::M/objects [_type] + [["lux;DataT" _]] + (return (&/|list (&/T (&/V "jvm-instanceof" (&/T ?class ?object)) (&/V "lux;DataT" "java.lang.Boolean")))) + + [_] + (fail "[Analyser Error] Can only use instanceof with object types.")))) + (do-template [ ] (defn [analyse ?class ?method ?classes ?object ?args] (|do [=classes (&/map% &host/extract-jvm-param ?classes) diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj index d02599f10..75881c80a 100644 --- a/src/lux/analyser/lux.clj +++ b/src/lux/analyser/lux.clj @@ -248,11 +248,11 @@ [["lux;MacroD" macro]] (|do [macro-expansion #(-> macro (.apply ?args) (.apply %)) :let [_ (when (and ;; (= "lux/control/monad" ?module) - (= "do" ?name)) + (= "case" ?name)) (->> (&/|map &/show-ast macro-expansion) (&/|interpose "\n") (&/fold str "") - (prn ?module "do")))] + (prn ?module "case")))] ] (&/flat-map% (partial analyse exo-type) macro-expansion)) @@ -310,7 +310,9 @@ [["lux;VarT" ?id]] (|do [? (&type/bound? ?id)] (if ? - (|do [dtype (&type/deref ?id)] + (|do [dtype (&type/deref ?id) + ;; dtype* (&type/actual-type dtype) + ] (matchv ::M/objects [dtype] [["lux;ExT" _]] (return (&/T _expr exo-type)) @@ -341,7 +343,7 @@ (|do [module-name &/get-module-name ? (&&module/defined? module-name ?name)] (if ? - (fail (str "[Analyser Error] Can't redefine " ?name)) + (fail (str "[Analyser Error] Can't redefine " (str module-name ";" ?name))) (|do [=value (&/with-scope ?name (analyse-1+ analyse ?value)) =value-type (&&/expr-type =value)] diff --git a/src/lux/base.clj b/src/lux/base.clj index d88bb2ec1..e22e51473 100644 --- a/src/lux/base.clj +++ b/src/lux/base.clj @@ -158,7 +158,6 @@ )))) (defmacro |do [steps return] - (assert (not= 0 (count steps)) "The steps can't be empty!") (assert (= 0 (rem (count steps) 2)) "The number of steps must be even!") (reduce (fn [inner [label computation]] (case label @@ -330,6 +329,9 @@ map% |cons flat-map% |++) +(defn list-join [xss] + (fold |++ (V "lux;Nil" nil) xss)) + (defn |as-pairs [xs] (matchv ::M/objects [xs] [["lux;Cons" [x ["lux;Cons" [y xs*]]]]] @@ -669,6 +671,14 @@ [_ _] (fail "Lists don't match in size."))) +(defn map2 [f xs ys] + (matchv ::M/objects [xs ys] + [["lux;Cons" [x xs*]] ["lux;Cons" [y ys*]]] + (|cons (f x y) (map2 f xs* ys*)) + + [_ _] + (V "lux;Nil" nil))) + (defn fold2 [f init xs ys] (matchv ::M/objects [xs ys] [["lux;Cons" [x xs*]] ["lux;Cons" [y ys*]]] diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj index 04f4fb4c2..559c1179b 100644 --- a/src/lux/compiler.clj +++ b/src/lux/compiler.clj @@ -74,6 +74,16 @@ [["ann" [?value-ex ?type-ex]]] (&&lux/compile-ann compile-expression ?type ?value-ex ?type-ex) + + ;; Characters + [["jvm-ceq" [?x ?y]]] + (&&host/compile-jvm-ceq compile-expression ?type ?x ?y) + + [["jvm-clt" [?x ?y]]] + (&&host/compile-jvm-clt compile-expression ?type ?x ?y) + + [["jvm-cgt" [?x ?y]]] + (&&host/compile-jvm-cgt compile-expression ?type ?x ?y) ;; Integer arithmetic [["jvm-iadd" [?x ?y]]] @@ -297,6 +307,9 @@ [["jvm-lushr" [?x ?y]]] (&&host/compile-jvm-lushr compile-expression ?type ?x ?y) + + [["jvm-instanceof" [?class ?object]]] + (&&host/compile-jvm-instanceof compile-expression ?type ?class ?object) ) )) diff --git a/src/lux/compiler/host.clj b/src/lux/compiler/host.clj index 2a8bdac89..5c2c43296 100644 --- a/src/lux/compiler/host.clj +++ b/src/lux/compiler/host.clj @@ -144,6 +144,10 @@ compile-jvm-ieq Opcodes/IF_ICMPEQ "java.lang.Integer" "intValue" "()I" compile-jvm-ilt Opcodes/IF_ICMPLT "java.lang.Integer" "intValue" "()I" compile-jvm-igt Opcodes/IF_ICMPGT "java.lang.Integer" "intValue" "()I" + + compile-jvm-ceq Opcodes/IF_ICMPEQ "java.lang.Character" "charValue" "()C" + compile-jvm-clt Opcodes/IF_ICMPLT "java.lang.Character" "charValue" "()C" + compile-jvm-cgt Opcodes/IF_ICMPGT "java.lang.Character" "charValue" "()C" ) (do-template [ ] @@ -186,12 +190,12 @@ (defn compile-jvm-invokestatic [compile *type* ?class ?method ?classes ?args] (|do [^MethodVisitor *writer* &/get-writer - :let [method-sig (str "(" (reduce str "" (map &host/->type-signature ?classes)) ")" (&host/->java-sig *type*))] - _ (&/map% (fn [[class-name arg]] - (|do [ret (compile arg) - :let [_ (prepare-arg! *writer* class-name)]] - (return ret))) - (map vector ?classes ?args)) + :let [method-sig (str "(" (&/fold str "" (&/|map &host/->type-signature ?classes)) ")" (&host/->java-sig *type*))] + _ (&/map2% (fn [class-name arg] + (|do [ret (compile arg) + :let [_ (prepare-arg! *writer* class-name)]] + (return ret))) + ?classes ?args) :let [_ (doto *writer* (.visitMethodInsn Opcodes/INVOKESTATIC (&host/->class ?class) ?method method-sig) (prepare-return! *type*))]] @@ -319,6 +323,14 @@ ;; else 0))) +(defn compile-jvm-instanceof [compile *type* class object] + (|do [^MethodVisitor *writer* &/get-writer + _ (compile object) + :let [_ (doto *writer* + (.visitLdcInsn class) + (.visitTypeInsn Opcodes/INSTANCEOF class))]] + (return nil))) + (defn compile-jvm-class [compile ?name ?super-class ?interfaces ?fields ?methods] (|do [module &/get-module-name] (let [super-class* (&host/->class ?super-class) diff --git a/src/lux/compiler/lux.clj b/src/lux/compiler/lux.clj index 7d6b2b502..ecb614732 100644 --- a/src/lux/compiler/lux.clj +++ b/src/lux/compiler/lux.clj @@ -25,17 +25,6 @@ :let [_ (.visitFieldInsn *writer* Opcodes/GETSTATIC "java/lang/Boolean" (if ?value "TRUE" "FALSE") "Ljava/lang/Boolean;")]] (return nil))) -(defn compile-int [compile *type* value] - (|do [^MethodVisitor *writer* &/get-writer - :let [_ (doto *writer* - (.visitTypeInsn Opcodes/NEW "java/lang/Long") - (.visitInsn Opcodes/DUP) - (.visitLdcInsn (bit-shift-left (long value) 0) - ;; (bit-shift-left (long value) 32) - ) - (.visitMethodInsn Opcodes/INVOKESPECIAL "java/lang/Long" "" "(J)V"))]] - (return nil))) - (do-template [ ] (defn [compile *type* value] (|do [^MethodVisitor *writer* &/get-writer @@ -46,7 +35,7 @@ (.visitMethodInsn Opcodes/INVOKESPECIAL "" ))]] (return nil))) - ;; compile-int "java/lang/Long" "(J)V" long + compile-int "java/lang/Long" "(J)V" long compile-real "java/lang/Double" "(D)V" double compile-char "java/lang/Character" "(C)V" char ) -- cgit v1.2.3 From f5e3afe5a5337b5dc840ed0fd6a76244cf0aac6b Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sun, 19 Jul 2015 22:32:08 -0400 Subject: Added copyright notice on all files that missed it. --- src/lux.clj | 8 ++++++++ src/lux/analyser.clj | 8 ++++++++ src/lux/analyser/base.clj | 8 ++++++++ src/lux/analyser/case.clj | 8 ++++++++ src/lux/analyser/env.clj | 8 ++++++++ src/lux/analyser/host.clj | 8 ++++++++ src/lux/analyser/lambda.clj | 8 ++++++++ src/lux/analyser/lux.clj | 8 ++++++++ src/lux/analyser/module.clj | 8 ++++++++ src/lux/base.clj | 8 ++++++++ src/lux/compiler.clj | 8 ++++++++ src/lux/compiler/base.clj | 8 ++++++++ src/lux/compiler/case.clj | 8 ++++++++ src/lux/compiler/host.clj | 8 ++++++++ src/lux/compiler/lambda.clj | 8 ++++++++ src/lux/compiler/lux.clj | 8 ++++++++ src/lux/host.clj | 8 ++++++++ src/lux/lexer.clj | 8 ++++++++ src/lux/optimizer.clj | 9 ++++++++- src/lux/parser.clj | 8 ++++++++ src/lux/reader.clj | 8 ++++++++ src/lux/type.clj | 8 ++++++++ 22 files changed, 176 insertions(+), 1 deletion(-) (limited to 'src') diff --git a/src/lux.clj b/src/lux.clj index eb025f55e..0fcb33785 100644 --- a/src/lux.clj +++ b/src/lux.clj @@ -1,3 +1,11 @@ +;; Copyright (c) Eduardo Julian. All rights reserved. +;; The use and distribution terms for this software are covered by the +;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) +;; which can be found in the file epl-v10.html at the root of this distribution. +;; By using this software in any fashion, you are agreeing to be bound by +;; the terms of this license. +;; You must not remove this notice, or any other, from this software. + (ns lux (:gen-class) (:require [lux.base :as &] diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj index 782ae4685..995e77fe6 100644 --- a/src/lux/analyser.clj +++ b/src/lux/analyser.clj @@ -1,3 +1,11 @@ +;; Copyright (c) Eduardo Julian. All rights reserved. +;; The use and distribution terms for this software are covered by the +;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) +;; which can be found in the file epl-v10.html at the root of this distribution. +;; By using this software in any fashion, you are agreeing to be bound by +;; the terms of this license. +;; You must not remove this notice, or any other, from this software. + (ns lux.analyser (:require (clojure [template :refer [do-template]]) [clojure.core.match :as M :refer [matchv]] diff --git a/src/lux/analyser/base.clj b/src/lux/analyser/base.clj index 11e92f7b7..9fc3f1030 100644 --- a/src/lux/analyser/base.clj +++ b/src/lux/analyser/base.clj @@ -1,3 +1,11 @@ +;; Copyright (c) Eduardo Julian. All rights reserved. +;; The use and distribution terms for this software are covered by the +;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) +;; which can be found in the file epl-v10.html at the root of this distribution. +;; By using this software in any fashion, you are agreeing to be bound by +;; the terms of this license. +;; You must not remove this notice, or any other, from this software. + (ns lux.analyser.base (:require [clojure.core.match :as M :refer [match matchv]] clojure.core.match.array diff --git a/src/lux/analyser/case.clj b/src/lux/analyser/case.clj index 267bd1269..659b2b0f6 100644 --- a/src/lux/analyser/case.clj +++ b/src/lux/analyser/case.clj @@ -1,3 +1,11 @@ +;; Copyright (c) Eduardo Julian. All rights reserved. +;; The use and distribution terms for this software are covered by the +;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) +;; which can be found in the file epl-v10.html at the root of this distribution. +;; By using this software in any fashion, you are agreeing to be bound by +;; the terms of this license. +;; You must not remove this notice, or any other, from this software. + (ns lux.analyser.case (:require [clojure.core.match :as M :refer [match matchv]] clojure.core.match.array diff --git a/src/lux/analyser/env.clj b/src/lux/analyser/env.clj index de6bdb036..cac0f8cd4 100644 --- a/src/lux/analyser/env.clj +++ b/src/lux/analyser/env.clj @@ -1,3 +1,11 @@ +;; Copyright (c) Eduardo Julian. All rights reserved. +;; The use and distribution terms for this software are covered by the +;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) +;; which can be found in the file epl-v10.html at the root of this distribution. +;; By using this software in any fashion, you are agreeing to be bound by +;; the terms of this license. +;; You must not remove this notice, or any other, from this software. + (ns lux.analyser.env (:require [clojure.core.match :as M :refer [matchv]] clojure.core.match.array diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj index 918bcb8f1..68bd627fc 100644 --- a/src/lux/analyser/host.clj +++ b/src/lux/analyser/host.clj @@ -1,3 +1,11 @@ +;; Copyright (c) Eduardo Julian. All rights reserved. +;; The use and distribution terms for this software are covered by the +;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) +;; which can be found in the file epl-v10.html at the root of this distribution. +;; By using this software in any fashion, you are agreeing to be bound by +;; the terms of this license. +;; You must not remove this notice, or any other, from this software. + (ns lux.analyser.host (:require (clojure [template :refer [do-template]]) [clojure.core.match :as M :refer [match matchv]] diff --git a/src/lux/analyser/lambda.clj b/src/lux/analyser/lambda.clj index 4dd1be38f..b1b9e2c22 100644 --- a/src/lux/analyser/lambda.clj +++ b/src/lux/analyser/lambda.clj @@ -1,3 +1,11 @@ +;; Copyright (c) Eduardo Julian. All rights reserved. +;; The use and distribution terms for this software are covered by the +;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) +;; which can be found in the file epl-v10.html at the root of this distribution. +;; By using this software in any fashion, you are agreeing to be bound by +;; the terms of this license. +;; You must not remove this notice, or any other, from this software. + (ns lux.analyser.lambda (:require [clojure.core.match :as M :refer [matchv]] clojure.core.match.array diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj index 75881c80a..fc96fecff 100644 --- a/src/lux/analyser/lux.clj +++ b/src/lux/analyser/lux.clj @@ -1,3 +1,11 @@ +;; Copyright (c) Eduardo Julian. All rights reserved. +;; The use and distribution terms for this software are covered by the +;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) +;; which can be found in the file epl-v10.html at the root of this distribution. +;; By using this software in any fashion, you are agreeing to be bound by +;; the terms of this license. +;; You must not remove this notice, or any other, from this software. + (ns lux.analyser.lux (:require (clojure [template :refer [do-template]]) [clojure.core.match :as M :refer [matchv]] diff --git a/src/lux/analyser/module.clj b/src/lux/analyser/module.clj index 27aa7374c..c13be61c4 100644 --- a/src/lux/analyser/module.clj +++ b/src/lux/analyser/module.clj @@ -1,3 +1,11 @@ +;; Copyright (c) Eduardo Julian. All rights reserved. +;; The use and distribution terms for this software are covered by the +;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) +;; which can be found in the file epl-v10.html at the root of this distribution. +;; By using this software in any fashion, you are agreeing to be bound by +;; the terms of this license. +;; You must not remove this notice, or any other, from this software. + (ns lux.analyser.module (:require [clojure.string :as string] [clojure.core.match :as M :refer [matchv]] diff --git a/src/lux/base.clj b/src/lux/base.clj index e22e51473..7ed21e9bd 100644 --- a/src/lux/base.clj +++ b/src/lux/base.clj @@ -1,3 +1,11 @@ +;; Copyright (c) Eduardo Julian. All rights reserved. +;; The use and distribution terms for this software are covered by the +;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) +;; which can be found in the file epl-v10.html at the root of this distribution. +;; By using this software in any fashion, you are agreeing to be bound by +;; the terms of this license. +;; You must not remove this notice, or any other, from this software. + (ns lux.base (:require (clojure [template :refer [do-template]]) [clojure.core.match :as M :refer [matchv]] diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj index 559c1179b..549f2e0a9 100644 --- a/src/lux/compiler.clj +++ b/src/lux/compiler.clj @@ -1,3 +1,11 @@ +;; Copyright (c) Eduardo Julian. All rights reserved. +;; The use and distribution terms for this software are covered by the +;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) +;; which can be found in the file epl-v10.html at the root of this distribution. +;; By using this software in any fashion, you are agreeing to be bound by +;; the terms of this license. +;; You must not remove this notice, or any other, from this software. + (ns lux.compiler (:refer-clojure :exclude [compile]) (:require (clojure [string :as string] diff --git a/src/lux/compiler/base.clj b/src/lux/compiler/base.clj index 7ac48e67e..25451aae0 100644 --- a/src/lux/compiler/base.clj +++ b/src/lux/compiler/base.clj @@ -1,3 +1,11 @@ +;; Copyright (c) Eduardo Julian. All rights reserved. +;; The use and distribution terms for this software are covered by the +;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) +;; which can be found in the file epl-v10.html at the root of this distribution. +;; By using this software in any fashion, you are agreeing to be bound by +;; the terms of this license. +;; You must not remove this notice, or any other, from this software. + (ns lux.compiler.base (:require [clojure.string :as string] [clojure.java.io :as io] diff --git a/src/lux/compiler/case.clj b/src/lux/compiler/case.clj index 1a0a9c6bc..fc0cce31f 100644 --- a/src/lux/compiler/case.clj +++ b/src/lux/compiler/case.clj @@ -1,3 +1,11 @@ +;; Copyright (c) Eduardo Julian. All rights reserved. +;; The use and distribution terms for this software are covered by the +;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) +;; which can be found in the file epl-v10.html at the root of this distribution. +;; By using this software in any fashion, you are agreeing to be bound by +;; the terms of this license. +;; You must not remove this notice, or any other, from this software. + (ns lux.compiler.case (:require (clojure [set :as set] [template :refer [do-template]]) diff --git a/src/lux/compiler/host.clj b/src/lux/compiler/host.clj index 5c2c43296..1dca81857 100644 --- a/src/lux/compiler/host.clj +++ b/src/lux/compiler/host.clj @@ -1,3 +1,11 @@ +;; Copyright (c) Eduardo Julian. All rights reserved. +;; The use and distribution terms for this software are covered by the +;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) +;; which can be found in the file epl-v10.html at the root of this distribution. +;; By using this software in any fashion, you are agreeing to be bound by +;; the terms of this license. +;; You must not remove this notice, or any other, from this software. + (ns lux.compiler.host (:require (clojure [string :as string] [set :as set] diff --git a/src/lux/compiler/lambda.clj b/src/lux/compiler/lambda.clj index 7b08532fe..9f4bef80c 100644 --- a/src/lux/compiler/lambda.clj +++ b/src/lux/compiler/lambda.clj @@ -1,3 +1,11 @@ +;; Copyright (c) Eduardo Julian. All rights reserved. +;; The use and distribution terms for this software are covered by the +;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) +;; which can be found in the file epl-v10.html at the root of this distribution. +;; By using this software in any fashion, you are agreeing to be bound by +;; the terms of this license. +;; You must not remove this notice, or any other, from this software. + (ns lux.compiler.lambda (:require (clojure [string :as string] [set :as set] diff --git a/src/lux/compiler/lux.clj b/src/lux/compiler/lux.clj index ecb614732..ac3d6f56d 100644 --- a/src/lux/compiler/lux.clj +++ b/src/lux/compiler/lux.clj @@ -1,3 +1,11 @@ +;; Copyright (c) Eduardo Julian. All rights reserved. +;; The use and distribution terms for this software are covered by the +;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) +;; which can be found in the file epl-v10.html at the root of this distribution. +;; By using this software in any fashion, you are agreeing to be bound by +;; the terms of this license. +;; You must not remove this notice, or any other, from this software. + (ns lux.compiler.lux (:require (clojure [string :as string] [set :as set] diff --git a/src/lux/host.clj b/src/lux/host.clj index e2efd92e9..abbdb8c6d 100644 --- a/src/lux/host.clj +++ b/src/lux/host.clj @@ -1,3 +1,11 @@ +;; Copyright (c) Eduardo Julian. All rights reserved. +;; The use and distribution terms for this software are covered by the +;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) +;; which can be found in the file epl-v10.html at the root of this distribution. +;; By using this software in any fashion, you are agreeing to be bound by +;; the terms of this license. +;; You must not remove this notice, or any other, from this software. + (ns lux.host (:require (clojure [string :as string] [template :refer [do-template]]) diff --git a/src/lux/lexer.clj b/src/lux/lexer.clj index fbfe1f757..bb6e54cb4 100644 --- a/src/lux/lexer.clj +++ b/src/lux/lexer.clj @@ -1,3 +1,11 @@ +;; Copyright (c) Eduardo Julian. All rights reserved. +;; The use and distribution terms for this software are covered by the +;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) +;; which can be found in the file epl-v10.html at the root of this distribution. +;; By using this software in any fashion, you are agreeing to be bound by +;; the terms of this license. +;; You must not remove this notice, or any other, from this software. + (ns lux.lexer (:require [clojure.template :refer [do-template]] (lux [base :as & :refer [|do return* return fail fail*]] diff --git a/src/lux/optimizer.clj b/src/lux/optimizer.clj index 8b97b6ebb..5056a09e0 100644 --- a/src/lux/optimizer.clj +++ b/src/lux/optimizer.clj @@ -1,3 +1,11 @@ +;; Copyright (c) Eduardo Julian. All rights reserved. +;; The use and distribution terms for this software are covered by the +;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) +;; which can be found in the file epl-v10.html at the root of this distribution. +;; By using this software in any fashion, you are agreeing to be bound by +;; the terms of this license. +;; You must not remove this notice, or any other, from this software. + (ns lux.optimizer (:require [lux.analyser :as &analyser])) @@ -12,7 +20,6 @@ ;; Pre-compute constant expressions: Find function calls for which all arguments are known at compile-time and pre-calculate everything prior to compilation. ;; Convert pattern-matching on booleans into regular if-then-else structures ;; Local var aliasing. -;; Global var aliasing. ;; [Exports] (defn optimize [eval! compile-module] diff --git a/src/lux/parser.clj b/src/lux/parser.clj index 7a3ad18aa..966c322bf 100644 --- a/src/lux/parser.clj +++ b/src/lux/parser.clj @@ -1,3 +1,11 @@ +;; Copyright (c) Eduardo Julian. All rights reserved. +;; The use and distribution terms for this software are covered by the +;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) +;; which can be found in the file epl-v10.html at the root of this distribution. +;; By using this software in any fashion, you are agreeing to be bound by +;; the terms of this license. +;; You must not remove this notice, or any other, from this software. + (ns lux.parser (:require [clojure.template :refer [do-template]] [clojure.core.match :as M :refer [matchv]] diff --git a/src/lux/reader.clj b/src/lux/reader.clj index bef093247..9fd9b14ea 100644 --- a/src/lux/reader.clj +++ b/src/lux/reader.clj @@ -1,3 +1,11 @@ +;; Copyright (c) Eduardo Julian. All rights reserved. +;; The use and distribution terms for this software are covered by the +;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) +;; which can be found in the file epl-v10.html at the root of this distribution. +;; By using this software in any fashion, you are agreeing to be bound by +;; the terms of this license. +;; You must not remove this notice, or any other, from this software. + (ns lux.reader (:require [clojure.string :as string] [clojure.core.match :as M :refer [matchv]] diff --git a/src/lux/type.clj b/src/lux/type.clj index c3a27ce2b..77fc6a2f8 100644 --- a/src/lux/type.clj +++ b/src/lux/type.clj @@ -1,3 +1,11 @@ +;; Copyright (c) Eduardo Julian. All rights reserved. +;; The use and distribution terms for this software are covered by the +;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) +;; which can be found in the file epl-v10.html at the root of this distribution. +;; By using this software in any fashion, you are agreeing to be bound by +;; the terms of this license. +;; You must not remove this notice, or any other, from this software. + (ns lux.type (:refer-clojure :exclude [deref apply merge bound?]) (:require [clojure.core.match :as M :refer [match matchv]] -- cgit v1.2.3 From 3a760fa6c0f47f7621970b9747779f3edcc96286 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sun, 19 Jul 2015 23:43:37 -0400 Subject: - Added a few more modules. - Added some type-tags to avoid reflection inside the compiler. --- src/lux/analyser/module.clj | 1 + src/lux/compiler/base.clj | 48 ++++++++++++++++++++++++++------------------- 2 files changed, 29 insertions(+), 20 deletions(-) (limited to 'src') diff --git a/src/lux/analyser/module.clj b/src/lux/analyser/module.clj index c13be61c4..9b68fb680 100644 --- a/src/lux/analyser/module.clj +++ b/src/lux/analyser/module.clj @@ -7,6 +7,7 @@ ;; You must not remove this notice, or any other, from this software. (ns lux.analyser.module + (:refer-clojure :exclude [alias]) (:require [clojure.string :as string] [clojure.core.match :as M :refer [matchv]] clojure.core.match.array diff --git a/src/lux/compiler/base.clj b/src/lux/compiler/base.clj index 25451aae0..68c3b7d6c 100644 --- a/src/lux/compiler/base.clj +++ b/src/lux/compiler/base.clj @@ -18,31 +18,35 @@ (:import (org.objectweb.asm Opcodes Label ClassWriter - MethodVisitor))) + MethodVisitor) + (java.io File + BufferedOutputStream + FileOutputStream) + (java.lang.reflect Field))) ;; [Utils] (defn ^:private write-file [^String file ^bytes data] - (with-open [stream (java.io.BufferedOutputStream. (java.io.FileOutputStream. file))] + (with-open [stream (BufferedOutputStream. (FileOutputStream. file))] (.write stream data))) (defn ^:private write-output [module name data] (let [module* module] - (.mkdirs (java.io.File. (str "output/jvm/" module*))) + (.mkdirs (File. (str "output/jvm/" module*))) (write-file (str "output/jvm/" module* "/" name ".class") data))) (defn ^:private write-cache [module name data] (let [module* (string/replace module #"/" " ")] - (.mkdirs (java.io.File. (str "cache/jvm/" module*))) + (.mkdirs (File. (str "cache/jvm/" module*))) (write-file (str "cache/jvm/" module* "/" name ".class") data))) -(defn ^:private clean-file [^java.io.File file] +(defn ^:private clean-file [^File file] (if (.isDirectory file) (do (doseq [f (seq (.listFiles file))] (clean-file f)) (.delete file)) (.delete file))) -(defn ^:private read-file [file] +(defn ^:private read-file [^File file] (with-open [reader (io/input-stream file)] (let [length (.length file) buffer (byte-array length)] @@ -74,11 +78,11 @@ (return nil))) (defn cached? [module] - (.exists (java.io.File. (str "cache/jvm/" (string/replace module #"/" " ") "/_.class")))) + (.exists (File. (str "cache/jvm/" (string/replace module #"/" " ") "/_.class")))) (defn delete-cache [module] (fn [state] - (do (clean-file (java.io.File. (str "cache/jvm/" (string/replace module #"/" " ")))) + (do (clean-file (File. (str "cache/jvm/" (string/replace module #"/" " ")))) (return* state nil)))) (defn ^:private replace-several [content & replacements] @@ -90,7 +94,7 @@ (throw e))) content replacement-list))) -(defn ^:private replace-cache [cache-name] +(defn ^:private replace-cache [^String cache-name] (if (.startsWith cache-name "$") (replace-several cache-name #"_ASTER_" "*" @@ -118,16 +122,19 @@ #"_PIPE_" "|") cache-name)) +(defn ^:private get-field [^String field-name ^Class class] + (-> class ^Field (.getField field-name) (.get nil))) + (defn load-cache [module module-hash compile-module] (|do [loader &/loader !classes &/classes] (let [module-path (str "cache/jvm/" (string/replace module #"/" " ")) module* (string/replace module #"/" ".") class-name (str module* "._") - module-meta (do (swap! !classes assoc class-name (read-file (java.io.File. (str module-path "/_.class")))) - (load-class! loader class-name))] - (if (and (= module-hash (-> module-meta (.getField "_hash") (.get nil))) - (= version (-> module-meta (.getField "_compiler") (.get nil)))) + ^Class module-meta (do (swap! !classes assoc class-name (read-file (File. (str module-path "/_.class")))) + (load-class! loader class-name))] + (if (and (= module-hash (get-field "_hash" module-meta)) + (= version (get-field "_compiler" module-meta))) (let [imports (string/split (-> module-meta (.getField "_imports") (.get nil)) #"\t") ;; _ (prn module 'imports imports) ] @@ -137,9 +144,10 @@ (&/|list) (&/->list imports)))] (if (->> loads &/->seq (every? true?)) - (do (doseq [file (seq (.listFiles (java.io.File. module-path))) - :when (not= "_.class" (.getName file))] - (let [real-name (second (re-find #"^(.*)\.class$" (.getName file))) + (do (doseq [^File file (seq (.listFiles (File. module-path))) + :let [file-name (.getName file)] + :when (not= "_.class" file-name)] + (let [real-name (second (re-find #"^(.*)\.class$" file-name)) bytecode (read-file file) ;; _ (prn 'load-cache module real-name) ] @@ -149,18 +157,18 @@ ;; (swap! !classes assoc (-> (load-class! loader "__temp__") (.getField "_name") (.get nil)) bytecode) (write-output module real-name bytecode))) ;; (swap! !classes dissoc "__temp__") - (let [defs (string/split (-> module-meta (.getField "_defs") (.get nil)) #"\t")] + (let [defs (string/split (get-field "_defs" module-meta) #"\t")] (|do [_ (fn [state] (&/run-state (&/map% (fn [_def] (let [[_exported? _name _ann] (string/split _def #" ") ;; _ (prn '[_exported? _name _ann] [_exported? _name _ann]) def-class (load-class! loader (str module* ".$" (&/normalize-ident _name))) - def-name (-> def-class (.getField "_name") (.get nil))] + def-name (get-field "_name" def-class)] (|do [_ (case _ann "T" (&a-module/define module def-name (&/V "lux;TypeD" nil) &type/Type) "M" (|do [_ (&a-module/define module def-name (&/V "lux;ValueD" &type/Macro) &type/Macro)] (&a-module/declare-macro module def-name)) - "V" (let [def-type (-> def-class (.getField "_meta") (.get nil))] + "V" (let [def-type (get-field "_meta" def-class)] (matchv ::M/objects [def-type] [["lux;ValueD" _def-type]] (&a-module/define module def-name def-type _def-type))) @@ -168,7 +176,7 @@ (let [[_ __module __name] (re-find #"^A(.*);(.*)$" _ann)] (|do [__type (&a-module/def-type __module __name)] (do ;; (prn '__type [__module __name] (&type/show-type __type)) - (&a-module/def-alias module def-name __module __name __type)))))] + (&a-module/def-alias module def-name __module __name __type)))))] (if (= "1" _exported?) (&a-module/export module def-name) (return nil))) -- cgit v1.2.3 From 874af34a80ab799d0470810b7ade337b96ce50bc Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Tue, 21 Jul 2015 01:03:37 -0400 Subject: - Added a way to pass the cursor from un-expanded macro-forms to their expansions in order to aid error-reporting. - Added recursive type definitions through the #rec tag in deftype. --- src/lux/analyser.clj | 2 +- src/lux/analyser/lux.clj | 12 +++++++++--- 2 files changed, 10 insertions(+), 4 deletions(-) (limited to 'src') diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj index 995e77fe6..f85b3d619 100644 --- a/src/lux/analyser.clj +++ b/src/lux/analyser.clj @@ -535,7 +535,7 @@ ] [["lux;Right" [state* =fn]]] (do ;; (prn 'GOT_FUN (&/show-ast ?fn) (&/show-ast token) (aget =fn 0 0) (aget =fn 1 0)) - ((&&lux/analyse-apply (partial analyse-ast eval! compile-module) exo-type =fn ?args) state*)) + ((&&lux/analyse-apply (partial analyse-ast eval! compile-module) exo-type meta =fn ?args) state*)) [_] ((analyse-basic-ast (partial analyse-ast eval! compile-module) eval! compile-module exo-type token) state))) diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj index fc96fecff..8be2a8924 100644 --- a/src/lux/analyser/lux.clj +++ b/src/lux/analyser/lux.clj @@ -30,6 +30,11 @@ (return (&/T ?item =type))) ))))) +(defn ^:private with-cursor [cursor form] + (matchv ::M/objects [form] + [["lux;Meta" [_ syntax]]] + (&/V "lux;Meta" (&/T cursor syntax)))) + ;; [Exports] (defn analyse-tuple [analyse exo-type ?elems] (|do [exo-type* (&type/actual-type exo-type)] @@ -245,7 +250,7 @@ (fail (str "[Analyser Error] Can't apply a non-function: " (&type/show-type ?fun-type*))))) )) -(defn analyse-apply [analyse exo-type =fn ?args] +(defn analyse-apply [analyse exo-type form-cursor =fn ?args] (|do [loader &/loader] (matchv ::M/objects [=fn] [[=fn-form =fn-type]] @@ -255,14 +260,15 @@ (matchv ::M/objects [$def] [["lux;MacroD" macro]] (|do [macro-expansion #(-> macro (.apply ?args) (.apply %)) + :let [macro-expansion* (&/|map (partial with-cursor form-cursor) macro-expansion)] :let [_ (when (and ;; (= "lux/control/monad" ?module) (= "case" ?name)) - (->> (&/|map &/show-ast macro-expansion) + (->> (&/|map &/show-ast macro-expansion*) (&/|interpose "\n") (&/fold str "") (prn ?module "case")))] ] - (&/flat-map% (partial analyse exo-type) macro-expansion)) + (&/flat-map% (partial analyse exo-type) macro-expansion*)) [_] (|do [[=output-t =args] (analyse-apply* analyse exo-type =fn-type ?args)] -- cgit v1.2.3 From 1fd2fc0ff67f76177d4addc13faae5d0e95773d3 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Fri, 24 Jul 2015 19:19:16 -0400 Subject: - Fixed an error when compiling Java field access (both static & virtual). - Fixed some errors regarding cache loading. --- src/lux.clj | 2 +- src/lux/analyser/lux.clj | 39 ++++++------ src/lux/analyser/module.clj | 82 ++++++++++++------------ src/lux/base.clj | 21 ++++++- src/lux/compiler.clj | 89 +++++++++++++------------- src/lux/compiler/base.clj | 149 +++++++++++++++++++++++--------------------- src/lux/compiler/host.clj | 10 ++- src/lux/compiler/lux.clj | 2 +- 8 files changed, 209 insertions(+), 185 deletions(-) (limited to 'src') diff --git a/src/lux.clj b/src/lux.clj index 0fcb33785..7ff8fda37 100644 --- a/src/lux.clj +++ b/src/lux.clj @@ -14,7 +14,7 @@ :reload-all)) (defn -main [& _] - (do (time (&compiler/compile-all (&/|list "program"))) + (do (time (&compiler/compile-all (&/|list "lux" "program"))) ;; (prn @&type/counter) ) (System/exit 0)) diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj index 8be2a8924..72923c43e 100644 --- a/src/lux/analyser/lux.clj +++ b/src/lux/analyser/lux.clj @@ -261,12 +261,12 @@ [["lux;MacroD" macro]] (|do [macro-expansion #(-> macro (.apply ?args) (.apply %)) :let [macro-expansion* (&/|map (partial with-cursor form-cursor) macro-expansion)] - :let [_ (when (and ;; (= "lux/control/monad" ?module) - (= "case" ?name)) - (->> (&/|map &/show-ast macro-expansion*) - (&/|interpose "\n") - (&/fold str "") - (prn ?module "case")))] + ;; :let [_ (when (and ;; (= "lux/control/monad" ?module) + ;; (= "case" ?name)) + ;; (->> (&/|map &/show-ast macro-expansion*) + ;; (&/|interpose "\n") + ;; (&/fold str "") + ;; (prn ?module "case")))] ] (&/flat-map% (partial analyse exo-type) macro-expansion*)) @@ -388,21 +388,18 @@ (return (&/|list (&/V "declare-macro" (&/T module-name ?name)))))) (defn analyse-import [analyse compile-module ?path] - (|do [module-name &/get-module-name] - (if (= module-name ?path) - (fail (str "[Analyser Error] Module can't import itself: " ?path)) - (&/save-module - (fn [state] - (let [already-compiled? (&/fold #(or %1 (= %2 ?path)) false (&/get$ &/$SEEN-SOURCES state))] - (prn 'analyse-import module-name ?path already-compiled?) - (&/run-state (|do [_ (&&module/add-import ?path) - _ (if already-compiled? - (return nil) - (compile-module ?path))] - (return (&/|list))) - (if already-compiled? - state - (&/update$ &/$SEEN-SOURCES (partial &/|cons ?path) state))))))))) + (|do [module-name &/get-module-name + _ (if (= module-name ?path) + (fail (str "[Analyser Error] Module can't import itself: " ?path)) + (return nil))] + (&/save-module + (|do [already-compiled? (&/source-seen? ?path) + :let [must-compile? (not already-compiled?) + _ (prn 'analyse-import module-name ?path already-compiled?)] + _ (&/when% must-compile? (&/see-source ?path)) + _ (&&module/add-import ?path) + _ (&/when% must-compile? (compile-module ?path))] + (return (&/|list)))))) (defn analyse-export [analyse name] (|do [module-name &/get-module-name diff --git a/src/lux/analyser/module.clj b/src/lux/analyser/module.clj index 9b68fb680..830319549 100644 --- a/src/lux/analyser/module.clj +++ b/src/lux/analyser/module.clj @@ -20,9 +20,7 @@ (def ^:private $DEFS 0) (def ^:private $ALIASES 1) (def ^:private $IMPORTS 2) - -;; [Exports] -(def init-module +(def ^:private +init+ (&/R ;; "lux;defs" (&/|table) ;; "lux;module-aliases" @@ -31,6 +29,7 @@ (&/|list) )) +;; [Exports] (defn add-import [module] "(-> Text (Lux (,)))" (|do [current-module &/get-module-name] @@ -55,15 +54,7 @@ (&/update$ $DEFS #(&/|put name (&/T false def-data) %) m)) - ms))) - ;; (&/set$ &/$ENVS (&/|list (&/update$ &/$LOCALS (fn [locals] - ;; (&/update$ &/$MAPPINGS (fn [mappings] - ;; (&/|put (str "" &/+name-separator+ name) - ;; (&/T (&/V "lux;Global" (&/T module name)) type) - ;; mappings)) - ;; locals)) - ;; ?env))) - ) + ms)))) nil) [_] @@ -75,18 +66,21 @@ (if-let [$module (->> state (&/get$ &/$MODULES) (&/|get module))] (if-let [$def (->> $module (&/get$ $DEFS) (&/|get name))] (matchv ::M/objects [$def] - [["lux;TypeD" _]] + [[_ ["lux;TypeD" _]]] (return* state &type/Type) - [["lux;MacroD" _]] + [[_ ["lux;MacroD" _]]] (return* state &type/Macro) - [["lux;ValueD" _type]] + [[_ ["lux;ValueD" _type]]] (return* state _type) - [["lux;AliasD" [?r-module ?r-name]]] + [[_ ["lux;AliasD" [?r-module ?r-name]]]] (&/run-state (def-type ?r-module ?r-name) - state)) + state) + + [_] + (assert false (prn-str 'def-type (str module ";" name) (aget $def 0)))) (fail* (str "[Analyser Error] Unknown definition: " (str module ";" name)))) (fail* (str "[Analyser Error] Unknown module: " module))))) @@ -103,16 +97,7 @@ (&/update$ $DEFS #(&/|put a-name (&/T false (&/V "lux;AliasD" (&/T r-module r-name))) %) m)) - ms))) - ;; (&/set$ &/$ENVS (&/|list (&/update$ &/$LOCALS (fn [locals] - ;; (&/update$ &/$MAPPINGS (fn [mappings] - ;; (&/|put (str "" &/+name-separator+ a-name) - ;; (&/T (&/V "lux;Global" (&/T r-module r-name)) type) - ;; ;; (aget (->> state (&/get$ &/$MODULES) (&/|get r-module) (&/get$ $DEFS) (&/|get r-name)) 1) - ;; mappings)) - ;; locals)) - ;; ?env))) - ) + ms)))) nil) [_] @@ -150,7 +135,12 @@ ;; (prn 'find-def/_0 module name 'current-module current-module) (if-let [$module (->> state (&/get$ &/$MODULES) (&/|get module))] (do ;; (prn 'find-def/_0.1 module (&/->seq (&/|keys $module))) - (if-let [$def (->> $module (&/get$ $DEFS) (&/|get name))] + (if-let [$def (try (->> $module (&/get$ $DEFS) (&/|get name)) + (catch StackOverflowError e + (assert false (prn-str 'find-def + (str module ";" name) + (&/->seq (&/|keys (&/get$ $DEFS $module))) + (&/->seq (&/|keys (&/get$ &/$MODULES state)))))))] (matchv ::M/objects [$def] [[exported? $$def]] (do ;; (prn 'find-def/_1 module name 'exported? exported? (.equals ^Object current-module module)) @@ -165,10 +155,7 @@ (return* state (&/T (&/T module name) $$def))) (fail* (str "[Analyser Error] Can't use unexported definition: " (str module &/+name-separator+ name)))))) (fail* (str "[Analyser Error] Definition does not exist: " (str module &/+name-separator+ name))))) - (do (prn [module name] - (str "[Analyser Error] Module doesn't exist: " module) - (->> state (&/get$ &/$MODULES) &/|keys &/->seq)) - (fail* (str "[Analyser Error] Module doesn't exist: " module))))))) + (fail* (str "[Analyser Error] Module doesn't exist: " module)))))) (defn defined? [module name] (&/try-all% (&/|list (|do [_ (find-def module name)] @@ -239,21 +226,32 @@ (matchv ::M/objects [v] [[?exported? ?def]] (do ;; (prn 'defs k ?exported?) - (matchv ::M/objects [?def] - [["lux;AliasD" [?r-module ?r-name]]] - (&/T ?exported? k (str "A" ?r-module ";" ?r-name)) - - [["lux;MacroD" _]] - (&/T ?exported? k "M") + (matchv ::M/objects [?def] + [["lux;AliasD" [?r-module ?r-name]]] + (&/T ?exported? k (str "A" ?r-module ";" ?r-name)) + + [["lux;MacroD" _]] + (&/T ?exported? k "M") - [["lux;TypeD" _]] - (&/T ?exported? k "T") + [["lux;TypeD" _]] + (&/T ?exported? k "T") - [_] - (&/T ?exported? k "V")))))) + [_] + (&/T ?exported? k "V")))))) (->> state (&/get$ &/$MODULES) (&/|get module) (&/get$ $DEFS))))))) (def imports (|do [module &/get-module-name] (fn [state] (return* state (->> state (&/get$ &/$MODULES) (&/|get module) (&/get$ $IMPORTS)))))) + +(defn create-module [name] + (fn [state] + (return* (&/update$ &/$MODULES #(&/|put name +init+ %) state) nil))) + +(defn enter-module [name] + (fn [state] + (return* (->> state + (&/update$ &/$MODULES #(&/|put name +init+ %)) + (&/set$ &/$ENVS (&/|list (&/env name)))) + nil))) diff --git a/src/lux/base.clj b/src/lux/base.clj index 7ed21e9bd..7b1e7139e 100644 --- a/src/lux/base.clj +++ b/src/lux/base.clj @@ -468,7 +468,7 @@ ;; (prn 'findClass class-name) (if-let [^bytes bytecode (get @store class-name)] (.invoke define-class this (to-array [class-name bytecode (int 0) (int (alength bytecode))])) - (do (prn 'memory-class-loader/store (keys @store)) + (do (prn 'memory-class-loader/store class-name (keys @store)) (throw (IllegalStateException. (str "[Class Loader] Unknown class: " class-name))))))))) (defn host [_] @@ -477,7 +477,6 @@ store ;; "lux;loader" (memory-class-loader store) - ;; (-> (java.io.File. "./output/") .toURL vector into-array java.net.URLClassLoader.) ;; "lux;writer" (V "lux;None" nil)))) @@ -493,7 +492,7 @@ ;; "lux;seed" 0 ;; "lux;seen-sources" - (|list "lux") + (|list) ;; "lux;source" (V "lux;None" nil) ;; "lux;types" @@ -711,3 +710,19 @@ (defn enumerate [xs] (enumerate* 0 xs)) + +(defn source-seen? [path] + "(-> Text (Lux Bool))" + (fn [state] + (return* state (fold #(or %1 (= %2 path)) false (get$ $SEEN-SOURCES state))))) + +(defn see-source [path] + "(-> Text (Lux (,)))" + (fn [state] + (return* (update$ $SEEN-SOURCES (partial |cons path) state) nil))) + +(defn when% [test body] + "(-> Bool (Lux (,)) (Lux (,)))" + (if test + body + (return nil))) diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj index 549f2e0a9..fbf8afb89 100644 --- a/src/lux/compiler.clj +++ b/src/lux/compiler.clj @@ -372,52 +372,53 @@ ;; (prn 'compile-module name) (if (&&/cached? name) (do ;; (println "YOLO") - (let [file-name (str "input/" name ".lux") - file-content (slurp file-name)] - (&&/load-cache name (hash file-content) compile-module))) + (let [file-name (str "input/" name ".lux") + file-content (slurp file-name)] + (&&/load-cache name (hash file-content) compile-module))) (let [compiler-step (|do [analysis+ (&optimizer/optimize eval! compile-module)] (&/map% compile-statement analysis+))] - (fn [state] - (if (->> state (&/get$ &/$MODULES) (&/|contains? name)) + (|do [module-exists? (&a-module/exists? name)] + (if module-exists? (if (.equals ^Object name "lux") - (return* state nil) - (fail* "[Compiler Error] Can't redefine a module!")) - (let [file-name (str "input/" name ".lux") - file-content (slurp file-name) - =class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS) - (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER) - (str name "/_") nil "java/lang/Object" nil) - (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_hash" "I" nil (hash file-content)) - .visitEnd) - (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_compiler" "Ljava/lang/String;" nil &&/version) - .visitEnd))] - (matchv ::M/objects [((&/exhaust% compiler-step) - (->> state - (&/set$ &/$SOURCE (&reader/from file-name file-content)) - (&/set$ &/$ENVS (&/|list (&/env name))) - (&/update$ &/$HOST #(&/set$ &/$WRITER (&/V "lux;Some" =class) %)) - (&/update$ &/$MODULES #(&/|put name &a-module/init-module %))))] - [["lux;Right" [?state _]]] - (&/run-state (|do [defs &a-module/defs - imports &a-module/imports - :let [_ (doto =class - (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_defs" "Ljava/lang/String;" nil - (->> defs - (&/|map (fn [_def] - (|let [[?exported ?name ?ann] _def] - (str (if ?exported "1" "0") " " ?name " " ?ann)))) - (&/|interpose "\t") - (&/fold str ""))) - .visitEnd) - (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_imports" "Ljava/lang/String;" nil - (->> imports (&/|interpose "\t") (&/fold str ""))) - .visitEnd) - (.visitEnd))]] - (&&/save-class! "_" (.toByteArray =class))) - ?state) - - [["lux;Left" ?message]] - (fail* ?message)))))))) + (return nil) + (fail "[Compiler Error] Can't redefine a module!")) + (|do [_ (&a-module/enter-module name) + :let [file-name (str "input/" name ".lux") + file-content (slurp file-name) + =class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS) + (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER) + (str name "/_") nil "java/lang/Object" nil) + (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_hash" "I" nil (hash file-content)) + .visitEnd) + (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_compiler" "Ljava/lang/String;" nil &&/version) + .visitEnd))]] + (fn [state] + (matchv ::M/objects [((&/exhaust% compiler-step) + (->> state + (&/set$ &/$SOURCE (&reader/from file-name file-content)) + (&/update$ &/$HOST #(&/set$ &/$WRITER (&/V "lux;Some" =class) %))))] + [["lux;Right" [?state _]]] + (&/run-state (|do [defs &a-module/defs + imports &a-module/imports + :let [_ (doto =class + (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_defs" "Ljava/lang/String;" nil + (->> defs + (&/|map (fn [_def] + (|let [[?exported ?name ?ann] _def] + (str (if ?exported "1" "0") " " ?name " " ?ann)))) + (&/|interpose "\t") + (&/fold str ""))) + .visitEnd) + (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_imports" "Ljava/lang/String;" nil + (->> imports (&/|interpose "\t") (&/fold str ""))) + .visitEnd) + (.visitEnd))]] + (&&/save-class! "_" (.toByteArray =class))) + ?state) + + [["lux;Left" ?message]] + (fail* ?message))))))) + )) (defn ^:private clean-file [^java.io.File file] (if (.isDirectory file) @@ -437,7 +438,7 @@ ;; [Resources] (defn compile-all [modules] (setup-dirs!) - (matchv ::M/objects [((&/map% compile-module (&/|cons "lux" modules)) (&/init-state nil))] + (matchv ::M/objects [((&/map% compile-module modules) (&/init-state nil))] [["lux;Right" [?state _]]] (println (str "Compilation complete! " (str "[" (->> modules (&/|interpose " ") diff --git a/src/lux/compiler/base.clj b/src/lux/compiler/base.clj index 68c3b7d6c..89303c48d 100644 --- a/src/lux/compiler/base.clj +++ b/src/lux/compiler/base.clj @@ -62,6 +62,7 @@ (def apply-signature "(Ljava/lang/Object;)Ljava/lang/Object;") (defn load-class! [^ClassLoader loader name] + ;; (prn 'load-class! name) (.loadClass loader name)) (defn save-class! [name bytecode] @@ -123,76 +124,84 @@ cache-name)) (defn ^:private get-field [^String field-name ^Class class] - (-> class ^Field (.getField field-name) (.get nil))) + (-> class ^Field (.getField field-name) (.get nil)) + ;; (try (-> class ^Field (.getField field-name) (.get nil)) + ;; (catch Error e + ;; (assert false (prn-str 'get-field field-name class)))) + ) (defn load-cache [module module-hash compile-module] (|do [loader &/loader - !classes &/classes] - (let [module-path (str "cache/jvm/" (string/replace module #"/" " ")) - module* (string/replace module #"/" ".") - class-name (str module* "._") - ^Class module-meta (do (swap! !classes assoc class-name (read-file (File. (str module-path "/_.class")))) - (load-class! loader class-name))] - (if (and (= module-hash (get-field "_hash" module-meta)) - (= version (get-field "_compiler" module-meta))) - (let [imports (string/split (-> module-meta (.getField "_imports") (.get nil)) #"\t") - ;; _ (prn module 'imports imports) - ] - (|do [loads (&/map% (fn [_import] - (load-cache _import (-> (str "input/" _import ".lux") slurp hash) compile-module)) - (if (= [""] imports) - (&/|list) - (&/->list imports)))] - (if (->> loads &/->seq (every? true?)) - (do (doseq [^File file (seq (.listFiles (File. module-path))) - :let [file-name (.getName file)] - :when (not= "_.class" file-name)] - (let [real-name (second (re-find #"^(.*)\.class$" file-name)) - bytecode (read-file file) - ;; _ (prn 'load-cache module real-name) - ] - ;; (swap! !classes assoc (str module* "." (replace-cache real-name)) bytecode) - (swap! !classes assoc (str module* "." real-name) bytecode) - ;; (swap! !classes assoc "__temp__" bytecode) - ;; (swap! !classes assoc (-> (load-class! loader "__temp__") (.getField "_name") (.get nil)) bytecode) - (write-output module real-name bytecode))) - ;; (swap! !classes dissoc "__temp__") - (let [defs (string/split (get-field "_defs" module-meta) #"\t")] - (|do [_ (fn [state] - (&/run-state (&/map% (fn [_def] - (let [[_exported? _name _ann] (string/split _def #" ") - ;; _ (prn '[_exported? _name _ann] [_exported? _name _ann]) - def-class (load-class! loader (str module* ".$" (&/normalize-ident _name))) - def-name (get-field "_name" def-class)] - (|do [_ (case _ann - "T" (&a-module/define module def-name (&/V "lux;TypeD" nil) &type/Type) - "M" (|do [_ (&a-module/define module def-name (&/V "lux;ValueD" &type/Macro) &type/Macro)] - (&a-module/declare-macro module def-name)) - "V" (let [def-type (get-field "_meta" def-class)] - (matchv ::M/objects [def-type] - [["lux;ValueD" _def-type]] - (&a-module/define module def-name def-type _def-type))) - ;; else - (let [[_ __module __name] (re-find #"^A(.*);(.*)$" _ann)] - (|do [__type (&a-module/def-type __module __name)] - (do ;; (prn '__type [__module __name] (&type/show-type __type)) - (&a-module/def-alias module def-name __module __name __type)))))] - (if (= "1" _exported?) - (&a-module/export module def-name) - (return nil))) - )) - (if (= [""] defs) - (&/|list) - (&/->list defs))) - (->> state - (&/set$ &/$ENVS (&/|list (&/env module))) - (&/update$ &/$MODULES #(&/|put module &a-module/init-module %)))))] - (return true)))) - (|do [_ (delete-cache module) - _ (compile-module module)] - (return false))))) - - (|do [_ (delete-cache module) - _ (compile-module module)] - (return false))) - ))) + !classes &/classes + already-loaded? (&/source-seen? module) + :let [redo-cache (|do [_ (delete-cache module) + _ (compile-module module)] + (return false))]] + (if already-loaded? + (return true) + (if (cached? module) + (do (prn 'load-cache module module-hash) + (let [module-path (str "cache/jvm/" (string/replace module #"/" " ")) + module* (string/replace module #"/" ".") + class-name (str module* "._") + ^Class module-meta (do (swap! !classes assoc class-name (read-file (File. (str module-path "/_.class")))) + (load-class! loader class-name))] + (if (and (= module-hash (get-field "_hash" module-meta)) + (= version (get-field "_compiler" module-meta))) + (let [imports (string/split (-> module-meta (.getField "_imports") (.get nil)) #"\t") + ;; _ (prn module 'imports imports) + ] + (|do [loads (&/map% (fn [_import] + (load-cache _import (-> (str "input/" _import ".lux") slurp hash) compile-module)) + (if (= [""] imports) + (&/|list) + (&/->list imports)))] + (if (->> loads &/->seq (every? true?)) + (do (doseq [^File file (seq (.listFiles (File. module-path))) + :let [file-name (.getName file)] + :when (not= "_.class" file-name)] + (let [real-name (second (re-find #"^(.*)\.class$" file-name)) + bytecode (read-file file) + ;; _ (prn 'load-cache module real-name) + ] + ;; (swap! !classes assoc (str module* "." (replace-cache real-name)) bytecode) + (swap! !classes assoc (str module* "." real-name) bytecode) + ;; (swap! !classes assoc "__temp__" bytecode) + ;; (swap! !classes assoc (-> (load-class! loader "__temp__") (.getField "_name") (.get nil)) bytecode) + (write-output module real-name bytecode))) + ;; (swap! !classes dissoc "__temp__") + (let [defs (string/split (get-field "_defs" module-meta) #"\t")] + ;; (prn 'load-cache module defs) + (|do [_ (&/see-source module) + _ (&a-module/enter-module module) + _ (&/map% (fn [_def] + (let [[_exported? _name _ann] (string/split _def #" ") + ;; _ (prn '[_exported? _name _ann] [_exported? _name _ann]) + ] + (|do [_ (case _ann + "T" (&a-module/define module _name (&/V "lux;TypeD" nil) &type/Type) + "M" (|do [_ (&a-module/define module _name (&/V "lux;ValueD" &type/Macro) &type/Macro)] + (&a-module/declare-macro module _name)) + "V" (let [def-class (load-class! loader (str module* ".$" (&/normalize-ident _name))) + ;; _ (println "Fetching _meta" module _name (str module* ".$" (&/normalize-ident _name)) def-class) + def-type (get-field "_meta" def-class)] + (matchv ::M/objects [def-type] + [["lux;ValueD" _def-type]] + (&a-module/define module _name def-type _def-type))) + ;; else + (let [[_ __module __name] (re-find #"^A(.*);(.*)$" _ann)] + (|do [__type (&a-module/def-type __module __name)] + (do ;; (prn '__type [__module __name] (&type/show-type __type)) + (&a-module/def-alias module _name __module __name __type)))))] + (if (= "1" _exported?) + (&a-module/export module _name) + (return nil))) + )) + (if (= [""] defs) + (&/|list) + (&/->list defs)))] + (return true)))) + redo-cache))) + redo-cache) + )) + redo-cache)))) diff --git a/src/lux/compiler/host.clj b/src/lux/compiler/host.clj index 1dca81857..fd34a45a7 100644 --- a/src/lux/compiler/host.clj +++ b/src/lux/compiler/host.clj @@ -292,14 +292,18 @@ (defn compile-jvm-getstatic [compile *type* ?class ?field] (|do [^MethodVisitor *writer* &/get-writer - :let [_ (.visitFieldInsn *writer* Opcodes/GETSTATIC (&host/->class ?class) ?field (&host/->java-sig *type*))]] + :let [_ (doto *writer* + (.visitFieldInsn Opcodes/GETSTATIC (&host/->class ?class) ?field (&host/->java-sig *type*)) + (prepare-return! *type*))]] (return nil))) (defn compile-jvm-getfield [compile *type* ?class ?field ?object] (|do [^MethodVisitor *writer* &/get-writer _ (compile ?object) - :let [_ (.visitTypeInsn *writer* Opcodes/CHECKCAST (&host/->class ?class))] - :let [_ (.visitFieldInsn *writer* Opcodes/GETFIELD (&host/->class ?class) ?field (&host/->java-sig *type*))]] + :let [_ (doto *writer* + (.visitTypeInsn Opcodes/CHECKCAST (&host/->class ?class)) + (.visitFieldInsn Opcodes/GETFIELD (&host/->class ?class) ?field (&host/->java-sig *type*)) + (prepare-return! *type*))]] (return nil))) (defn compile-jvm-putstatic [compile *type* ?class ?field ?value] diff --git a/src/lux/compiler/lux.clj b/src/lux/compiler/lux.clj index ac3d6f56d..66db6923d 100644 --- a/src/lux/compiler/lux.clj +++ b/src/lux/compiler/lux.clj @@ -87,7 +87,7 @@ ret (compile v) :let [_ (.visitInsn *writer* Opcodes/AASTORE)]] (return ret)))) - (&/|range num-elems) elems*)] + (&/|range num-elems) elems*)] (return nil))) (defn compile-variant [compile *type* ?tag ?value] -- cgit v1.2.3 From 23b51269d8d0e1d756d019a6bf28ec24b6a507e1 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Fri, 24 Jul 2015 23:09:26 -0400 Subject: - Removed the "seen-sources" field from the compiler state. - Fixed the caching mechanism. --- src/lux/analyser/lux.clj | 8 +-- src/lux/base.clj | 18 ++---- src/lux/compiler.clj | 2 +- src/lux/compiler/base.clj | 140 +++++++++++++++++++++++----------------------- src/lux/type.clj | 1 - 5 files changed, 80 insertions(+), 89 deletions(-) (limited to 'src') diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj index 72923c43e..6acae193f 100644 --- a/src/lux/analyser/lux.clj +++ b/src/lux/analyser/lux.clj @@ -393,12 +393,10 @@ (fail (str "[Analyser Error] Module can't import itself: " ?path)) (return nil))] (&/save-module - (|do [already-compiled? (&/source-seen? ?path) - :let [must-compile? (not already-compiled?) - _ (prn 'analyse-import module-name ?path already-compiled?)] - _ (&/when% must-compile? (&/see-source ?path)) + (|do [already-compiled? (&&module/exists? ?path) + :let [_ (prn 'analyse-import module-name ?path already-compiled?)] _ (&&module/add-import ?path) - _ (&/when% must-compile? (compile-module ?path))] + _ (&/when% (not already-compiled?) (compile-module ?path))] (return (&/|list)))))) (defn analyse-export [analyse name] diff --git a/src/lux/base.clj b/src/lux/base.clj index 7b1e7139e..f88ca560e 100644 --- a/src/lux/base.clj +++ b/src/lux/base.clj @@ -33,9 +33,8 @@ (def $HOST 2) (def $MODULES 3) (def $SEED 4) -(def $SEEN-SOURCES 5) -(def $SOURCE 6) -(def $TYPES 7) +(def $SOURCE 5) +(def $TYPES 6) ;; [Exports] (def +name-separator+ ";") @@ -491,8 +490,6 @@ (|table) ;; "lux;seed" 0 - ;; "lux;seen-sources" - (|list) ;; "lux;source" (V "lux;None" nil) ;; "lux;types" @@ -711,15 +708,10 @@ (defn enumerate [xs] (enumerate* 0 xs)) -(defn source-seen? [path] - "(-> Text (Lux Bool))" - (fn [state] - (return* state (fold #(or %1 (= %2 path)) false (get$ $SEEN-SOURCES state))))) - -(defn see-source [path] - "(-> Text (Lux (,)))" +(def modules + "(Lux (List Text))" (fn [state] - (return* (update$ $SEEN-SOURCES (partial |cons path) state) nil))) + (return* state (|keys (get$ $MODULES state))))) (defn when% [test body] "(-> Bool (Lux (,)) (Lux (,)))" diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj index fbf8afb89..9ecdcc6ad 100644 --- a/src/lux/compiler.clj +++ b/src/lux/compiler.clj @@ -369,7 +369,7 @@ return)))) (defn ^:private compile-module [name] - ;; (prn 'compile-module name) + (prn 'compile-module name (&&/cached? name)) (if (&&/cached? name) (do ;; (println "YOLO") (let [file-name (str "input/" name ".lux") diff --git a/src/lux/compiler/base.clj b/src/lux/compiler/base.clj index 89303c48d..a9abe44fc 100644 --- a/src/lux/compiler/base.clj +++ b/src/lux/compiler/base.clj @@ -133,75 +133,77 @@ (defn load-cache [module module-hash compile-module] (|do [loader &/loader !classes &/classes - already-loaded? (&/source-seen? module) + already-loaded? (&a-module/exists? module) + _modules &/modules :let [redo-cache (|do [_ (delete-cache module) _ (compile-module module)] (return false))]] - (if already-loaded? - (return true) - (if (cached? module) - (do (prn 'load-cache module module-hash) - (let [module-path (str "cache/jvm/" (string/replace module #"/" " ")) - module* (string/replace module #"/" ".") - class-name (str module* "._") - ^Class module-meta (do (swap! !classes assoc class-name (read-file (File. (str module-path "/_.class")))) - (load-class! loader class-name))] - (if (and (= module-hash (get-field "_hash" module-meta)) - (= version (get-field "_compiler" module-meta))) - (let [imports (string/split (-> module-meta (.getField "_imports") (.get nil)) #"\t") - ;; _ (prn module 'imports imports) - ] - (|do [loads (&/map% (fn [_import] - (load-cache _import (-> (str "input/" _import ".lux") slurp hash) compile-module)) - (if (= [""] imports) - (&/|list) - (&/->list imports)))] - (if (->> loads &/->seq (every? true?)) - (do (doseq [^File file (seq (.listFiles (File. module-path))) - :let [file-name (.getName file)] - :when (not= "_.class" file-name)] - (let [real-name (second (re-find #"^(.*)\.class$" file-name)) - bytecode (read-file file) - ;; _ (prn 'load-cache module real-name) - ] - ;; (swap! !classes assoc (str module* "." (replace-cache real-name)) bytecode) - (swap! !classes assoc (str module* "." real-name) bytecode) - ;; (swap! !classes assoc "__temp__" bytecode) - ;; (swap! !classes assoc (-> (load-class! loader "__temp__") (.getField "_name") (.get nil)) bytecode) - (write-output module real-name bytecode))) - ;; (swap! !classes dissoc "__temp__") - (let [defs (string/split (get-field "_defs" module-meta) #"\t")] - ;; (prn 'load-cache module defs) - (|do [_ (&/see-source module) - _ (&a-module/enter-module module) - _ (&/map% (fn [_def] - (let [[_exported? _name _ann] (string/split _def #" ") - ;; _ (prn '[_exported? _name _ann] [_exported? _name _ann]) - ] - (|do [_ (case _ann - "T" (&a-module/define module _name (&/V "lux;TypeD" nil) &type/Type) - "M" (|do [_ (&a-module/define module _name (&/V "lux;ValueD" &type/Macro) &type/Macro)] - (&a-module/declare-macro module _name)) - "V" (let [def-class (load-class! loader (str module* ".$" (&/normalize-ident _name))) - ;; _ (println "Fetching _meta" module _name (str module* ".$" (&/normalize-ident _name)) def-class) - def-type (get-field "_meta" def-class)] - (matchv ::M/objects [def-type] - [["lux;ValueD" _def-type]] - (&a-module/define module _name def-type _def-type))) - ;; else - (let [[_ __module __name] (re-find #"^A(.*);(.*)$" _ann)] - (|do [__type (&a-module/def-type __module __name)] - (do ;; (prn '__type [__module __name] (&type/show-type __type)) - (&a-module/def-alias module _name __module __name __type)))))] - (if (= "1" _exported?) - (&a-module/export module _name) - (return nil))) - )) - (if (= [""] defs) - (&/|list) - (&/->list defs)))] - (return true)))) - redo-cache))) - redo-cache) - )) - redo-cache)))) + (do (prn 'load-cache module 'sources already-loaded? + (&/->seq _modules)) + (if already-loaded? + (return true) + (if (cached? module) + (do (prn 'load-cache/HASH module module-hash) + (let [module-path (str "cache/jvm/" (string/replace module #"/" " ")) + module* (string/replace module #"/" ".") + class-name (str module* "._") + ^Class module-meta (do (swap! !classes assoc class-name (read-file (File. (str module-path "/_.class")))) + (load-class! loader class-name))] + (if (and (= module-hash (get-field "_hash" module-meta)) + (= version (get-field "_compiler" module-meta))) + (let [imports (string/split (-> module-meta (.getField "_imports") (.get nil)) #"\t") + _ (prn 'load-cache/IMPORTS module imports) + ] + (|do [loads (&/map% (fn [_import] + (load-cache _import (-> (str "input/" _import ".lux") slurp hash) compile-module)) + (if (= [""] imports) + (&/|list) + (&/->list imports)))] + (if (->> loads &/->seq (every? true?)) + (do (doseq [^File file (seq (.listFiles (File. module-path))) + :let [file-name (.getName file)] + :when (not= "_.class" file-name)] + (let [real-name (second (re-find #"^(.*)\.class$" file-name)) + bytecode (read-file file) + ;; _ (prn 'load-cache module real-name) + ] + ;; (swap! !classes assoc (str module* "." (replace-cache real-name)) bytecode) + (swap! !classes assoc (str module* "." real-name) bytecode) + ;; (swap! !classes assoc "__temp__" bytecode) + ;; (swap! !classes assoc (-> (load-class! loader "__temp__") (.getField "_name") (.get nil)) bytecode) + (write-output module real-name bytecode))) + ;; (swap! !classes dissoc "__temp__") + (let [defs (string/split (get-field "_defs" module-meta) #"\t")] + ;; (prn 'load-cache module defs) + (|do [_ (&a-module/enter-module module) + _ (&/map% (fn [_def] + (let [[_exported? _name _ann] (string/split _def #" ") + ;; _ (prn '[_exported? _name _ann] [_exported? _name _ann]) + ] + (|do [_ (case _ann + "T" (&a-module/define module _name (&/V "lux;TypeD" nil) &type/Type) + "M" (|do [_ (&a-module/define module _name (&/V "lux;ValueD" &type/Macro) &type/Macro)] + (&a-module/declare-macro module _name)) + "V" (let [def-class (load-class! loader (str module* ".$" (&/normalize-ident _name))) + ;; _ (println "Fetching _meta" module _name (str module* ".$" (&/normalize-ident _name)) def-class) + def-type (get-field "_meta" def-class)] + (matchv ::M/objects [def-type] + [["lux;ValueD" _def-type]] + (&a-module/define module _name def-type _def-type))) + ;; else + (let [[_ __module __name] (re-find #"^A(.*);(.*)$" _ann)] + (|do [__type (&a-module/def-type __module __name)] + (do ;; (prn '__type [__module __name] (&type/show-type __type)) + (&a-module/def-alias module _name __module __name __type)))))] + (if (= "1" _exported?) + (&a-module/export module _name) + (return nil))) + )) + (if (= [""] defs) + (&/|list) + (&/->list defs)))] + (return true)))) + redo-cache))) + redo-cache) + )) + redo-cache))))) diff --git a/src/lux/type.clj b/src/lux/type.clj index 77fc6a2f8..14e87e063 100644 --- a/src/lux/type.clj +++ b/src/lux/type.clj @@ -177,7 +177,6 @@ (&/T "lux;types" (&/V "lux;AppT" (&/T (&/V "lux;AppT" (&/T Bindings Int)) Type))) (&/T "lux;host" HostState) (&/T "lux;seed" Int) - (&/T "lux;seen-sources" (&/V "lux;AppT" (&/T List Text))) (&/T "lux;eval?" Bool)))) $Void))) -- cgit v1.2.3 From 6c51e5e50aa98bb26a3e2b34f57a0e24f8537d93 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sat, 25 Jul 2015 18:02:26 -0400 Subject: /cache and /output now using same format. --- src/lux/analyser/module.clj | 14 ++---- src/lux/base.clj | 2 +- src/lux/compiler.clj | 108 ++++++++++++++++++++------------------------ src/lux/compiler/base.clj | 53 +++++----------------- src/lux/compiler/lambda.clj | 13 +++--- src/lux/compiler/lux.clj | 13 +++--- src/lux/host.clj | 11 +++-- src/lux/type.clj | 66 --------------------------- 8 files changed, 84 insertions(+), 196 deletions(-) (limited to 'src') diff --git a/src/lux/analyser/module.clj b/src/lux/analyser/module.clj index 830319549..68cdc4747 100644 --- a/src/lux/analyser/module.clj +++ b/src/lux/analyser/module.clj @@ -77,10 +77,7 @@ [[_ ["lux;AliasD" [?r-module ?r-name]]]] (&/run-state (def-type ?r-module ?r-name) - state) - - [_] - (assert false (prn-str 'def-type (str module ";" name) (aget $def 0)))) + state)) (fail* (str "[Analyser Error] Unknown definition: " (str module ";" name)))) (fail* (str "[Analyser Error] Unknown module: " module))))) @@ -135,12 +132,7 @@ ;; (prn 'find-def/_0 module name 'current-module current-module) (if-let [$module (->> state (&/get$ &/$MODULES) (&/|get module))] (do ;; (prn 'find-def/_0.1 module (&/->seq (&/|keys $module))) - (if-let [$def (try (->> $module (&/get$ $DEFS) (&/|get name)) - (catch StackOverflowError e - (assert false (prn-str 'find-def - (str module ";" name) - (&/->seq (&/|keys (&/get$ $DEFS $module))) - (&/->seq (&/|keys (&/get$ &/$MODULES state)))))))] + (if-let [$def (->> $module (&/get$ $DEFS) (&/|get name))] (matchv ::M/objects [$def] [[exported? $$def]] (do ;; (prn 'find-def/_1 module name 'exported? exported? (.equals ^Object current-module module)) @@ -170,7 +162,7 @@ [[exported? ["lux;ValueD" ?type]]] ((|do [_ (&type/check &type/Macro ?type) ^ClassLoader loader &/loader - :let [macro (-> (.loadClass loader (str (string/replace module #"/" ".") ".$" (&/normalize-ident name))) + :let [macro (-> (.loadClass loader (str (&host/->module-class module) "." (&/normalize-name name))) (.getField "_datum") (.get nil))]] (fn [state*] diff --git a/src/lux/base.clj b/src/lux/base.clj index f88ca560e..9f0a78fa7 100644 --- a/src/lux/base.clj +++ b/src/lux/base.clj @@ -427,7 +427,7 @@ ;; default char)) -(defn normalize-ident [ident] +(defn normalize-name [ident] (reduce str "" (map normalize-char ident))) (def loader diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj index 9ecdcc6ad..05ab12bf1 100644 --- a/src/lux/compiler.clj +++ b/src/lux/compiler.clj @@ -342,7 +342,7 @@ (&/with-eval (|do [module &/get-module-name id &/gen-id - :let [class-name (str module "/" id) + :let [class-name (str (&host/->module-class module) "/" id) ;; _ (prn 'eval! id class-name) =class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS) (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER) @@ -363,62 +363,58 @@ .visitEnd))] _ (&&/save-class! (str id) bytecode) loader &/loader] - (-> (.loadClass ^ClassLoader loader (str (string/replace module #"/" ".") "." id)) + (-> (.loadClass ^ClassLoader loader (str (&host/->module-class module) "." id)) (.getField "_eval") (.get nil) return)))) (defn ^:private compile-module [name] - (prn 'compile-module name (&&/cached? name)) - (if (&&/cached? name) - (do ;; (println "YOLO") - (let [file-name (str "input/" name ".lux") - file-content (slurp file-name)] - (&&/load-cache name (hash file-content) compile-module))) - (let [compiler-step (|do [analysis+ (&optimizer/optimize eval! compile-module)] - (&/map% compile-statement analysis+))] - (|do [module-exists? (&a-module/exists? name)] - (if module-exists? - (if (.equals ^Object name "lux") - (return nil) - (fail "[Compiler Error] Can't redefine a module!")) - (|do [_ (&a-module/enter-module name) - :let [file-name (str "input/" name ".lux") - file-content (slurp file-name) - =class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS) - (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER) - (str name "/_") nil "java/lang/Object" nil) - (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_hash" "I" nil (hash file-content)) - .visitEnd) - (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_compiler" "Ljava/lang/String;" nil &&/version) - .visitEnd))]] - (fn [state] - (matchv ::M/objects [((&/exhaust% compiler-step) - (->> state - (&/set$ &/$SOURCE (&reader/from file-name file-content)) - (&/update$ &/$HOST #(&/set$ &/$WRITER (&/V "lux;Some" =class) %))))] - [["lux;Right" [?state _]]] - (&/run-state (|do [defs &a-module/defs - imports &a-module/imports - :let [_ (doto =class - (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_defs" "Ljava/lang/String;" nil - (->> defs - (&/|map (fn [_def] - (|let [[?exported ?name ?ann] _def] - (str (if ?exported "1" "0") " " ?name " " ?ann)))) - (&/|interpose "\t") - (&/fold str ""))) - .visitEnd) - (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_imports" "Ljava/lang/String;" nil - (->> imports (&/|interpose "\t") (&/fold str ""))) - .visitEnd) - (.visitEnd))]] - (&&/save-class! "_" (.toByteArray =class))) - ?state) - - [["lux;Left" ?message]] - (fail* ?message))))))) - )) + ;; (prn 'compile-module name (&&/cached? name)) + (let [file-name (str "input/" name ".lux") + file-content (slurp file-name) + file-hash (hash file-content)] + (if (&&/cached? name) + (&&/load-cache name file-hash compile-module) + (let [compiler-step (|do [analysis+ (&optimizer/optimize eval! compile-module)] + (&/map% compile-statement analysis+))] + (|do [module-exists? (&a-module/exists? name)] + (if module-exists? + (fail "[Compiler Error] Can't redefine a module!") + (|do [_ (&a-module/enter-module name) + :let [=class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS) + (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER) + (str (&host/->module-class name) "/_") nil "java/lang/Object" nil) + (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_hash" "I" nil file-hash) + .visitEnd) + (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_compiler" "Ljava/lang/String;" nil &&/version) + .visitEnd))]] + (fn [state] + (matchv ::M/objects [((&/exhaust% compiler-step) + (->> state + (&/set$ &/$SOURCE (&reader/from file-name file-content)) + (&/update$ &/$HOST #(&/set$ &/$WRITER (&/V "lux;Some" =class) %))))] + [["lux;Right" [?state _]]] + (&/run-state (|do [defs &a-module/defs + imports &a-module/imports + :let [_ (doto =class + (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_defs" "Ljava/lang/String;" nil + (->> defs + (&/|map (fn [_def] + (|let [[?exported ?name ?ann] _def] + (str (if ?exported "1" "0") " " ?name " " ?ann)))) + (&/|interpose "\t") + (&/fold str ""))) + .visitEnd) + (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_imports" "Ljava/lang/String;" nil + (->> imports (&/|interpose "\t") (&/fold str ""))) + .visitEnd) + (.visitEnd))]] + (&&/save-class! "_" (.toByteArray =class))) + ?state) + + [["lux;Left" ?message]] + (fail* ?message))))))) + ))) (defn ^:private clean-file [^java.io.File file] (if (.isDirectory file) @@ -440,14 +436,10 @@ (setup-dirs!) (matchv ::M/objects [((&/map% compile-module modules) (&/init-state nil))] [["lux;Right" [?state _]]] - (println (str "Compilation complete! " (str "[" (->> modules - (&/|interpose " ") - (&/fold str "")) - "]"))) + (println "Compilation complete!") [["lux;Left" ?message]] - (do (prn 'compile-all '?message ?message) - (assert false ?message)))) + (assert false ?message))) (comment (compile-all ["lux"]) diff --git a/src/lux/compiler/base.clj b/src/lux/compiler/base.clj index a9abe44fc..d3dfc8746 100644 --- a/src/lux/compiler/base.clj +++ b/src/lux/compiler/base.clj @@ -12,7 +12,8 @@ [clojure.core.match :as M :refer [matchv]] clojure.core.match.array (lux [base :as & :refer [|do return* return fail fail*]] - [type :as &type]) + [type :as &type] + [host :as &host]) (lux.analyser [base :as &a] [module :as &a-module])) (:import (org.objectweb.asm Opcodes @@ -30,12 +31,12 @@ (.write stream data))) (defn ^:private write-output [module name data] - (let [module* module] + (let [module* (&host/->module-class module)] (.mkdirs (File. (str "output/jvm/" module*))) (write-file (str "output/jvm/" module* "/" name ".class") data))) (defn ^:private write-cache [module name data] - (let [module* (string/replace module #"/" " ")] + (let [module* (&host/->module-class module)] (.mkdirs (File. (str "cache/jvm/" module*))) (write-file (str "cache/jvm/" module* "/" name ".class") data))) @@ -70,7 +71,7 @@ module &/get-module-name loader &/loader !classes &/classes - :let [real-name (str (string/replace module #"/" ".") "." name) + :let [real-name (str (&host/->module-class module) "." name) _ (swap! !classes assoc real-name bytecode) _ (load-class! loader real-name) _ (when (not eval?) @@ -79,11 +80,11 @@ (return nil))) (defn cached? [module] - (.exists (File. (str "cache/jvm/" (string/replace module #"/" " ") "/_.class")))) + (.exists (File. (str "cache/jvm/" (&host/->module-class module) "/_.class")))) (defn delete-cache [module] (fn [state] - (do (clean-file (File. (str "cache/jvm/" (string/replace module #"/" " ")))) + (do (clean-file (File. (str "cache/jvm/" (&host/->module-class module)))) (return* state nil)))) (defn ^:private replace-several [content & replacements] @@ -95,34 +96,6 @@ (throw e))) content replacement-list))) -(defn ^:private replace-cache [^String cache-name] - (if (.startsWith cache-name "$") - (replace-several cache-name - #"_ASTER_" "*" - #"_PLUS_" "+" - #"_DASH_" "-" - #"_SLASH_" "/" - #"_BSLASH_" "\\" - #"_UNDERS_" "_" - #"_PERCENT_" "%" - #"_DOLLAR_" "$" - #"_QUOTE_" "'" - #"_BQUOTE_" "`" - #"_AT_" "@" - #"_CARET_" "^" - #"_AMPERS_" "&" - #"_EQ_" "=" - #"_BANG_" "!" - #"_QM_" "?" - #"_COLON_" ":" - #"_PERIOD_" "." - #"_COMMA_" "," - #"_LT_" "<" - #"_GT_" ">" - #"_TILDE_" "~" - #"_PIPE_" "|") - cache-name)) - (defn ^:private get-field [^String field-name ^Class class] (-> class ^Field (.getField field-name) (.get nil)) ;; (try (-> class ^Field (.getField field-name) (.get nil)) @@ -144,8 +117,8 @@ (return true) (if (cached? module) (do (prn 'load-cache/HASH module module-hash) - (let [module-path (str "cache/jvm/" (string/replace module #"/" " ")) - module* (string/replace module #"/" ".") + (let [module* (&host/->module-class module) + module-path (str "cache/jvm/" module*) class-name (str module* "._") ^Class module-meta (do (swap! !classes assoc class-name (read-file (File. (str module-path "/_.class")))) (load-class! loader class-name))] @@ -167,12 +140,8 @@ bytecode (read-file file) ;; _ (prn 'load-cache module real-name) ] - ;; (swap! !classes assoc (str module* "." (replace-cache real-name)) bytecode) (swap! !classes assoc (str module* "." real-name) bytecode) - ;; (swap! !classes assoc "__temp__" bytecode) - ;; (swap! !classes assoc (-> (load-class! loader "__temp__") (.getField "_name") (.get nil)) bytecode) (write-output module real-name bytecode))) - ;; (swap! !classes dissoc "__temp__") (let [defs (string/split (get-field "_defs" module-meta) #"\t")] ;; (prn 'load-cache module defs) (|do [_ (&a-module/enter-module module) @@ -184,8 +153,8 @@ "T" (&a-module/define module _name (&/V "lux;TypeD" nil) &type/Type) "M" (|do [_ (&a-module/define module _name (&/V "lux;ValueD" &type/Macro) &type/Macro)] (&a-module/declare-macro module _name)) - "V" (let [def-class (load-class! loader (str module* ".$" (&/normalize-ident _name))) - ;; _ (println "Fetching _meta" module _name (str module* ".$" (&/normalize-ident _name)) def-class) + "V" (let [def-class (load-class! loader (str module* "." (&/normalize-name _name))) + ;; _ (println "Fetching _meta" module _name (str module* "." (&/normalize-name _name)) def-class) def-type (get-field "_meta" def-class)] (matchv ::M/objects [def-type] [["lux;ValueD" _def-type]] diff --git a/src/lux/compiler/lambda.clj b/src/lux/compiler/lambda.clj index 9f4bef80c..d97cc1f26 100644 --- a/src/lux/compiler/lambda.clj +++ b/src/lux/compiler/lambda.clj @@ -93,20 +93,21 @@ ;; [Exports] (defn compile-lambda [compile ?scope ?env ?body] ;; (prn 'compile-lambda (->> ?scope &/->seq)) - (|do [:let [lambda-class (str (&/|head ?scope) "/$" (&host/location (&/|tail ?scope))) + (|do [:let [name (&host/location (&/|tail ?scope)) + class-name (str (&host/->module-class (&/|head ?scope)) "/" name) =class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS) (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_SUPER) - lambda-class nil "java/lang/Object" (into-array ["lux/Function"])) + class-name nil "java/lang/Object" (into-array ["lux/Function"])) (-> (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 [?name+?captured] [[?name [["captured" [_ ?captured-id ?source]] _]]]) (doseq [?name+?captured (&/->seq ?env)]))) - (add-lambda-apply lambda-class ?env) - (add-lambda- lambda-class ?env) + (add-lambda-apply class-name ?env) + (add-lambda- class-name ?env) )] _ (add-lambda-impl =class compile lambda-impl-signature ?body) :let [_ (.visitEnd =class)] - _ (&&/save-class! (str "$" (&host/location (&/|tail ?scope))) (.toByteArray =class))] - (instance-closure compile lambda-class ?env (lambda--signature ?env)))) + _ (&&/save-class! name (.toByteArray =class))] + (instance-closure compile class-name ?env (lambda--signature ?env)))) diff --git a/src/lux/compiler/lux.clj b/src/lux/compiler/lux.clj index 66db6923d..32a7af751 100644 --- a/src/lux/compiler/lux.clj +++ b/src/lux/compiler/lux.clj @@ -115,14 +115,14 @@ :let [_ (doto *writer* (.visitVarInsn Opcodes/ALOAD 0) (.visitFieldInsn Opcodes/GETFIELD - (str (&/|head ?scope) "/$" (&host/location (&/|tail ?scope))) + (str (&host/->module-class (&/|head ?scope)) "/" (&host/location (&/|tail ?scope))) (str &&/closure-prefix ?captured-id) "Ljava/lang/Object;"))]] (return nil))) (defn compile-global [compile *type* ?owner-class ?name] (|do [^MethodVisitor *writer* &/get-writer - :let [_ (.visitFieldInsn *writer* Opcodes/GETSTATIC (str ?owner-class "/$" (&/normalize-ident ?name)) "_datum" "Ljava/lang/Object;")]] + :let [_ (.visitFieldInsn *writer* Opcodes/GETSTATIC (str (&host/->module-class ?owner-class) "/" (&/normalize-name ?name)) "_datum" "Ljava/lang/Object;")]] (return nil))) (defn compile-apply [compile *type* ?fn ?args] @@ -279,10 +279,9 @@ (defn compile-def [compile ?name ?body ?def-data] (|do [^ClassWriter *writer* &/get-writer module-name &/get-module-name - :let [outer-class (&host/->class module-name) - datum-sig "Ljava/lang/Object;" - current-class (str outer-class "/" (str "$" (&/normalize-ident ?name))) - ;; _ (prn 'compile-def 'outer-class outer-class '?name ?name 'current-class current-class) + :let [datum-sig "Ljava/lang/Object;" + def-name (&/normalize-name ?name) + current-class (str (&host/->module-class module-name) "/" def-name) =class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS) (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_SUPER) current-class nil "java/lang/Object" (into-array ["lux/Function"])) @@ -305,7 +304,7 @@ (.visitEnd))]] (return nil))) :let [_ (.visitEnd *writer*)] - _ (&&/save-class! (str "$" (&/normalize-ident ?name)) (.toByteArray =class))] + _ (&&/save-class! def-name (.toByteArray =class))] (return nil))) (defn compile-ann [compile *type* ?value-ex ?type-ex] diff --git a/src/lux/host.clj b/src/lux/host.clj index abbdb8c6d..d248c708e 100644 --- a/src/lux/host.clj +++ b/src/lux/host.clj @@ -39,7 +39,10 @@ (defn ^String ->class [class] (string/replace class #"\." "/")) -(def ->package ->class) +(defn ^String ->module-class [module-name] + (string/replace module-name #"/" " ")) + +(def ->package ->module-class) (defn ->type-signature [class] ;; (assert (string? class)) @@ -70,9 +73,7 @@ [["lux;VariantT" ["lux;Nil" _]]] "V" - - [_] - (assert false (prn-str '->java-sig (aget type 0))))) + )) (defn extract-jvm-param [token] (matchv ::M/objects [token] @@ -114,4 +115,4 @@ ) (defn location [scope] - (->> scope (&/|map &/normalize-ident) (&/|interpose "$") (&/fold str ""))) + (->> scope (&/|map &/normalize-name) (&/|interpose "$") (&/fold str ""))) diff --git a/src/lux/type.clj b/src/lux/type.clj index 14e87e063..f1a5b7623 100644 --- a/src/lux/type.clj +++ b/src/lux/type.clj @@ -416,73 +416,7 @@ [args body*]))] (str "(All " ?name " [" (->> args reverse (interpose " ") (reduce str "")) "] " (show-type body) ")")) ?name) - - [_] - (assert false (prn-str 'show-type (aget type 0) (class (aget type 1)))) )) -;; (defn show-type [^objects type] -;; (matchv ::M/objects [type] -;; [["lux;DataT" name]] -;; (str "(^ " name ")") - -;; [["lux;TupleT" elems]] -;; (if (&/|empty? elems) -;; "(,)" -;; (str "(, " (->> elems (&/|map show-type) (&/|interpose " ") (&/fold str "")) ")")) - -;; [["lux;VariantT" cases]] -;; (if (&/|empty? cases) -;; "(|)" -;; (str "(| " (->> cases -;; (&/|map (fn [kv] -;; (matchv ::M/objects [kv] -;; [[k ["lux;TupleT" ["lux;Nil" _]]]] -;; (str "#" k) - -;; [[k v]] -;; (str "(#" k " " (show-type v) ")")))) -;; (&/|interpose " ") -;; (&/fold str "")) ")")) - - -;; [["lux;RecordT" fields]] -;; (str "(& " (->> fields -;; (&/|map (fn [kv] -;; (matchv ::M/objects [kv] -;; [[k v]] -;; (str "#" k " " (show-type v))))) -;; (&/|interpose " ") -;; (&/fold str "")) ")") - -;; [["lux;LambdaT" [input output]]] -;; (str "(-> " (show-type input) " " (show-type output) ")") - -;; [["lux;VarT" id]] -;; (str "⌈" id "⌋") - -;; [["lux;BoundT" name]] -;; name - -;; [["lux;ExT" ?id]] -;; (str "⟨" ?id "⟩") - -;; [["lux;AppT" [?lambda ?param]]] -;; (str "(" (show-type ?lambda) " " (show-type ?param) ")") - -;; [["lux;AllT" [?env ?name ?arg ?body]]] -;; (let [[args body] (loop [args (list ?arg) -;; body* ?body] -;; (matchv ::M/objects [body*] -;; [["lux;AllT" [?env* ?name* ?arg* ?body*]]] -;; (recur (cons ?arg* args) ?body*) - -;; [_] -;; [args body*]))] -;; (str "(All " ?name " [" (->> args reverse (interpose " ") (reduce str "")) "] " (show-type body) ")")) - -;; [_] -;; (assert false (prn-str 'show-type (aget type 0) (class (aget type 1)))) -;; )) (defn type= [x y] (or (clojure.lang.Util/identical x y) -- cgit v1.2.3 From 4cd9b0c9242f1105e50ad9b42b7f6f5d074f14b4 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sat, 25 Jul 2015 20:19:43 -0400 Subject: - The output directory is now being used as the cache. - "input" has been renamed as "source" and "output" has been renamed as "target". --- src/lux.clj | 4 +- src/lux/analyser/host.clj | 6 +- src/lux/analyser/lux.clj | 2 +- src/lux/compiler.clj | 34 ++++------- src/lux/compiler/base.clj | 144 +++++---------------------------------------- src/lux/compiler/cache.clj | 135 ++++++++++++++++++++++++++++++++++++++++++ 6 files changed, 165 insertions(+), 160 deletions(-) create mode 100644 src/lux/compiler/cache.clj (limited to 'src') diff --git a/src/lux.clj b/src/lux.clj index 7ff8fda37..9c913c9ac 100644 --- a/src/lux.clj +++ b/src/lux.clj @@ -14,9 +14,7 @@ :reload-all)) (defn -main [& _] - (do (time (&compiler/compile-all (&/|list "lux" "program"))) - ;; (prn @&type/counter) - ) + (time (&compiler/compile-all (&/|list "lux" "program"))) (System/exit 0)) (comment diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj index 68bd627fc..e490bc62f 100644 --- a/src/lux/analyser/host.clj +++ b/src/lux/analyser/host.clj @@ -117,9 +117,9 @@ (defn analyse-jvm-invokestatic [analyse ?class ?method ?classes ?args] (|do [=classes (&/map% &host/extract-jvm-param ?classes) =return (&host/lookup-static-method ?class ?method =classes) - :let [_ (matchv ::M/objects [=return] - [["lux;DataT" _return-class]] - (prn 'analyse-jvm-invokestatic ?class ?method _return-class))] + ;; :let [_ (matchv ::M/objects [=return] + ;; [["lux;DataT" _return-class]] + ;; (prn 'analyse-jvm-invokestatic ?class ?method _return-class))] =args (&/map2% (fn [_class _arg] (&&/analyse-1 analyse (&/V "lux;DataT" _class) _arg)) =classes diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj index 6acae193f..b25dff9eb 100644 --- a/src/lux/analyser/lux.clj +++ b/src/lux/analyser/lux.clj @@ -394,7 +394,7 @@ (return nil))] (&/save-module (|do [already-compiled? (&&module/exists? ?path) - :let [_ (prn 'analyse-import module-name ?path already-compiled?)] + ;; :let [_ (prn 'analyse-import module-name ?path already-compiled?)] _ (&&module/add-import ?path) _ (&/when% (not already-compiled?) (compile-module ?path))] (return (&/|list)))))) diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj index 05ab12bf1..bb1c72f66 100644 --- a/src/lux/compiler.clj +++ b/src/lux/compiler.clj @@ -24,6 +24,7 @@ [lux.analyser.base :as &a] [lux.analyser.module :as &a-module] (lux.compiler [base :as &&] + [cache :as &&cache] [lux :as &&lux] [host :as &&host] [case :as &&case] @@ -369,12 +370,12 @@ return)))) (defn ^:private compile-module [name] - ;; (prn 'compile-module name (&&/cached? name)) - (let [file-name (str "input/" name ".lux") + ;; (prn 'compile-module name (&&cache/cached? name)) + (let [file-name (str &&/input-dir "/" name ".lux") file-content (slurp file-name) file-hash (hash file-content)] - (if (&&/cached? name) - (&&/load-cache name file-hash compile-module) + (if (&&cache/cached? name) + (&&cache/load name file-hash compile-module) (let [compiler-step (|do [analysis+ (&optimizer/optimize eval! compile-module)] (&/map% compile-statement analysis+))] (|do [module-exists? (&a-module/exists? name)] @@ -416,31 +417,16 @@ (fail* ?message))))))) ))) -(defn ^:private clean-file [^java.io.File file] - (if (.isDirectory file) - (do (doseq [f (seq (.listFiles file))] - (clean-file f)) - (.delete file)) - (.delete file))) - -(defn ^:private setup-dirs! [] - (.mkdir (java.io.File. "cache")) - (.mkdir (java.io.File. "cache/jvm")) - (.mkdir (java.io.File. "output")) - (.mkdir (java.io.File. "output/jvm")) - (doseq [f (seq (.listFiles (java.io.File. "output/jvm")))] - (clean-file f))) +(defn ^:private init! [] + (.mkdirs (java.io.File. &&/output-dir))) ;; [Resources] (defn compile-all [modules] - (setup-dirs!) + (init!) (matchv ::M/objects [((&/map% compile-module modules) (&/init-state nil))] [["lux;Right" [?state _]]] - (println "Compilation complete!") + (do (println "Compilation complete!") + (&&cache/clean ?state)) [["lux;Left" ?message]] (assert false ?message))) - -(comment - (compile-all ["lux"]) - ) diff --git a/src/lux/compiler/base.clj b/src/lux/compiler/base.clj index d3dfc8746..e7b338b16 100644 --- a/src/lux/compiler/base.clj +++ b/src/lux/compiler/base.clj @@ -25,43 +25,28 @@ FileOutputStream) (java.lang.reflect Field))) +;; [Constants] +(def ^String version "0.2") +(def ^String input-dir "source") +(def ^String output-dir "target/jvm") + +(def ^String local-prefix "l") +(def ^String partial-prefix "p") +(def ^String closure-prefix "c") +(def ^String apply-signature "(Ljava/lang/Object;)Ljava/lang/Object;") + ;; [Utils] (defn ^:private write-file [^String file ^bytes data] (with-open [stream (BufferedOutputStream. (FileOutputStream. file))] (.write stream data))) (defn ^:private write-output [module name data] - (let [module* (&host/->module-class module)] - (.mkdirs (File. (str "output/jvm/" module*))) - (write-file (str "output/jvm/" module* "/" name ".class") data))) - -(defn ^:private write-cache [module name data] - (let [module* (&host/->module-class module)] - (.mkdirs (File. (str "cache/jvm/" module*))) - (write-file (str "cache/jvm/" module* "/" name ".class") data))) - -(defn ^:private clean-file [^File file] - (if (.isDirectory file) - (do (doseq [f (seq (.listFiles file))] - (clean-file f)) - (.delete file)) - (.delete file))) - -(defn ^:private read-file [^File file] - (with-open [reader (io/input-stream file)] - (let [length (.length file) - buffer (byte-array length)] - (.read reader buffer 0 length) - buffer))) + (let [module* (&host/->module-class module) + module-dir (str output-dir "/" module*)] + (.mkdirs (File. module-dir)) + (write-file (str module-dir "/" name ".class") data))) ;; [Exports] -(def version "0.2") - -(def local-prefix "l") -(def partial-prefix "p") -(def closure-prefix "c") -(def apply-signature "(Ljava/lang/Object;)Ljava/lang/Object;") - (defn load-class! [^ClassLoader loader name] ;; (prn 'load-class! name) (.loadClass loader name)) @@ -75,104 +60,5 @@ _ (swap! !classes assoc real-name bytecode) _ (load-class! loader real-name) _ (when (not eval?) - (do (write-output module name bytecode) - (write-cache module name bytecode)))]] + (write-output module name bytecode))]] (return nil))) - -(defn cached? [module] - (.exists (File. (str "cache/jvm/" (&host/->module-class module) "/_.class")))) - -(defn delete-cache [module] - (fn [state] - (do (clean-file (File. (str "cache/jvm/" (&host/->module-class module)))) - (return* state nil)))) - -(defn ^:private replace-several [content & replacements] - (let [replacement-list (partition 2 replacements)] - (reduce #(try (let [[_pattern _rep] %2] - (string/replace %1 _pattern (string/re-quote-replacement _rep))) - (catch Exception e - (prn 'replace-several content %1 %2) - (throw e))) - content replacement-list))) - -(defn ^:private get-field [^String field-name ^Class class] - (-> class ^Field (.getField field-name) (.get nil)) - ;; (try (-> class ^Field (.getField field-name) (.get nil)) - ;; (catch Error e - ;; (assert false (prn-str 'get-field field-name class)))) - ) - -(defn load-cache [module module-hash compile-module] - (|do [loader &/loader - !classes &/classes - already-loaded? (&a-module/exists? module) - _modules &/modules - :let [redo-cache (|do [_ (delete-cache module) - _ (compile-module module)] - (return false))]] - (do (prn 'load-cache module 'sources already-loaded? - (&/->seq _modules)) - (if already-loaded? - (return true) - (if (cached? module) - (do (prn 'load-cache/HASH module module-hash) - (let [module* (&host/->module-class module) - module-path (str "cache/jvm/" module*) - class-name (str module* "._") - ^Class module-meta (do (swap! !classes assoc class-name (read-file (File. (str module-path "/_.class")))) - (load-class! loader class-name))] - (if (and (= module-hash (get-field "_hash" module-meta)) - (= version (get-field "_compiler" module-meta))) - (let [imports (string/split (-> module-meta (.getField "_imports") (.get nil)) #"\t") - _ (prn 'load-cache/IMPORTS module imports) - ] - (|do [loads (&/map% (fn [_import] - (load-cache _import (-> (str "input/" _import ".lux") slurp hash) compile-module)) - (if (= [""] imports) - (&/|list) - (&/->list imports)))] - (if (->> loads &/->seq (every? true?)) - (do (doseq [^File file (seq (.listFiles (File. module-path))) - :let [file-name (.getName file)] - :when (not= "_.class" file-name)] - (let [real-name (second (re-find #"^(.*)\.class$" file-name)) - bytecode (read-file file) - ;; _ (prn 'load-cache module real-name) - ] - (swap! !classes assoc (str module* "." real-name) bytecode) - (write-output module real-name bytecode))) - (let [defs (string/split (get-field "_defs" module-meta) #"\t")] - ;; (prn 'load-cache module defs) - (|do [_ (&a-module/enter-module module) - _ (&/map% (fn [_def] - (let [[_exported? _name _ann] (string/split _def #" ") - ;; _ (prn '[_exported? _name _ann] [_exported? _name _ann]) - ] - (|do [_ (case _ann - "T" (&a-module/define module _name (&/V "lux;TypeD" nil) &type/Type) - "M" (|do [_ (&a-module/define module _name (&/V "lux;ValueD" &type/Macro) &type/Macro)] - (&a-module/declare-macro module _name)) - "V" (let [def-class (load-class! loader (str module* "." (&/normalize-name _name))) - ;; _ (println "Fetching _meta" module _name (str module* "." (&/normalize-name _name)) def-class) - def-type (get-field "_meta" def-class)] - (matchv ::M/objects [def-type] - [["lux;ValueD" _def-type]] - (&a-module/define module _name def-type _def-type))) - ;; else - (let [[_ __module __name] (re-find #"^A(.*);(.*)$" _ann)] - (|do [__type (&a-module/def-type __module __name)] - (do ;; (prn '__type [__module __name] (&type/show-type __type)) - (&a-module/def-alias module _name __module __name __type)))))] - (if (= "1" _exported?) - (&a-module/export module _name) - (return nil))) - )) - (if (= [""] defs) - (&/|list) - (&/->list defs)))] - (return true)))) - redo-cache))) - redo-cache) - )) - redo-cache))))) diff --git a/src/lux/compiler/cache.clj b/src/lux/compiler/cache.clj new file mode 100644 index 000000000..d6f0b1db7 --- /dev/null +++ b/src/lux/compiler/cache.clj @@ -0,0 +1,135 @@ +;; Copyright (c) Eduardo Julian. All rights reserved. +;; The use and distribution terms for this software are covered by the +;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) +;; which can be found in the file epl-v10.html at the root of this distribution. +;; By using this software in any fashion, you are agreeing to be bound by +;; the terms of this license. +;; You must not remove this notice, or any other, from this software. + +(ns lux.compiler.cache + (:refer-clojure :exclude [load]) + (:require [clojure.string :as string] + [clojure.java.io :as io] + [clojure.core.match :as M :refer [matchv]] + clojure.core.match.array + (lux [base :as & :refer [|do return* return fail fail*]] + [type :as &type] + [host :as &host]) + (lux.analyser [base :as &a] + [module :as &a-module]) + (lux.compiler [base :as &&])) + (:import (java.io File + BufferedOutputStream + FileOutputStream) + (java.lang.reflect Field))) + +;; [Utils] +(defn ^:private read-file [^File file] + (with-open [reader (io/input-stream file)] + (let [length (.length file) + buffer (byte-array length)] + (.read reader buffer 0 length) + buffer))) + +(defn ^:private clean-file [^File file] + (if (.isDirectory file) + (do (doseq [f (seq (.listFiles file))] + (clean-file f)) + (.delete file)) + (.delete file))) + +(defn ^:private get-field [^String field-name ^Class class] + (-> class ^Field (.getField field-name) (.get nil))) + +;; [Resources] +(defn cached? [module] + "(-> Text Bool)" + (.exists (new File (str &&/output-dir "/" (&host/->module-class module) "/_.class")))) + +(defn delete [module] + "(-> Text (Lux (,)))" + (fn [state] + (do (clean-file (new File (str &&/output-dir "/" (&host/->module-class module)))) + (return* state nil)))) + +(defn clean [state] + "(-> Compiler (,))" + (let [needed-modules (->> state (&/get$ &/$MODULES) &/|keys &/->seq set) + outdated? #(-> % .getName (string/replace " " "/") (->> (contains? needed-modules)) not) + outdate-files (->> &&/output-dir (new File) .listFiles seq (filter outdated?))] + (doseq [f outdate-files] + (clean-file f)) + nil)) + +(defn load [module module-hash compile-module] + (|do [loader &/loader + !classes &/classes + already-loaded? (&a-module/exists? module) + _modules &/modules + :let [redo-cache (|do [_ (delete module) + _ (compile-module module)] + (return false))]] + (do ;; (prn 'load module 'sources already-loaded? + ;; (&/->seq _modules)) + (if already-loaded? + (return true) + (if (cached? module) + (do ;; (prn 'load/HASH module module-hash) + (let [module* (&host/->module-class module) + module-path (str &&/output-dir "/" module*) + class-name (str module* "._") + ^Class module-meta (do (swap! !classes assoc class-name (read-file (File. (str module-path "/_.class")))) + (&&/load-class! loader class-name))] + (if (and (= module-hash (get-field "_hash" module-meta)) + (= &&/version (get-field "_compiler" module-meta))) + (let [imports (string/split (-> module-meta (.getField "_imports") (.get nil)) #"\t") + ;; _ (prn 'load/IMPORTS module imports) + ] + (|do [loads (&/map% (fn [_import] + (load _import (-> (str &&/input-dir "/" _import ".lux") slurp hash) compile-module)) + (if (= [""] imports) + (&/|list) + (&/->list imports)))] + (if (->> loads &/->seq (every? true?)) + (do (doseq [^File file (seq (.listFiles (File. module-path))) + :let [file-name (.getName file)] + :when (not= "_.class" file-name)] + (let [real-name (second (re-find #"^(.*)\.class$" file-name)) + bytecode (read-file file) + ;; _ (prn 'load module real-name) + ] + (swap! !classes assoc (str module* "." real-name) bytecode))) + (let [defs (string/split (get-field "_defs" module-meta) #"\t")] + ;; (prn 'load module defs) + (|do [_ (&a-module/enter-module module) + _ (&/map% (fn [_def] + (let [[_exported? _name _ann] (string/split _def #" ") + ;; _ (prn '[_exported? _name _ann] [_exported? _name _ann]) + ] + (|do [_ (case _ann + "T" (&a-module/define module _name (&/V "lux;TypeD" nil) &type/Type) + "M" (|do [_ (&a-module/define module _name (&/V "lux;ValueD" &type/Macro) &type/Macro)] + (&a-module/declare-macro module _name)) + "V" (let [def-class (&&/load-class! loader (str module* "." (&/normalize-name _name))) + ;; _ (println "Fetching _meta" module _name (str module* "." (&/normalize-name _name)) def-class) + def-type (get-field "_meta" def-class)] + (matchv ::M/objects [def-type] + [["lux;ValueD" _def-type]] + (&a-module/define module _name def-type _def-type))) + ;; else + (let [[_ __module __name] (re-find #"^A(.*);(.*)$" _ann)] + (|do [__type (&a-module/def-type __module __name)] + (do ;; (prn '__type [__module __name] (&type/show-type __type)) + (&a-module/def-alias module _name __module __name __type)))))] + (if (= "1" _exported?) + (&a-module/export module _name) + (return nil))) + )) + (if (= [""] defs) + (&/|list) + (&/->list defs)))] + (return true)))) + redo-cache))) + redo-cache) + )) + redo-cache))))) -- cgit v1.2.3 From 9b7cfd6f5bcc93e2f2f0c3129b7ec6d62c69bb37 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sun, 26 Jul 2015 20:57:21 -0400 Subject: - Fixed a pattern-matching error where generalizations of types (universal-quantification / AllT) was not being taken into account properly when destructuring. - Fixed a compiler error wherein the types of definitions didn't generate (correctly) the structures necessary for storage inside the class _meta(data) field. - Improved both the "open" and "import" macros with extra features. --- src/lux/analyser/case.clj | 120 ++++++++++++++++++++++++++++++++++++-------- src/lux/analyser/lux.clj | 18 ++++--- src/lux/compiler/base.clj | 1 + src/lux/compiler/cache.clj | 2 +- src/lux/compiler/host.clj | 2 +- src/lux/compiler/lambda.clj | 2 +- src/lux/compiler/lux.clj | 113 ++++------------------------------------- src/lux/compiler/type.clj | 97 +++++++++++++++++++++++++++++++++++ src/lux/type.clj | 20 ++++++-- 9 files changed, 234 insertions(+), 141 deletions(-) create mode 100644 src/lux/compiler/type.clj (limited to 'src') diff --git a/src/lux/analyser/case.clj b/src/lux/analyser/case.clj index 659b2b0f6..cb76d8d54 100644 --- a/src/lux/analyser/case.clj +++ b/src/lux/analyser/case.clj @@ -23,7 +23,8 @@ (fail "##9##")))] (resolve-type type*)) - [["lux;AllT" ?id]] + [["lux;AllT" [_aenv _aname _aarg _abody]]] + ;; (&type/actual-type _abody) (|do [$var &type/existential =type (&type/apply-type type $var)] (&type/actual-type =type)) @@ -35,6 +36,79 @@ [_] (&type/actual-type type))) +(defn adjust-type* [up type] + "(-> (List (, (Maybe (Env Text Type)) Text Text Type)) Type (Lux Type))" + (matchv ::M/objects [type] + [["lux;AllT" [_aenv _aname _aarg _abody]]] + (&type/with-var + (fn [$var] + (|do [=type (&type/apply-type type $var)] + (adjust-type* (&/|cons (&/T _aenv _aname _aarg $var) up) =type)))) + + [["lux;TupleT" ?members]] + (|do [["lux;TupleT" ?members*] (&/fold% (fn [_abody ena] + (|let [[_aenv _aname _aarg ["lux;VarT" _avar]] ena] + (|do [_ (&type/set-var _avar (&/V "lux;BoundT" _aarg))] + (&type/clean* _avar _abody)))) + type + up)] + (return (&/V "lux;TupleT" (&/|map (fn [v] + (&/fold (fn [_abody ena] + (|let [[_aenv _aname _aarg _avar] ena] + (&/V "lux;AllT" (&/T _aenv _aname _aarg _abody)))) + v + up)) + ?members*)))) + + [["lux;RecordT" ?fields]] + (|do [["lux;RecordT" ?fields*] (&/fold% (fn [_abody ena] + (|let [[_aenv _aname _aarg ["lux;VarT" _avar]] ena] + (|do [_ (&type/set-var _avar (&/V "lux;BoundT" _aarg))] + (&type/clean* _avar _abody)))) + type + up)] + (return (&/V "lux;RecordT" (&/|map (fn [kv] + (|let [[k v] kv] + (&/T k (&/fold (fn [_abody ena] + (|let [[_aenv _aname _aarg _avar] ena] + (&/V "lux;AllT" (&/T _aenv _aname _aarg _abody)))) + v + up)))) + ?fields*)))) + + [["lux;VariantT" ?cases]] + (|do [["lux;VariantT" ?cases*] (&/fold% (fn [_abody ena] + (|let [[_aenv _aname _aarg ["lux;VarT" _avar]] ena] + (|do [_ (&type/set-var _avar (&/V "lux;BoundT" _aarg))] + (&type/clean* _avar _abody)))) + type + up)] + (return (&/V "lux;VariantT" (&/|map (fn [kv] + (|let [[k v] kv] + (&/T k (&/fold (fn [_abody ena] + (|let [[_aenv _aname _aarg _avar] ena] + (&/V "lux;AllT" (&/T _aenv _aname _aarg _abody)))) + v + up)))) + ?cases*)))) + + [["lux;AppT" [?tfun ?targ]]] + (|do [=type (&type/apply-type ?tfun ?targ)] + (adjust-type* up =type)) + + [["lux;VarT" ?id]] + (|do [type* (&/try-all% (&/|list (&type/deref ?id) + (fail "##9##")))] + (adjust-type* up type*)) + + [_] + (assert false (aget type 0)) + )) + +(defn adjust-type [type] + "(-> Type (Lux Type))" + (adjust-type* (&/|list) type)) + (defn ^:private analyse-pattern [value-type pattern kont] (matchv ::M/objects [pattern] [["lux;Meta" [_ pattern*]]] @@ -71,27 +145,31 @@ (return (&/T (&/V "TextTestAC" ?value) =kont))) [["lux;TupleS" ?members]] - (|do [value-type* (resolve-type value-type)] + (|do [value-type* (adjust-type value-type)] (do ;; (prn 'PM/TUPLE-1 (&type/show-type value-type*)) - (matchv ::M/objects [value-type*] - [["lux;TupleT" ?member-types]] - (do ;; (prn 'PM/TUPLE-2 (&/|length ?member-types) (&/|length ?members)) - (if (not (.equals ^Object (&/|length ?member-types) (&/|length ?members))) - (fail (str "[Pattern-matching Error] Pattern-matching mismatch. Require tuple[" (&/|length ?member-types) "]. Given tuple [" (&/|length ?members) "]")) - (|do [[=tests =kont] (&/fold (fn [kont* vm] - (|let [[v m] vm] - (|do [[=test [=tests =kont]] (analyse-pattern v m kont*)] - (return (&/T (&/|cons =test =tests) =kont))))) - (|do [=kont kont] - (return (&/T (&/|list) =kont))) - (&/|reverse (&/zip2 ?member-types ?members)))] - (return (&/T (&/V "TupleTestAC" =tests) =kont))))) - - [_] - (fail (str "[Pattern-matching Error] Tuples require tuple-types: " (&type/show-type value-type*)))))) + (matchv ::M/objects [value-type*] + [["lux;TupleT" ?member-types]] + (do ;; (prn 'PM/TUPLE-2 (&/|length ?member-types) (&/|length ?members)) + (if (not (.equals ^Object (&/|length ?member-types) (&/|length ?members))) + (fail (str "[Pattern-matching Error] Pattern-matching mismatch. Require tuple[" (&/|length ?member-types) "]. Given tuple [" (&/|length ?members) "]")) + (|do [[=tests =kont] (&/fold (fn [kont* vm] + (|let [[v m] vm] + (|do [[=test [=tests =kont]] (analyse-pattern v m kont*)] + (return (&/T (&/|cons =test =tests) =kont))))) + (|do [=kont kont] + (return (&/T (&/|list) =kont))) + (&/|reverse (&/zip2 ?member-types ?members)))] + (return (&/T (&/V "TupleTestAC" =tests) =kont))))) + + [_] + (fail (str "[Pattern-matching Error] Tuples require tuple-types: " (&type/show-type value-type*)))))) [["lux;RecordS" ?slots]] - (|do [value-type* (resolve-type value-type)] + (|do [;; :let [_ (prn 'PRE (&type/show-type value-type))] + value-type* (adjust-type value-type) + ;; :let [_ (prn 'POST (&type/show-type value-type*))] + ;; value-type* (resolve-type value-type) + ] (matchv ::M/objects [value-type*] [["lux;RecordT" ?slot-types]] (if (not (.equals ^Object (&/|length ?slot-types) (&/|length ?slots))) @@ -118,7 +196,7 @@ [["lux;TagS" ?ident]] (|do [=tag (&&/resolved-ident ?ident) - value-type* (resolve-type value-type) + value-type* (adjust-type value-type) case-type (&type/variant-case =tag value-type*) [=test =kont] (analyse-pattern case-type (&/V "lux;Meta" (&/T (&/T "" -1 -1) (&/V "lux;TupleS" (&/|list)))) @@ -129,7 +207,7 @@ ["lux;Cons" [?value ["lux;Nil" _]]]]]]] (|do [=tag (&&/resolved-ident ?ident) - value-type* (resolve-type value-type) + value-type* (adjust-type value-type) case-type (&type/variant-case =tag value-type*) [=test =kont] (analyse-pattern case-type ?value kont)] diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj index b25dff9eb..4a912f1c1 100644 --- a/src/lux/analyser/lux.clj +++ b/src/lux/analyser/lux.clj @@ -219,7 +219,7 @@ [["lux;Cons" [?arg ?args*]]] (|do [?fun-type* (&type/actual-type fun-type)] (matchv ::M/objects [?fun-type*] - [["lux;AllT" _]] + [["lux;AllT" [_aenv _aname _aarg _abody]]] ;; (|do [$var &type/existential ;; type* (&type/apply-type ?fun-type* $var)] ;; (analyse-apply* analyse exo-type type* ?args)) @@ -230,11 +230,10 @@ (matchv ::M/objects [$var] [["lux;VarT" ?id]] (|do [? (&type/bound? ?id) - _ (if ? - (return nil) - (|do [ex &type/existential] - (&type/set-var ?id ex))) - type** (&type/clean $var =output-t)] + type** (if ? + (&type/clean $var =output-t) + (|do [_ (&type/set-var ?id (&/V "lux;BoundT" _aarg))] + (&type/clean $var =output-t)))] (return (&/T type** =args))) )))) @@ -262,11 +261,11 @@ (|do [macro-expansion #(-> macro (.apply ?args) (.apply %)) :let [macro-expansion* (&/|map (partial with-cursor form-cursor) macro-expansion)] ;; :let [_ (when (and ;; (= "lux/control/monad" ?module) - ;; (= "case" ?name)) + ;; (= "open" ?name)) ;; (->> (&/|map &/show-ast macro-expansion*) ;; (&/|interpose "\n") ;; (&/fold str "") - ;; (prn ?module "case")))] + ;; (prn ?module "open")))] ] (&/flat-map% (partial analyse exo-type) macro-expansion*)) @@ -328,6 +327,9 @@ ;; dtype* (&type/actual-type dtype) ] (matchv ::M/objects [dtype] + [["lux;BoundT" ?vname]] + (return (&/T _expr exo-type)) + [["lux;ExT" _]] (return (&/T _expr exo-type)) diff --git a/src/lux/compiler/base.clj b/src/lux/compiler/base.clj index e7b338b16..0631f51e8 100644 --- a/src/lux/compiler/base.clj +++ b/src/lux/compiler/base.clj @@ -29,6 +29,7 @@ (def ^String version "0.2") (def ^String input-dir "source") (def ^String output-dir "target/jvm") +(def ^String function-class "lux/Function") (def ^String local-prefix "l") (def ^String partial-prefix "p") diff --git a/src/lux/compiler/cache.clj b/src/lux/compiler/cache.clj index d6f0b1db7..57e81a2b0 100644 --- a/src/lux/compiler/cache.clj +++ b/src/lux/compiler/cache.clj @@ -55,7 +55,7 @@ (defn clean [state] "(-> Compiler (,))" (let [needed-modules (->> state (&/get$ &/$MODULES) &/|keys &/->seq set) - outdated? #(-> % .getName (string/replace " " "/") (->> (contains? needed-modules)) not) + outdated? #(-> ^File % .getName (string/replace " " "/") (->> (contains? needed-modules)) not) outdate-files (->> &&/output-dir (new File) .listFiles seq (filter outdated?))] (doseq [f outdate-files] (clean-file f)) diff --git a/src/lux/compiler/host.clj b/src/lux/compiler/host.clj index fd34a45a7..3df09b29e 100644 --- a/src/lux/compiler/host.clj +++ b/src/lux/compiler/host.clj @@ -593,7 +593,7 @@ _ (compile ?body) :let [_ (doto main-writer (.visitInsn Opcodes/ACONST_NULL) - (.visitMethodInsn Opcodes/INVOKEINTERFACE "lux/Function" "apply" &&/apply-signature))] + (.visitMethodInsn Opcodes/INVOKEINTERFACE &&/function-class "apply" &&/apply-signature))] :let [_ (doto main-writer (.visitInsn Opcodes/POP) (.visitInsn Opcodes/RETURN) diff --git a/src/lux/compiler/lambda.clj b/src/lux/compiler/lambda.clj index d97cc1f26..ccd12e68a 100644 --- a/src/lux/compiler/lambda.clj +++ b/src/lux/compiler/lambda.clj @@ -97,7 +97,7 @@ class-name (str (&host/->module-class (&/|head ?scope)) "/" name) =class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS) (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_SUPER) - class-name nil "java/lang/Object" (into-array ["lux/Function"])) + class-name nil "java/lang/Object" (into-array [&&/function-class])) (-> (doto (.visitField (+ Opcodes/ACC_PRIVATE Opcodes/ACC_FINAL) captured-name clo-field-sig nil nil) (.visitEnd)) (->> (let [captured-name (str &&/closure-prefix ?captured-id)]) diff --git a/src/lux/compiler/lux.clj b/src/lux/compiler/lux.clj index 32a7af751..f1c261d6b 100644 --- a/src/lux/compiler/lux.clj +++ b/src/lux/compiler/lux.clj @@ -21,7 +21,8 @@ (lux.analyser [base :as &a] [module :as &a-module]) (lux.compiler [base :as &&] - [lambda :as &&lambda])) + [lambda :as &&lambda] + [type :as &&type])) (:import (org.objectweb.asm Opcodes Label ClassWriter @@ -63,7 +64,10 @@ (|do [:let [_ (doto *writer* (.visitInsn Opcodes/DUP) (.visitLdcInsn (int idx)))] - ret (compile elem) + ret (try (compile elem) + (catch Exception e + (prn 'compile-tuple (aget elem 0) (->> ?elems (&/|map #(aget % 0)) &/->seq)) + (throw e))) :let [_ (.visitInsn *writer* Opcodes/AASTORE)]] (return ret))) (&/|range num-elems) ?elems)] @@ -130,110 +134,11 @@ _ (compile ?fn) _ (&/map% (fn [?arg] (|do [=arg (compile ?arg) - :let [_ (.visitMethodInsn *writer* Opcodes/INVOKEINTERFACE "lux/Function" "apply" &&/apply-signature)]] + :let [_ (.visitMethodInsn *writer* Opcodes/INVOKEINTERFACE &&/function-class "apply" &&/apply-signature)]] (return =arg))) ?args)] (return nil))) -(defn ^:private type->analysis [type] - (matchv ::M/objects [type] - [["lux;DataT" ?class]] - (&/T (&/V "variant" (&/T "lux;DataT" - (&/T (&/V "text" ?class) &type/$Void))) - &type/$Void) - - [["lux;TupleT" ?members]] - (&/T (&/V "variant" (&/T "lux;TupleT" - (&/fold (fn [tail head] - (&/V "variant" (&/T "lux;Cons" - (&/T (&/V "tuple" (&/|list (type->analysis head) - tail)) - &type/$Void)))) - (&/V "variant" (&/T "lux;Nil" - (&/T (&/V "tuple" (&/|list)) - &type/$Void))) - (&/|reverse ?members)))) - &type/$Void) - - [["lux;VariantT" ?cases]] - (&/T (&/V "variant" (&/T "lux;VariantT" - (&/fold (fn [tail head] - (|let [[hlabel htype] head] - (&/V "variant" (&/T "lux;Cons" - (&/T (&/V "tuple" (&/|list (&/T (&/V "tuple" (&/|list (&/T (&/V "text" hlabel) &type/$Void) - (type->analysis htype))) - &type/$Void) - tail)) - &type/$Void))))) - (&/V "variant" (&/T "lux;Nil" - (&/T (&/V "tuple" (&/|list)) - &type/$Void))) - (&/|reverse ?cases)))) - &type/$Void) - - [["lux;RecordT" ?slots]] - (&/T (&/V "variant" (&/T "lux;RecordT" - (&/fold (fn [tail head] - (|let [[hlabel htype] head] - (&/V "variant" (&/T "lux;Cons" - (&/T (&/V "tuple" (&/|list (&/T (&/V "tuple" (&/|list (&/T (&/V "text" hlabel) &type/$Void) - (type->analysis htype))) - &type/$Void) - tail)) - &type/$Void))))) - (&/V "variant" (&/T "lux;Nil" - (&/T (&/V "tuple" (&/|list)) - &type/$Void))) - (&/|reverse ?slots)))) - &type/$Void) - - [["lux;LambdaT" [?input ?output]]] - (&/T (&/V "variant" (&/T "lux;LambdaT" - (&/T (&/V "tuple" (&/|map type->analysis (&/|list ?input ?output))) - &type/$Void))) - &type/$Void) - - [["lux;AllT" [?env ?name ?arg ?body]]] - (&/T (&/V "variant" (&/T "lux;AllT" - (&/T (&/V "tuple" (&/|list (matchv ::M/objects [?env] - [["lux;None" _]] - (&/V "variant" (&/T "lux;Some" - (&/T (&/V "tuple" (&/|list)) - &type/$Void))) - - [["lux;Some" ??env]] - (&/V "variant" (&/T "lux;Some" - (&/T (&/fold (fn [tail head] - (|let [[hlabel htype] head] - (&/V "variant" (&/T "lux;Cons" - (&/T (&/V "tuple" (&/|list (&/T (&/V "tuple" (&/|list (&/T (&/V "text" hlabel) &type/$Void) - (type->analysis htype))) - &type/$Void) - tail)) - &type/$Void))))) - (&/V "variant" (&/T "lux;Nil" - (&/T (&/V "tuple" (&/|list)) - &type/$Void))) - (&/|reverse ??env)) - &type/$Void)))) - (&/T (&/V "text" ?name) &type/$Void) - (&/T (&/V "text" ?arg) &type/$Void) - (type->analysis ?body))) - &type/$Void))) - &type/$Void) - - [["lux;BoundT" ?name]] - (&/T (&/V "variant" (&/T "lux;BoundT" - (&/T (&/V "text" ?name) &type/$Void))) - &type/$Void) - - [["lux;AppT" [?fun ?arg]]] - (&/T (&/V "variant" (&/T "lux;AppT" - (&/T (&/V "tuple" (&/|map type->analysis (&/|list ?fun ?arg))) - &type/$Void))) - &type/$Void) - )) - (defn ^:private compile-def-type [compile ?body ?def-data] (|do [^MethodVisitor **writer** &/get-writer] (matchv ::M/objects [?def-data] @@ -260,7 +165,7 @@ (&/T ?def-value ?type-expr) [[?def-value ?def-type]] - (&/T ?body (type->analysis ?def-type)))] + (&/T ?body (&&type/->analysis ?def-type)))] (|do [:let [_ (doto **writer** (.visitLdcInsn (int 2)) ;; S (.visitTypeInsn Opcodes/ANEWARRAY "java/lang/Object") ;; V @@ -284,7 +189,7 @@ current-class (str (&host/->module-class module-name) "/" def-name) =class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS) (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_SUPER) - current-class nil "java/lang/Object" (into-array ["lux/Function"])) + current-class nil "java/lang/Object" (into-array [&&/function-class])) (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_name" "Ljava/lang/String;" nil ?name) (doto (.visitEnd))) (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_datum" datum-sig nil nil) diff --git a/src/lux/compiler/type.clj b/src/lux/compiler/type.clj new file mode 100644 index 000000000..a92911444 --- /dev/null +++ b/src/lux/compiler/type.clj @@ -0,0 +1,97 @@ +;; Copyright (c) Eduardo Julian. All rights reserved. +;; The use and distribution terms for this software are covered by the +;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) +;; which can be found in the file epl-v10.html at the root of this distribution. +;; By using this software in any fashion, you are agreeing to be bound by +;; the terms of this license. +;; You must not remove this notice, or any other, from this software. + +(ns lux.compiler.type + (:require [clojure.core.match :as M :refer [matchv]] + clojure.core.match.array + (lux [base :as & :refer [|do return* return fail fail* |let]] + [type :as &type]))) + +;; [Utils] +(defn ^:private variant$ [tag body] + "(-> Text Analysis Analysis)" + (&/T (&/V "variant" (&/T tag body)) + &type/$Void)) + +(defn ^:private tuple$ [members] + "(-> (List Analysis) Analysis)" + (&/T (&/V "tuple" members) + &type/$Void)) + +(defn ^:private text$ [text] + "(-> Text Analysis)" + (&/T (&/V "text" text) + &type/$Void)) + +(def ^:private $Nil + "Analysis" + (variant$ "lux;Nil" (tuple$ (&/|list)))) + +(defn ^:private Cons$ [head tail] + "(-> Analysis Analysis Analysis)" + (variant$ "lux;Cons" (tuple$ (&/|list head tail)))) + +;; [Exports] +(defn ->analysis [type] + "(-> Type Analysis)" + (matchv ::M/objects [type] + [["lux;DataT" ?class]] + (variant$ "lux;DataT" (text$ ?class)) + + [["lux;TupleT" ?members]] + (variant$ "lux;TupleT" + (&/fold (fn [tail head] + (Cons$ (->analysis head) tail)) + $Nil + (&/|reverse ?members))) + + [["lux;VariantT" ?cases]] + (variant$ "lux;VariantT" + (&/fold (fn [tail head] + (|let [[hlabel htype] head] + (Cons$ (tuple$ (&/|list (text$ hlabel) (->analysis htype))) + tail))) + $Nil + (&/|reverse ?cases))) + + [["lux;RecordT" ?slots]] + (variant$ "lux;RecordT" + (&/fold (fn [tail head] + (|let [[hlabel htype] head] + (Cons$ (tuple$ (&/|list (text$ hlabel) (->analysis htype))) + tail))) + $Nil + (&/|reverse ?slots))) + + [["lux;LambdaT" [?input ?output]]] + (variant$ "lux;LambdaT" (tuple$ (&/|list (->analysis ?input) (->analysis ?output)))) + + [["lux;AllT" [?env ?name ?arg ?body]]] + (variant$ "lux;AllT" + (tuple$ (&/|list (matchv ::M/objects [?env] + [["lux;None" _]] + (variant$ "lux;Some" (tuple$ (&/|list))) + + [["lux;Some" ??env]] + (variant$ "lux;Some" + (&/fold (fn [tail head] + (|let [[hlabel htype] head] + (Cons$ (tuple$ (&/|list (text$ hlabel) (->analysis htype))) + tail))) + $Nil + (&/|reverse ??env)))) + (text$ ?name) + (text$ ?arg) + (->analysis ?body)))) + + [["lux;BoundT" ?name]] + (variant$ "lux;BoundT" (text$ ?name)) + + [["lux;AppT" [?fun ?arg]]] + (variant$ "lux;AppT" (tuple$ (&/|list (->analysis ?fun) (->analysis ?arg)))) + )) diff --git a/src/lux/type.clj b/src/lux/type.clj index f1a5b7623..af2bbf30f 100644 --- a/src/lux/type.clj +++ b/src/lux/type.clj @@ -284,7 +284,7 @@ _ (&/map% delete-var (&/|reverse =vars))] (return output))) -(defn ^:private clean* [?tid type] +(defn clean* [?tid type] (matchv ::M/objects [type] [["lux;VarT" ?id]] (if (.equals ^Object ?tid ?id) @@ -345,6 +345,15 @@ [_] (fail (str "[Type Error] Not type-var: " (show-type tvar))))) +(defn ^:private unravel-fun [type] + (matchv ::M/objects [type] + [["lux;LambdaT" [?in ?out]]] + (|let [[??out ?args] (unravel-fun ?out)] + (&/T ??out (&/|cons ?in ?args))) + + [_] + (&/T type (&/|list)))) + (defn ^:private unravel-app [fun-type] (matchv ::M/objects [fun-type] [["lux;AppT" [?left ?right]]] @@ -389,17 +398,18 @@ (&/fold str "")) ")") [["lux;LambdaT" [input output]]] - (str "(-> " (show-type input) " " (show-type output) ")") + (|let [[?out ?ins] (unravel-fun type)] + (str "(-> " (->> ?ins (&/|map show-type) (&/|interpose " ") (&/fold str "")) " " (show-type ?out) ")")) [["lux;VarT" id]] (str "⌈" id "⌋") - [["lux;BoundT" name]] - name - [["lux;ExT" ?id]] (str "⟨" ?id "⟩") + [["lux;BoundT" name]] + name + [["lux;AppT" [_ _]]] (|let [[?call-fun ?call-args] (unravel-app type)] (str "(" (show-type ?call-fun) " " (->> ?call-args (&/|map show-type) (&/|interpose " ") (&/fold str "")) ")")) -- cgit v1.2.3 From 8fb7683f9029127be9cf36336c367813c88f681b Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sun, 26 Jul 2015 23:09:47 -0400 Subject: - Changed the name of lux/host/java to lux/host/jvm - Completed lux/host/jvm - Modified (slightly) the syntax used in several host (JVM) special forms. - The "defsyntax" macro now binds all of the arguments it receives inside a variable named "tokens". --- src/lux/analyser.clj | 38 +++++++++++++++++++------------------- src/lux/analyser/case.clj | 4 ++-- src/lux/analyser/host.clj | 22 +++++++--------------- src/lux/compiler/lux.clj | 5 +---- src/lux/host.clj | 8 -------- 5 files changed, 29 insertions(+), 48 deletions(-) (limited to 'src') diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj index f85b3d619..1606a95c2 100644 --- a/src/lux/analyser.clj +++ b/src/lux/analyser.clj @@ -166,57 +166,57 @@ (&&host/analyse-jvm-null? analyse ?object) [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_instanceof"]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?class]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?class]]] ["lux;Cons" [?object ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-instanceof analyse ?class ?object) [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_new"]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ ?class]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?class]]] ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?classes]]] ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?args]]] ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-new analyse ?class ?classes ?args) [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_getstatic"]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?class]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?field]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?class]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?field]]] ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-getstatic analyse ?class ?field) [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_getfield"]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?class]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?field]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?class]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?field]]] ["lux;Cons" [?object ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-getfield analyse ?class ?field ?object) [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_putstatic"]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?class]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?field]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?class]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?field]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-putstatic analyse ?class ?field ?value) [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_putfield"]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?class]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?field]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?class]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?field]]] ["lux;Cons" [?object ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]]]]]] (&&host/analyse-jvm-putfield analyse ?class ?field ?object ?value) [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_invokestatic"]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?class]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?method]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?class]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?method]]] ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?classes]]] ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?args]]] ["lux;Nil" _]]]]]]]]]]]]] (&&host/analyse-jvm-invokestatic analyse ?class ?method ?classes ?args) [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_invokevirtual"]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?class]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?method]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?class]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?method]]] ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?classes]]] ["lux;Cons" [?object ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?args]]] @@ -224,8 +224,8 @@ (&&host/analyse-jvm-invokevirtual analyse ?class ?method ?classes ?object ?args) [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_invokeinterface"]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?class]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?method]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?class]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?method]]] ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?classes]]] ["lux;Cons" [?object ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?args]]] @@ -233,8 +233,8 @@ (&&host/analyse-jvm-invokeinterface analyse ?class ?method ?classes ?object ?args) [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_invokespecial"]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?class]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?method]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?class]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?method]]] ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?classes]]] ["lux;Cons" [?object ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?args]]] @@ -408,7 +408,7 @@ ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] (&&lux/analyse-def analyse ?name ?value) - + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_lux_declare-macro"]]]] ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?name]]]] ["lux;Nil" _]]]]]]] diff --git a/src/lux/analyser/case.clj b/src/lux/analyser/case.clj index cb76d8d54..ebbb6911a 100644 --- a/src/lux/analyser/case.clj +++ b/src/lux/analyser/case.clj @@ -101,8 +101,8 @@ (fail "##9##")))] (adjust-type* up type*)) - [_] - (assert false (aget type 0)) + ;; [_] + ;; (assert false (aget type 0)) )) (defn adjust-type [type] diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj index e490bc62f..11d43ce9e 100644 --- a/src/lux/analyser/host.clj +++ b/src/lux/analyser/host.clj @@ -18,14 +18,6 @@ [env :as &&env]))) ;; [Utils] -(defn ^:private extract-ident [ident] - (matchv ::M/objects [ident] - [["lux;Meta" [_ ["lux;SymbolS" [_ ?ident]]]]] - (return ?ident) - - [_] - (fail "[Analyser Error] Can't extract Symbol."))) - (defn ^:private extract-text [text] (matchv ::M/objects [text] [["lux;Meta" [_ ["lux;TextS" ?text]]]] @@ -115,7 +107,7 @@ (return (&/|list (&/T (&/V "jvm-putfield" (&/T ?class ?field =object =value)) =type))))) (defn analyse-jvm-invokestatic [analyse ?class ?method ?classes ?args] - (|do [=classes (&/map% &host/extract-jvm-param ?classes) + (|do [=classes (&/map% extract-text ?classes) =return (&host/lookup-static-method ?class ?method =classes) ;; :let [_ (matchv ::M/objects [=return] ;; [["lux;DataT" _return-class]] @@ -138,7 +130,7 @@ (do-template [ ] (defn [analyse ?class ?method ?classes ?object ?args] - (|do [=classes (&/map% &host/extract-jvm-param ?classes) + (|do [=classes (&/map% extract-text ?classes) =return (&host/lookup-virtual-method ?class ?method =classes) =object (&&/analyse-1 analyse (&/V "lux;DataT" ?class) ?object) =args (&/map2% (fn [?c ?o] @@ -151,7 +143,7 @@ ) (defn analyse-jvm-invokespecial [analyse ?class ?method ?classes ?object ?args] - (|do [=classes (&/map% &host/extract-jvm-param ?classes) + (|do [=classes (&/map% extract-text ?classes) =return (if (= "" ?method) (return &type/$Void) (&host/lookup-virtual-method ?class ?method =classes)) @@ -166,7 +158,7 @@ (return (&/|list (&/T (&/V "jvm-null?" =object) (&/V "lux;DataT" "java.lang.Boolean")))))) (defn analyse-jvm-new [analyse ?class ?classes ?args] - (|do [=classes (&/map% &host/extract-jvm-param ?classes) + (|do [=classes (&/map% extract-text ?classes) =args (&/flat-map% analyse ?args)] (return (&/|list (&/T (&/V "jvm-new" (&/T ?class =classes =args)) (&/V "lux;DataT" ?class)))))) @@ -239,7 +231,7 @@ (|do [=interfaces (&/map% extract-text ?interfaces) =fields (&/map% (fn [?field] (matchv ::M/objects [?field] - [["lux;Meta" [_ ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ ?field-name]]]] + [["lux;Meta" [_ ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?field-name]]] ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?field-type]]] ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?field-modifiers]]] ["lux;Nil" _]]]]]]]]]]] @@ -253,7 +245,7 @@ ?fields) =methods (&/map% (fn [?method] (matchv ::M/objects [?method] - [[?idx ["lux;Meta" [_ ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ ?method-name]]]] + [[?idx ["lux;Meta" [_ ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?method-name]]] ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?method-inputs]]] ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?method-output]]] ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?method-modifiers]]] @@ -297,7 +289,7 @@ (|do [=supers (&/map% extract-text ?supers) =methods (&/map% (fn [method] (matchv ::M/objects [method] - [["lux;Meta" [_ ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ ?method-name]]]] + [["lux;Meta" [_ ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?method-name]]] ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?inputs]]] ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?output]]] ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?modifiers]]] diff --git a/src/lux/compiler/lux.clj b/src/lux/compiler/lux.clj index f1c261d6b..b1023689e 100644 --- a/src/lux/compiler/lux.clj +++ b/src/lux/compiler/lux.clj @@ -64,10 +64,7 @@ (|do [:let [_ (doto *writer* (.visitInsn Opcodes/DUP) (.visitLdcInsn (int idx)))] - ret (try (compile elem) - (catch Exception e - (prn 'compile-tuple (aget elem 0) (->> ?elems (&/|map #(aget % 0)) &/->seq)) - (throw e))) + ret (compile elem) :let [_ (.visitInsn *writer* Opcodes/AASTORE)]] (return ret))) (&/|range num-elems) ?elems)] diff --git a/src/lux/host.clj b/src/lux/host.clj index d248c708e..cf9830169 100644 --- a/src/lux/host.clj +++ b/src/lux/host.clj @@ -75,14 +75,6 @@ "V" )) -(defn extract-jvm-param [token] - (matchv ::M/objects [token] - [["lux;Meta" [_ ["lux;SymbolS" [_ ?ident]]]]] - (return ?ident) - - [_] - (fail (str "[Host] Unknown JVM param: " (pr-str token))))) - (do-template [ ] (defn [target field] (if-let [type* (first (for [^Field =field (.getDeclaredFields (Class/forName target)) -- cgit v1.2.3 From c79621772c862e9b94e1fc43e11996cbac54fed1 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 29 Jul 2015 20:20:26 -0400 Subject: - lux;using no longer prefixes variables. - Fixed several bugs with host (JVM) interop. - Now packaging everything in a .jar file ("program.jar"). --- src/lux.clj | 12 ++- src/lux/analyser.clj | 169 ++++++++++++++++---------------- src/lux/analyser/host.clj | 222 +++++++++++++++++++++++++++---------------- src/lux/analyser/lux.clj | 4 +- src/lux/base.clj | 5 +- src/lux/compiler.clj | 27 +++--- src/lux/compiler/base.clj | 32 ++++++- src/lux/compiler/cache.clj | 7 +- src/lux/compiler/host.clj | 206 +++++++++++++++++++++++---------------- src/lux/compiler/package.clj | 61 ++++++++++++ src/lux/host.clj | 16 ++-- src/lux/type.clj | 150 ++++++++++++----------------- 12 files changed, 544 insertions(+), 367 deletions(-) create mode 100644 src/lux/compiler/package.clj (limited to 'src') diff --git a/src/lux.clj b/src/lux.clj index 9c913c9ac..7e3627cd7 100644 --- a/src/lux.clj +++ b/src/lux.clj @@ -10,13 +10,15 @@ (:gen-class) (:require [lux.base :as &] [lux.compiler :as &compiler] - [lux.type :as &type] :reload-all)) -(defn -main [& _] - (time (&compiler/compile-all (&/|list "lux" "program"))) - (System/exit 0)) +(defn -main [& [program-module & _]] + (if program-module + (time (&compiler/compile-program program-module)) + (println "Please provide a module name to compile.")) + (System/exit 0) + ) (comment - ;; cd output && jar cvf program.jar * && java -cp "program.jar" program && cd .. + (-main "program") ) diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj index 1606a95c2..de7fc8497 100644 --- a/src/lux/analyser.clj +++ b/src/lux/analyser.clj @@ -10,7 +10,7 @@ (:require (clojure [template :refer [do-template]]) [clojure.core.match :as M :refer [matchv]] clojure.core.match.array - (lux [base :as & :refer [|let |do return fail return* fail* |list]] + (lux [base :as & :refer [|let |do return fail return* fail*]] [reader :as &reader] [parser :as &parser] [type :as &type] @@ -23,16 +23,16 @@ (defn ^:private parse-handler [[catch+ finally+] token] (matchv ::M/objects [token] [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_catch"]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ ?ex-class]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?ex-class]]] ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ ?ex-arg]]]] ["lux;Cons" [?catch-body ["lux;Nil" _]]]]]]]]]]]]] - (&/T (&/|++ catch+ (|list (&/T ?ex-class ?ex-arg ?catch-body))) finally+) + (&/T (&/|++ catch+ (&/|list (&/T ?ex-class ?ex-arg ?catch-body))) finally+) [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_finally"]]]] ["lux;Cons" [?finally-body ["lux;Nil" _]]]]]]]]] - (&/T catch+ ?finally-body))) + (&/T catch+ (&/V "lux;Some" ?finally-body)))) (defn ^:private aba7 [analyse eval! compile-module exo-type token] (matchv ::M/objects [token] @@ -62,7 +62,8 @@ ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?super-class]]] ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?interfaces]]] ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?fields]]] - ?methods]]]]]]]]]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?methods]]] + ["lux;Nil" _]]]]]]]]]]]]]]] (&&host/analyse-jvm-class analyse ?name ?super-class ?interfaces ?fields ?methods) [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_interface"]]]] @@ -85,74 +86,74 @@ (matchv ::M/objects [token] ;; Primitive conversions [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_d2f"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]] - (&&host/analyse-jvm-d2f analyse ?value) + (&&host/analyse-jvm-d2f analyse exo-type ?value) [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_d2i"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]] - (&&host/analyse-jvm-d2i analyse ?value) + (&&host/analyse-jvm-d2i analyse exo-type ?value) [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_d2l"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]] - (&&host/analyse-jvm-d2l analyse ?value) + (&&host/analyse-jvm-d2l analyse exo-type ?value) [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_f2d"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]] - (&&host/analyse-jvm-f2d analyse ?value) + (&&host/analyse-jvm-f2d analyse exo-type ?value) [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_f2i"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]] - (&&host/analyse-jvm-f2i analyse ?value) + (&&host/analyse-jvm-f2i analyse exo-type ?value) [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_f2l"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]] - (&&host/analyse-jvm-f2l analyse ?value) + (&&host/analyse-jvm-f2l analyse exo-type ?value) [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_i2b"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]] - (&&host/analyse-jvm-i2b analyse ?value) + (&&host/analyse-jvm-i2b analyse exo-type ?value) [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_i2c"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]] - (&&host/analyse-jvm-i2c analyse ?value) + (&&host/analyse-jvm-i2c analyse exo-type ?value) [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_i2d"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]] - (&&host/analyse-jvm-i2d analyse ?value) + (&&host/analyse-jvm-i2d analyse exo-type ?value) [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_i2f"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]] - (&&host/analyse-jvm-i2f analyse ?value) + (&&host/analyse-jvm-i2f analyse exo-type ?value) [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_i2l"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]] - (&&host/analyse-jvm-i2l analyse ?value) + (&&host/analyse-jvm-i2l analyse exo-type ?value) [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_i2s"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]] - (&&host/analyse-jvm-i2s analyse ?value) + (&&host/analyse-jvm-i2s analyse exo-type ?value) [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_l2d"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]] - (&&host/analyse-jvm-l2d analyse ?value) + (&&host/analyse-jvm-l2d analyse exo-type ?value) [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_l2f"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]] - (&&host/analyse-jvm-l2f analyse ?value) + (&&host/analyse-jvm-l2f analyse exo-type ?value) [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_l2i"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]] - (&&host/analyse-jvm-l2i analyse ?value) + (&&host/analyse-jvm-l2i analyse exo-type ?value) ;; Bitwise operators [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_iand"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]] - (&&host/analyse-jvm-iand analyse ?x ?y) + (&&host/analyse-jvm-iand analyse exo-type ?x ?y) [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_ior"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]] - (&&host/analyse-jvm-ior analyse ?x ?y) + (&&host/analyse-jvm-ior analyse exo-type ?x ?y) [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_land"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]] - (&&host/analyse-jvm-land analyse ?x ?y) + (&&host/analyse-jvm-land analyse exo-type ?x ?y) [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_lor"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]] - (&&host/analyse-jvm-lor analyse ?x ?y) + (&&host/analyse-jvm-lor analyse exo-type ?x ?y) [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_lxor"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]] - (&&host/analyse-jvm-lxor analyse ?x ?y) + (&&host/analyse-jvm-lxor analyse exo-type ?x ?y) [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_lshl"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]] - (&&host/analyse-jvm-lshl analyse ?x ?y) + (&&host/analyse-jvm-lshl analyse exo-type ?x ?y) [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_lshr"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]] - (&&host/analyse-jvm-lshr analyse ?x ?y) + (&&host/analyse-jvm-lshr analyse exo-type ?x ?y) [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_lushr"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]] - (&&host/analyse-jvm-lushr analyse ?x ?y) + (&&host/analyse-jvm-lushr analyse exo-type ?x ?y) [_] (aba7 analyse eval! compile-module exo-type token))) @@ -163,40 +164,40 @@ [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_null?"]]]] ["lux;Cons" [?object ["lux;Nil" _]]]]]]] - (&&host/analyse-jvm-null? analyse ?object) + (&&host/analyse-jvm-null? analyse exo-type ?object) [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_instanceof"]]]] ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?class]]] ["lux;Cons" [?object ["lux;Nil" _]]]]]]]]] - (&&host/analyse-jvm-instanceof analyse ?class ?object) + (&&host/analyse-jvm-instanceof analyse exo-type ?class ?object) [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_new"]]]] ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?class]]] ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?classes]]] ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?args]]] ["lux;Nil" _]]]]]]]]]]] - (&&host/analyse-jvm-new analyse ?class ?classes ?args) + (&&host/analyse-jvm-new analyse exo-type ?class ?classes ?args) [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_getstatic"]]]] ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?class]]] ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?field]]] ["lux;Nil" _]]]]]]]]] - (&&host/analyse-jvm-getstatic analyse ?class ?field) + (&&host/analyse-jvm-getstatic analyse exo-type ?class ?field) [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_getfield"]]]] ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?class]]] ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?field]]] ["lux;Cons" [?object ["lux;Nil" _]]]]]]]]]]] - (&&host/analyse-jvm-getfield analyse ?class ?field ?object) + (&&host/analyse-jvm-getfield analyse exo-type ?class ?field ?object) [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_putstatic"]]]] ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?class]]] ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?field]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]]]] - (&&host/analyse-jvm-putstatic analyse ?class ?field ?value) + (&&host/analyse-jvm-putstatic analyse exo-type ?class ?field ?value) [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_putfield"]]]] ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?class]]] @@ -204,7 +205,7 @@ ["lux;Cons" [?object ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]]]]]] - (&&host/analyse-jvm-putfield analyse ?class ?field ?object ?value) + (&&host/analyse-jvm-putfield analyse exo-type ?class ?field ?object ?value) [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_invokestatic"]]]] ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?class]]] @@ -212,7 +213,7 @@ ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?classes]]] ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?args]]] ["lux;Nil" _]]]]]]]]]]]]] - (&&host/analyse-jvm-invokestatic analyse ?class ?method ?classes ?args) + (&&host/analyse-jvm-invokestatic analyse exo-type ?class ?method ?classes ?args) [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_invokevirtual"]]]] ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?class]]] @@ -221,7 +222,7 @@ ["lux;Cons" [?object ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?args]]] ["lux;Nil" _]]]]]]]]]]]]]]] - (&&host/analyse-jvm-invokevirtual analyse ?class ?method ?classes ?object ?args) + (&&host/analyse-jvm-invokevirtual analyse exo-type ?class ?method ?classes ?object ?args) [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_invokeinterface"]]]] ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?class]]] @@ -230,7 +231,7 @@ ["lux;Cons" [?object ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?args]]] ["lux;Nil" _]]]]]]]]]]]]]]] - (&&host/analyse-jvm-invokeinterface analyse ?class ?method ?classes ?object ?args) + (&&host/analyse-jvm-invokeinterface analyse exo-type ?class ?method ?classes ?object ?args) [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_invokespecial"]]]] ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?class]]] @@ -239,29 +240,29 @@ ["lux;Cons" [?object ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?args]]] ["lux;Nil" _]]]]]]]]]]]]]]] - (&&host/analyse-jvm-invokespecial analyse ?class ?method ?classes ?object ?args) - + (&&host/analyse-jvm-invokespecial analyse exo-type ?class ?method ?classes ?object ?args) + ;; Exceptions [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_try"]]]] ["lux;Cons" [?body ?handlers]]]]]] - (&&host/analyse-jvm-try analyse ?body (&/fold parse-handler [(list) nil] ?handlers)) + (&&host/analyse-jvm-try analyse exo-type ?body (&/fold parse-handler (&/T (&/|list) (&/V "lux;None" nil)) ?handlers)) [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_throw"]]]] ["lux;Cons" [?ex ["lux;Nil" _]]]]]]] - (&&host/analyse-jvm-throw analyse ?ex) + (&&host/analyse-jvm-throw analyse exo-type ?ex) ;; Syncronization/monitos [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_monitorenter"]]]] ["lux;Cons" [?monitor ["lux;Nil" _]]]]]]] - (&&host/analyse-jvm-monitorenter analyse ?monitor) + (&&host/analyse-jvm-monitorenter analyse exo-type ?monitor) [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_monitorexit"]]]] ["lux;Cons" [?monitor ["lux;Nil" _]]]]]]] - (&&host/analyse-jvm-monitorexit analyse ?monitor) + (&&host/analyse-jvm-monitorexit analyse exo-type ?monitor) [_] (aba6 analyse eval! compile-module exo-type token))) @@ -270,53 +271,53 @@ (matchv ::M/objects [token] ;; Float arithmetic [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_fadd"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] - (&&host/analyse-jvm-fadd analyse ?x ?y) + (&&host/analyse-jvm-fadd analyse exo-type ?x ?y) [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_fsub"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] - (&&host/analyse-jvm-fsub analyse ?x ?y) + (&&host/analyse-jvm-fsub analyse exo-type ?x ?y) [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_fmul"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] - (&&host/analyse-jvm-fmul analyse ?x ?y) + (&&host/analyse-jvm-fmul analyse exo-type ?x ?y) [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_fdiv"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] - (&&host/analyse-jvm-fdiv analyse ?x ?y) + (&&host/analyse-jvm-fdiv analyse exo-type ?x ?y) [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_frem"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] - (&&host/analyse-jvm-frem analyse ?x ?y) + (&&host/analyse-jvm-frem analyse exo-type ?x ?y) [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_feq"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] - (&&host/analyse-jvm-feq analyse ?x ?y) + (&&host/analyse-jvm-feq analyse exo-type ?x ?y) [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_flt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] - (&&host/analyse-jvm-flt analyse ?x ?y) + (&&host/analyse-jvm-flt analyse exo-type ?x ?y) [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_fgt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] - (&&host/analyse-jvm-fgt analyse ?x ?y) + (&&host/analyse-jvm-fgt analyse exo-type ?x ?y) ;; Double arithmetic [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_dadd"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] - (&&host/analyse-jvm-dadd analyse ?x ?y) + (&&host/analyse-jvm-dadd analyse exo-type ?x ?y) [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_dsub"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] - (&&host/analyse-jvm-dsub analyse ?x ?y) + (&&host/analyse-jvm-dsub analyse exo-type ?x ?y) [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_dmul"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] - (&&host/analyse-jvm-dmul analyse ?x ?y) + (&&host/analyse-jvm-dmul analyse exo-type ?x ?y) [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_ddiv"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] - (&&host/analyse-jvm-ddiv analyse ?x ?y) + (&&host/analyse-jvm-ddiv analyse exo-type ?x ?y) [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_drem"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] - (&&host/analyse-jvm-drem analyse ?x ?y) + (&&host/analyse-jvm-drem analyse exo-type ?x ?y) [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_deq"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] - (&&host/analyse-jvm-deq analyse ?x ?y) + (&&host/analyse-jvm-deq analyse exo-type ?x ?y) [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_dlt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] - (&&host/analyse-jvm-dlt analyse ?x ?y) + (&&host/analyse-jvm-dlt analyse exo-type ?x ?y) [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_dgt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] - (&&host/analyse-jvm-dgt analyse ?x ?y) + (&&host/analyse-jvm-dgt analyse exo-type ?x ?y) [_] (aba5 analyse eval! compile-module exo-type token))) @@ -326,63 +327,63 @@ ;; Host special forms ;; Characters [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_ceq"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] - (&&host/analyse-jvm-ceq analyse ?x ?y) + (&&host/analyse-jvm-ceq analyse exo-type ?x ?y) [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_clt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] - (&&host/analyse-jvm-clt analyse ?x ?y) + (&&host/analyse-jvm-clt analyse exo-type ?x ?y) [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_cgt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] - (&&host/analyse-jvm-cgt analyse ?x ?y) + (&&host/analyse-jvm-cgt analyse exo-type ?x ?y) ;; Integer arithmetic [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_iadd"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] - (&&host/analyse-jvm-iadd analyse ?x ?y) + (&&host/analyse-jvm-iadd analyse exo-type ?x ?y) [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_isub"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] - (&&host/analyse-jvm-isub analyse ?x ?y) + (&&host/analyse-jvm-isub analyse exo-type ?x ?y) [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_imul"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] - (&&host/analyse-jvm-imul analyse ?x ?y) + (&&host/analyse-jvm-imul analyse exo-type ?x ?y) [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_idiv"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] - (&&host/analyse-jvm-idiv analyse ?x ?y) + (&&host/analyse-jvm-idiv analyse exo-type ?x ?y) [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_irem"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] - (&&host/analyse-jvm-irem analyse ?x ?y) + (&&host/analyse-jvm-irem analyse exo-type ?x ?y) [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_ieq"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] - (&&host/analyse-jvm-ieq analyse ?x ?y) + (&&host/analyse-jvm-ieq analyse exo-type ?x ?y) [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_ilt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] - (&&host/analyse-jvm-ilt analyse ?x ?y) + (&&host/analyse-jvm-ilt analyse exo-type ?x ?y) [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_igt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] - (&&host/analyse-jvm-igt analyse ?x ?y) + (&&host/analyse-jvm-igt analyse exo-type ?x ?y) ;; Long arithmetic [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_ladd"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] - (&&host/analyse-jvm-ladd analyse ?x ?y) + (&&host/analyse-jvm-ladd analyse exo-type ?x ?y) [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_lsub"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] - (&&host/analyse-jvm-lsub analyse ?x ?y) + (&&host/analyse-jvm-lsub analyse exo-type ?x ?y) [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_lmul"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] - (&&host/analyse-jvm-lmul analyse ?x ?y) + (&&host/analyse-jvm-lmul analyse exo-type ?x ?y) [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_ldiv"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] - (&&host/analyse-jvm-ldiv analyse ?x ?y) + (&&host/analyse-jvm-ldiv analyse exo-type ?x ?y) [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_lrem"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] - (&&host/analyse-jvm-lrem analyse ?x ?y) + (&&host/analyse-jvm-lrem analyse exo-type ?x ?y) [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_leq"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] - (&&host/analyse-jvm-leq analyse ?x ?y) + (&&host/analyse-jvm-leq analyse exo-type ?x ?y) [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_llt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] - (&&host/analyse-jvm-llt analyse ?x ?y) + (&&host/analyse-jvm-llt analyse exo-type ?x ?y) [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_lgt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] - (&&host/analyse-jvm-lgt analyse ?x ?y) + (&&host/analyse-jvm-lgt analyse exo-type ?x ?y) [_] (aba4 analyse eval! compile-module exo-type token))) @@ -445,7 +446,7 @@ [_] (aba3 analyse eval! compile-module exo-type token))) -(let [unit (&/V "lux;Meta" (&/T (&/T "" -1 -1) (&/V "lux;TupleS" (|list))))] +(let [unit (&/V "lux;Meta" (&/T (&/T "" -1 -1) (&/V "lux;TupleS" (&/|list))))] (defn ^:private aba1 [analyse eval! compile-module exo-type token] (matchv ::M/objects [token] ;; Standard special forms @@ -479,7 +480,7 @@ (&&lux/analyse-variant analyse exo-type ?ident unit) [["lux;SymbolS" [_ "_jvm_null"]]] - (return (&/|list (&/T (&/V "jvm-null" nil) (&/V "lux;DataT" "null")))) + (&&host/analyse-jvm-null analyse exo-type) [_] (aba2 analyse eval! compile-module exo-type token) @@ -505,7 +506,11 @@ [["lux;Left" msg]] (fail* (add-loc meta msg)) - )))) + )) + + ;; [_] + ;; (assert false (aget token 0)) + )) (defn ^:private just-analyse [analyse-ast eval! compile-module syntax] (&type/with-var diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj index 11d43ce9e..5033f4f2c 100644 --- a/src/lux/analyser/host.clj +++ b/src/lux/analyser/host.clj @@ -36,13 +36,32 @@ (return (&/T ?item =type))) ))))) +(defn ^:private ensure-object [token] + "(-> Analysis (Lux (,)))" + (matchv ::M/objects [token] + [[_ ["lux;DataT" _]]] + (return nil) + + [_] + (fail "[Analyser Error] Expecting object"))) + +(defn ^:private as-object [type] + "(-> Type Type)" + (matchv ::M/objects [type] + [["lux;DataT" class]] + (&/V "lux;DataT" (&type/as-obj class)) + + [_] + type)) + ;; [Resources] (do-template [ ] (let [input-type (&/V "lux;DataT" ) output-type (&/V "lux;DataT" )] - (defn [analyse ?x ?y] + (defn [analyse exo-type ?x ?y] (|do [=x (&&/analyse-1 analyse input-type ?x) - =y (&&/analyse-1 analyse input-type ?y)] + =y (&&/analyse-1 analyse input-type ?y) + _ (&type/check exo-type output-type)] (return (&/|list (&/T (&/V (&/T =x =y)) output-type)))))) analyse-jvm-iadd "jvm-iadd" "java.lang.Integer" "java.lang.Integer" @@ -86,94 +105,121 @@ analyse-jvm-dgt "jvm-dgt" "java.lang.Double" "java.lang.Boolean" ) -(defn analyse-jvm-getstatic [analyse ?class ?field] - (|do [=type (&host/lookup-static-field ?class ?field)] - (return (&/|list (&/T (&/V "jvm-getstatic" (&/T ?class ?field)) =type))))) - -(defn analyse-jvm-getfield [analyse ?class ?field ?object] - (|do [=type (&host/lookup-static-field ?class ?field) - =object (&&/analyse-1 analyse ?object)] - (return (&/|list (&/T (&/V "jvm-getfield" (&/T ?class ?field =object)) =type))))) - -(defn analyse-jvm-putstatic [analyse ?class ?field ?value] - (|do [=type (&host/lookup-static-field ?class ?field) - =value (&&/analyse-1 analyse =type ?value)] - (return (&/|list (&/T (&/V "jvm-putstatic" (&/T ?class ?field =value)) =type))))) +(defn analyse-jvm-getstatic [analyse exo-type ?class ?field] + (|do [class-loader &/loader + =type (&host/lookup-static-field class-loader ?class ?field) + :let [output-type =type] + _ (&type/check exo-type output-type)] + (return (&/|list (&/T (&/V "jvm-getstatic" (&/T ?class ?field)) output-type))))) -(defn analyse-jvm-putfield [analyse ?class ?field ?object ?value] - (|do [=type (&host/lookup-static-field ?class ?field) +(defn analyse-jvm-getfield [analyse exo-type ?class ?field ?object] + (|do [class-loader &/loader + =type (&host/lookup-static-field class-loader ?class ?field) =object (&&/analyse-1 analyse ?object) - =value (&&/analyse-1 analyse =type ?value)] - (return (&/|list (&/T (&/V "jvm-putfield" (&/T ?class ?field =object =value)) =type))))) - -(defn analyse-jvm-invokestatic [analyse ?class ?method ?classes ?args] - (|do [=classes (&/map% extract-text ?classes) - =return (&host/lookup-static-method ?class ?method =classes) + :let [output-type =type] + _ (&type/check exo-type output-type)] + (return (&/|list (&/T (&/V "jvm-getfield" (&/T ?class ?field =object)) output-type))))) + +(defn analyse-jvm-putstatic [analyse exo-type ?class ?field ?value] + (|do [class-loader &/loader + =type (&host/lookup-static-field class-loader ?class ?field) + =value (&&/analyse-1 analyse =type ?value) + :let [output-type &type/Unit] + _ (&type/check exo-type output-type)] + (return (&/|list (&/T (&/V "jvm-putstatic" (&/T ?class ?field =value)) output-type))))) + +(defn analyse-jvm-putfield [analyse exo-type ?class ?field ?object ?value] + (|do [class-loader &/loader + =type (&host/lookup-static-field class-loader ?class ?field) + =object (&&/analyse-1 analyse ?object) + =value (&&/analyse-1 analyse =type ?value) + :let [output-type &type/Unit] + _ (&type/check exo-type output-type)] + (return (&/|list (&/T (&/V "jvm-putfield" (&/T ?class ?field =object =value)) output-type))))) + +(defn analyse-jvm-invokestatic [analyse exo-type ?class ?method ?classes ?args] + (|do [class-loader &/loader + =classes (&/map% extract-text ?classes) + =return (&host/lookup-static-method class-loader ?class ?method =classes) ;; :let [_ (matchv ::M/objects [=return] ;; [["lux;DataT" _return-class]] ;; (prn 'analyse-jvm-invokestatic ?class ?method _return-class))] =args (&/map2% (fn [_class _arg] (&&/analyse-1 analyse (&/V "lux;DataT" _class) _arg)) =classes - ?args)] - (return (&/|list (&/T (&/V "jvm-invokestatic" (&/T ?class ?method =classes =args)) =return))))) + ?args) + :let [output-type =return] + _ (&type/check exo-type output-type)] + (return (&/|list (&/T (&/V "jvm-invokestatic" (&/T ?class ?method =classes =args)) output-type))))) -(defn analyse-jvm-instanceof [analyse ?class ?object] +(defn analyse-jvm-instanceof [analyse exo-type ?class ?object] (|do [=object (analyse-1+ analyse ?object) - :let [[_obj _type] =object]] - (matchv ::M/objects [_type] - [["lux;DataT" _]] - (return (&/|list (&/T (&/V "jvm-instanceof" (&/T ?class ?object)) (&/V "lux;DataT" "java.lang.Boolean")))) - - [_] - (fail "[Analyser Error] Can only use instanceof with object types.")))) + _ (ensure-object =object) + :let [output-type &type/Bool] + _ (&type/check exo-type output-type)] + (return (&/|list (&/T (&/V "jvm-instanceof" (&/T ?class =object)) output-type))))) (do-template [ ] - (defn [analyse ?class ?method ?classes ?object ?args] - (|do [=classes (&/map% extract-text ?classes) - =return (&host/lookup-virtual-method ?class ?method =classes) + (defn [analyse exo-type ?class ?method ?classes ?object ?args] + (|do [class-loader &/loader + =classes (&/map% extract-text ?classes) + =return (&host/lookup-virtual-method class-loader ?class ?method =classes) =object (&&/analyse-1 analyse (&/V "lux;DataT" ?class) ?object) - =args (&/map2% (fn [?c ?o] - (&&/analyse-1 analyse (&/V "lux;DataT" ?c) ?o)) - =classes ?args)] - (return (&/|list (&/T (&/V (&/T ?class ?method =classes =object =args)) =return))))) + =args (&/map2% (fn [?c ?o] (&&/analyse-1 analyse (&/V "lux;DataT" ?c) ?o)) + =classes ?args) + :let [output-type =return] + _ (&type/check exo-type output-type)] + (return (&/|list (&/T (&/V (&/T ?class ?method =classes =object =args)) output-type))))) analyse-jvm-invokevirtual "jvm-invokevirtual" analyse-jvm-invokeinterface "jvm-invokeinterface" ) -(defn analyse-jvm-invokespecial [analyse ?class ?method ?classes ?object ?args] - (|do [=classes (&/map% extract-text ?classes) +(defn analyse-jvm-invokespecial [analyse exo-type ?class ?method ?classes ?object ?args] + (|do [class-loader &/loader + =classes (&/map% extract-text ?classes) =return (if (= "" ?method) - (return &type/$Void) - (&host/lookup-virtual-method ?class ?method =classes)) + (return &type/Unit) + (&host/lookup-virtual-method class-loader ?class ?method =classes)) =object (&&/analyse-1 analyse (&/V "lux;DataT" ?class) ?object) =args (&/map2% (fn [?c ?o] (&&/analyse-1 analyse (&/V "lux;DataT" ?c) ?o)) - =classes ?args)] - (return (&/|list (&/T (&/V "jvm-invokespecial" (&/T ?class ?method =classes =object =args)) =return))))) + =classes ?args) + :let [output-type =return] + _ (&type/check exo-type output-type)] + (return (&/|list (&/T (&/V "jvm-invokespecial" (&/T ?class ?method =classes =object =args)) output-type))))) + +(defn analyse-jvm-null? [analyse exo-type ?object] + (|do [=object (analyse-1+ analyse ?object) + _ (ensure-object =object) + :let [output-type &type/Bool] + _ (&type/check exo-type output-type)] + (return (&/|list (&/T (&/V "jvm-null?" =object) output-type))))) -(defn analyse-jvm-null? [analyse ?object] - (|do [=object (&&/analyse-1 analyse ?object)] - (return (&/|list (&/T (&/V "jvm-null?" =object) (&/V "lux;DataT" "java.lang.Boolean")))))) +(defn analyse-jvm-null [analyse exo-type] + (|do [:let [output-type (&/V "lux;DataT" "null")] + _ (&type/check exo-type output-type)] + (return (&/|list (&/T (&/V "jvm-null" nil) output-type))))) -(defn analyse-jvm-new [analyse ?class ?classes ?args] +(defn analyse-jvm-new [analyse exo-type ?class ?classes ?args] (|do [=classes (&/map% extract-text ?classes) - =args (&/flat-map% analyse ?args)] - (return (&/|list (&/T (&/V "jvm-new" (&/T ?class =classes =args)) (&/V "lux;DataT" ?class)))))) + =args (&/map% (partial analyse-1+ analyse) ?args) + :let [output-type (&/V "lux;DataT" ?class)] + _ (&type/check exo-type output-type)] + (return (&/|list (&/T (&/V "jvm-new" (&/T ?class =classes =args)) output-type))))) (defn analyse-jvm-new-array [analyse ?class ?length] (return (&/|list (&/T (&/V "jvm-new-array" (&/T ?class ?length)) (&/V "array" (&/T (&/V "lux;DataT" ?class) (&/V "lux;Nil" nil))))))) (defn analyse-jvm-aastore [analyse ?array ?idx ?elem] - (|do [=array (&&/analyse-1 analyse &type/$Void ?array) - =elem (&&/analyse-1 analyse &type/$Void ?elem) + (|do [=array (analyse-1+ analyse ?array) + =elem (analyse-1+ analyse ?elem) =array-type (&&/expr-type =array)] (return (&/|list (&/T (&/V "jvm-aastore" (&/T =array ?idx =elem)) =array-type))))) (defn analyse-jvm-aaload [analyse ?array ?idx] - (|do [=array (&&/analyse-1 analyse ?array) + (|do [=array (analyse-1+ analyse ?array) =array-type (&&/expr-type =array)] (return (&/|list (&/T (&/V "jvm-aaload" (&/T =array ?idx)) =array-type))))) @@ -259,7 +305,7 @@ (return (&/T (&/ident->text ?input-name) ?input-type)) [_] - (fail "[Analyser Error] Wrong syntax for method."))) + (fail "[Analyser Error] Wrong syntax for method input."))) ?method-inputs) =method-modifiers (analyse-modifiers ?method-modifiers) =method-body (&/with-scope (str ?name "_" ?idx) @@ -302,37 +348,49 @@ :output ?output})) [_] - (fail "[Analyser Error] Invalid method signature!"))) + (fail (str "[Analyser Error] Invalid method signature: " (&/show-ast method))))) ?methods)] (return (&/|list (&/V "jvm-interface" (&/T ?name =supers =methods)))))) -(defn analyse-jvm-try [analyse ?body [?catches ?finally]] - (|do [=body (&&/analyse-1 analyse ?body) +(defn analyse-jvm-try [analyse exo-type ?body ?catches+?finally] + (|do [:let [[?catches ?finally] ?catches+?finally] + =body (&&/analyse-1 analyse exo-type ?body) =catches (&/map% (fn [[?ex-class ?ex-arg ?catch-body]] - (&&env/with-local ?ex-arg (&/V "lux;DataT" ?ex-class) - (|do [=catch-body (&&/analyse-1 analyse ?catch-body)] - (return [?ex-class ?ex-arg =catch-body])))) + (|do [=catch-body (&&env/with-local (str ";" ?ex-arg) (&/V "lux;DataT" ?ex-class) + (&&/analyse-1 analyse exo-type ?catch-body)) + idx &&env/next-local-idx] + (return (&/T ?ex-class idx =catch-body)))) ?catches) - =finally (&&/analyse-1 analyse ?finally) - =body-type (&&/expr-type =body)] - (return (&/|list (&/T (&/V "jvm-try" (&/T =body =catches =finally)) =body-type))))) - -(defn analyse-jvm-throw [analyse ?ex] - (|do [=ex (&&/analyse-1 analyse ?ex)] + =finally (matchv ::M/objects [?finally] + [["lux;None" _]] (return (&/V "lux;None" nil)) + [["lux;Some" ?finally*]] (|do [=finally (analyse-1+ analyse ?finally*)] + (return (&/V "lux;Some" =finally))))] + (return (&/|list (&/T (&/V "jvm-try" (&/T =body =catches =finally)) exo-type))))) + +(defn analyse-jvm-throw [analyse exo-type ?ex] + (|do [=ex (analyse-1+ analyse ?ex) + :let [[_obj _type] =ex] + _ (&type/check (&/V "lux;DataT" "java.lang.Throwable") _type)] (return (&/|list (&/T (&/V "jvm-throw" =ex) &type/$Void))))) -(defn analyse-jvm-monitorenter [analyse ?monitor] - (|do [=monitor (&&/analyse-1 analyse ?monitor)] - (return (&/|list (&/T (&/V "jvm-monitorenter" =monitor) (&/V "lux;TupleT" (&/V "lux;Nil" nil))))))) - -(defn analyse-jvm-monitorexit [analyse ?monitor] - (|do [=monitor (&&/analyse-1 analyse ?monitor)] - (return (&/|list (&/T (&/V "jvm-monitorexit" =monitor) (&/V "lux;TupleT" (&/V "lux;Nil" nil))))))) +(do-template [ ] + (defn [analyse exo-type ?monitor] + (|do [=monitor (analyse-1+ analyse ?monitor) + _ (ensure-object =monitor) + :let [output-type &type/Unit] + _ (&type/check exo-type output-type)] + (return (&/|list (&/T (&/V =monitor) output-type))))) + + analyse-jvm-monitorenter "jvm-monitorenter" + analyse-jvm-monitorexit "jvm-monitorexit" + ) (do-template [ ] - (defn [analyse ?value] - (|do [=value (&&/analyse-1 analyse (&/V "lux;DataT" ) ?value)] - (return (&/|list (&/T (&/V =value) (&/V "lux;DataT" )))))) + (let [output-type (&/V "lux;DataT" )] + (defn [analyse exo-type ?value] + (|do [=value (&&/analyse-1 analyse (&/V "lux;DataT" ) ?value) + _ (&type/check exo-type output-type)] + (return (&/|list (&/T (&/V =value) output-type)))))) analyse-jvm-d2f "jvm-d2f" "java.lang.Double" "java.lang.Float" analyse-jvm-d2i "jvm-d2i" "java.lang.Double" "java.lang.Integer" @@ -355,9 +413,11 @@ ) (do-template [ ] - (defn [analyse ?value] - (|do [=value (&&/analyse-1 analyse (&/V "lux;DataT" ) ?value)] - (return (&/|list (&/T (&/V =value) (&/V "lux;DataT" )))))) + (let [output-type (&/V "lux;DataT" )] + (defn [analyse exo-type ?value] + (|do [=value (&&/analyse-1 analyse (&/V "lux;DataT" ) ?value) + _ (&type/check exo-type output-type)] + (return (&/|list (&/T (&/V =value) output-type)))))) analyse-jvm-iand "jvm-iand" "java.lang.Integer" "java.lang.Integer" analyse-jvm-ior "jvm-ior" "java.lang.Integer" "java.lang.Integer" diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj index 4a912f1c1..065e150d9 100644 --- a/src/lux/analyser/lux.clj +++ b/src/lux/analyser/lux.clj @@ -261,11 +261,11 @@ (|do [macro-expansion #(-> macro (.apply ?args) (.apply %)) :let [macro-expansion* (&/|map (partial with-cursor form-cursor) macro-expansion)] ;; :let [_ (when (and ;; (= "lux/control/monad" ?module) - ;; (= "open" ?name)) + ;; (= "case" ?name)) ;; (->> (&/|map &/show-ast macro-expansion*) ;; (&/|interpose "\n") ;; (&/fold str "") - ;; (prn ?module "open")))] + ;; (prn ?module "case")))] ] (&/flat-map% (partial analyse exo-type) macro-expansion*)) diff --git a/src/lux/base.clj b/src/lux/base.clj index 9f0a78fa7..eb94c2c90 100644 --- a/src/lux/base.clj +++ b/src/lux/base.clj @@ -466,7 +466,10 @@ (findClass [^String class-name] ;; (prn 'findClass class-name) (if-let [^bytes bytecode (get @store class-name)] - (.invoke define-class this (to-array [class-name bytecode (int 0) (int (alength bytecode))])) + (try (.invoke define-class this (to-array [class-name bytecode (int 0) (int (alength bytecode))])) + (catch java.lang.reflect.InvocationTargetException e + (prn 'InvocationTargetException (.getCause e)) + (throw e))) (do (prn 'memory-class-loader/store class-name (keys @store)) (throw (IllegalStateException. (str "[Class Loader] Unknown class: " class-name))))))))) diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj index bb1c72f66..3449900e0 100644 --- a/src/lux/compiler.clj +++ b/src/lux/compiler.clj @@ -28,7 +28,8 @@ [lux :as &&lux] [host :as &&host] [case :as &&case] - [lambda :as &&lambda])) + [lambda :as &&lambda] + [package :as &&package])) (:import (org.objectweb.asm Opcodes Label ClassWriter @@ -383,17 +384,18 @@ (fail "[Compiler Error] Can't redefine a module!") (|do [_ (&a-module/enter-module name) :let [=class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS) - (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER) + (.visit Opcodes/V1_6 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER) (str (&host/->module-class name) "/_") nil "java/lang/Object" nil) (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_hash" "I" nil file-hash) .visitEnd) (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_compiler" "Ljava/lang/String;" nil &&/version) - .visitEnd))]] + .visitEnd)) + ;; _ (prn 'compile-module name =class) + ]] (fn [state] - (matchv ::M/objects [((&/exhaust% compiler-step) - (->> state - (&/set$ &/$SOURCE (&reader/from file-name file-content)) - (&/update$ &/$HOST #(&/set$ &/$WRITER (&/V "lux;Some" =class) %))))] + (matchv ::M/objects [((&/with-writer =class + (&/exhaust% compiler-step)) + (&/set$ &/$SOURCE (&reader/from file-name file-content) state))] [["lux;Right" [?state _]]] (&/run-state (|do [defs &a-module/defs imports &a-module/imports @@ -409,7 +411,9 @@ (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_imports" "Ljava/lang/String;" nil (->> imports (&/|interpose "\t") (&/fold str ""))) .visitEnd) - (.visitEnd))]] + (.visitEnd)) + ;; _ (prn 'CLOSED name =class) + ]] (&&/save-class! "_" (.toByteArray =class))) ?state) @@ -421,12 +425,13 @@ (.mkdirs (java.io.File. &&/output-dir))) ;; [Resources] -(defn compile-all [modules] +(defn compile-program [program-module] (init!) - (matchv ::M/objects [((&/map% compile-module modules) (&/init-state nil))] + (matchv ::M/objects [((&/map% compile-module (&/|list "lux" program-module)) (&/init-state nil))] [["lux;Right" [?state _]]] (do (println "Compilation complete!") - (&&cache/clean ?state)) + (&&cache/clean ?state) + (&&package/package program-module)) [["lux;Left" ?message]] (assert false ?message))) diff --git a/src/lux/compiler/base.clj b/src/lux/compiler/base.clj index 0631f51e8..28339c162 100644 --- a/src/lux/compiler/base.clj +++ b/src/lux/compiler/base.clj @@ -7,7 +7,8 @@ ;; You must not remove this notice, or any other, from this software. (ns lux.compiler.base - (:require [clojure.string :as string] + (:require (clojure [template :refer [do-template]] + [string :as string]) [clojure.java.io :as io] [clojure.core.match :as M :refer [matchv]] clojure.core.match.array @@ -29,6 +30,7 @@ (def ^String version "0.2") (def ^String input-dir "source") (def ^String output-dir "target/jvm") +(def ^String output-package (str output-dir "/program.jar")) (def ^String function-class "lux/Function") (def ^String local-prefix "l") @@ -59,7 +61,31 @@ !classes &/classes :let [real-name (str (&host/->module-class module) "." name) _ (swap! !classes assoc real-name bytecode) - _ (load-class! loader real-name) _ (when (not eval?) - (write-output module name bytecode))]] + (write-output module name bytecode)) + _ (load-class! loader real-name)]] (return nil))) + +(do-template [ ] + (defn [^MethodVisitor writer] + (doto writer + (.visitMethodInsn Opcodes/INVOKESTATIC "valueOf" (str (&host/->type-signature )))) + ;; (doto writer + ;; ;; X + ;; (.visitTypeInsn Opcodes/NEW ) ;; XW + ;; (.visitInsn ) ;; WXW + ;; (.visitInsn ) ;; WWXW + ;; (.visitInsn Opcodes/POP) ;; WWX + ;; (.visitMethodInsn Opcodes/INVOKESPECIAL "" ) ;; W + ;; ) + ) + + wrap-boolean "java/lang/Boolean" "(Z)" Opcodes/DUP_X1 + wrap-byte "java/lang/Byte" "(B)" Opcodes/DUP_X1 + wrap-short "java/lang/Short" "(S)" Opcodes/DUP_X1 + wrap-int "java/lang/Integer" "(I)" Opcodes/DUP_X1 + wrap-long "java/lang/Long" "(J)" Opcodes/DUP_X2 + wrap-float "java/lang/Float" "(F)" Opcodes/DUP_X1 + wrap-double "java/lang/Double" "(D)" Opcodes/DUP_X2 + wrap-char "java/lang/Character" "(C)" Opcodes/DUP_X1 + ) diff --git a/src/lux/compiler/cache.clj b/src/lux/compiler/cache.clj index 57e81a2b0..c0d978146 100644 --- a/src/lux/compiler/cache.clj +++ b/src/lux/compiler/cache.clj @@ -55,8 +55,11 @@ (defn clean [state] "(-> Compiler (,))" (let [needed-modules (->> state (&/get$ &/$MODULES) &/|keys &/->seq set) - outdated? #(-> ^File % .getName (string/replace " " "/") (->> (contains? needed-modules)) not) - outdate-files (->> &&/output-dir (new File) .listFiles seq (filter outdated?))] + outdated? #(-> ^File % .getName (string/replace &host/module-separator "/") (->> (contains? needed-modules)) not) + outdate-files (->> &&/output-dir (new File) .listFiles seq (filter outdated?)) + program-file (new File &&/output-package)] + (when (.exists program-file) + (.delete program-file)) (doseq [f outdate-files] (clean-file f)) nil)) diff --git a/src/lux/compiler/host.clj b/src/lux/compiler/host.clj index 3df09b29e..346b66fd2 100644 --- a/src/lux/compiler/host.clj +++ b/src/lux/compiler/host.clj @@ -52,7 +52,7 @@ char-class "java.lang.Character"] (defn prepare-return! [^MethodVisitor *writer* *type*] (matchv ::M/objects [*type*] - [["lux;VariantT" ["lux;Nil" _]]] + [["lux;TupleT" ["lux;Nil" _]]] (.visitInsn *writer* Opcodes/ACONST_NULL) [["lux;DataT" "boolean"]] @@ -84,7 +84,7 @@ *writer*)) ;; [Resources] -(do-template [ ] +(do-template [ ] (defn [compile *type* ?x ?y] (|do [:let [+wrapper-class+ (&host/->class )] ^MethodVisitor *writer* &/get-writer @@ -98,32 +98,32 @@ (.visitMethodInsn Opcodes/INVOKEVIRTUAL +wrapper-class+ )) _ (doto *writer* (.visitInsn ) - (.visitMethodInsn Opcodes/INVOKESTATIC +wrapper-class+ (str (&host/->type-signature ))))]] + ())]] (return nil))) - compile-jvm-iadd Opcodes/IADD "java.lang.Integer" "intValue" "()I" "valueOf" "(I)" - compile-jvm-isub Opcodes/ISUB "java.lang.Integer" "intValue" "()I" "valueOf" "(I)" - compile-jvm-imul Opcodes/IMUL "java.lang.Integer" "intValue" "()I" "valueOf" "(I)" - compile-jvm-idiv Opcodes/IDIV "java.lang.Integer" "intValue" "()I" "valueOf" "(I)" - compile-jvm-irem Opcodes/IREM "java.lang.Integer" "intValue" "()I" "valueOf" "(I)" + compile-jvm-iadd Opcodes/IADD "java.lang.Integer" "intValue" "()I" &&/wrap-int + compile-jvm-isub Opcodes/ISUB "java.lang.Integer" "intValue" "()I" &&/wrap-int + compile-jvm-imul Opcodes/IMUL "java.lang.Integer" "intValue" "()I" &&/wrap-int + compile-jvm-idiv Opcodes/IDIV "java.lang.Integer" "intValue" "()I" &&/wrap-int + compile-jvm-irem Opcodes/IREM "java.lang.Integer" "intValue" "()I" &&/wrap-int - compile-jvm-ladd Opcodes/LADD "java.lang.Long" "longValue" "()J" "valueOf" "(J)" - compile-jvm-lsub Opcodes/LSUB "java.lang.Long" "longValue" "()J" "valueOf" "(J)" - compile-jvm-lmul Opcodes/LMUL "java.lang.Long" "longValue" "()J" "valueOf" "(J)" - compile-jvm-ldiv Opcodes/LDIV "java.lang.Long" "longValue" "()J" "valueOf" "(J)" - compile-jvm-lrem Opcodes/LREM "java.lang.Long" "longValue" "()J" "valueOf" "(J)" - - compile-jvm-fadd Opcodes/FADD "java.lang.Float" "floatValue" "()F" "valueOf" "(F)" - compile-jvm-fsub Opcodes/FSUB "java.lang.Float" "floatValue" "()F" "valueOf" "(F)" - compile-jvm-fmul Opcodes/FMUL "java.lang.Float" "floatValue" "()F" "valueOf" "(F)" - compile-jvm-fdiv Opcodes/FDIV "java.lang.Float" "floatValue" "()F" "valueOf" "(F)" - compile-jvm-frem Opcodes/FREM "java.lang.Float" "floatValue" "()F" "valueOf" "(F)" + compile-jvm-ladd Opcodes/LADD "java.lang.Long" "longValue" "()J" &&/wrap-long + compile-jvm-lsub Opcodes/LSUB "java.lang.Long" "longValue" "()J" &&/wrap-long + compile-jvm-lmul Opcodes/LMUL "java.lang.Long" "longValue" "()J" &&/wrap-long + compile-jvm-ldiv Opcodes/LDIV "java.lang.Long" "longValue" "()J" &&/wrap-long + compile-jvm-lrem Opcodes/LREM "java.lang.Long" "longValue" "()J" &&/wrap-long + + compile-jvm-fadd Opcodes/FADD "java.lang.Float" "floatValue" "()F" &&/wrap-float + compile-jvm-fsub Opcodes/FSUB "java.lang.Float" "floatValue" "()F" &&/wrap-float + compile-jvm-fmul Opcodes/FMUL "java.lang.Float" "floatValue" "()F" &&/wrap-float + compile-jvm-fdiv Opcodes/FDIV "java.lang.Float" "floatValue" "()F" &&/wrap-float + compile-jvm-frem Opcodes/FREM "java.lang.Float" "floatValue" "()F" &&/wrap-float - compile-jvm-dadd Opcodes/DADD "java.lang.Double" "doubleValue" "()D" "valueOf" "(D)" - compile-jvm-dsub Opcodes/DSUB "java.lang.Double" "doubleValue" "()D" "valueOf" "(D)" - compile-jvm-dmul Opcodes/DMUL "java.lang.Double" "doubleValue" "()D" "valueOf" "(D)" - compile-jvm-ddiv Opcodes/DDIV "java.lang.Double" "doubleValue" "()D" "valueOf" "(D)" - compile-jvm-drem Opcodes/DREM "java.lang.Double" "doubleValue" "()D" "valueOf" "(D)" + compile-jvm-dadd Opcodes/DADD "java.lang.Double" "doubleValue" "()D" &&/wrap-double + compile-jvm-dsub Opcodes/DSUB "java.lang.Double" "doubleValue" "()D" &&/wrap-double + compile-jvm-dmul Opcodes/DMUL "java.lang.Double" "doubleValue" "()D" &&/wrap-double + compile-jvm-ddiv Opcodes/DDIV "java.lang.Double" "doubleValue" "()D" &&/wrap-double + compile-jvm-drem Opcodes/DREM "java.lang.Double" "doubleValue" "()D" &&/wrap-double ) (do-template [ ] @@ -205,31 +205,50 @@ (return ret))) ?classes ?args) :let [_ (doto *writer* - (.visitMethodInsn Opcodes/INVOKESTATIC (&host/->class ?class) ?method method-sig) + (.visitMethodInsn Opcodes/INVOKESTATIC (&host/->class (&type/as-obj ?class)) ?method method-sig) (prepare-return! *type*))]] (return nil))) (do-template [ ] (defn [compile *type* ?class ?method ?classes ?object ?args] - (|do [^MethodVisitor *writer* &/get-writer + (|do [:let [?class* (&host/->class (&type/as-obj ?class))] + ^MethodVisitor *writer* &/get-writer :let [method-sig (str "(" (&/fold str "" (&/|map &host/->type-signature ?classes)) ")" (&host/->java-sig *type*))] _ (compile ?object) - :let [_ (.visitTypeInsn *writer* Opcodes/CHECKCAST (&host/->class ?class))] + :let [_ (.visitTypeInsn *writer* Opcodes/CHECKCAST ?class*)] _ (&/map2% (fn [class-name arg] (|do [ret (compile arg) :let [_ (prepare-arg! *writer* class-name)]] (return ret))) ?classes ?args) :let [_ (doto *writer* - (.visitMethodInsn (&host/->class ?class) ?method method-sig) + (.visitMethodInsn ?class* ?method method-sig) (prepare-return! *type*))]] (return nil))) compile-jvm-invokevirtual Opcodes/INVOKEVIRTUAL compile-jvm-invokeinterface Opcodes/INVOKEINTERFACE - compile-jvm-invokespecial Opcodes/INVOKESPECIAL + ;; compile-jvm-invokespecial Opcodes/INVOKESPECIAL ) +(defn compile-jvm-invokespecial [compile *type* ?class ?method ?classes ?object ?args] + (|do [:let [?class* (&host/->class (&type/as-obj ?class))] + ^MethodVisitor *writer* &/get-writer + :let [method-sig (str "(" (&/fold str "" (&/|map &host/->type-signature ?classes)) ")" (&host/->java-sig *type*))] + _ (compile ?object) + ;; :let [_ (.visitTypeInsn *writer* Opcodes/CHECKCAST ?class*)] + :let [_ (when (not= "" ?method) + (.visitTypeInsn *writer* Opcodes/CHECKCAST ?class*))] + _ (&/map2% (fn [class-name arg] + (|do [ret (compile arg) + :let [_ (prepare-arg! *writer* class-name)]] + (return ret))) + ?classes ?args) + :let [_ (doto *writer* + (.visitMethodInsn Opcodes/INVOKESPECIAL ?class* ?method method-sig) + (prepare-return! *type*))]] + (return nil))) + (defn compile-jvm-null [compile *type*] (|do [^MethodVisitor *writer* &/get-writer :let [_ (.visitInsn *writer* Opcodes/ACONST_NULL)]] @@ -293,31 +312,33 @@ (defn compile-jvm-getstatic [compile *type* ?class ?field] (|do [^MethodVisitor *writer* &/get-writer :let [_ (doto *writer* - (.visitFieldInsn Opcodes/GETSTATIC (&host/->class ?class) ?field (&host/->java-sig *type*)) + (.visitFieldInsn Opcodes/GETSTATIC (&host/->class (&type/as-obj ?class)) ?field (&host/->java-sig *type*)) (prepare-return! *type*))]] (return nil))) (defn compile-jvm-getfield [compile *type* ?class ?field ?object] - (|do [^MethodVisitor *writer* &/get-writer + (|do [:let [class* (&host/->class (&type/as-obj ?class))] + ^MethodVisitor *writer* &/get-writer _ (compile ?object) :let [_ (doto *writer* - (.visitTypeInsn Opcodes/CHECKCAST (&host/->class ?class)) - (.visitFieldInsn Opcodes/GETFIELD (&host/->class ?class) ?field (&host/->java-sig *type*)) + (.visitTypeInsn Opcodes/CHECKCAST class*) + (.visitFieldInsn Opcodes/GETFIELD class* ?field (&host/->java-sig *type*)) (prepare-return! *type*))]] (return nil))) (defn compile-jvm-putstatic [compile *type* ?class ?field ?value] (|do [^MethodVisitor *writer* &/get-writer _ (compile ?value) - :let [_ (.visitFieldInsn *writer* Opcodes/PUTSTATIC (&host/->class ?class) ?field (&host/->java-sig *type*))]] + :let [_ (.visitFieldInsn *writer* Opcodes/PUTSTATIC (&host/->class (&type/as-obj ?class)) ?field (&host/->java-sig *type*))]] (return nil))) (defn compile-jvm-putfield [compile *type* ?class ?field ?object ?value] - (|do [^MethodVisitor *writer* &/get-writer + (|do [:let [class* (&host/->class (&type/as-obj ?class))] + ^MethodVisitor *writer* &/get-writer _ (compile ?object) _ (compile ?value) - :let [_ (.visitTypeInsn *writer* Opcodes/CHECKCAST (&host/->class ?class))] - :let [_ (.visitFieldInsn *writer* Opcodes/PUTFIELD (&host/->class ?class) ?field (&host/->java-sig *type*))]] + :let [_ (.visitTypeInsn *writer* Opcodes/CHECKCAST class*)] + :let [_ (.visitFieldInsn *writer* Opcodes/PUTFIELD class* ?field (&host/->java-sig *type*))]] (return nil))) (defn ^:private modifiers->int [mods] @@ -336,11 +357,12 @@ 0))) (defn compile-jvm-instanceof [compile *type* class object] - (|do [^MethodVisitor *writer* &/get-writer + (|do [:let [class* (&host/->class class)] + ^MethodVisitor *writer* &/get-writer _ (compile object) :let [_ (doto *writer* - (.visitLdcInsn class) - (.visitTypeInsn Opcodes/INSTANCEOF class))]] + (.visitTypeInsn Opcodes/INSTANCEOF class*) + (&&/wrap-boolean))]] (return nil))) (defn compile-jvm-class [compile ?name ?super-class ?interfaces ?fields ?methods] @@ -391,46 +413,50 @@ $to (new Label) $end (new Label) $catch-finally (new Label) - compile-finally (if ?finally - (|do [_ (return nil) - _ (compile ?finally) - :let [_ (doto *writer* - (.visitInsn Opcodes/POP) - (.visitJumpInsn Opcodes/GOTO $end))]] - (return nil)) - (|do [_ (return nil) - :let [_ (.visitJumpInsn *writer* Opcodes/GOTO $end)]] - (return nil))) - _ (.visitLabel *writer* $from)] + compile-finally (matchv ::M/objects [?finally] + [["lux;Some" ?finally*]] (|do [_ (return nil) + _ (compile ?finally*) + :let [_ (doto *writer* + (.visitInsn Opcodes/POP) + (.visitJumpInsn Opcodes/GOTO $end))]] + (return nil)) + [["lux;None" _]] (|do [_ (return nil) + :let [_ (.visitJumpInsn *writer* Opcodes/GOTO $end)]] + (return nil))) + catch-boundaries (&/|map (fn [[?ex-class ?ex-idx ?catch-body]] [?ex-class (new Label) (new Label)]) + ?catches) + _ (doseq [[?ex-class $handler-start $handler-end] (&/->seq catch-boundaries) + ;; :let [_ (prn 'HANDLER ?ex-class (&host/->class ?ex-class) $handler-start $handler-end $from $to $catch-finally)] + ] + (doto *writer* + (.visitTryCatchBlock $from $to $handler-start (&host/->class ?ex-class)) + (.visitTryCatchBlock $handler-start $handler-end $catch-finally nil))) + _ (.visitTryCatchBlock *writer* $from $to $catch-finally nil)] + :let [_ (.visitLabel *writer* $from)] _ (compile ?body) :let [_ (.visitLabel *writer* $to)] _ compile-finally - handlers (&/map% (fn [[?ex-class ?ex-arg ?catch-body]] - (|do [:let [$handler-start (new Label) - $handler-end (new Label)] - _ (compile ?catch-body) - :let [_ (.visitLabel *writer* $handler-end)] - _ compile-finally] - (return [?ex-class $handler-start $handler-end]))) - ?catches) + handlers (&/map2% (fn [[?ex-class ?ex-idx ?catch-body] [_ $handler-start $handler-end]] + (|do [:let [_ (doto *writer* + (.visitLabel $handler-start) + (.visitVarInsn Opcodes/ASTORE ?ex-idx))] + _ (compile ?catch-body) + :let [_ (.visitLabel *writer* $handler-end)]] + compile-finally)) + ?catches + catch-boundaries) + ;; :let [_ (prn 'handlers (&/->seq handlers))] :let [_ (.visitLabel *writer* $catch-finally)] - _ (if ?finally - (|do [_ (compile ?finally) - :let [_ (doto *writer* - (.visitInsn Opcodes/POP) - (.visitInsn Opcodes/ATHROW))]] - (return nil)) - (|do [_ (return nil) - :let [_ (.visitInsn *writer* Opcodes/ATHROW)]] - (return nil))) + _ (matchv ::M/objects [?finally] + [["lux;Some" ?finally*]] (|do [_ (compile ?finally*) + :let [_ (.visitInsn *writer* Opcodes/POP)] + :let [_ (.visitInsn *writer* Opcodes/ATHROW)]] + (return nil)) + [["lux;None" _]] (|do [_ (return nil) + :let [_ (.visitInsn *writer* Opcodes/ATHROW)]] + (return nil))) :let [_ (.visitJumpInsn *writer* Opcodes/GOTO $end)] - :let [_ (.visitLabel *writer* $end)] - :let [_ (doseq [[?ex-class $handler-start $handler-end] handlers] - (doto *writer* - (.visitTryCatchBlock $from $to $handler-start ?ex-class) - (.visitTryCatchBlock $handler-start $handler-end $catch-finally nil)) - ) - _ (.visitTryCatchBlock *writer* $from $to $catch-finally nil)]] + :let [_ (.visitLabel *writer* $end)]] (return nil))) (defn compile-jvm-throw [compile *type* ?ex] @@ -518,12 +544,17 @@ ) (defn compile-jvm-program [compile ?body] - (|do [^ClassWriter *writer* &/get-writer] + (|do [module-name &/get-module-name + ;; :let [_ (prn 'compile-jvm-program module-name)] + ^ClassWriter *writer* &/get-writer] (&/with-writer (doto (.visitMethod *writer* (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "main" "([Ljava/lang/String;)V" nil nil) (.visitCode)) (|do [^MethodVisitor main-writer &/get-writer - :let [$loop (new Label) + :let [;; _ (prn "#1" module-name *writer*) + $loop (new Label) + ;; _ (prn "#2") $end (new Label) + ;; _ (prn "#3") _ (doto main-writer ;; Tail: Begin (.visitLdcInsn (int 2)) ;; S @@ -589,14 +620,21 @@ (.visitLabel $end) ;; VI (.visitInsn Opcodes/POP) ;; V (.visitVarInsn Opcodes/ASTORE (int 0)) ;; - )] + ) + ;; _ (prn "#4") + ] _ (compile ?body) - :let [_ (doto main-writer + :let [;; _ (prn "#5") + _ (doto main-writer (.visitInsn Opcodes/ACONST_NULL) - (.visitMethodInsn Opcodes/INVOKEINTERFACE &&/function-class "apply" &&/apply-signature))] + (.visitMethodInsn Opcodes/INVOKEINTERFACE &&/function-class "apply" &&/apply-signature)) + ;; _ (prn "#6") + ] :let [_ (doto main-writer - (.visitInsn Opcodes/POP) - (.visitInsn Opcodes/RETURN) - (.visitMaxs 0 0) - (.visitEnd))]] + (.visitInsn Opcodes/POP) + (.visitInsn Opcodes/RETURN) + (.visitMaxs 0 0) + (.visitEnd)) + ;; _ (prn "#7") + ]] (return nil))))) diff --git a/src/lux/compiler/package.clj b/src/lux/compiler/package.clj new file mode 100644 index 000000000..40639e85a --- /dev/null +++ b/src/lux/compiler/package.clj @@ -0,0 +1,61 @@ +;; Copyright (c) Eduardo Julian. All rights reserved. +;; The use and distribution terms for this software are covered by the +;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) +;; which can be found in the file epl-v10.html at the root of this distribution. +;; By using this software in any fashion, you are agreeing to be bound by +;; the terms of this license. +;; You must not remove this notice, or any other, from this software. + +(ns lux.compiler.package + (:require [clojure.core.match :as M :refer [matchv]] + clojure.core.match.array + (lux [base :as & :refer [|let |do return* return fail fail*]] + [host :as &host]) + (lux.compiler [base :as &&])) + (:import (java.io File + FileInputStream + FileOutputStream + BufferedInputStream) + (java.util.jar Manifest + Attributes$Name + JarEntry + JarOutputStream + ))) + +;; [Utils] +(def ^:private kilobyte 1024) + +(defn ^:private manifest [^String module] + "(-> Text Manifest)" + (doto (new Manifest) + (-> .getMainAttributes (doto (.put Attributes$Name/MAIN_CLASS (str (&host/->module-class module) "._")) + (.put Attributes$Name/MANIFEST_VERSION "1.0"))))) + +(defn ^:private write-class! [^String path ^File file ^JarOutputStream out] + "(-> Text File JarOutputStream Unit)" + (with-open [in (new BufferedInputStream (new FileInputStream file))] + (let [buffer (byte-array (* 10 kilobyte))] + (doto out + (.putNextEntry (new JarEntry (str path "/" (.getName file)))) + (-> (.write buffer 0 bytes-read) + (->> (when (not= -1 bytes-read)) + (loop [bytes-read (.read in buffer)]))) + (.flush) + (.closeEntry) + )) + )) + +(defn ^:private write-module! [^File file ^JarOutputStream out] + "(-> File JarOutputStream Unit)" + (let [module-name (.getName file)] + (doseq [$class (.listFiles file)] + (write-class! module-name $class out)))) + +;; [Resources] +(defn package [module] + "(-> Text (,))" + ;; (prn 'package module) + (with-open [out (new JarOutputStream (->> &&/output-package (new File) (new FileOutputStream)) (manifest module))] + (doseq [$group (.listFiles (new File &&/output-dir))] + (write-module! $group out)) + )) diff --git a/src/lux/host.clj b/src/lux/host.clj index cf9830169..906e3c714 100644 --- a/src/lux/host.clj +++ b/src/lux/host.clj @@ -18,6 +18,7 @@ ;; [Constants] (def prefix "lux.") (def function-class (str prefix "Function")) +(def module-separator "_") ;; [Utils] (defn ^:private class->type [^Class class] @@ -27,7 +28,7 @@ "") (.getSimpleName class)))] (if (.equals "void" base) - (return &type/$Void) + (return &type/Unit) (return (&/V "lux;DataT" (str (reduce str "" (repeat (int (/ (count arr-level) 2)) "[")) base))) ))) @@ -40,7 +41,7 @@ (string/replace class #"\." "/")) (defn ^String ->module-class [module-name] - (string/replace module-name #"/" " ")) + (string/replace module-name #"/" module-separator)) (def ->package ->module-class) @@ -71,13 +72,13 @@ [["lux;LambdaT" [_ _]]] (->type-signature function-class) - [["lux;VariantT" ["lux;Nil" _]]] + [["lux;TupleT" ["lux;Nil" _]]] "V" )) (do-template [ ] - (defn [target field] - (if-let [type* (first (for [^Field =field (.getDeclaredFields (Class/forName target)) + (defn [class-loader target field] + (if-let [type* (first (for [^Field =field (.getDeclaredFields (Class/forName (&type/as-obj target) true class-loader)) :when (and (.equals ^Object field (.getName =field)) (.equals ^Object (Modifier/isStatic (.getModifiers =field))))] (.getType =field)))] @@ -90,8 +91,9 @@ ) (do-template [ ] - (defn [target method-name args] - (if-let [method (first (for [^Method =method (.getDeclaredMethods (Class/forName target)) + (defn [class-loader target method-name args] + ;; (prn ' target method-name) + (if-let [method (first (for [^Method =method (.getDeclaredMethods (Class/forName (&type/as-obj target) true class-loader)) :when (and (.equals ^Object method-name (.getName =method)) (.equals ^Object (Modifier/isStatic (.getModifiers =method))) (&/fold2 #(and %1 (.equals ^Object %2 %3)) diff --git a/src/lux/type.clj b/src/lux/type.clj index af2bbf30f..f5b8d3f25 100644 --- a/src/lux/type.clj +++ b/src/lux/type.clj @@ -587,12 +587,24 @@ [_] (fail (str "[Type System] Not type function:\n" (show-type type-fn) "\n")))) -(def init-fixpoints (&/|list)) - -(def counter (atom {})) -(defn ^:private check* [fixpoints expected actual] - ;; (swap! counter update-in [[(aget expected 0) (aget actual 0)]] - ;; #(inc (or % 0))) +(defn as-obj [class] + (case class + "boolean" "java.lang.Boolean" + "byte" "java.lang.Byte" + "short" "java.lang.Short" + "int" "java.lang.Integer" + "long" "java.lang.Long" + "float" "java.lang.Float" + "double" "java.lang.Double" + "char" "java.lang.Character" + ;; else + class)) + +(def ^:private primitive-types #{"boolean" "byte" "short" "int" "long" "float" "double" "char"}) + +(def ^:private init-fixpoints (&/|list)) + +(defn ^:private check* [class-loader fixpoints expected actual] (if (clojure.lang.Util/identical expected actual) (return (&/T fixpoints nil)) (matchv ::M/objects [expected actual] @@ -619,13 +631,13 @@ (return (&/T fixpoints nil))) [["lux;Some" etype] ["lux;None" _]] - (check* fixpoints etype actual) + (check* class-loader fixpoints etype actual) [["lux;None" _] ["lux;Some" atype]] - (check* fixpoints expected atype) + (check* class-loader fixpoints expected atype) [["lux;Some" etype] ["lux;Some" atype]] - (check* fixpoints etype atype)))) + (check* class-loader fixpoints etype atype)))) [["lux;VarT" ?id] _] (fn [state] @@ -635,7 +647,7 @@ [["lux;Left" _]] ((|do [bound (deref ?id)] - (check* fixpoints bound actual)) + (check* class-loader fixpoints bound actual)) state))) [_ ["lux;VarT" ?id]] @@ -646,7 +658,7 @@ [["lux;Left" _]] ((|do [bound (deref ?id)] - (check* fixpoints expected bound)) + (check* class-loader fixpoints expected bound)) state))) [["lux;AppT" [["lux;VarT" ?eid] A1]] ["lux;AppT" [["lux;VarT" ?aid] A2]]] @@ -654,13 +666,13 @@ (matchv ::M/objects [((|do [F1 (deref ?eid)] (fn [state] (matchv ::M/objects [((|do [F2 (deref ?aid)] - (check* fixpoints (&/V "lux;AppT" (&/T F1 A1)) (&/V "lux;AppT" (&/T F2 A2)))) + (check* class-loader fixpoints (&/V "lux;AppT" (&/T F1 A1)) (&/V "lux;AppT" (&/T F2 A2)))) state)] [["lux;Right" [state* output]]] (return* state* output) [["lux;Left" _]] - ((check* fixpoints (&/V "lux;AppT" (&/T F1 A1)) actual) + ((check* class-loader fixpoints (&/V "lux;AppT" (&/T F1 A1)) actual) state)))) state)] [["lux;Right" [state* output]]] @@ -668,62 +680,62 @@ [["lux;Left" _]] (matchv ::M/objects [((|do [F2 (deref ?aid)] - (check* fixpoints expected (&/V "lux;AppT" (&/T F2 A2)))) + (check* class-loader fixpoints expected (&/V "lux;AppT" (&/T F2 A2)))) state)] [["lux;Right" [state* output]]] (return* state* output) [["lux;Left" _]] - ((|do [[fixpoints* _] (check* fixpoints (&/V "lux;VarT" ?eid) (&/V "lux;VarT" ?aid)) - [fixpoints** _] (check* fixpoints* A1 A2)] + ((|do [[fixpoints* _] (check* class-loader fixpoints (&/V "lux;VarT" ?eid) (&/V "lux;VarT" ?aid)) + [fixpoints** _] (check* class-loader fixpoints* A1 A2)] (return (&/T fixpoints** nil))) state)))) - ;; (|do [_ (check* fixpoints (&/V "lux;VarT" ?eid) (&/V "lux;VarT" ?aid)) - ;; _ (check* fixpoints A1 A2)] + ;; (|do [_ (check* class-loader fixpoints (&/V "lux;VarT" ?eid) (&/V "lux;VarT" ?aid)) + ;; _ (check* class-loader fixpoints A1 A2)] ;; (return (&/T fixpoints nil))) [["lux;AppT" [["lux;VarT" ?id] A1]] ["lux;AppT" [F2 A2]]] (fn [state] (matchv ::M/objects [((|do [F1 (deref ?id)] - (check* fixpoints (&/V "lux;AppT" (&/T F1 A1)) actual)) + (check* class-loader fixpoints (&/V "lux;AppT" (&/T F1 A1)) actual)) state)] [["lux;Right" [state* output]]] (return* state* output) [["lux;Left" _]] - ((|do [[fixpoints* _] (check* fixpoints (&/V "lux;VarT" ?id) F2) + ((|do [[fixpoints* _] (check* class-loader fixpoints (&/V "lux;VarT" ?id) F2) e* (apply-type F2 A1) a* (apply-type F2 A2) - [fixpoints** _] (check* fixpoints* e* a*)] + [fixpoints** _] (check* class-loader fixpoints* e* a*)] (return (&/T fixpoints** nil))) state))) ;; [["lux;AppT" [["lux;VarT" ?id] A1]] ["lux;AppT" [F2 A2]]] - ;; (|do [[fixpoints* _] (check* fixpoints (&/V "lux;VarT" ?id) F2) + ;; (|do [[fixpoints* _] (check* class-loader fixpoints (&/V "lux;VarT" ?id) F2) ;; e* (apply-type F2 A1) ;; a* (apply-type F2 A2) - ;; [fixpoints** _] (check* fixpoints* e* a*)] + ;; [fixpoints** _] (check* class-loader fixpoints* e* a*)] ;; (return (&/T fixpoints** nil))) [["lux;AppT" [F1 A1]] ["lux;AppT" [["lux;VarT" ?id] A2]]] (fn [state] (matchv ::M/objects [((|do [F2 (deref ?id)] - (check* fixpoints expected (&/V "lux;AppT" (&/T F2 A2)))) + (check* class-loader fixpoints expected (&/V "lux;AppT" (&/T F2 A2)))) state)] [["lux;Right" [state* output]]] (return* state* output) [["lux;Left" _]] - ((|do [[fixpoints* _] (check* fixpoints F1 (&/V "lux;VarT" ?id)) + ((|do [[fixpoints* _] (check* class-loader fixpoints F1 (&/V "lux;VarT" ?id)) e* (apply-type F1 A1) a* (apply-type F1 A2) - [fixpoints** _] (check* fixpoints* e* a*)] + [fixpoints** _] (check* class-loader fixpoints* e* a*)] (return (&/T fixpoints** nil))) state))) ;; [["lux;AppT" [F1 A1]] ["lux;AppT" [["lux;VarT" ?id] A2]]] - ;; (|do [[fixpoints* _] (check* fixpoints F1 (&/V "lux;VarT" ?id)) + ;; (|do [[fixpoints* _] (check* class-loader fixpoints F1 (&/V "lux;VarT" ?id)) ;; e* (apply-type F1 A1) ;; a* (apply-type F1 A2) - ;; [fixpoints** _] (check* fixpoints* e* a*)] + ;; [fixpoints** _] (check* class-loader fixpoints* e* a*)] ;; (return (&/T fixpoints** nil))) [["lux;AppT" [F A]] _] @@ -745,85 +757,44 @@ [["lux;None" _]] (|do [expected* (apply-type F A)] - (check* (fp-put fp-pair true fixpoints) expected* actual)))) + (check* class-loader (fp-put fp-pair true fixpoints) expected* actual)))) [_ ["lux;AppT" [F A]]] (|do [actual* (apply-type F A)] - (check* fixpoints expected actual*)) + (check* class-loader fixpoints expected actual*)) [["lux;AllT" _] _] (with-var (fn [$arg] (|do [expected* (apply-type expected $arg)] - (check* fixpoints expected* actual)))) + (check* class-loader fixpoints expected* actual)))) [_ ["lux;AllT" _]] (with-var (fn [$arg] (|do [actual* (apply-type actual $arg)] - (check* fixpoints expected actual*)))) - - [["lux;DataT" "boolean"] ["lux;DataT" "java.lang.Boolean"]] - (return (&/T fixpoints nil)) - - [["lux;DataT" "byte"] ["lux;DataT" "java.lang.Byte"]] - (return (&/T fixpoints nil)) - - [["lux;DataT" "short"] ["lux;DataT" "java.lang.Short"]] - (return (&/T fixpoints nil)) - - [["lux;DataT" "int"] ["lux;DataT" "java.lang.Integer"]] - (return (&/T fixpoints nil)) - - [["lux;DataT" "long"] ["lux;DataT" "java.lang.Long"]] - (return (&/T fixpoints nil)) - - [["lux;DataT" "float"] ["lux;DataT" "java.lang.Float"]] - (return (&/T fixpoints nil)) - - [["lux;DataT" "double"] ["lux;DataT" "java.lang.Double"]] - (return (&/T fixpoints nil)) - - [["lux;DataT" "char"] ["lux;DataT" "java.lang.Character"]] - (return (&/T fixpoints nil)) + (check* class-loader fixpoints expected actual*)))) - [["lux;DataT" "java.lang.Boolean"] ["lux;DataT" "boolean"]] - (return (&/T fixpoints nil)) - - [["lux;DataT" "java.lang.Byte"] ["lux;DataT" "byte"]] - (return (&/T fixpoints nil)) - - [["lux;DataT" "java.lang.Short"] ["lux;DataT" "short"]] - (return (&/T fixpoints nil)) - - [["lux;DataT" "java.lang.Integer"] ["lux;DataT" "int"]] - (return (&/T fixpoints nil)) - - [["lux;DataT" "java.lang.Long"] ["lux;DataT" "long"]] - (return (&/T fixpoints nil)) - - [["lux;DataT" "java.lang.Float"] ["lux;DataT" "float"]] - (return (&/T fixpoints nil)) - - [["lux;DataT" "java.lang.Double"] ["lux;DataT" "double"]] - (return (&/T fixpoints nil)) - - [["lux;DataT" "java.lang.Character"] ["lux;DataT" "char"]] - (return (&/T fixpoints nil)) + [["lux;DataT" e!name] ["lux;DataT" "null"]] + (if (contains? primitive-types e!name) + (fail (str "[Type Error] Can't use \"null\" with primitive types.")) + (return (&/T fixpoints nil))) [["lux;DataT" e!name] ["lux;DataT" a!name]] - (if (or (.equals ^Object e!name a!name) - (.isAssignableFrom (Class/forName e!name) (Class/forName a!name))) - (return (&/T fixpoints nil)) - (fail (str "[Type Error] Names don't match: " e!name " =/= " a!name))) + (let [e!name (as-obj e!name) + a!name (as-obj a!name)] + (if (or (.equals ^Object e!name a!name) + (.isAssignableFrom (Class/forName e!name true class-loader) (Class/forName a!name true class-loader))) + (return (&/T fixpoints nil)) + (fail (str "[Type Error] Names don't match: " e!name " =/= " a!name)))) [["lux;LambdaT" [eI eO]] ["lux;LambdaT" [aI aO]]] - (|do [[fixpoints* _] (check* fixpoints aI eI)] - (check* fixpoints* eO aO)) + (|do [[fixpoints* _] (check* class-loader fixpoints aI eI)] + (check* class-loader fixpoints* eO aO)) [["lux;TupleT" e!members] ["lux;TupleT" a!members]] (|do [fixpoints* (&/fold2% (fn [fp e a] - (|do [[fp* _] (check* fp e a)] + (|do [[fp* _] (check* class-loader fp e a)] (return fp*))) fixpoints e!members a!members)] @@ -834,7 +805,7 @@ (|let [[e!name e!type] e!case [a!name a!type] a!case] (if (.equals ^Object e!name a!name) - (|do [[fp* _] (check* fp e!type a!type)] + (|do [[fp* _] (check* class-loader fp e!type a!type)] (return fp*)) (fail (check-error expected actual))))) fixpoints @@ -846,7 +817,7 @@ (|let [[e!name e!type] e!slot [a!name a!type] a!slot] (if (.equals ^Object e!name a!name) - (|do [[fp* _] (check* fp e!type a!type)] + (|do [[fp* _] (check* class-loader fp e!type a!type)] (return fp*)) (fail (check-error expected actual))))) fixpoints @@ -863,7 +834,8 @@ ))) (defn check [expected actual] - (|do [_ (check* init-fixpoints expected actual)] + (|do [class-loader &/loader + _ (check* class-loader init-fixpoints expected actual)] (return nil))) (defn apply-lambda [func param] -- cgit v1.2.3