diff options
-rw-r--r-- | source/lux.lux | 41 | ||||
-rw-r--r-- | src/lux/analyser/lux.clj | 16 | ||||
-rw-r--r-- | src/lux/base.clj | 12 | ||||
-rw-r--r-- | src/lux/compiler.clj | 3 | ||||
-rw-r--r-- | src/lux/compiler/lux.clj | 4 | ||||
-rw-r--r-- | src/lux/type.clj | 73 |
6 files changed, 109 insertions, 40 deletions
diff --git a/source/lux.lux b/source/lux.lux index 8e004913b..a385bb700 100644 --- a/source/lux.lux +++ b/source/lux.lux @@ -238,7 +238,8 @@ (#Cons [["lux;envs" (#AppT [List (#AppT [(#AppT [Env Text]) Void])])] (#Cons [["lux;types" (#AppT [(#AppT [Bindings Int]) Type])] (#Cons [["lux;host" HostState] - #Nil])])])])])]))]) + (#Cons [["lux;seed" Int] + #Nil])])])])])])]))]) Void])) (export' CompilerState) @@ -1284,7 +1285,8 @@ ## (let [[module name] ident] ## (case' state ## {#source source #modules modules #module-aliases module-aliases -## #envs envs #types types #host host} +## #envs envs #types types #host host +## #seed seed} ## (case' (:' ($' Maybe Macro) ## (do Maybe:Monad ## [bindings (get module modules) @@ -1306,7 +1308,8 @@ (let [[module name] ident] (case' state {#source source #modules modules #module-aliases module-aliases - #envs envs #types types #host host} + #envs envs #types types #host host + #seed seed} (case' (:' ($' Maybe Macro) (case' (get module modules) (#Some bindings) @@ -1335,6 +1338,32 @@ (-> ($' List ($' List a)) ($' List a))) (fold list:++ #Nil xs)) +## (def #export (macro-expand syntax state) +## (-> Syntax ($' Lux ($' List Syntax))) +## (case' syntax +## (#Meta [_ (#Form (#Cons [(#Meta [_ (#Symbol macro-name)]) args]))]) +## (do Lux:Monad +## [macro' (find-macro macro-name)] +## (case' macro' +## (#Some macro) +## (do Lux:Monad +## [expansion (macro args) +## expansion' (map% Lux:Monad macro-expand expansion)] +## (return (:' SyntaxList (join-list expansion')))) + +## #None +## (do Lux:Monad +## [parts' (map% Lux:Monad macro-expand (list& ($symbol macro-name) args))] +## (return (:' Syntax (list ($form (join-list parts')))))))) + +## (#Meta [_ (#Tuple members)]) +## (do Lux:Monad +## [members' (map% Lux:Monad macro-expand members)] +## (return (:' Syntax (list ($tuple (join-list members')))))) + +## _ +## (return (:' SyntaxList (list syntax))))) + (def #export (macro-expand syntax state) (-> Syntax ($' Lux ($' List Syntax))) (case' syntax @@ -1346,17 +1375,17 @@ (do Lux:Monad [expansion (macro args) expansion' (map% Lux:Monad macro-expand expansion)] - (return (:' SyntaxList (join-list expansion')))) + (;return (:' SyntaxList (join-list expansion')))) #None (do Lux:Monad [parts' (map% Lux:Monad macro-expand (list& ($symbol macro-name) args))] - (return (:' Syntax (list ($form (join-list parts')))))))) + (;return (:' Syntax (list ($form (join-list parts')))))))) (#Meta [_ (#Tuple members)]) (do Lux:Monad [members' (map% Lux:Monad macro-expand members)] - (return (:' Syntax (list ($tuple (join-list members')))))) + (;return (:' Syntax (list ($tuple (join-list members')))))) _ (return (:' SyntaxList (list syntax))))) diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj index 7c9b9b5f0..191a16235 100644 --- a/src/lux/analyser/lux.clj +++ b/src/lux/analyser/lux.clj @@ -320,7 +320,17 @@ (|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;BoundT" _]] + (matchv ::M/objects [output] + [["Expression" [_expr _]]] + ;; (|do [_ (&type/set-var ?id (&/V "lux;BoundT" _arg))] + ;; (return (&/V "Expression" (&/T _expr exo-type)))) + (return (&/V "Expression" (&/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))))) (matchv ::M/objects [output] [["Expression" [_expr _]]] ;; (|do [_ (&type/set-var ?id (&/V "lux;BoundT" _arg))] @@ -388,6 +398,10 @@ _ (&&module/declare-macro module-name ?name)] (return (&/|list)))) +(defn analyse-declare-macro [analyse ?name] + (|do [module-name &/get-module-name] + (return (&/|list (&/V "Statement" (&/V "declare-macro" (&/T module-name ?name))))))) + (defn analyse-import [analyse exo-type ?path] (return (&/|list))) diff --git a/src/lux/base.clj b/src/lux/base.clj index 4f3e6f028..306c09b19 100644 --- a/src/lux/base.clj +++ b/src/lux/base.clj @@ -24,8 +24,9 @@ (def $HOST 1) (def $MODULE-ALIASES 2) (def $MODULES 3) -(def $SOURCE 4) -(def $TYPES 5) +(def $SEED 4) +(def $SOURCE 5) +(def $TYPES 6) ;; [Exports] (def +name-separator+ ";") @@ -555,6 +556,8 @@ (|table) ;; "lux;modules" (|table) + ;; "lux;seed" + 0 ;; "lux;source" (V "lux;None" nil) ;; "lux;types" @@ -593,6 +596,11 @@ (catch Throwable _ (fail* "No local environment."))))) +(def gen-id + (fn [state] + (let [seed (get$ $SEED state)] + (return* (set$ $SEED (inc seed) state) seed)))) + (defn ->seq [xs] (matchv ::M/objects [xs] [["lux;Nil" _]] diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj index 6a9cc58c6..e6879f4da 100644 --- a/src/lux/compiler.clj +++ b/src/lux/compiler.clj @@ -317,6 +317,9 @@ (matchv ::M/objects [?form] [["def" [?name ?body ?def-data]]] (&&lux/compile-def compile-expression ?name ?body ?def-data) + + [["declare-macro" [?module ?name]]] + (&&lux/compile-declare-macro compile-expression ?module ?name) [["jvm-interface" [?package ?name ?methods]]] (&&host/compile-jvm-interface compile-expression ?package ?name ?methods) diff --git a/src/lux/compiler/lux.clj b/src/lux/compiler/lux.clj index 1553d3975..35a706f05 100644 --- a/src/lux/compiler/lux.clj +++ b/src/lux/compiler/lux.clj @@ -165,3 +165,7 @@ ;; :let [_ (prn 'compile-def/_2 ?name)] ] (return nil))) + +(defn compile-declare-macro [compile module name] + (|do [_ (&a-module/declare-macro module name)] + (return nil))) diff --git a/src/lux/type.clj b/src/lux/type.clj index 217a167a4..b739be3c2 100644 --- a/src/lux/type.clj +++ b/src/lux/type.clj @@ -150,7 +150,8 @@ (&/V "lux;AppT" (&/T (&/V "lux;AppT" (&/T Env Text)) $Void))))) (&/T "lux;types" (&/V "lux;AppT" (&/T (&/V "lux;AppT" (&/T Bindings Int)) Type))) - (&/T "lux;host" HostState)))) + (&/T "lux;host" HostState) + (&/T "lux;seed" Int)))) $Void))) (def Macro @@ -212,37 +213,42 @@ (declare clean*) (defn ^:private delete-var [id] - (fn [state] - (&/run-state (|do [mappings* (&/map% (fn [binding] - (|let [[?id ?type] binding] - (if (= id ?id) - (return binding) - (matchv ::M/objects [?type] - [["lux;None" _]] + (|do [? (bound? id) + _ (if ? + (return nil) + (|do [seed &/gen-id] + (set-var id (&/V "lux;BoundT" (str seed)))))] + (fn [state] + (&/run-state (|do [mappings* (&/map% (fn [binding] + (|let [[?id ?type] binding] + (if (= id ?id) (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**)))) - ) - - [_] - (|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))) + (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**)))) + ) + + [_] + (|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 @@ -749,6 +755,11 @@ (return (&/T fixpoints* nil))) (fail "[Type Error] Records don't match in size.")) + [["lux;BoundT" e!name] ["lux;BoundT" a!name]] + (if (= e!name a!name) + (return (&/T fixpoints nil)) + (check-error expected actual)) + [_ _] (fail (println-str "[Type Error] Can't type-check: " (show-type expected) (show-type actual))) )) |