diff options
| -rw-r--r-- | source/lux.lux | 212 | ||||
| -rw-r--r-- | source/program.lux | 12 | ||||
| -rw-r--r-- | src/lux.clj | 2 | ||||
| -rw-r--r-- | src/lux/analyser.clj | 2 | ||||
| -rw-r--r-- | src/lux/analyser/host.clj | 2 | ||||
| -rw-r--r-- | src/lux/analyser/lux.clj | 54 | ||||
| -rw-r--r-- | src/lux/analyser/module.clj | 85 | ||||
| -rw-r--r-- | src/lux/base.clj | 4 | ||||
| -rw-r--r-- | src/lux/compiler.clj | 7 | ||||
| -rw-r--r-- | src/lux/type.clj | 11 |
10 files changed, 245 insertions, 146 deletions
diff --git a/source/lux.lux b/source/lux.lux index 637c4607f..b967dc0b3 100644 --- a/source/lux.lux +++ b/source/lux.lux @@ -221,7 +221,7 @@ ## (deftype #rec CompilerState ## (& #source (Maybe Reader) -## #modules (List (, Text (List (, Text (DefData' (-> (List Syntax) (StateE CompilerState (List Syntax)))))))) +## #modules (List (, Text (List (, Text (, Bool (DefData' (-> (List Syntax) (StateE CompilerState (List Syntax))))))))) ## #module-aliases (List Void) ## #envs (List (Env Text Void)) ## #types (Bindings Int Type) @@ -231,10 +231,11 @@ (#RecordT (#Cons [["lux;source" (#AppT [Maybe Reader])] (#Cons [["lux;modules" (#AppT [List (#TupleT (#Cons [Text (#Cons [(#AppT [List (#TupleT (#Cons [Text - (#Cons [(#AppT [DefData' (#LambdaT [SyntaxList - (#AppT [(#AppT [StateE (#AppT [(#BoundT "CompilerState") - (#BoundT "")])]) - SyntaxList])])]) + (#Cons [(#TupleT (#Cons [Bool (#Cons [(#AppT [DefData' (#LambdaT [SyntaxList + (#AppT [(#AppT [StateE (#AppT [(#BoundT "CompilerState") + (#BoundT "")])]) + SyntaxList])])]) + #Nil])])) #Nil])]))]) #Nil])]))])] (#Cons [["lux;module-aliases" (#AppT [List Void])] @@ -303,37 +304,31 @@ (:' (#LambdaT [Text Syntax]) (lambda' _ text (_meta (#Text text))))) -(export' $text) (def' $symbol (:' (#LambdaT [Ident Syntax]) (lambda' _ ident (_meta (#Symbol ident))))) -(export' $symbol) (def' $tag (:' (#LambdaT [Ident Syntax]) (lambda' _ ident (_meta (#Tag ident))))) -(export' $tag) (def' $form (:' (#LambdaT [(#AppT [List Syntax]) Syntax]) (lambda' _ tokens (_meta (#Form tokens))))) -(export' $form) (def' $tuple (:' (#LambdaT [(#AppT [List Syntax]) Syntax]) (lambda' _ tokens (_meta (#Tuple tokens))))) -(export' $tuple) (def' $record (:' (#LambdaT [(#AppT [List (#TupleT (#Cons [Syntax (#Cons [Syntax #Nil])]))]) Syntax]) (lambda' _ tokens (_meta (#Record tokens))))) -(export' $record) (def' let' (:' Macro @@ -1263,28 +1258,6 @@ #Nil #None)) -(def__ #export (find-macro ident state) - (-> Ident ($' Lux ($' Maybe Macro))) - (let [[module name] ident] - (case' state - {#source source #modules modules #module-aliases module-aliases - #envs envs #types types #host host - #seed seed} - (#Right [state (do Maybe:Monad - [bindings (get module modules) - gdef (get name bindings)] - (case' (:' ($' DefData' Macro) gdef) - (#MacroD macro') - (#Some macro') - - _ - #None))])))) - -(def__ (list:join xs) - (All [a] - (-> ($' List ($' List a)) ($' List a))) - (fold list:++ #Nil xs)) - (def__ #export (get-module-name state) ($' Lux Text) (case' state @@ -1298,6 +1271,45 @@ (#Cons [{#name module-name #inner-closures _ #locals _ #closure _} _]) (#Right [state module-name])))) +(def__ (find-macro' modules current-module module name) + (-> ($' List (, Text ($' List (, Text (, Bool ($' DefData' (-> ($' List Syntax) ($' StateE CompilerState ($' List Syntax))))))))) + Text Text Text + ($' Maybe Macro)) + (do Maybe:Monad + [bindings (get module modules) + gdef (get name bindings)] + (case' (:' (, Bool ($' DefData' Macro)) gdef) + [exported? (#MacroD macro')] + (if exported? + (#Some macro') + (if (text:= module current-module) + (#Some macro') + #None)) + + [_ (#AliasD [r-module r-name])] + (find-macro' modules current-module r-module r-name) + + _ + #None))) + +(def__ #export (find-macro ident) + (-> Ident ($' Lux ($' Maybe Macro))) + (do Lux:Monad + [current-module get-module-name] + (let [[module name] ident] + (:' ($' Lux ($' Maybe Macro)) + (lambda [state] + (case' state + {#source source #modules modules #module-aliases module-aliases + #envs envs #types types #host host + #seed seed} + (#Right [state (find-macro' modules current-module module name)]))))))) + +(def__ (list:join xs) + (All [a] + (-> ($' List ($' List a)) ($' List a))) + (fold list:++ #Nil xs)) + (def__ #export (normalize ident state) (-> Ident ($' Lux Ident)) (case' ident @@ -1879,8 +1891,8 @@ _ (fail <message>)))] - [and (if (~ pre) true (~ post)) "and requires >=1 elements."] - [or (if (~ pre) (~ post) false) "or requires >=1 elements."]) + [and (if (~ pre) true (~ post)) "and requires >=1 clauses."] + [or (if (~ pre) (~ post) false) "or requires >=1 clauses."]) (do-template [<name> <type> <lt> <gt> <eq>] [(defstruct #export <name> (Ord <type>) @@ -1898,6 +1910,31 @@ [Int:Ord Int jvm-llt jvm-lgt jvm-leq] [Real:Ord Real jvm-dlt jvm-dgt jvm-deq]) +(defmacro #export (alias-lux tokens state) + (case state + {#source source #modules modules #module-aliases module-aliases + #envs envs #types types #host host + #seed seed} + (case (get "lux" modules) + (#Some lux) + (let [to-alias (map (: (-> (, Text (, Bool (DefData' (-> (List Syntax) (StateE CompilerState (List Syntax)))))) + (List Text)) + (lambda [gdef] + (let [[name [export? _]] gdef] + (if export? + (list name) + (list))))) + lux)] + (#Right [state (map (: (-> Text Syntax) + (lambda [name] + (` ((~ ($symbol ["" "def'"])) (~ ($symbol ["" name])) + (~ ($symbol ["lux" name])))))) + (list:join to-alias))])) + + #None + (#Left "Uh, oh... The universe is not working properly...")) + )) + ## (def #export (print x) ## (-> Text (IO (,))) ## (io (jvm-invokevirtual java.io.PrintStream print [java.lang.Object] @@ -1907,55 +1944,56 @@ ## (-> Text (IO (,))) ## (print (text:++ x "\n"))) -## ## (defmacro (loop tokens) -## ## (case' tokens -## ## (#Cons [bindings (#Cons [body #Nil])]) -## ## (let [pairs (as-pairs bindings)] -## ## (return (list (#Form (#Cons [(` (lambda (~ (#Symbol ["" "recur"])) (~ (#Tuple (map first pairs))) -## ## (~ body))) -## ## (map second pairs)]))))))) - -## ## ## (defmacro (get@ tokens) -## ## ## (let [output (case' tokens -## ## ## (#Cons [tag (#Cons [record #Nil])]) -## ## ## (` (get@' (~ tag) (~ record))) - -## ## ## (#Cons [tag #Nil]) -## ## ## (` (lambda [record] (get@' (~ tag) record))))] -## ## ## (return (list output)))) - -## ## ## (defmacro (set@ tokens) -## ## ## (let [output (case' tokens -## ## ## (#Cons [tag (#Cons [value (#Cons [record #Nil])])]) -## ## ## (` (set@' (~ tag) (~ value) (~ record))) - -## ## ## (#Cons [tag (#Cons [value #Nil])]) -## ## ## (` (lambda [record] (set@' (~ tag) (~ value) record))) - -## ## ## (#Cons [tag #Nil]) -## ## ## (` (lambda [value record] (set@' (~ tag) value record))))] -## ## ## (return (list output)))) - -## ## ## (defmacro (update@ tokens) -## ## ## (let [output (case' tokens -## ## ## (#Cons [tag (#Cons [func (#Cons [record #Nil])])]) -## ## ## (` (let [_record_ (~ record)] -## ## ## (set@' (~ tag) ((~ func) (get@' (~ tag) _record_)) _record_))) - -## ## ## (#Cons [tag (#Cons [func #Nil])]) -## ## ## (` (lambda [record] -## ## ## (` (set@' (~ tag) ((~ func) (get@' (~ tag) record)) record)))) - -## ## ## (#Cons [tag #Nil]) -## ## ## (` (lambda [func record] -## ## ## (set@' (~ tag) (func (get@' (~ tag) record)) record))))] -## ## ## (return (list output)))) - -## ## (do-template [<name> <member>] -## ## (def (<name> pair) -## ## (case' pair -## ## [f s] -## ## <member>)) - -## ## [first f] -## ## [second s]) +## (defmacro (loop tokens) +## (case' tokens +## (#Cons [bindings (#Cons [body #Nil])]) +## (let [pairs (as-pairs bindings)] +## (return (list (#Form (#Cons [(` (lambda (~ (#Symbol ["" "recur"])) (~ (#Tuple (map first pairs))) +## (~ body))) +## (map second pairs)]))))))) + +## (defmacro (get@ tokens) +## (let [output (case' tokens +## (#Cons [tag (#Cons [record #Nil])]) +## (` (get@' (~ tag) (~ record))) + +## (#Cons [tag #Nil]) +## (` (lambda [record] (get@' (~ tag) record))))] +## (return (list output)))) + +## (defmacro (set@ tokens) +## (let [output (case' tokens +## (#Cons [tag (#Cons [value (#Cons [record #Nil])])]) +## (` (set@' (~ tag) (~ value) (~ record))) + +## (#Cons [tag (#Cons [value #Nil])]) +## (` (lambda [record] (set@' (~ tag) (~ value) record))) + +## (#Cons [tag #Nil]) +## (` (lambda [value record] (set@' (~ tag) value record))))] +## (return (list output)))) + +## (defmacro (update@ tokens) +## (let [output (case' tokens +## (#Cons [tag (#Cons [func (#Cons [record #Nil])])]) +## (` (let [_record_ (~ record)] +## (set@' (~ tag) ((~ func) (get@' (~ tag) _record_)) _record_))) + +## (#Cons [tag (#Cons [func #Nil])]) +## (` (lambda [record] +## (` (set@' (~ tag) ((~ func) (get@' (~ tag) record)) record)))) + +## (#Cons [tag #Nil]) +## (` (lambda [func record] +## (set@' (~ tag) (func (get@' (~ tag) record)) record))))] +## (return (list output)))) + +## (do-template [<name> <member> <type>] +## (def (<name> pair) +## (All [a b] (-> (, a b) <type>)) +## (case pair +## [f s] +## <member>)) + +## [first f a] +## [second s b]) diff --git a/source/program.lux b/source/program.lux new file mode 100644 index 000000000..6ec9db79e --- /dev/null +++ b/source/program.lux @@ -0,0 +1,12 @@ +(;alias-lux) + +(def (filter p xs) + (All [a] (-> (-> a Bool) (List a) (List a))) + (case xs + #;Nil + (list) + + (#;Cons [x xs']) + (if (p x) + (list& x (filter p xs')) + (filter p xs')))) diff --git a/src/lux.clj b/src/lux.clj index b69494909..37978aa05 100644 --- a/src/lux.clj +++ b/src/lux.clj @@ -6,6 +6,8 @@ (comment ;; TODO: Finish total-locals + (time (&compiler/compile-all (&/|list "program"))) + (time (&compiler/compile-all (&/|list "lux"))) (System/gc) (time (&compiler/compile-all (&/|list "lux" "test2"))) diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj index de44c992d..679a3fea3 100644 --- a/src/lux/analyser.clj +++ b/src/lux/analyser.clj @@ -113,7 +113,7 @@ (&&lux/analyse-coerce analyse eval! ?type ?value) [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "export'"]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ?ident]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ?ident]]]] ["lux;Nil" _]]]]]]]]] (&&lux/analyse-export analyse ?ident) diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj index 1b1947b35..1528f2032 100644 --- a/src/lux/analyser/host.clj +++ b/src/lux/analyser/host.clj @@ -102,7 +102,7 @@ (do-template [<name> <tag>] (defn <name> [analyse ?class ?method ?classes ?object ?args] - (prn '<name> ?class ?method) + ;; (prn '<name> ?class ?method) (|do [=class (&host/full-class-name ?class) ;; :let [_ (prn 'analyse-jvm-invokevirtual/=class =class)] =classes (&/map% &host/extract-jvm-param ?classes) diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj index b8ffafd59..457fd13d6 100644 --- a/src/lux/analyser/lux.clj +++ b/src/lux/analyser/lux.clj @@ -114,15 +114,6 @@ ?elems)] (return (&/|list (&/T (&/V "record" =slots) (&/V "lux;RecordT" exo-type)))))) -(defn find-def+ [?module ?name] - (|do [$def (&&module/find-def ?module ?name)] - (matchv ::M/objects [$def] - [["lux;AliasD" [?r-module ?r-name]]] - (find-def+ ?r-module ?r-name) - - [_] - (return $def)))) - (defn analyse-symbol [analyse exo-type ident] (|do [module-name &/get-module-name] (fn [state] @@ -135,8 +126,8 @@ [inner outer] (&/|split-with no-binding? stack)] (matchv ::M/objects [outer] [["lux;Nil" _]] - (&/run-state (|do [$def (find-def+ (if (= "" ?module) module-name ?module) - ?name) + (&/run-state (|do [[[r-module r-name] $def] (&&module/find-def (if (= "" ?module) module-name ?module) + ?name) endo-type (matchv ::M/objects [$def] [["lux;ValueD" ?type]] (return ?type) @@ -154,8 +145,7 @@ (&type/check exo-type endo-type)) ;; :let [_ (println "Type-checked:" exo-type endo-type)] ] - (return (&/|list (&/T (&/V "global" (&/T (if (= "" ?module) module-name ?module) - ?name)) + (return (&/|list (&/T (&/V "global" (&/T r-module r-name)) endo-type)))) state) @@ -164,7 +154,9 @@ (do ;; (prn 'GOT_GLOBAL local-ident) (matchv ::M/objects [global] [[["global" [?module* ?name*]] _]] - (&/run-state (|do [$def (&&module/find-def ?module* ?name*) + (&/run-state (|do [;; :let [_ (prn 'GLOBAL/_1 ?module* ?name*)] + [[r-module r-name] $def] (&&module/find-def ?module* ?name*) + ;; :let [_ (prn 'GLOBAL/_2 r-module r-name)] ;; :let [_ (println "Found def:" ?module* ?name*)] endo-type (matchv ::M/objects [$def] [["lux;ValueD" ?type]] @@ -182,7 +174,7 @@ (&type/check exo-type endo-type)) ;; :let [_ (println "Type-checked:" exo-type endo-type)] ] - (return (&/|list (&/T (&/V "global" (&/T ?module* ?name*)) + (return (&/|list (&/T (&/V "global" (&/T r-module r-name)) endo-type)))) state) @@ -265,10 +257,21 @@ (do ;; (prn 'analyse-apply2 (aget =fn-form 0)) (matchv ::M/objects [=fn-form] [["global" [?module ?name]]] - (|do [$def (&&module/find-def ?module ?name)] + (|do [[[r-module r-name] $def] (&&module/find-def ?module ?name) + ;; :let [_ (prn 'apply [?module ?name] (aget $def 0))] + ] (matchv ::M/objects [$def] [["lux;MacroD" macro]] - (|do [macro-expansion #(-> macro (.apply ?args) (.apply %))] + (|do [macro-expansion #(-> macro (.apply ?args) (.apply %)) + ;; :let [_ (cond (= ?name "def") + ;; (println (str "def " ?module ";" ?name ": " (->> macro-expansion (&/|map &/show-ast) (&/|interpose " ") (&/fold str "")))) + + ;; (= ?name "type`") + ;; (println (str "type`: " (->> macro-expansion (&/|map &/show-ast) (&/|interpose " ") (&/fold str "")))) + + ;; :else + ;; nil)] + ] (&/flat-map% (partial analyse exo-type) macro-expansion)) [_] @@ -363,7 +366,8 @@ (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)) + (prn 'analyse-def/BEGIN ?name) (|do [module-name &/get-module-name ? (&&module/defined? module-name ?name)] (if ? @@ -371,11 +375,13 @@ (|do [;; :let [_ (prn 'analyse-def/_0)] =value (&/with-scope ?name (analyse-1+ analyse ?value)) - ;; :let [_ (prn 'analyse-def/_1 (aget =value 0 0))] + ;; :let [_ (prn 'analyse-def/_1 [?name ?value] (aget =value 0 0))] ] (matchv ::M/objects [=value] - [["global" [?r-module ?r-name]]] - (|do [_ (&&module/def-alias module-name ?name ?r-module ?r-name)] + [[["global" [?r-module ?r-name]] _]] + (|do [_ (&&module/def-alias module-name ?name ?r-module ?r-name) + :let [_ (println 'analyse-def/ALIAS (str module-name ";" ?name) '=> (str ?r-module ";" ?r-name)) + _ (println)]] (return (&/|list))) [_] @@ -403,8 +409,10 @@ (defn analyse-import [analyse exo-type ?path] (return (&/|list))) -(defn analyse-export [analyse ?ident] - (return (&/|list))) +(defn analyse-export [analyse name] + (|do [module-name &/get-module-name + _ (&&module/export module-name name)] + (return (&/|list)))) (defn analyse-check [analyse eval! exo-type ?type ?value] ;; (println "analyse-check#0") diff --git a/src/lux/analyser/module.clj b/src/lux/analyser/module.clj index 6e42a56f7..83169b17d 100644 --- a/src/lux/analyser/module.clj +++ b/src/lux/analyser/module.clj @@ -16,7 +16,7 @@ [["lux;Cons" [?env ["lux;Nil" _]]]] (return* (->> state (&/update$ &/$MODULES (fn [ms] - (&/|update module #(&/|put name def-data %) + (&/|update module #(&/|put name (&/T false def-data) %) ms))) (&/set$ &/$ENVS (&/|list (&/update$ &/$LOCALS (fn [locals] (&/update$ &/$MAPPINGS (fn [mappings] @@ -32,15 +32,16 @@ (defn def-alias [a-module a-name r-module r-name] (fn [state] + ;; (prn 'def-alias [a-module a-name] '=> [r-module r-name]) (matchv ::M/objects [(&/get$ &/$ENVS state)] [["lux;Cons" [?env ["lux;Nil" _]]]] (return* (->> state (&/update$ &/$MODULES (fn [ms] - (&/|update a-module #(&/|put a-name (&/V "lux;AliasD" (&/T r-module r-name)) %) + (&/|update a-module #(&/|put a-name (&/T false (&/V "lux;AliasD" (&/T r-module r-name))) %) ms))) (&/set$ &/$ENVS (&/|list (&/update$ &/$LOCALS (fn [locals] (&/update$ &/$MAPPINGS (fn [mappings] - (&/|put (str "" &/+name-separator+ name) + (&/|put (str "" &/+name-separator+ a-name) (&/T (&/V "global" (&/T r-module r-name)) &type/$Void) mappings)) locals)) @@ -63,12 +64,26 @@ (fail* (str "Unknown alias: " name))))) (defn find-def [module name] - (fn [state] - (if-let [$module (->> state (&/get$ &/$MODULES) (&/|get module))] - (if-let [$def (&/|get name $module)] - (return* state $def) - (fail* (str "[Analyser Error] Definition doesn't exist: " (str module &/+name-separator+ name)))) - (fail* (str "[Analyser Error] Module doesn't exist: " module))))) + (|do [current-module &/get-module-name] + (fn [state] + (if-let [$module (->> state (&/get$ &/$MODULES) (&/|get module))] + (if-let [$def (&/|get name $module)] + (matchv ::M/objects [$def] + [[exported? $$def]] + (if (or exported? (= current-module module)) + (matchv ::M/objects [$$def] + [["lux;AliasD" [?r-module ?r-name]]] + (&/run-state (find-def ?r-module ?r-name) + state) + + [_] + (return* state (&/T (&/T module name) $$def))) + (fail* (str "[Analyser Error] Can't use unexported definition: " (str module &/+name-separator+ name))))) + (fail* (str "[Analyser Error] Definition doesn't exist: " (str module &/+name-separator+ name)))) + (do (prn [module name] + (str "[Analyser Error] Module doesn't exist: " module) + (->> state (&/get$ &/$MODULES) &/|keys &/->seq)) + (fail* (str "[Analyser Error] Module doesn't exist: " module))))))) (defn defined? [module name] (&/try-all% (&/|list (|do [_ (find-def module name)] @@ -80,26 +95,46 @@ (if-let [$module (->> state (&/get$ &/$MODULES) (&/|get module))] (if-let [$def (&/|get name $module)] (matchv ::M/objects [$def] - [["lux;ValueD" ?type]] + [[exported? ["lux;ValueD" ?type]]] (do ;; (prn 'declare-macro/?type (aget ?type 0)) - (&/run-state (|do [_ (&type/check &type/Macro ?type) - ^ClassLoader loader &/loader - :let [macro (-> (.loadClass loader (&host/location (&/|list module name))) - (.getField "_datum") - (.get nil))]] - (fn [state*] - (return* (&/update$ &/$MODULES - (fn [$modules] - (&/|put module (&/|put name (&/V "lux;MacroD" macro) $module) - $modules)) - state*) - nil))) - state)) + (&/run-state (|do [_ (&type/check &type/Macro ?type) + ^ClassLoader loader &/loader + :let [macro (-> (.loadClass loader (&host/location (&/|list module name))) + (.getField "_datum") + (.get nil))]] + (fn [state*] + (return* (&/update$ &/$MODULES + (fn [$modules] + (&/|put module (&/|put name (&/T exported? (&/V "lux;MacroD" macro)) $module) + $modules)) + state*) + nil))) + state)) - [["lux;MacroD" _]] + [[_ ["lux;MacroD" _]]] (fail* (str "[Analyser Error] Can't re-declare a macro: " (str module &/+name-separator+ name))) - [["lux;TypeD" _]] + [[_ ["lux;TypeD" _]]] (fail* (str "[Analyser Error] Definition doesn't have macro type: " module ";" name))) (fail* (str "[Analyser Error] Definition doesn't exist: " (str module &/+name-separator+ name)))) (fail* (str "[Analyser Error] Module doesn't exist: " module))))) + +(defn export [module name] + (fn [state] + (matchv ::M/objects [(&/get$ &/$ENVS state)] + [["lux;Cons" [?env ["lux;Nil" _]]]] + (if-let [$def (->> state (&/get$ &/$MODULES) (&/|get module) (&/|get name))] + (matchv ::M/objects [$def] + [[true _]] + (fail* (str "[Analyser Error] Definition has already been exported: " module ";" name)) + + [[false ?data]] + (return* (->> state + (&/update$ &/$MODULES (fn [ms] + (&/|update module #(&/|put name (&/T true ?data) %) + ms)))) + nil)) + (fail* (str "[Analyser Error] Can't export an inexistent definition: " module ";" name))) + + [_] + (fail* "[Analyser Error] Can't export a global definition outside of a global environment.")))) diff --git a/src/lux/base.clj b/src/lux/base.clj index d06920d6f..d3250670b 100644 --- a/src/lux/base.clj +++ b/src/lux/base.clj @@ -127,8 +127,8 @@ [["lux;Cons" [[k* v] table*]]] (if (= k k*) - (V "lux;Cons" (T (T k (f v)) table*)) - (|update k f table*)))) + (V "lux;Cons" (T (T k* (f v)) table*)) + (V "lux;Cons" (T (T k* v) (|update k f table*)))))) (defn |head [xs] (matchv ::M/objects [xs] diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj index 9aa734f3c..14f9863bd 100644 --- a/src/lux/compiler.clj +++ b/src/lux/compiler.clj @@ -358,8 +358,11 @@ )] (defn ^:private compile-module [name] (fn [state] + (prn 'compile-module name (->> state (&/get$ &/$MODULES) &/|keys &/->seq)) (if (->> state (&/get$ &/$MODULES) (&/|contains? name)) - (fail* "[Compiler Error] Can't redefine a module!") + (if (= name "lux") + (return* state nil) + (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))] @@ -380,7 +383,7 @@ ;; [Resources] (defn compile-all [modules] (.mkdir (java.io.File. "output")) - (matchv ::M/objects [(&/run-state (&/map% compile-module modules) (&/init-state nil))] + (matchv ::M/objects [(&/run-state (&/map% compile-module (&/|cons "lux" modules)) (&/init-state nil))] [["lux;Right" [?state _]]] (println (str "Compilation complete! " (str "[" (->> modules (&/|interpose " ") diff --git a/src/lux/type.clj b/src/lux/type.clj index 38f848676..7ab585d65 100644 --- a/src/lux/type.clj +++ b/src/lux/type.clj @@ -143,11 +143,12 @@ (&/|list Text (&/V "lux;AppT" (&/T List (&/V "lux;TupleT" (&/|list Text - (&/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" "CompilerState") - (&/V "lux;BoundT" ""))))) - SyntaxList))))))))))))))) + (&/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" "CompilerState") + (&/V "lux;BoundT" ""))))) + SyntaxList))))))))))))))))) (&/T "lux;module-aliases" (&/V "lux;AppT" (&/T List $Void))) (&/T "lux;envs" (&/V "lux;AppT" (&/T List (&/V "lux;AppT" (&/T (&/V "lux;AppT" (&/T Env Text)) |