diff options
-rw-r--r-- | source/lux.lux | 61 | ||||
-rw-r--r-- | src/lux/analyser/module.clj | 73 | ||||
-rw-r--r-- | src/lux/base.clj | 11 | ||||
-rw-r--r-- | src/lux/type.clj | 22 |
4 files changed, 108 insertions, 59 deletions
diff --git a/source/lux.lux b/source/lux.lux index 2a4cc8660..10abcb88a 100644 --- a/source/lux.lux +++ b/source/lux.lux @@ -244,10 +244,24 @@ #Nil])]))) (_lux_export LuxVar) +## (deftype (Module Compiler) +## (& #aliases (List (, Text Text)) +## #defs (List (, Text (, Bool (DefData' (-> (List Syntax) (StateE Compiler (List Syntax))))))))) +(_lux_def Module + (#AllT [(#Some #Nil) "lux;Module" "Compiler" + (#RecordT (#Cons [["lux;aliases" (#AppT [List (#TupleT (#Cons [Text (#Cons [Text #Nil])]))])] + (#Cons [["lux;defs" (#AppT [List (#TupleT (#Cons [Text + (#Cons [(#TupleT (#Cons [Bool (#Cons [(#AppT [DefData' (#LambdaT [SyntaxList + (#AppT [(#AppT [StateE (#BoundT "Compiler")]) + SyntaxList])])]) + #Nil])])) + #Nil])]))])] + #Nil])]))])) +(_lux_export Module) + ## (deftype #rec Compiler ## (& #source Reader -## #modules (List (, Text (List (, Text (, Bool (DefData' (-> (List Syntax) (StateE Compiler (List Syntax))))))))) -## #module-aliases (List Void) +## #modules (List (, Text (Module Compiler))) ## #envs (List (Env Text (, LuxVar Type))) ## #types (Bindings Int Type) ## #host HostState)) @@ -255,21 +269,14 @@ (#AppT [(#AllT [(#Some #Nil) "lux;Compiler" "" (#RecordT (#Cons [["lux;source" Reader] (#Cons [["lux;modules" (#AppT [List (#TupleT (#Cons [Text - (#Cons [(#AppT [List (#TupleT (#Cons [Text - (#Cons [(#TupleT (#Cons [Bool (#Cons [(#AppT [DefData' (#LambdaT [SyntaxList - (#AppT [(#AppT [StateE (#AppT [(#BoundT "lux;Compiler") - (#BoundT "")])]) - SyntaxList])])]) - #Nil])])) - #Nil])]))]) + (#Cons [(#AppT [Module (#AppT [(#BoundT "lux;Compiler") (#BoundT "")])]) #Nil])]))])] - (#Cons [["lux;module-aliases" (#AppT [List Void])] - (#Cons [["lux;envs" (#AppT [List (#AppT [(#AppT [Env Text]) - (#TupleT (#Cons [LuxVar (#Cons [Type #Nil])]))])])] - (#Cons [["lux;types" (#AppT [(#AppT [Bindings Int]) Type])] - (#Cons [["lux;host" HostState] - (#Cons [["lux;seed" Int] - #Nil])])])])])])]))]) + (#Cons [["lux;envs" (#AppT [List (#AppT [(#AppT [Env Text]) + (#TupleT (#Cons [LuxVar (#Cons [Type #Nil])]))])])] + (#Cons [["lux;types" (#AppT [(#AppT [Bindings Int]) Type])] + (#Cons [["lux;host" HostState] + (#Cons [["lux;seed" Int] + #Nil])])])])])]))]) Void])) (_lux_export Compiler) @@ -1293,7 +1300,7 @@ (def'' #export (get-module-name state) ($' Lux Text) (_lux_case state - {#source source #modules modules #module-aliases module-aliases + {#source source #modules modules #envs envs #types types #host host #seed seed} (_lux_case (reverse envs) @@ -1304,12 +1311,13 @@ (#Right [state module-name])))) (def'' (find-macro' modules current-module module name) - (-> ($' List (, Text ($' List (, Text (, Bool ($' DefData' (-> ($' List Syntax) ($' StateE Compiler ($' List Syntax))))))))) + (-> ($' List (, Text ($' Module Compiler))) Text Text Text ($' Maybe Macro)) (do Maybe:Monad - [bindings (get module modules) - gdef (get name bindings)] + [$module (get module modules) + gdef (let [{#aliases _ #defs bindings} (_lux_: ($' Module Compiler) $module)] + (get name bindings))] (_lux_case (_lux_: (, Bool ($' DefData' Macro)) gdef) [exported? (#MacroD macro')] (if exported? @@ -1331,7 +1339,7 @@ (let [[module name] ident] (lambda [state] (_lux_case state - {#source source #modules modules #module-aliases module-aliases + {#source source #modules modules #envs envs #types types #host host #seed seed} (#Right [state (find-macro' modules current-module module name)])))))) @@ -1741,10 +1749,10 @@ (def #export (gensym prefix state) (-> Text (Lux Syntax)) (case state - {#source source #modules modules #module-aliases module-aliases + {#source source #modules modules #envs envs #types types #host host #seed seed} - (#Right [{#source source #modules modules #module-aliases module-aliases + (#Right [{#source source #modules modules #envs envs #types types #host host #seed (inc seed)} ($symbol ["__gensym__" (int:show seed)])]))) @@ -1950,7 +1958,7 @@ (defmacro #export (lux tokens state) (case state - {#source source #modules modules #module-aliases module-aliases + {#source source #modules modules #envs envs #types types #host host #seed seed} (case (get "lux" modules) @@ -1962,7 +1970,8 @@ (if export? (list name) (list))))) - lux)] + (let [{#aliases _ #defs defs} lux] + defs))] (#Right [state (: (List Syntax) (map (: (-> Text Syntax) (lambda [name] @@ -2044,7 +2053,7 @@ (#Meta [_ (#SymbolS vname)]) (let [vname' (ident->text vname)] (case state - {#source source #modules modules #module-aliases module-aliases + {#source source #modules modules #envs envs #types types #host host #seed seed} (let [?struct-type (some (: (-> (Env Text (, LuxVar Type)) (Maybe Type)) 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))))))) |