From da7d3d23227e6d162ff287c8b1ba3f466caafdff Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Mon, 4 May 2015 08:00:05 -0400 Subject: - Added alias-lux to import lux.lux definitions. - Fixed a few bugs both in lux.lux & the compiler. - Added exports to the language. --- src/lux.clj | 2 ++ src/lux/analyser.clj | 2 +- src/lux/analyser/host.clj | 2 +- src/lux/analyser/lux.clj | 54 ++++++++++++++++------------ src/lux/analyser/module.clj | 85 ++++++++++++++++++++++++++++++++------------- src/lux/base.clj | 4 +-- src/lux/compiler.clj | 7 ++-- src/lux/type.clj | 11 +++--- 8 files changed, 108 insertions(+), 59 deletions(-) (limited to 'src') 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 [ ] (defn [analyse ?class ?method ?classes ?object ?args] - (prn ' ?class ?method) + ;; (prn ' ?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)) -- cgit v1.2.3