aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--source/lux.lux61
-rw-r--r--src/lux/analyser/module.clj73
-rw-r--r--src/lux/base.clj11
-rw-r--r--src/lux/type.clj22
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)))))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-08-24 06:20:37 +0000