From ccf68d96c9c9e6bb6016ee8663289c3b3f6079d2 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Tue, 28 Apr 2015 01:18:39 -0400 Subject: - Fixed some errors in lux.lux. - Added the ability to export from def. - Added an optimized lambda macro. - Finished record analysis & compilation. - Fixed a bug in tuple, function & record analysis wherein AppT wasn't being performed prior to analysing the expression under analysis. - Fixed several bugs wherein "fail*" was needed but "fail" was used. - Added a case for records in base;show-ast. - Made an improvement for AllT in type;show-type. - Corrected an error in pattern-matching compilation wherein casts weren't being performed to make sure the source datum was of the necessary type for PM. - Removed the (now unnecessary) lux/macro. --- src/lux/analyser.clj | 3 +- src/lux/analyser/lux.clj | 195 ++++++++++++++++++++++++-------------------- src/lux/analyser/module.clj | 5 +- src/lux/base.clj | 31 ++++--- src/lux/compiler.clj | 2 +- src/lux/compiler/case.clj | 4 + src/lux/compiler/lux.clj | 22 ++--- src/lux/lexer.clj | 5 +- src/lux/macro.clj | 25 ------ src/lux/parser.clj | 22 +++-- src/lux/type.clj | 36 ++++++-- 11 files changed, 189 insertions(+), 161 deletions(-) delete mode 100644 src/lux/macro.clj (limited to 'src') diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj index 6976f47f0..e4511fdeb 100644 --- a/src/lux/analyser.clj +++ b/src/lux/analyser.clj @@ -6,7 +6,6 @@ [reader :as &reader] [parser :as &parser] [type :as &type] - [macro :as ¯o] [host :as &host]) (lux.analyser [base :as &&] [lux :as &&lux] @@ -61,7 +60,7 @@ (&&lux/analyse-tuple analyse exo-type ?elems) [["lux;Meta" [meta ["lux;Record" ?elems]]]] - (&&lux/analyse-record analyse ?elems) + (&&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)))) diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj index 8d7819fd3..87db5a125 100644 --- a/src/lux/analyser/lux.clj +++ b/src/lux/analyser/lux.clj @@ -5,7 +5,6 @@ (lux [base :as & :refer [|do return return* fail fail* |let |list]] [parser :as &parser] [type :as &type] - [macro :as ¯o] [host :as &host]) (lux.analyser [base :as &&] [lambda :as &&lambda] @@ -29,22 +28,22 @@ ;; (prn "^^ analyse-tuple ^^") ;; (prn 'analyse-tuple (str "[" (->> ?elems (&/|map &/show-ast) (&/|interpose " ") (&/fold str "")) "]") ;; (&type/show-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))] - (return (&/|list (&/V "Expression" (&/T (&/V "tuple" =elems) - exo-type))))) + (|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))] + (return (&/|list (&/V "Expression" (&/T (&/V "tuple" =elems) + exo-type))))) - [_] - (fail "[Analyser Error] Tuples require tuple-types."))) + [_] + (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))] - ?tag (&&/resolved-ident ident) exo-type* (matchv ::M/objects [exo-type] [["lux;VarT" ?id]] (&/try-all% (&/|list (|do [exo-type* (&type/deref ?id)] @@ -54,6 +53,7 @@ [_] (&type/actual-type exo-type)) + ?tag (&&/resolved-ident ident) ;; :let [_ (prn 'analyse-variant/exo-type* (&type/show-type exo-type*))] ] (matchv ::M/objects [exo-type*] @@ -71,24 +71,34 @@ (fail (str "[Analyser Error] Can't create a variant if the expected type is " (&type/show-type exo-type*)))))) (defn analyse-record [analyse exo-type ?elems] - (|do [=elems (&/map% (fn [kv] + (|do [exo-type* (matchv ::M/objects [exo-type] + [["lux;VarT" ?id]] + (|do [exo-type* (&type/deref ?id)] + (&type/actual-type exo-type*)) + + [_] + (&type/actual-type exo-type)) + types (matchv ::M/objects [exo-type*] + [["lux;RecordT" ?table]] + (return ?table) + + [_] + (fail "[Analyser Error] The type of a record must be a record type.")) + =slots (&/map% (fn [kv] (matchv ::M/objects [kv] - [[k v]] - (|do [=v (&&/analyse-1 analyse v)] - (return (to-array [k =v]))))) - ?elems) - =elems-types (&/map% (fn [kv] - (matchv ::M/objects [kv] - [[k v]] - (|do [module (if (= "" k) - &/get-module-name - (return k)) - =v (&&/expr-type v)] - (return (to-array [module =v]))))) - =elems) - ;; :let [_ (prn 'analyse-tuple =elems)] - ] - (return (&/|list (&/V "Expression" (&/T (&/V "lux;record" =elems) (&/V "lux;RecordT" =elems-types))))))) + [[["lux;Meta" [_ ["lux;Tag" ?ident]]] ?value]] + (|do [?tag (&&/resolved-ident ?ident) + 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))) + + [_] + (fail "[Analyser Error] Wrong syntax for records. Odd elements must be tags."))) + ?elems)] + (return (&/|list (&/V "Expression" (&/T (&/V "record" =slots) (&/V "lux;RecordT" exo-type))))))) (defn ^:private show-frame [frame] (str "{{" (->> frame (&/get$ &/$LOCALS) (&/get$ &/$MAPPINGS) @@ -124,7 +134,7 @@ _ (if (and (= &type/Type endo-type) (= &type/Type exo-type)) (do ;; (println "OH YEAH" (if (= "" ?module) module-name ?module) ;; ?name) - (return nil)) + (return nil)) (&type/check exo-type endo-type)) ;; :let [_ (println "Type-checked:" exo-type endo-type)] ] @@ -136,32 +146,32 @@ [["lux;Cons" [?genv ["lux;Nil" _]]]] (if-let [global (->> ?genv (&/get$ &/$LOCALS) (&/get$ &/$MAPPINGS) (&/|get local-ident))] (do ;; (prn 'GOT_GLOBAL local-ident) - (matchv ::M/objects [global] - [["Expression" [["global" [?module* ?name*]] _]]] - (&/run-state (|do [$def (&&module/find-def ?module* ?name*) - ;; :let [_ (println "Found def:" ?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" ?module* ?name*) - (return nil)) - (&type/check exo-type endo-type)) - ;; :let [_ (println "Type-checked:" exo-type endo-type)] - ] - (return (&/|list (&/V "Expression" (&/T (&/V "global" (&/T ?module* ?name*)) - endo-type))))) - state) - - [_] - (fail* "[Analyser Error] Can't have anything other than a global def in the global environment."))) + (matchv ::M/objects [global] + [["Expression" [["global" [?module* ?name*]] _]]] + (&/run-state (|do [$def (&&module/find-def ?module* ?name*) + ;; :let [_ (println "Found def:" ?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" ?module* ?name*) + (return nil)) + (&type/check exo-type endo-type)) + ;; :let [_ (println "Type-checked:" exo-type endo-type)] + ] + (return (&/|list (&/V "Expression" (&/T (&/V "global" (&/T ?module* ?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 _]]] @@ -198,32 +208,32 @@ (return (&/|list =fn))) [["lux;Cons" [?arg ?args*]]] - (do ;; (prn 'analyse-apply*/=fn (&type/show-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 (&/V "Expression" (&/T ?fun-expr type*)) ?args)] - (matchv ::M/objects [output] - [["lux;Cons" [["Expression" [?expr* ?type*]] ["lux;Nil" _]]]] - (|do [type** (&type/clean $var ?type*)] - (return (&/|list (&/V "Expression" (&/T ?expr* type**))))) - - [_] - (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)] - (analyse-apply* analyse exo-type (&/V "Expression" (&/T (&/V "apply" (&/T =fn =arg)) - ?output-t)) - ?args*)) - - [_] - (fail (str "[Analyser Error] Can't apply a non-function: " (&type/show-type ?fun-type))))) + (|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 (&/V "Expression" (&/T ?fun-expr type*)) ?args)] + (matchv ::M/objects [output] + [["lux;Cons" [["Expression" [?expr* ?type*]] ["lux;Nil" _]]]] + (|do [type** (&type/clean $var ?type*)] + (return (&/|list (&/V "Expression" (&/T ?expr* type**))))) + + [_] + (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)] + (analyse-apply* analyse exo-type (&/V "Expression" (&/T (&/V "apply" (&/T =fn =arg)) + ?output-t)) + ?args*)) + + [_] + (fail (str "[Analyser Error] Can't apply a non-function: " (&type/show-type ?fun-type*))))) ))) (defn analyse-apply [analyse exo-type =fn ?args] @@ -279,12 +289,16 @@ (return (&/V "Expression" (&/T (&/V "lambda" (&/T =scope =captured =body)) exo-type)))) [_] - (fail (str "[Analyser Error] Functions require function types: " (&type/show-type exo-type))))) + (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" _]] + [["lux;AllT" [_env _self _arg _body]]] (&type/with-var (fn [$var] (|do [exo-type* (&type/apply-type exo-type $var) @@ -294,18 +308,20 @@ (|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 (&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 output))))))) [_] - (analyse-lambda* analyse exo-type ?self ?arg ?body))) + (|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/CODE ?name (&/show-ast ?value)) (|do [module-name &/get-module-name ? (&&module/defined? module-name ?name)] (if ? @@ -316,8 +332,9 @@ ;; :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)) - ;; _ (println) + :let [_ (prn 'analyse-def/TYPE ?name ;; (&type/show-type =value-type) + ) + _ (println) def-data (cond (&type/type= &type/Macro =value-type) (&/V "lux;MacroD" (&/V "lux;None" nil)) diff --git a/src/lux/analyser/module.clj b/src/lux/analyser/module.clj index 944e98580..ac5968026 100644 --- a/src/lux/analyser/module.clj +++ b/src/lux/analyser/module.clj @@ -27,10 +27,11 @@ nil) [_] - (fail "[Analyser Error] Can't create a new global definition outside of a global environment.")))) + (fail* "[Analyser Error] Can't create a new global definition outside of a global environment.")))) (defn exists? [name] (fn [state] + ;; (prn `exists? name (->> state (&/get$ &/$MODULES) (&/|contains? name))) (return* state (->> state (&/get$ &/$MODULES) (&/|contains? name))))) @@ -38,7 +39,7 @@ (fn [state] (if-let [real-name (->> state (&/get$ &/$MODULE-ALIASES) (&/|get name))] (return* state real-name) - (fail (str "Unknown alias: " name))))) + (fail* (str "Unknown alias: " name))))) (defn find-def [module name] (fn [state] diff --git a/src/lux/base.clj b/src/lux/base.clj index 6a4d93007..4f3e6f028 100644 --- a/src/lux/base.clj +++ b/src/lux/base.clj @@ -429,20 +429,6 @@ [_] (return nil))) -(defn repeat% [monad] - (fn [state] - (matchv ::M/objects [(monad state)] - [["lux;Right" [?state ?head]]] - (do ;; (prn 'repeat-m/?state ?state) - (matchv ::M/objects [((repeat% monad) ?state)] - [["lux;Right" [?state* ?tail]]] - (do ;; (prn 'repeat-m/?state* ?state*) - (return* ?state* (|cons ?head ?tail))))) - - [["lux;Left" ?message]] - (do ;; (println "Failed at last:" ?message) - (return* state (V "lux;Nil" nil)))))) - (def source-consumed? (fn [state] (matchv ::M/objects [(get$ $SOURCE state)] @@ -475,6 +461,12 @@ ))) )) +(defn repeat% [monad] + (try-all% (|list (|do [head monad + tail (repeat% monad)] + (return (|cons head tail))) + (return (|list))))) + (defn exhaust% [step] (fn [state] (matchv ::M/objects [(step state)] @@ -485,7 +477,7 @@ ((|do [? source-consumed?] (if ? (return nil) - (fail* msg))) + (fail msg))) state) ;; (if (= "[Reader Error] EOF" msg) ;; ((|do [? source-consumed? @@ -599,7 +591,7 @@ (try (let [top (|head (get$ $ENVS state))] (return* state top)) (catch Throwable _ - (fail "No local environment."))))) + (fail* "No local environment."))))) (defn ->seq [xs] (matchv ::M/objects [xs] @@ -705,6 +697,13 @@ [["lux;Meta" [_ ["lux;Tuple" ?elems]]]] (str "[" (->> ?elems (|map show-ast) (|interpose " ") (fold str "")) "]") + [["lux;Meta" [_ ["lux;Record" ?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]]]] (str "(" (->> ?elems (|map show-ast) (|interpose " ") (fold str "")) ")") )) diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj index 59e3d9c36..6a9cc58c6 100644 --- a/src/lux/compiler.clj +++ b/src/lux/compiler.clj @@ -367,7 +367,7 @@ (defn ^:private compile-module [name] (fn [state] (if (->> state (&/get$ &/$MODULES) (&/|contains? name)) - (fail "[Compiler Error] Can't redefine a module!") + (fail* "[Compiler Error] Can't redefine a module!") (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))] diff --git a/src/lux/compiler/case.clj b/src/lux/compiler/case.clj index d6a259476..2f051903b 100644 --- a/src/lux/compiler/case.clj +++ b/src/lux/compiler/case.clj @@ -29,6 +29,7 @@ [["BoolTestAC" ?value]] (doto writer + (.visitTypeInsn Opcodes/CHECKCAST (&host/->class "java.lang.Boolean")) (.visitInsn Opcodes/DUP) (.visitMethodInsn Opcodes/INVOKEVIRTUAL (&host/->class "java.lang.Boolean") "booleanValue" "()Z") (.visitLdcInsn ?value) @@ -38,6 +39,7 @@ [["IntTestAC" ?value]] (doto writer + (.visitTypeInsn Opcodes/CHECKCAST (&host/->class "java.lang.Long")) (.visitInsn Opcodes/DUP) (.visitMethodInsn Opcodes/INVOKEVIRTUAL (&host/->class "java.lang.Long") "longValue" "()J") (.visitLdcInsn ?value) @@ -48,6 +50,7 @@ [["RealTestAC" ?value]] (doto writer + (.visitTypeInsn Opcodes/CHECKCAST (&host/->class "java.lang.Double")) (.visitInsn Opcodes/DUP) (.visitMethodInsn Opcodes/INVOKEVIRTUAL (&host/->class "java.lang.Double") "doubleValue" "()D") (.visitLdcInsn ?value) @@ -58,6 +61,7 @@ [["CharTestAC" ?value]] (doto writer + (.visitTypeInsn Opcodes/CHECKCAST (&host/->class "java.lang.Character")) (.visitInsn Opcodes/DUP) (.visitMethodInsn Opcodes/INVOKEVIRTUAL (&host/->class "java.lang.Character") "charValue" "()C") (.visitLdcInsn ?value) diff --git a/src/lux/compiler/lux.clj b/src/lux/compiler/lux.clj index f9a56e74e..5ceeca1bc 100644 --- a/src/lux/compiler/lux.clj +++ b/src/lux/compiler/lux.clj @@ -68,26 +68,26 @@ (return nil))) (defn compile-record [compile *type* ?elems] + ;; (prn 'compile-record (str "{{" (->> ?elems &/|keys (&/|interpose " ") (&/fold str "")) "}}")) (|do [*writer* &/get-writer - :let [num-elems (&/|length ?elems) + :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 (* 2 num-elems))) + (.visitLdcInsn (int num-elems)) (.visitTypeInsn Opcodes/ANEWARRAY (&host/->class "java.lang.Object")))] _ (&/map% (fn [idx+kv] (|let [[idx [k v]] idx+kv] - (|do [:let [idx* (* 2 idx) - _ (doto *writer* - (.visitInsn Opcodes/DUP) - (.visitLdcInsn (int idx*)) - (.visitLdcInsn k) - (.visitInsn Opcodes/AASTORE))] - :let [_ (doto *writer* + (|do [:let [_ (doto *writer* (.visitInsn Opcodes/DUP) - (.visitLdcInsn (int (inc idx*))))] + (.visitLdcInsn (int idx)))] ret (compile v) :let [_ (.visitInsn *writer* Opcodes/AASTORE)]] (return ret)))) - (&/zip2 (&/|range num-elems) ?elems))] + (&/zip2 (&/|range num-elems) elems*))] (return nil))) (defn compile-variant [compile *type* ?tag ?value] diff --git a/src/lux/lexer.clj b/src/lux/lexer.clj index ca63576ef..38fe77264 100644 --- a/src/lux/lexer.clj +++ b/src/lux/lexer.clj @@ -102,7 +102,10 @@ (def ^:private lex-tag (|do [[_ [meta _]] (&reader/read-text "#") - [_ [_ ident]] lex-ident] + ;; :let [_ (prn 'lex-tag)] + [_ [_ ident]] lex-ident + ;; :let [_ (prn 'lex-tag [(aget ident 0) (aget ident 1)])] + ] (return (&/V "lux;Meta" (&/T meta (&/V "Tag" ident)))))) (do-template [ ] diff --git a/src/lux/macro.clj b/src/lux/macro.clj deleted file mode 100644 index d5fee9eab..000000000 --- a/src/lux/macro.clj +++ /dev/null @@ -1,25 +0,0 @@ -(ns lux.macro - (:require [clojure.core.match :as M :refer [match matchv]] - clojure.core.match.array - (lux [base :as & :refer [fail* return*]]))) - -;; [Resources] -(defn expand [loader macro-class tokens] - (fn [state] - ;; (prn 'expand macro-class tokens state) - (let [expansion (-> (.loadClass loader macro-class) - (.getField "_datum") - (.get nil) - (.apply tokens) - (.apply state))] - ;; (if (or (= "lux$_BQUOTE_" macro-class) - ;; (= "lux$if" macro-class)) - ;; (matchv ::M/objects [expansion] - ;; [["lux;Right" [state* nodes]]] - ;; (doseq [node (&/->seq nodes)] - ;; (prn 'expansion macro-class (&/show-ast node))) - - ;; [_] - ;; nil)) - expansion) - )) diff --git a/src/lux/parser.clj b/src/lux/parser.clj index a21dd5ba6..85074be7d 100644 --- a/src/lux/parser.clj +++ b/src/lux/parser.clj @@ -9,7 +9,7 @@ (do-template [ ] (defn [parse] (|do [elems (&/repeat% parse) - token &lexer/lex] + token &lexer/lex] (matchv ::M/objects [token] [["lux;Meta" [meta [ _]]]] (return (&/V (&/fold &/|++ (&/|list) elems))) @@ -22,13 +22,19 @@ ) (defn ^:private parse-record [parse] - (|do [elems* (&/repeat% parse) - token &lexer/lex - :let [elems (&/fold &/|++ (&/|list) elems*)]] + (|do [;; :let [_ (prn 'parse-record 0)] + elems* (&/repeat% parse) + ;; :let [_ (prn 'parse-record 1)] + token &lexer/lex + ;; :let [_ (prn 'parse-record 2)] + :let [elems (&/fold &/|++ (&/|list) elems*)] + ;; :let [_ (prn 'parse-record 3)] + ] (matchv ::M/objects [token] [["lux;Meta" [meta ["Close_Brace" _]]]] (if (even? (&/|length elems)) - (return (&/V "lux;Record" (&/|as-pairs elems))) + (do ;; (prn 'PARSED_RECORD (&/|length elems)) + (return (&/V "lux;Record" (&/|as-pairs elems)))) (fail (str "[Parser Error] Records must have an even number of elements."))) [_] @@ -37,9 +43,9 @@ ;; [Interface] (def parse (|do [token &lexer/lex - ;; :let [_ (prn 'parse/token token)] - ;; :let [_ (prn 'parse (aget token 0))] - ] + ;; :let [_ (prn 'parse/token token)] + ;; :let [_ (prn 'parse (aget token 0))] + ] (matchv ::M/objects [token] [["lux;Meta" [meta ["White_Space" _]]]] (return (&/|list)) diff --git a/src/lux/type.clj b/src/lux/type.clj index dcaf0bf5e..73b244569 100644 --- a/src/lux/type.clj +++ b/src/lux/type.clj @@ -177,10 +177,11 @@ (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))) + (do ;; (prn 'set-var id (show-type type)) + (return* (&/update$ &/$TYPES (fn [ts] (&/update$ &/$MAPPINGS #(&/|put id (&/V "lux;Some" type) %) + ts)) + state) + nil)))) (fail* (str "[Type Error] Unknown type-var: " id))))) ;; [Exports] @@ -309,7 +310,7 @@ (&/|map (fn [kv] (matchv ::M/objects [kv] [[k v]] - (str "(#" k " " (show-type v) ")")))) + (str "#" k " " (show-type v))))) (&/|interpose " ") (&/fold str "")) ")") @@ -326,7 +327,15 @@ (str "(" (show-type ?lambda) " " (show-type ?param) ")") [["lux;AllT" [?env ?name ?arg ?body]]] - (str "(All " ?name " " ?arg " " (show-type ?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) ")")) )) (defn type= [x y] @@ -524,6 +533,21 @@ (|do [bound (deref ?id)] (check* fixpoints expected bound)))) + ;; [["lux;AppT" [F1 A1]] ["lux;AppT" [F2 A2]]] + ;; (|do [_ (check* fixpoints F1 F2) + ;; _ (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" [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" [F A]] _] (let [fp-pair (&/T expected actual) ;; _ (prn 'LEFT_APP (&/|length fixpoints)) -- cgit v1.2.3