From 3cbe80d419ad328badc75732984297eaac116f5f Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Thu, 23 Apr 2015 00:24:16 -0400 Subject: - Removed analyse-2, as it was redundant. - Fixed several bugs within lux.lux. - Renamed "check'" to ":'" and "coerce" to ":!". --- src/lux/analyser.clj | 6 ++--- src/lux/analyser/base.clj | 12 --------- src/lux/analyser/case.clj | 4 +-- src/lux/analyser/host.clj | 11 ++++---- src/lux/analyser/lambda.clj | 10 ++++---- src/lux/analyser/lux.clj | 42 ++++++++++++++++++------------ src/lux/compiler/case.clj | 2 +- src/lux/compiler/lambda.clj | 62 ++++++++++++++++++++++++++++++++------------- 8 files changed, 87 insertions(+), 62 deletions(-) (limited to 'src') diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj index 181d76b5b..9097168e2 100644 --- a/src/lux/analyser.clj +++ b/src/lux/analyser.clj @@ -101,13 +101,13 @@ ["lux;Nil" _]]]]]]]]] (&&lux/analyse-import analyse ?path) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "check'"]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ":"]]]] ["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" ["" "coerce'"]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ":!"]]]] ["lux;Cons" [?type ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]]]] @@ -435,7 +435,7 @@ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [?fn ?args]]]]]] (fn [state] - ;; (prn '(&/show-ast ?fn) (&/show-ast ?fn)) + ;; (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*) diff --git a/src/lux/analyser/base.clj b/src/lux/analyser/base.clj index 4b23f9460..1653a4fa1 100644 --- a/src/lux/analyser/base.clj +++ b/src/lux/analyser/base.clj @@ -26,18 +26,6 @@ [_] (fail "[Analyser Error] Can't expand to other than 1 element."))))) -(defn analyse-2 [analyse exo-type1 el1 exo-type2 el2] - (|do [output1 (analyse exo-type1 el1) - output2 (analyse exo-type2 el2)] - (do ;; (prn 'analyse-2 (aget output 0)) - (matchv ::M/objects [output1 output2] - [["lux;Cons" [x ["lux;Nil" _]]] - ["lux;Cons" [y ["lux;Nil" _]]]] - (return (&/T x y)) - - [_ _] - (fail "[Analyser Error] Can't expand to other than 2 elements."))))) - (defn resolved-ident [ident] (|let [[?module ?name] ident] (|do [module* (if (= "" ?module) diff --git a/src/lux/analyser/case.clj b/src/lux/analyser/case.clj index a9424b50d..e1f5c4c84 100644 --- a/src/lux/analyser/case.clj +++ b/src/lux/analyser/case.clj @@ -203,7 +203,7 @@ )))) (defn ^:private check-totality [value-type struct] - (prn 'check-totality (aget value-type 0) (aget struct 0) (&type/show-type value-type)) + ;; (prn 'check-totality (aget value-type 0) (aget struct 0) (&type/show-type value-type)) (matchv ::M/objects [struct] [["BoolTotal" [?total _]]] (return ?total) @@ -279,7 +279,7 @@ (analyse-branch analyse exo-type value-type pattern body patterns))) (&/|list) branches) - :let [_ (prn 'PRE_MERGE_TOTALS)] + ;; :let [_ (prn 'PRE_MERGE_TOTALS)] struct (&/fold% merge-total (&/V "DefaultTotal" false) patterns) ? (check-totality value-type struct)] (if ? diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj index b282f806e..299471ee8 100644 --- a/src/lux/analyser/host.clj +++ b/src/lux/analyser/host.clj @@ -23,7 +23,8 @@ (let [input-type (&/V "lux;DataT" ) output-type (&/V "lux;DataT" )] (defn [analyse ?x ?y] - (|do [[=x =y] (&&/analyse-2 analyse input-type ?x input-type ?y)] + (|do [=x (&&/analyse-1 analyse input-type ?x) + =y (&&/analyse-1 analyse input-type ?y)] (return (&/|list (&/V "Expression" (&/T (&/V (&/T =x =y)) output-type))))))) analyse-jvm-iadd "jvm-iadd" "java.lang.Integer" "java.lang.Integer" @@ -136,11 +137,9 @@ (&/V "lux;Nil" nil))))))))) (defn analyse-jvm-aastore [analyse ?array ?idx ?elem] - (|do [=array+=elem (&&/analyse-2 analyse ?array ?elem) - :let [[=array =elem] (matchv ::M/objects [=array+=elem] - [[=array =elem]] - [=array =elem])] - =array-type (&&/expr-type =array)] + (|do [=array (&&/analyse-1 analyse &type/Nothing ?array) + =elem (&&/analyse-1 analyse &type/Nothing ?elem) + =array-type (&&/expr-type =array)] (return (&/|list (&/V "Expression" (&/T (&/V "jvm-aastore" (&/T =array ?idx =elem)) =array-type)))))) (defn analyse-jvm-aaload [analyse ?array ?idx] diff --git a/src/lux/analyser/lambda.clj b/src/lux/analyser/lambda.clj index 553c4ea9b..da9d6b044 100644 --- a/src/lux/analyser/lambda.clj +++ b/src/lux/analyser/lambda.clj @@ -21,11 +21,11 @@ (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$ "lux;closure") (&/get$ "lux;counter"))) + ;; (prn 'close-over + ;; (&host/location scope) + ;; (&host/location (&/|list ident)) + ;; register + ;; (->> frame (&/get$ "lux;closure") (&/get$ "lux;counter"))) (matchv ::M/objects [register] [["Expression" [_ register-type]]] (|let [register* (&/V "Expression" (&/T (&/V "captured" (&/T scope diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj index f1c7a6035..68d612db6 100644 --- a/src/lux/analyser/lux.clj +++ b/src/lux/analyser/lux.clj @@ -16,7 +16,7 @@ (defn ^:private analyse-1+ [analyse ?token] (&type/with-var (fn [$var] - (prn 'analyse-1+ (aget $var 1) (&/show-ast ?token)) + ;; (prn 'analyse-1+ (aget $var 1) (&/show-ast ?token)) (|do [=expr (&&/analyse-1 analyse $var ?token)] (matchv ::M/objects [=expr] [["Expression" [?item ?type]]] @@ -125,7 +125,7 @@ ;; _ (&type/check exo-type btype)] ;; (return (&/|list global))) state) - (do (prn (str "((" (->> stack (&/|map show-frame) &/->seq (interpose " ") (reduce str "")) "))")) + (do ;; (prn (str "((" (->> stack (&/|map show-frame) &/->seq (interpose " ") (reduce str "")) "))")) (fail* (str "[Analyser Error] Unrecognized identifier: " local-ident)))) [["lux;Cons" [top-outer _]]] @@ -150,7 +150,8 @@ )) (defn ^:private analyse-apply* [analyse exo-type =fn ?args] - (prn 'analyse-apply*/exo-type (&type/show-type exo-type)) + ;; (prn 'analyse-apply* (&/->seq (&/|map &/show-ast ?args))) + ;; (prn 'analyse-apply*/exo-type (&type/show-type exo-type)) (matchv ::M/objects [=fn] [["Statement" _]] (fail "[Analyser Error] Can't apply a statement!") @@ -162,7 +163,7 @@ (return (&/|list =fn))) [["lux;Cons" [?arg ?args*]]] - (do (prn 'analyse-apply*/=fn (&type/show-type ?fun-type)) + (do ;; (prn 'analyse-apply*/=fn (&type/show-type ?fun-type)) (matchv ::M/objects [?fun-type] [["lux;AllT" _]] (&type/with-var @@ -175,13 +176,16 @@ (return (&/|list (&/V "Expression" (&/T ?expr* type**))))) [_] - (do (prn 'analyse-apply*/output (aget output 0)) - (assert false)))))) + (assert false (prn-str 'analyse-apply*/output (aget output 0))))))) [["lux;LambdaT" [?input-t ?output-t]]] + ;; (|do [=arg (&&/analyse-1 analyse ?input-t ?arg)] + ;; (return (&/|list (&/V "Expression" (&/T (&/V "apply" (&/T =fn =arg)) + ;; ?output-t))))) (|do [=arg (&&/analyse-1 analyse ?input-t ?arg)] - (return (&/|list (&/V "Expression" (&/T (&/V "apply" (&/T =fn =arg)) - ?output-t))))) + (analyse-apply* analyse exo-type (&/V "Expression" (&/T (&/V "apply" (&/T =fn =arg)) + ?output-t)) + ?args*)) [_] (fail "[Analyser Error] Can't apply a non-function."))) @@ -199,7 +203,10 @@ (if macro? (let [macro-class (&host/location (&/|list ?module ?name))] (|do [macro-expansion (¯o/expand loader macro-class ?args) - :let [_ (prn 'EXPANDING (&type/show-type exo-type))] + ;; :let [_ (when (and (= "lux" ?module) + ;; (= "`" ?name)) + ;; (prn 'macro-expansion (->> macro-expansion (&/|map &/show-ast) (&/|interpose " ") (&/fold str ""))))] + ;; :let [_ (prn 'EXPANDING (&type/show-type exo-type))] output (&/flat-map% (partial analyse exo-type) macro-expansion)] (return output))) (analyse-apply* analyse exo-type =fn ?args))) @@ -212,15 +219,16 @@ )) (defn analyse-case [analyse exo-type ?value ?branches] - (prn 'analyse-case 'exo-type (&type/show-type exo-type) (&/show-ast ?value)) + ;; (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))] + ;; :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)]] + ;; :let [_ (prn 'analyse-case/GOT_MATCH)] + ] (return (&/|list (&/V "Expression" (&/T (&/V "case" (&/T =value =match)) exo-type)))))) @@ -237,7 +245,7 @@ (fail (str "[Analyser Error] Functions require function types: " (&type/show-type exo-type))))) (defn analyse-lambda** [analyse exo-type ?self ?arg ?body] - (prn 'analyse-lambda**/&& (aget exo-type 0)) + ;; (prn 'analyse-lambda**/&& (aget exo-type 0)) (matchv ::M/objects [exo-type] [["lux;AllT" _]] (&type/with-var @@ -270,7 +278,8 @@ ;; :let [_ (prn 'analyse-def/_1)] =value-type (&&/expr-type =value) ;; :let [_ (prn 'analyse-def/_2)] - :let [_ (prn 'analyse-def/TYPE ?name (&type/show-type =value-type))] + :let [_ (prn 'analyse-def/TYPE ?name (&type/show-type =value-type)) + _ (println)] _ (&&def/define module-name ?name =value-type) ;; :let [_ (prn 'analyse-def/_3)] ] @@ -278,9 +287,10 @@ (defn analyse-declare-macro [ident] (|do [current-module &/get-module-name - :let [_ (prn 'analyse-declare-macro/current-module current-module)] + ;; :let [_ (prn 'analyse-declare-macro/current-module current-module)] [?module ?name] (&&/resolved-ident* ident) - :let [_ (prn 'analyse-declare-macro '[?module ?name] [?module ?name])]] + ;; :let [_ (prn 'analyse-declare-macro '[?module ?name] [?module ?name])] + ] (if (= ?module current-module) (|do [_ (&&def/declare-macro ?module ?name)] (return (&/|list))) diff --git a/src/lux/compiler/case.clj b/src/lux/compiler/case.clj index 8f737af20..d6a259476 100644 --- a/src/lux/compiler/case.clj +++ b/src/lux/compiler/case.clj @@ -142,7 +142,7 @@ (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)) + ;; _ (prn '?body+?match (aget ?body+?match 0)) $else (new Label)]]))) (.visitInsn Opcodes/POP) (.visitTypeInsn Opcodes/NEW ex-class) diff --git a/src/lux/compiler/lambda.clj b/src/lux/compiler/lambda.clj index 332f9804b..3c3774e7e 100644 --- a/src/lux/compiler/lambda.clj +++ b/src/lux/compiler/lambda.clj @@ -40,7 +40,8 @@ (.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)]) + ;; _ (prn 'add-lambda- class-name ?captured-id) + ]) (matchv ::M/objects [?name+?captured] [[?name ["Expression" [["captured" [_ ?captured-id ?source]] _]]]]) (doseq [?name+?captured (&/->seq env)]))) @@ -78,23 +79,50 @@ (return ret)))) (defn ^:private instance-closure [compile lambda-class closed-over init-signature] - ;; (prn 'instance-closure lambda-class closed-over init-signature) + ;; (prn 'instance-closure lambda-class (&/|length closed-over) init-signature) (|do [*writer* &/get-writer - :let [_ (doto *writer* - (.visitTypeInsn Opcodes/NEW lambda-class) - (.visitInsn Opcodes/DUP))] - _ (->> closed-over - &/->seq - (sort #(matchv ::M/objects [(&/|second %1) (&/|second %2)] - [["Expression" [["captured" [_ ?cid1 _]] _]] - ["Expression" [["captured" [_ ?cid2 _]] _]]] - (< ?cid1 ?cid2))) - &/->list - (&/map% (fn [?name+?captured] - (matchv ::M/objects [?name+?captured] - [[?name ["Expression" [["captured" [_ _ ?source]] _]]]] - (compile ?source))))) - :let [_ (.visitMethodInsn *writer* Opcodes/INVOKESPECIAL lambda-class "" init-signature)]] + :let [_ (doto *writer* + (.visitTypeInsn Opcodes/NEW lambda-class) + (.visitInsn Opcodes/DUP)) + ;; _ (prn 'closed-over/pre + ;; (&/->seq (&/|map #(matchv ::M/objects [(&/|second %1)] + ;; [["Expression" [["captured" [_ ?cid _]] _]]] + ;; ?cid) + ;; closed-over))) + ;; _ (prn 'closed-over/post + ;; (->> closed-over + ;; &/->seq + ;; (sort #(matchv ::M/objects [(&/|second %1) (&/|second %2)] + ;; [["Expression" [["captured" [_ ?cid1 _]] _]] + ;; ["Expression" [["captured" [_ ?cid2 _]] _]]] + ;; (< ?cid1 ?cid2))) + ;; &/->list + ;; (&/|map #(matchv ::M/objects [(&/|second %1)] + ;; [["Expression" [["captured" [_ ?cid _]] _]]] + ;; ?cid)) + ;; &/->seq)) + ] + _ (->> closed-over + &/->seq + (sort #(matchv ::M/objects [(&/|second %1) (&/|second %2)] + [["Expression" [["captured" [_ ?cid1 _]] _]] + ["Expression" [["captured" [_ ?cid2 _]] _]]] + (< ?cid1 ?cid2))) + &/->list + (&/map% (fn [?name+?captured] + (matchv ::M/objects [?name+?captured] + [[?name ["Expression" [["captured" [_ _ ?source]] _]]]] + (do ;; (prn '?source (aget ?source 1 0 0) + ;; (cond (= "captured" (aget ?source 1 0 0)) + ;; ["captured" (aget ?source 1 0 1 1)] + + ;; (= "local" (aget ?source 1 0 0)) + ;; ["local" (aget ?source 1 0 1)] + + ;; :else + ;; '???)) + (compile ?source)))))) + :let [_ (.visitMethodInsn *writer* Opcodes/INVOKESPECIAL lambda-class "" init-signature)]] (return nil))) ;; [Exports] -- cgit v1.2.3