aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--src/lux/analyser.clj3
-rw-r--r--src/lux/analyser/lux.clj195
-rw-r--r--src/lux/analyser/module.clj5
-rw-r--r--src/lux/base.clj31
-rw-r--r--src/lux/compiler.clj2
-rw-r--r--src/lux/compiler/case.clj4
-rw-r--r--src/lux/compiler/lux.clj22
-rw-r--r--src/lux/lexer.clj5
-rw-r--r--src/lux/macro.clj25
-rw-r--r--src/lux/parser.clj22
-rw-r--r--src/lux/type.clj36
11 files changed, 189 insertions, 161 deletions
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 &macro]
[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 &macro]
[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 [<name> <text> <tag>]
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 [<name> <close-tag> <description> <tag>]
(defn <name> [parse]
(|do [elems (&/repeat% parse)
- token &lexer/lex]
+ token &lexer/lex]
(matchv ::M/objects [token]
[["lux;Meta" [meta [<close-token> _]]]]
(return (&/V <tag> (&/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))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-26 22:51:53 +0000