diff options
Diffstat (limited to '')
-rw-r--r-- | source/lux.lux | 42 | ||||
-rw-r--r-- | src/lux/analyser.clj | 50 | ||||
-rw-r--r-- | src/lux/analyser/lux.clj | 14 | ||||
-rw-r--r-- | src/lux/analyser/module.clj | 53 | ||||
-rw-r--r-- | src/lux/base.clj | 7 | ||||
-rw-r--r-- | src/lux/compiler.clj | 36 | ||||
-rw-r--r-- | src/lux/optimizer.clj | 4 | ||||
-rw-r--r-- | src/lux/reader.clj | 4 | ||||
-rw-r--r-- | src/lux/type.clj | 8 |
9 files changed, 145 insertions, 73 deletions
diff --git a/source/lux.lux b/source/lux.lux index 10abcb88a..07b245a5d 100644 --- a/source/lux.lux +++ b/source/lux.lux @@ -245,26 +245,31 @@ (_lux_export LuxVar) ## (deftype (Module Compiler) -## (& #aliases (List (, Text Text)) -## #defs (List (, Text (, Bool (DefData' (-> (List Syntax) (StateE Compiler (List Syntax))))))))) +## (& #module-aliases (List (, Text Text)) +## #defs (List (, Text (, Bool (DefData' (-> (List Syntax) (StateE Compiler (List Syntax))))))) +## #imports (List Text) +## )) (_lux_def Module (#AllT [(#Some #Nil) "lux;Module" "Compiler" - (#RecordT (#Cons [["lux;aliases" (#AppT [List (#TupleT (#Cons [Text (#Cons [Text #Nil])]))])] + (#RecordT (#Cons [["lux;module-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])]))])) + (#Cons [["lux;imports" (#AppT [List Text])] + #Nil])])]))])) (_lux_export Module) ## (deftype #rec Compiler -## (& #source Reader -## #modules (List (, Text (Module Compiler))) -## #envs (List (Env Text (, LuxVar Type))) -## #types (Bindings Int Type) -## #host HostState)) +## (& #source Reader +## #modules (List (, Text (Module Compiler))) +## #envs (List (Env Text (, LuxVar Type))) +## #types (Bindings Int Type) +## #host HostState +## #seed Int +## #seen-sources (List Text))) (_lux_def Compiler (#AppT [(#AllT [(#Some #Nil) "lux;Compiler" "" (#RecordT (#Cons [["lux;source" Reader] @@ -276,7 +281,8 @@ (#Cons [["lux;types" (#AppT [(#AppT [Bindings Int]) Type])] (#Cons [["lux;host" HostState] (#Cons [["lux;seed" Int] - #Nil])])])])])]))]) + (#Cons [["lux;seen-sources" (#AppT [List Text])] + #Nil])])])])])])]))]) Void])) (_lux_export Compiler) @@ -1302,7 +1308,7 @@ (_lux_case state {#source source #modules modules #envs envs #types types #host host - #seed seed} + #seed seed #seen-sources seen-sources} (_lux_case (reverse envs) #Nil (#Left "Can't get the module name without a module!") @@ -1316,7 +1322,7 @@ ($' Maybe Macro)) (do Maybe:Monad [$module (get module modules) - gdef (let [{#aliases _ #defs bindings} (_lux_: ($' Module Compiler) $module)] + gdef (let [{#module-aliases _ #defs bindings #imports _} (_lux_: ($' Module Compiler) $module)] (get name bindings))] (_lux_case (_lux_: (, Bool ($' DefData' Macro)) gdef) [exported? (#MacroD macro')] @@ -1341,7 +1347,7 @@ (_lux_case state {#source source #modules modules #envs envs #types types #host host - #seed seed} + #seed seed #seen-sources seen-sources} (#Right [state (find-macro' modules current-module module name)])))))) (def'' (list:join xs) @@ -1751,10 +1757,10 @@ (case state {#source source #modules modules #envs envs #types types #host host - #seed seed} + #seed seed #seen-sources seen-sources} (#Right [{#source source #modules modules #envs envs #types types #host host - #seed (inc seed)} + #seed (inc seed) #seen-sources seen-sources} ($symbol ["__gensym__" (int:show seed)])]))) (def #export (macro-expand-1 token) @@ -1960,7 +1966,7 @@ (case state {#source source #modules modules #envs envs #types types #host host - #seed seed} + #seed seed #seen-sources seen-sources} (case (get "lux" modules) (#Some lux) (let [to-alias (map (: (-> (, Text (, Bool (DefData' (-> (List Syntax) (StateE Compiler (List Syntax)))))) @@ -1970,7 +1976,7 @@ (if export? (list name) (list))))) - (let [{#aliases _ #defs defs} lux] + (let [{#module-aliases _ #defs defs #imports _} lux] defs))] (#Right [state (: (List Syntax) (map (: (-> Text Syntax) @@ -2055,7 +2061,7 @@ (case state {#source source #modules modules #envs envs #types types #host host - #seed seed} + #seed seed #seen-sources seen-sources} (let [?struct-type (some (: (-> (Env Text (, LuxVar Type)) (Maybe Type)) (lambda [env] (case env diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj index a89d37ee5..4cb1a4900 100644 --- a/src/lux/analyser.clj +++ b/src/lux/analyser.clj @@ -27,7 +27,7 @@ (&/T catch+ ?finally-body))) (let [unit (&/V "lux;Meta" (&/T (&/T "" -1 -1) (&/V "lux;TupleS" (|list))))] - (defn ^:private aba1 [analyse eval! exo-type token] + (defn ^:private aba1 [analyse eval! compile-module exo-type token] (matchv ::M/objects [token] ;; Standard special forms [["lux;BoolS" ?value]] @@ -66,7 +66,7 @@ (fail "") ))) -(defn ^:private aba2 [analyse eval! exo-type token] +(defn ^:private aba2 [analyse eval! compile-module exo-type token] (matchv ::M/objects [token] [["lux;SymbolS" ?ident]] (&&lux/analyse-symbol analyse exo-type ?ident) @@ -96,7 +96,7 @@ [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_lux_import"]]]] ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?path]]] ["lux;Nil" _]]]]]]] - (&&lux/analyse-import analyse ?path) + (&&lux/analyse-import analyse compile-module ?path) [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_lux_:"]]]] ["lux;Cons" [?type @@ -118,7 +118,7 @@ [_] (fail ""))) -(defn ^:private aba3 [analyse eval! exo-type token] +(defn ^:private aba3 [analyse eval! compile-module exo-type token] (matchv ::M/objects [token] ;; Host special forms ;; Integer arithmetic @@ -174,7 +174,7 @@ [_] (fail ""))) -(defn ^:private aba4 [analyse eval! exo-type token] +(defn ^:private aba4 [analyse eval! compile-module exo-type token] (matchv ::M/objects [token] ;; Float arithmetic [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_fadd"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] @@ -229,7 +229,7 @@ [_] (fail ""))) -(defn ^:private aba5 [analyse eval! exo-type token] +(defn ^:private aba5 [analyse eval! compile-module exo-type token] (matchv ::M/objects [token] ;; Objects [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_null?"]]]] @@ -332,7 +332,7 @@ [_] (fail ""))) -(defn ^:private aba6 [analyse eval! exo-type token] +(defn ^:private aba6 [analyse eval! compile-module exo-type token] (matchv ::M/objects [token] ;; Primitive conversions [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_d2f"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]] @@ -408,7 +408,7 @@ [_] (fail ""))) -(defn ^:private aba7 [analyse eval! exo-type token] +(defn ^:private aba7 [analyse eval! compile-module exo-type token] (matchv ::M/objects [token] ;; Arrays [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_new-array"]]]] @@ -455,48 +455,48 @@ [_] (fail ""))) -(defn ^:private add-loc [meta msg] +(defn ^:private add-loc [meta ^String msg] (if (.startsWith msg "@") msg (|let [[file line col] meta] (str "@ " file " : " line " , " col "\n" msg)))) -(defn ^:private analyse-basic-ast [analyse eval! exo-type token] +(defn ^:private analyse-basic-ast [analyse eval! compile-module exo-type token] ;; (prn 'analyse-basic-ast (&/show-ast token)) (matchv ::M/objects [token] [["lux;Meta" [meta ?token]]] (fn [state] - (matchv ::M/objects [((aba1 analyse eval! exo-type ?token) state)] + (matchv ::M/objects [((aba1 analyse eval! compile-module exo-type ?token) state)] [["lux;Right" [state* output]]] (return* state* output) [["lux;Left" ""]] - (matchv ::M/objects [((aba2 analyse eval! exo-type ?token) state)] + (matchv ::M/objects [((aba2 analyse eval! compile-module exo-type ?token) state)] [["lux;Right" [state* output]]] (return* state* output) [["lux;Left" ""]] - (matchv ::M/objects [((aba3 analyse eval! exo-type ?token) state)] + (matchv ::M/objects [((aba3 analyse eval! compile-module exo-type ?token) state)] [["lux;Right" [state* output]]] (return* state* output) [["lux;Left" ""]] - (matchv ::M/objects [((aba4 analyse eval! exo-type ?token) state)] + (matchv ::M/objects [((aba4 analyse eval! compile-module exo-type ?token) state)] [["lux;Right" [state* output]]] (return* state* output) [["lux;Left" ""]] - (matchv ::M/objects [((aba5 analyse eval! exo-type ?token) state)] + (matchv ::M/objects [((aba5 analyse eval! compile-module exo-type ?token) state)] [["lux;Right" [state* output]]] (return* state* output) [["lux;Left" ""]] - (matchv ::M/objects [((aba6 analyse eval! exo-type ?token) state)] + (matchv ::M/objects [((aba6 analyse eval! compile-module exo-type ?token) state)] [["lux;Right" [state* output]]] (return* state* output) [["lux;Left" ""]] - (matchv ::M/objects [((aba7 analyse eval! exo-type ?token) state)] + (matchv ::M/objects [((aba7 analyse eval! compile-module exo-type ?token) state)] [["lux;Right" [state* output]]] (return* state* output) @@ -521,25 +521,25 @@ [["lux;Left" msg]] (fail* (add-loc meta msg)))))) -(defn ^:private analyse-ast [eval! exo-type token] +(defn ^:private analyse-ast [eval! compile-module exo-type token] (matchv ::M/objects [token] [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;TagS" ?ident]]] ?values]]]]]] (do (assert (.equals ^Object (&/|length ?values) 1) "[Analyser Error] Can only tag 1 value.") - (&&lux/analyse-variant (partial analyse-ast eval!) exo-type ?ident (&/|head ?values))) + (&&lux/analyse-variant (partial analyse-ast eval! compile-module) exo-type ?ident (&/|head ?values))) [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [?fn ?args]]]]]] (fn [state] - (matchv ::M/objects [((&type/with-var #(&&/analyse-1 (partial analyse-ast eval!) % ?fn)) state)] + (matchv ::M/objects [((&type/with-var #(&&/analyse-1 (partial analyse-ast eval! compile-module) % ?fn)) state)] [["lux;Right" [state* =fn]]] - ((&&lux/analyse-apply (partial analyse-ast eval!) exo-type =fn ?args) state*) + ((&&lux/analyse-apply (partial analyse-ast eval! compile-module) exo-type =fn ?args) state*) [_] - ((analyse-basic-ast (partial analyse-ast eval!) eval! exo-type token) state))) + ((analyse-basic-ast (partial analyse-ast eval! compile-module) eval! compile-module exo-type token) state))) [_] - (analyse-basic-ast (partial analyse-ast eval!) eval! exo-type token))) + (analyse-basic-ast (partial analyse-ast eval! compile-module) eval! compile-module exo-type token))) ;; [Resources] -(defn analyse [eval!] +(defn analyse [eval! compile-module] (|do [asts &parser/parse] - (&/flat-map% (partial analyse-ast eval! &type/$Void) asts))) + (&/flat-map% (partial analyse-ast eval! compile-module &type/$Void) asts))) diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj index cdecd234f..242539b65 100644 --- a/src/lux/analyser/lux.clj +++ b/src/lux/analyser/lux.clj @@ -316,8 +316,18 @@ (|do [module-name &/get-module-name] (return (&/|list (&/V "declare-macro" (&/T module-name ?name)))))) -(defn analyse-import [analyse exo-type ?path] - (return (&/|list))) +(defn analyse-import [analyse compile-module ?path] + (prn 'analyse-import ?path) + (fn [state] + (let [already-compiled? (&/fold false #(or %1 (= %2 ?path)) (&/get$ &/$SEEN-SOURCES state))] + (&/run-state (|do [_ (&&module/add-import ?path) + _ (if already-compiled? + (return nil) + (compile-module ?path))] + (return (&/|list))) + (if already-compiled? + state + (&/update$ &/$SEEN-SOURCES (partial &/|cons ?path) state)))))) (defn analyse-export [analyse name] (|do [module-name &/get-module-name diff --git a/src/lux/analyser/module.clj b/src/lux/analyser/module.clj index cfa39f008..1fd96ce0a 100644 --- a/src/lux/analyser/module.clj +++ b/src/lux/analyser/module.clj @@ -1,23 +1,38 @@ (ns lux.analyser.module (:require [clojure.core.match :as M :refer [matchv]] clojure.core.match.array - (lux [base :as & :refer [|do return return* fail fail*]] + (lux [base :as & :refer [|let |do return return* fail fail*]] [type :as &type] [host :as &host]) [lux.analyser.base :as &&])) ;; [Utils] -(def ^:private $ALIASES 0) -(def ^:private $DEFS 1) +(def ^:private $DEFS 0) +(def ^:private $ALIASES 1) +(def ^:private $IMPORTS 2) ;; [Exports] (def init-module - (&/R ;; "lux;aliases" + (&/R ;; "lux;defs" (&/|table) - ;; "lux;defs" + ;; "lux;module-aliases" (&/|table) + ;; "lux;imports" + (&/|list) )) +(defn add-import [module] + "(-> Text (Lux (,)))" + (|do [current-module &/get-module-name] + (fn [state] + (return* (&/update$ &/$MODULES + (fn [ms] + (&/|update current-module + (fn [m] (&/update$ $IMPORTS (partial &/|cons module) m)) + ms)) + state) + nil)))) + (defn define [module name def-data type] (fn [state] (matchv ::M/objects [(&/get$ &/$ENVS state)] @@ -69,6 +84,7 @@ (fail* "[Analyser Error] Can't alias a global definition outside of a global environment.")))) (defn exists? [name] + "(-> Text (Lux Bool))" (fn [state] (return* state (->> state (&/get$ &/$MODULES) (&/|contains? name))))) @@ -174,3 +190,30 @@ [_] (fail* "[Analyser Error] Can't export a global definition outside of a global environment.")))) + +(def defs + (|do [module &/get-module-name] + (fn [state] + (return* state + (&/|map (fn [kv] + (|let [[k v] kv] + (matchv ::M/objects [v] + [[?exported? ?def]] + (matchv ::M/objects [?def] + [["lux;AliasD" [?r-module ?r-name]]] + (&/T ?exported? k (str "A" ?r-module ";" ?r-name)) + + [["lux;MacroD" _]] + (&/T ?exported? k "M") + + [["lux;TypeD" _]] + (&/T ?exported? k "T") + + [_] + (&/T ?exported? k "V"))))) + (->> state (&/get$ &/$MODULES) (&/|get module) (&/get$ $DEFS))))))) + +(def imports + (|do [module &/get-module-name] + (fn [state] + (return* state (->> state (&/get$ &/$MODULES) (&/|get module) (&/get$ $IMPORTS)))))) diff --git a/src/lux/base.clj b/src/lux/base.clj index 9087028bb..657ebd51e 100644 --- a/src/lux/base.clj +++ b/src/lux/base.clj @@ -24,8 +24,9 @@ (def $HOST 1) (def $MODULES 2) (def $SEED 3) -(def $SOURCE 4) -(def $TYPES 5) +(def $SEEN-SOURCES 4) +(def $SOURCE 5) +(def $TYPES 6) ;; [Exports] (def +name-separator+ ";") @@ -476,6 +477,8 @@ (|table) ;; "lux;seed" 0 + ;; "lux;seen-sources" + (|list) ;; "lux;source" (V "lux;None" nil) ;; "lux;types" diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj index a0425cdbe..90a382ed5 100644 --- a/src/lux/compiler.clj +++ b/src/lux/compiler.clj @@ -5,7 +5,7 @@ [template :refer [do-template]]) [clojure.core.match :as M :refer [matchv]] clojure.core.match.array - (lux [base :as & :refer [|do return* return fail fail*]] + (lux [base :as & :refer [|let |do return* return fail fail*]] [type :as &type] [reader :as &reader] [lexer :as &lexer] @@ -347,9 +347,9 @@ (.get nil) return))) -(let [compiler-step (|do [analysis+ (&optimizer/optimize eval!)] - (&/map% compile-statement analysis+))] - (defn ^:private compile-module [name] +(defn ^:private compile-module [name] + (let [compiler-step (|do [analysis+ (&optimizer/optimize eval! compile-module)] + (&/map% compile-statement analysis+))] (fn [state] (if (->> state (&/get$ &/$MODULES) (&/|contains? name)) (if (.equals ^Object name "lux") @@ -363,14 +363,7 @@ (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_hash" "I" nil (hash file-content)) .visitEnd) (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_compiler" "Ljava/lang/String;" nil version) - .visitEnd) - ;; (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_imports" "Ljava/lang/String;" nil ...) - ;; .visitEnd) - ;; (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_exports" "Ljava/lang/String;" nil ...) - ;; .visitEnd) - ;; (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_macros" "Ljava/lang/String;" nil ...) - ;; .visitEnd) - )] + .visitEnd))] (matchv ::M/objects [((&/exhaust% compiler-step) (->> state (&/set$ &/$SOURCE (&reader/from file-name file-content)) @@ -378,8 +371,23 @@ (&/update$ &/$HOST #(&/set$ &/$WRITER (&/V "lux;Some" =class) %)) (&/update$ &/$MODULES #(&/|put name &a-module/init-module %))))] [["lux;Right" [?state _]]] - (do (.visitEnd =class) - ((&&/save-class! name (.toByteArray =class)) ?state)) + (&/run-state (|do [defs &a-module/defs + imports &a-module/imports + :let [_ (doto =class + (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_defs" "Ljava/lang/String;" nil + (->> defs + (&/|map (fn [_def] + (|let [[?exported ?name ?ann] _def] + (str (if ?exported "1" "0") " " ?name " " ?ann)))) + (&/|interpose "\t") + (&/fold str ""))) + .visitEnd) + (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_imports" "Ljava/lang/String;" nil + (->> imports (&/|interpose ";") (&/fold str ""))) + .visitEnd) + (.visitEnd))]] + (&&/save-class! name (.toByteArray =class))) + ?state) [["lux;Left" ?message]] (fail* ?message))))))) diff --git a/src/lux/optimizer.clj b/src/lux/optimizer.clj index e50d2aae9..8b97b6ebb 100644 --- a/src/lux/optimizer.clj +++ b/src/lux/optimizer.clj @@ -15,5 +15,5 @@ ;; Global var aliasing. ;; [Exports] -(defn optimize [eval!] - (&analyser/analyse eval!)) +(defn optimize [eval! compile-module] + (&analyser/analyse eval! compile-module)) diff --git a/src/lux/reader.clj b/src/lux/reader.clj index 08b053a85..0e8c1b710 100644 --- a/src/lux/reader.clj +++ b/src/lux/reader.clj @@ -124,8 +124,8 @@ (&/T (&/T file-name line-num column-num*) line))))) (&/V "No" (str "[Reader Error] Text failed: " text)))))) -(def ^:private +source-dir+ "source/") -(defn from [file-name file-content] +(def ^:private ^String +source-dir+ "source/") +(defn from [^String file-name ^String file-content] (let [lines (&/->list (string/split-lines file-content)) file-name (.substring file-name (.length +source-dir+))] (&/|map (fn [line+line-num] diff --git a/src/lux/type.clj b/src/lux/type.clj index d34433f01..d82eae8fd 100644 --- a/src/lux/type.clj +++ b/src/lux/type.clj @@ -146,14 +146,15 @@ (def $Module (fAll "lux;$Module" "Compiler" (&/V "lux;RecordT" - (&/|list (&/T "lux;aliases" (&/V "lux;AppT" (&/T List (&/V "lux;TupleT" (&/|list Text Text))))) + (&/|list (&/T "lux;module-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))))))))))))))))) + SyntaxList))))))))))))) + (&/T "lux;imports" (&/V "lux;AppT" (&/T List Text))))))) (def $Compiler (&/V "lux;AppT" (&/T (fAll "lux;Compiler" "" @@ -167,7 +168,8 @@ (&/V "lux;TupleT" (&/|list LuxVar Type))))))) (&/T "lux;types" (&/V "lux;AppT" (&/T (&/V "lux;AppT" (&/T Bindings Int)) Type))) (&/T "lux;host" HostState) - (&/T "lux;seed" Int)))) + (&/T "lux;seed" Int) + (&/T "lux;seen-sources" (&/V "lux;AppT" (&/T List Text)))))) $Void))) (def Macro |