diff options
author | Eduardo Julian | 2017-12-05 02:41:59 -0400 |
---|---|---|
committer | Eduardo Julian | 2017-12-05 02:41:59 -0400 |
commit | 7e18f589a05bde28b3f710d92f72b7bd6b6e144f (patch) | |
tree | cea41a63fa361d82300e52720f1d96da89312b52 | |
parent | 9641cfa9ed5043f3df2792f5aeab4e42b2f79a44 (diff) |
- Added analysis, synthesis, translation and statement extensions.
- No longer doing ad-hoc I/O in new-luxc.
- Minor fixes and adjustments.
-rw-r--r-- | luxc/src/lux/base.clj | 3 | ||||
-rw-r--r-- | new-luxc/source/luxc/io.jvm.lux | 110 | ||||
-rw-r--r-- | new-luxc/source/luxc/lang/extension.lux | 84 | ||||
-rw-r--r-- | new-luxc/source/luxc/lang/extension/analysis.lux | 9 | ||||
-rw-r--r-- | new-luxc/source/luxc/lang/extension/statement.lux | 146 | ||||
-rw-r--r-- | new-luxc/source/luxc/lang/extension/synthesis.lux | 9 | ||||
-rw-r--r-- | new-luxc/source/luxc/lang/extension/translation.lux | 9 | ||||
-rw-r--r-- | new-luxc/source/luxc/lang/host/jvm.lux | 2 | ||||
-rw-r--r-- | new-luxc/source/luxc/lang/module.lux | 10 | ||||
-rw-r--r-- | new-luxc/source/luxc/lang/translation.lux | 164 | ||||
-rw-r--r-- | new-luxc/source/luxc/lang/translation/common.jvm.lux | 2 | ||||
-rw-r--r-- | new-luxc/source/luxc/repl.lux | 10 | ||||
-rw-r--r-- | stdlib/source/lux.lux | 38 | ||||
-rw-r--r-- | stdlib/source/lux/world/file.lux | 5 |
14 files changed, 401 insertions, 200 deletions
diff --git a/luxc/src/lux/base.clj b/luxc/src/lux/base.clj index ee4bcde10..02942f4e0 100644 --- a/luxc/src/lux/base.clj +++ b/luxc/src/lux/base.clj @@ -158,6 +158,7 @@ "expected" "seed" "scope-type-vars" + "extensions" "host"]) ;; Compiler @@ -834,6 +835,8 @@ 0 ;; scope-type-vars $Nil + ;; extensions + nil ;; "lux;host" host-data] )) diff --git a/new-luxc/source/luxc/io.jvm.lux b/new-luxc/source/luxc/io.jvm.lux index f3e8eacee..ef4a7fc8a 100644 --- a/new-luxc/source/luxc/io.jvm.lux +++ b/new-luxc/source/luxc/io.jvm.lux @@ -3,8 +3,6 @@ (lux (control monad ["ex" exception #+ exception:]) [io #+ Process] - (concurrency ["P" promise] - ["T" task]) (data ["e" error] [text "text/" Eq<Text>] text/format) @@ -21,46 +19,24 @@ (exception: #export File-Not-Found) (exception: #export Module-Not-Found) -(exception: #export Could-Not-Read-All-Data) -(host.import #long java/io/File - (new [String]) - (exists [] #io #try boolean) - (mkdir [] #io #try boolean) - (delete [] #io #try boolean) - (length [] #io #try long) - (listFiles [] #io #try (Array java/io/File)) - (getAbsolutePath [] #io #try String) - (isFile [] #io #try boolean) - (isDirectory [] #io #try boolean) - (#static separator String)) +(def: sanitize + (-> Text Text) + (text.replace-all "/" file.separator)) -(host.import java/lang/AutoCloseable - (close [] #io #try void)) - -(host.import java/io/InputStream - (read [(Array byte)] #io #try int)) - -(host.import java/io/FileInputStream - (new [java/io/File] #io #try)) - -(def: file-exists? - (-> File (Process Bool)) - (|>> java/io/File::new (java/io/File::exists []))) - -(def: (find-source path dirs) - (-> Text (List File) (Process [Text File])) +(def: (find-source dirs path) + (-> (List File) Text (Process [Text File])) (case dirs #.Nil (io.fail (File-Not-Found path)) (#.Cons dir dirs') (do io.Monad<Process> - [#let [file (format dir java/io/File::separator path)] - ? (file-exists? file)] + [#let [file (format dir file.separator path)] + ? (file.exists? file)] (if ? (wrap [path file]) - (find-source path dirs'))))) + (find-source dirs' path))))) (def: (either left right) (All [a] (-> (Process a) (Process a) (Process a))) @@ -73,58 +49,38 @@ (#e.Error error) right))) -(def: #export (read-file file) - (-> File (Process Blob)) - (do io.Monad<Process> - [#let [file' (java/io/File::new file)] - size (java/io/File::length [] file') - #let [data (blob.create (int-to-nat size))] - stream (FileInputStream::new [file']) - bytes-read (InputStream::read [data] stream) - _ (AutoCloseable::close [] stream)] - (if (i/= size bytes-read) - (wrap data) - (io.fail (Could-Not-Read-All-Data file))))) - (def: #export (read-module dirs name) (-> (List File) Text (Process [File Text])) - (let [host-path (format name host-extension lux-extension) - lux-path (format name lux-extension)] - (do io.Monad<Process> - [[path file] (: (Process [Text File]) - ($_ either - (find-source host-path dirs) - (find-source lux-path dirs) - (io.fail (Module-Not-Found name)))) - blob (read-file file)] - (wrap [path (String::new blob)])))) - -(def: #export (write-module name descriptor) - (-> Text Text (T.Task Unit)) - (T.fail "'write-module' is undefined.")) + (do io.Monad<Process> + [[path file] (: (Process [Text File]) + ($_ either + (find-source dirs (format name host-extension lux-extension)) + (find-source dirs (format name lux-extension)) + (io.fail (Module-Not-Found name)))) + blob (file.read file)] + (wrap [path (String::new blob)]))) (def: (platform-target root-target) (-> File File) - (format root-target - java/io/File::separator - (for {"JVM" "jvm" - "JS" "js"}))) + (format root-target "/" (for {"JVM" "jvm" + "JS" "js"}))) (def: #export (prepare-target target-dir) - (-> File (T.Task Unit)) - (do T.Monad<Task> - [_ (file.make-dir target-dir) - _ (file.make-dir (platform-target target-dir))] - (wrap []))) + (-> File (Process Bool)) + (do io.Monad<Process> + [_ (file.make-dir (sanitize target-dir))] + (file.make-dir (sanitize (platform-target target-dir))))) (def: #export (prepare-module target-dir module-name) - (-> File Text (T.Task Unit)) - (do T.Monad<Task> - [_ (file.make-dir (format (platform-target target-dir) java/io/File::separator module-name))] - (wrap []))) - -(def: #export (write-file target-dir file-name content) - (-> File Text Blob (T.Task Unit)) - (|> file-name - (format (platform-target target-dir) java/io/File::separator) + (-> File Text (Process Bool)) + (|> module-name + (format (platform-target target-dir) "/") + sanitize + file.make-dir)) + +(def: #export (write target name content) + (-> File Text Blob (Process Unit)) + (|> name + (format (platform-target target) "/") + sanitize (file.write content))) diff --git a/new-luxc/source/luxc/lang/extension.lux b/new-luxc/source/luxc/lang/extension.lux new file mode 100644 index 000000000..d38d564fb --- /dev/null +++ b/new-luxc/source/luxc/lang/extension.lux @@ -0,0 +1,84 @@ +(.module: + lux + (lux (control [monad #+ do] + ["ex" exception #+ exception:]) + (data ["e" error] + [text] + (coll [dict #+ Dict])) + [macro]) + [//]) + +(exception: #export Unknown-Analysis) +(exception: #export Unknown-Synthesis) +(exception: #export Unknown-Translation) +(exception: #export Unknown-Statement) + +(exception: #export Cannot-Define-Analysis-More-Than-Once) +(exception: #export Cannot-Define-Synthesis-More-Than-Once) +(exception: #export Cannot-Define-Translation-More-Than-Once) +(exception: #export Cannot-Define-Statement-More-Than-Once) + +(type: #export Expression + (-> (List Code) (Meta Code))) + +(type: #export Statement + (-> (List Code) (Meta Unit))) + +(type: #export Extensions + {#analysis (Dict Text Expression) + #synthesis (Dict Text Expression) + #translation (Dict Text Expression) + #statement (Dict Text Statement)}) + +(def: #export fresh + Extensions + {#analysis (dict.new text.Hash<Text>) + #synthesis (dict.new text.Hash<Text>) + #translation (dict.new text.Hash<Text>) + #statement (dict.new text.Hash<Text>)}) + +(def: get + (Meta Extensions) + (function [compiler] + (#e.Success [compiler + (|> compiler (get@ #.extensions) (:! Extensions))]))) + +(def: (set extensions) + (-> Extensions (Meta Unit)) + (function [compiler] + (#e.Success [(set@ #.extensions (:! Void extensions) compiler) + []]))) + +(do-template [<name> <type> <category> <exception>] + [(def: #export (<name> name) + (-> Text (Meta <type>)) + (do macro.Monad<Meta> + [extensions ..get] + (case (dict.get name (get@ <category> extensions)) + (#.Some extension) + (wrap extension) + + #.None + (//.throw <exception> name))))] + + [find-analysis Expression #analysis Unknown-Analysis] + [find-synthesis Expression #synthesis Unknown-Synthesis] + [find-translation Expression #translation Unknown-Translation] + [find-statement Statement #statement Unknown-Statement] + ) + +(do-template [<name> <type> <category> <exception>] + [(def: #export (<name> name extension) + (-> Text <type> (Meta Unit)) + (do macro.Monad<Meta> + [extensions ..get + _ (//.assert <exception> name + (not (dict.contains? name (get@ <category> extensions)))) + _ (..set (update@ <category> (dict.put name extension) extensions))] + (wrap [])))] + + [install-analysis Expression #analysis Cannot-Define-Analysis-More-Than-Once] + [install-synthesis Expression #synthesis Cannot-Define-Synthesis-More-Than-Once] + [install-translation Expression #translation Cannot-Define-Translation-More-Than-Once] + [install-statement Statement #statement Cannot-Define-Statement-More-Than-Once] + ) diff --git a/new-luxc/source/luxc/lang/extension/analysis.lux b/new-luxc/source/luxc/lang/extension/analysis.lux new file mode 100644 index 000000000..d034f2919 --- /dev/null +++ b/new-luxc/source/luxc/lang/extension/analysis.lux @@ -0,0 +1,9 @@ +(.module: + lux + (lux (data [text] + (coll [dict #+ Dict]))) + [//]) + +(def: #export defaults + (Dict Text //.Expression) + (dict.new text.Hash<Text>)) diff --git a/new-luxc/source/luxc/lang/extension/statement.lux b/new-luxc/source/luxc/lang/extension/statement.lux new file mode 100644 index 000000000..6e9530f38 --- /dev/null +++ b/new-luxc/source/luxc/lang/extension/statement.lux @@ -0,0 +1,146 @@ +(.module: + lux + (lux (control [monad #+ do] + ["ex" exception #+ exception:]) + (data [text] + text/format + (coll [list "list/" Functor<List>] + [dict #+ Dict])) + [macro] + (lang (type ["tc" check])) + [io #+ IO]) + [//] + (luxc [lang] + (lang [".L" host] + (host ["$" jvm]) + (analysis [".A" common] + [".A" expression]) + (synthesis [".S" expression]) + (translation [".T" expression] + [".T" statement] + [".T" eval]) + [".L" eval]))) + +(exception: #export Invalid-Statement) +(exception: #export Invalid-Alias) + +(def: (throw-invalid-statement procedure inputsC+) + (All [a] (-> Text (List Code) (Meta a))) + (lang.throw Invalid-Statement + (format "Statement: " procedure "\n" + " Inputs:" + (|> inputsC+ + list.enumerate + (list/map (function [[idx inputC]] + (format "\n " (%n idx) " " (%code inputC)))) + (text.join-with "")) "\n"))) + +(def: (process-annotations annsC) + (-> Code (Meta [$.Inst Code])) + (do macro.Monad<Meta> + [[_ annsA] (lang.with-scope + (lang.with-type Code + (expressionA.analyser evalL.eval annsC))) + annsI (expressionT.translate (expressionS.synthesize annsA)) + annsV (evalT.eval annsI)] + (wrap [annsI (:! Code annsV)]))) + +(def: (ensure-valid-alias def-name annotations value) + (-> Text Code Code (Meta Unit)) + (case [annotations value] + (^multi [[_ (#.Record pairs)] [_ (#.Symbol _)]] + (|> pairs list.size (n/= +1))) + (:: macro.Monad<Meta> wrap []) + + _ + (lang.throw Invalid-Alias def-name))) + +(def: (lux//def procedure) + (-> Text //.Statement) + (function [inputsC+] + (case inputsC+ + (^ (list [_ (#.Symbol ["" def-name])] valueC annotationsC)) + (hostL.with-context def-name + (lang.with-fresh-type-env + (do macro.Monad<Meta> + [[annotationsI annotationsV] (process-annotations annotationsC)] + (case (macro.get-symbol-ann (ident-for #.alias) annotationsV) + (#.Some real-def) + (do @ + [_ (ensure-valid-alias def-name annotationsV valueC) + _ (lang.with-scope + (statementT.translate-def def-name Void id annotationsI annotationsV))] + (wrap [])) + + #.None + (do @ + [[_ valueT valueA] (lang.with-scope + (if (macro.type? (:! Code annotationsV)) + (do @ + [valueA (lang.with-type Type + (expressionA.analyser evalL.eval valueC))] + (wrap [Type valueA])) + (commonA.with-unknown-type + (expressionA.analyser evalL.eval valueC)))) + valueT (lang.with-type-env + (tc.clean valueT)) + valueI (expressionT.translate (expressionS.synthesize valueA)) + _ (lang.with-scope + (statementT.translate-def def-name valueT valueI annotationsI annotationsV))] + (wrap [])))))) + + _ + (throw-invalid-statement procedure inputsC+)))) + +(def: (lux//program procedure) + (-> Text //.Statement) + (function [inputsC+] + (case inputsC+ + (^ (list [_ (#.Symbol ["" args])] programC)) + (do macro.Monad<Meta> + [[_ programA] (lang.with-scope + (lang.with-type (type (IO Unit)) + (expressionA.analyser evalL.eval programC))) + programI (expressionT.translate (expressionS.synthesize programA)) + _ (statementT.translate-program args programI)] + (wrap [])) + + _ + (throw-invalid-statement procedure inputsC+)))) + +(do-template [<mame> <type> <installer>] + [(def: (<mame> procedure) + (-> Text //.Statement) + (function [inputsC+] + (case inputsC+ + (^ (list [_ (#.Text name)] valueC)) + (do macro.Monad<Meta> + [[_ valueA] (lang.with-scope + (lang.with-type <type> + (expressionA.analyser evalL.eval valueC))) + valueI (expressionT.translate (expressionS.synthesize valueA)) + valueV (evalT.eval valueI) + _ (<installer> name (:! <type> valueV))] + (wrap [])) + + _ + (throw-invalid-statement procedure inputsC+))))] + + [lux//analysis //.Expression //.install-analysis] + [lux//synthesis //.Expression //.install-synthesis] + [lux//translation //.Expression //.install-translation] + [lux//statement //.Statement //.install-statement]) + +(def: #export defaults + (Dict Text //.Statement) + (`` (|> (dict.new text.Hash<Text>) + (~~ (do-template [<name> <extension>] + [(dict.put <name> (<extension> <name>))] + + ["lux def" lux//def] + ["lux program" lux//program] + ["lux analysis" lux//analysis] + ["lux synthesis" lux//synthesis] + ["lux translation" lux//translation] + ["lux statement" lux//statement] + ))))) diff --git a/new-luxc/source/luxc/lang/extension/synthesis.lux b/new-luxc/source/luxc/lang/extension/synthesis.lux new file mode 100644 index 000000000..d034f2919 --- /dev/null +++ b/new-luxc/source/luxc/lang/extension/synthesis.lux @@ -0,0 +1,9 @@ +(.module: + lux + (lux (data [text] + (coll [dict #+ Dict]))) + [//]) + +(def: #export defaults + (Dict Text //.Expression) + (dict.new text.Hash<Text>)) diff --git a/new-luxc/source/luxc/lang/extension/translation.lux b/new-luxc/source/luxc/lang/extension/translation.lux new file mode 100644 index 000000000..d034f2919 --- /dev/null +++ b/new-luxc/source/luxc/lang/extension/translation.lux @@ -0,0 +1,9 @@ +(.module: + lux + (lux (data [text] + (coll [dict #+ Dict]))) + [//]) + +(def: #export defaults + (Dict Text //.Expression) + (dict.new text.Hash<Text>)) diff --git a/new-luxc/source/luxc/lang/host/jvm.lux b/new-luxc/source/luxc/lang/host/jvm.lux index cfe71656c..67b28b7b0 100644 --- a/new-luxc/source/luxc/lang/host/jvm.lux +++ b/new-luxc/source/luxc/lang/host/jvm.lux @@ -1,5 +1,5 @@ (.module: - [lux #- Type Def] + [lux #- Type] (lux (control monad ["p" parser]) (data (coll [list "list/" Functor<List>])) diff --git a/new-luxc/source/luxc/lang/module.lux b/new-luxc/source/luxc/lang/module.lux index 58bf94571..ebc0ee7b0 100644 --- a/new-luxc/source/luxc/lang/module.lux +++ b/new-luxc/source/luxc/lang/module.lux @@ -25,7 +25,7 @@ (-> Nat Module) {#.module-hash hash #.module-aliases (list) - #.defs (list) + #.definitions (list) #.imports (list) #.tags (list) #.types (list) @@ -82,16 +82,16 @@ (def: #export (define (^@ full-name [module-name def-name]) definition) - (-> Ident Def (Meta Unit)) + (-> Ident Definition (Meta Unit)) (function [compiler] (case (&.pl-get module-name (get@ #.modules compiler)) (#.Some module) - (case (&.pl-get def-name (get@ #.defs module)) + (case (&.pl-get def-name (get@ #.definitions module)) #.None (#e.Success [(update@ #.modules (&.pl-put module-name - (update@ #.defs - (: (-> (List [Text Def]) (List [Text Def])) + (update@ #.definitions + (: (-> (List [Text Definition]) (List [Text Definition])) (|>> (#.Cons [def-name definition]))) module)) compiler) diff --git a/new-luxc/source/luxc/lang/translation.lux b/new-luxc/source/luxc/lang/translation.lux index 6cba6cc35..a0e5bca97 100644 --- a/new-luxc/source/luxc/lang/translation.lux +++ b/new-luxc/source/luxc/lang/translation.lux @@ -20,17 +20,24 @@ (lang [".L" module] [".L" host] [".L" macro] + [".L" extension] + (extension [".E" analysis] + [".E" synthesis] + [".E" translation] + [".E" statement]) (host ["$" jvm]) (analysis [".A" expression] [".A" common]) (synthesis [".S" expression]) (translation [".T" runtime] [".T" statement] - [".T" common] + [".T" common #+ Artifacts] [".T" expression] [".T" eval] [".T" imports]) - ["&." eval]) + ["&." eval] + ## [".L" cache] + ) )) (def: analyse @@ -39,7 +46,6 @@ (exception: #export Macro-Expansion-Failed) (exception: #export Unrecognized-Statement) -(exception: #export Invalid-Alias) (exception: #export Invalid-Macro) (def: (process-annotations annsC) @@ -60,55 +66,9 @@ (wrap (|> this (get@ #.module-aliases) (dict.from-list text.Hash<Text>) (: Aliases)))) new-compiler))) -(def: (ensure-valid-alias def-name annotations value) - (-> Text Code Code (Meta Unit)) - (case [annotations value] - (^multi [[_ (#.Record pairs)] [_ (#.Symbol _)]] - (|> pairs list.size (n/= +1))) - (:: macro.Monad<Meta> wrap []) - - _ - (&.throw Invalid-Alias def-name))) - (def: #export (translate translate-module aliases code) (-> (-> Text Compiler (Process Compiler)) Aliases Code (Meta Aliases)) (case code - (^code ("lux def" (~ [_ (#.Symbol ["" def-name])]) (~ valueC) (~ annsC))) - (hostL.with-context def-name - (&.with-fresh-type-env - (do macro.Monad<Meta> - [[annsI annsV] (process-annotations annsC)] - (case (macro.get-symbol-ann (ident-for #.alias) annsV) - (#.Some real-def) - (do @ - [_ (ensure-valid-alias def-name annsV valueC) - _ (&.with-scope - (statementT.translate-def def-name Void id annsI annsV))] - (wrap aliases)) - - #.None - (do @ - [[_ valueT valueA] (&.with-scope - (if (macro.type? (:! Code annsV)) - (do @ - [valueA (&.with-type Type - (analyse valueC))] - (wrap [Type valueA])) - (commonA.with-unknown-type - (analyse valueC)))) - valueT (&.with-type-env - (tc.clean valueT)) - ## #let [_ (if (or (text/= "string~" def-name)) - ## (log! (format "{" def-name "}\n" - ## " TYPE: " (%type valueT) "\n" - ## " ANALYSIS: " (%code valueA) "\n" - ## "SYNTHESIS: " (%code (expressionS.synthesize valueA)))) - ## [])] - valueI (expressionT.translate (expressionS.synthesize valueA)) - _ (&.with-scope - (statementT.translate-def def-name valueT valueI annsI annsV))] - (wrap aliases)))))) - (^code ("lux module" (~ annsC))) (do macro.Monad<Meta> [[annsI annsV] (process-annotations annsC) @@ -120,15 +80,12 @@ (#e.Error error) (macro.fail error))) - (^code ("lux program" (~ [_ (#.Symbol ["" program-args])]) (~ programC))) + (^code ((~ [_ (#.Text statement)]) (~+ argsC+))) (do macro.Monad<Meta> - [[_ programA] (&.with-scope - (&.with-type (type (io.IO Unit)) - (analyse programC))) - programI (expressionT.translate (expressionS.synthesize programA)) - _ (statementT.translate-program program-args programI)] + [statement (extensionL.find-statement statement) + _ (statement argsC+)] (wrap aliases)) - + (^code ((~ macroC) (~+ argsC+))) (do macro.Monad<Meta> [[_ macroA] (&.with-scope @@ -199,6 +156,22 @@ (#e.Success [(set@ #.source source' compiler) output])))) +(def: (write-module target-dir module-name module artifacts) + (-> File Text Module Artifacts (Process Unit)) + (do io.Monad<Process> + [_ (monad.map @ (function [[name content]] + (&io.write target-dir + (format module-name "/" name (for {"JVM" ".class" + "JS" ".js"})) + content)) + (dict.entries artifacts))] + (wrap []) + ## (&io.write (format module-dir "/" cacheL.descriptor-name) + ## (text-to-blob (%code (cacheL.describe module)))) + )) + +(def: no-aliases Aliases (dict.new text.Hash<Text>)) + (def: #export (translate-module source-dirs target-dir module-name compiler) (-> (List File) File Text Compiler (Process Compiler)) (do io.Monad<Process> @@ -208,26 +181,23 @@ translate-module (translate-module source-dirs target-dir)]] (case (macro.run' compiler (do macro.Monad<Meta> - [[_ artifacts _] (moduleL.with-module module-hash module-name - (commonT.with-artifacts - (with-active-compilation [module-name - file-name - file-content] - (forgive-eof - (loop [aliases (: Aliases - (dict.new text.Hash<Text>))] - (do @ - [code (read module-name aliases) - #let [[cursor _] code] - aliases' (&.with-cursor cursor - (translate translate-module aliases code))] - (forgive-eof (recur aliases'))))))))] - (wrap artifacts))) - (#e.Success [compiler artifacts]) + [[module artifacts _] (moduleL.with-module module-hash module-name + (commonT.with-artifacts + (with-active-compilation [module-name + file-name + file-content] + (forgive-eof + (loop [aliases no-aliases] + (do @ + [code (read module-name aliases) + #let [[cursor _] code] + aliases' (&.with-cursor cursor + (translate translate-module aliases code))] + (forgive-eof (recur aliases'))))))))] + (wrap [module artifacts]))) + (#e.Success [compiler [module artifacts]]) (do @ - [## _ (monad.map @ (function [[class-name class-bytecode]] - ## (&io.write-file target-dir class-name class-bytecode)) - ## (dict.entries artifacts)) + [## _ (write-module target-dir module-name module artifacts) ] (wrap compiler)) @@ -253,7 +223,7 @@ (-> commonT.Host Compiler) {#.info init-info #.source [init-cursor +0 ""] - #.cursor init-cursor + #.cursor .dummy-cursor #.current-module #.None #.modules (list) #.scopes (list) @@ -261,23 +231,35 @@ #.expected #.None #.seed +0 #.scope-type-vars (list) + #.extensions (:! Void extensionL.fresh) #.host (:! Void host)}) -(def: #export (translate-program sources target program) - (-> (List File) File Text (T.Task Unit)) - (do T.Monad<Task> - [compiler (|> (case (runtimeT.translate (init-compiler (io.run hostL.init-host))) - (#e.Error error) - (T.fail error) +(def: (initialize sources target) + (-> (List File) File (Process Compiler)) + (do io.Monad<Process> + [compiler (: (Process Compiler) + (case (runtimeT.translate (init-compiler (io.run hostL.init-host))) + (#e.Error error) + (io.fail error) - (#e.Success [compiler [runtime-bc function-bc]]) - (do @ - [_ (&io.prepare-target target) - _ (&io.write-file target (format hostL.runtime-class ".class") runtime-bc) - _ (&io.write-file target (format hostL.function-class ".class") function-bc)] - (wrap compiler))) - (: (T.Task Compiler)) - (:: @ map (|>> (translate-module sources target prelude) P.future)) (:: @ join) - (:: @ map (|>> (translate-module sources target program) P.future)) (:: @ join)) + (#e.Success [compiler [runtime-bc function-bc]]) + (do @ + [_ (&io.prepare-target target) + _ (&io.write target (format hostL.runtime-class ".class") runtime-bc) + _ (&io.write target (format hostL.function-class ".class") function-bc)] + (wrap (set@ #.extensions + (:! Void + {#extensionL.analysis analysisE.defaults + #extensionL.synthesis synthesisE.defaults + #extensionL.translation translationE.defaults + #extensionL.statement statementE.defaults}) + compiler)))))] + (translate-module sources target prelude compiler))) + +(def: #export (translate-program sources target program) + (-> (List File) File Text (Process Unit)) + (do io.Monad<Process> + [compiler (initialize sources target) + _ (translate-module sources target program compiler) #let [_ (log! "Compilation complete!")]] (wrap []))) diff --git a/new-luxc/source/luxc/lang/translation/common.jvm.lux b/new-luxc/source/luxc/lang/translation/common.jvm.lux index b75b0672b..1132928d0 100644 --- a/new-luxc/source/luxc/lang/translation/common.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/common.jvm.lux @@ -98,7 +98,5 @@ (#e.Success [compiler (ClassLoader::loadClass [name] (get@ #loader host))]) (ex.throw Unknown-Class name))))) -## (def: #export bytecode-version Int Opcodes::V1_6) - (def: #export value-field Text "_value") (def: #export $Object $.Type ($t.class "java.lang.Object" (list))) diff --git a/new-luxc/source/luxc/repl.lux b/new-luxc/source/luxc/repl.lux index 15f343a7d..466446003 100644 --- a/new-luxc/source/luxc/repl.lux +++ b/new-luxc/source/luxc/repl.lux @@ -53,7 +53,9 @@ (moduleL.with-module +0 repl-module runtimeT.translate)) (#e.Success [compiler _]) - (translationL.translate-module source-dirs target-dir translationL.prelude compiler) + (|> compiler + (set@ [#.info #.mode] #.REPL) + (translationL.translate-module source-dirs target-dir translationL.prelude)) (#e.Error error) (wrap (#e.Error error)))))] @@ -295,11 +297,7 @@ (macro.run' compiler (lang.with-current-module repl-module (do macro.Monad<Meta> - [[exprT exprV] (repl-translate source-dirs target-dir exprC) - ## [var-id varT] (lang.with-type-env check.var) - ## exprV (evalL.eval varT exprC) - ## ?exprT (lang.with-type-env (check.read var-id)) - ] + [[exprT exprV] (repl-translate source-dirs target-dir exprC)] (wrap [source' exprT exprV]))))) (#e.Success [compiler' [source' exprT exprV]]) (do @ diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux index 17eb44933..99cefa854 100644 --- a/stdlib/source/lux.lux +++ b/stdlib/source/lux.lux @@ -717,6 +717,7 @@ ## #expected (Maybe Type) ## #seed Nat ## #scope-type-vars (List Nat) +## #extensions Void ## #host Void}) ("lux def" Compiler (#Named ["lux" "Compiler"] @@ -740,8 +741,10 @@ Nat (#Product ## scope-type-vars (#Apply Nat List) - ## "lux.host" - Void))))))))))) + (#Product ## extensions + Void + ## "lux.host" + Void)))))))))))) (record$ (#Cons [(tag$ ["lux" "tags"]) (tuple$ (#Cons (text$ "info") (#Cons (text$ "source") @@ -753,8 +756,9 @@ (#Cons (text$ "expected") (#Cons (text$ "seed") (#Cons (text$ "scope-type-vars") - (#Cons (text$ "host") - #Nil))))))))))))] + (#Cons (text$ "extensions") + (#Cons (text$ "host") + #Nil)))))))))))))] (#Cons [(tag$ ["lux" "doc"]) (text$ "Represents the state of the Lux compiler during a run. @@ -1808,7 +1812,7 @@ (let' [[module name] ident {#info info #source source #current-module _ #modules modules #scopes scopes #type-context types #host host - #seed seed #expected expected #cursor cursor + #seed seed #expected expected #cursor cursor #extensions extensions #scope-type-vars scope-type-vars} state] ("lux case" (get module modules) {(#Some {#module-hash _ #module-aliases _ #definitions definitions #imports _ #tags tags #types types #module-annotations _ #module-state _}) @@ -1984,7 +1988,7 @@ ("lux case" state {{#info info #source source #current-module current-module #modules modules #scopes scopes #type-context types #host host - #seed seed #expected expected #cursor cursor + #seed seed #expected expected #cursor cursor #extensions extensions #scope-type-vars scope-type-vars} ("lux case" current-module {(#Some module-name) @@ -2466,7 +2470,7 @@ {{#info info #source source #current-module _ #modules modules #scopes scopes #type-context types #host host #seed seed #expected expected - #cursor cursor + #cursor cursor #extensions extensions #scope-type-vars scope-type-vars} (#Right state (find-macro' modules current-module module name))}))))) @@ -2730,12 +2734,12 @@ {{#info info #source source #current-module _ #modules modules #scopes scopes #type-context types #host host #seed seed #expected expected - #cursor cursor + #cursor cursor #extensions extensions #scope-type-vars scope-type-vars} (#Right {#info info #source source #current-module _ #modules modules #scopes scopes #type-context types #host host #seed (n/+ +1 seed) #expected expected - #cursor cursor + #cursor cursor #extensions extensions #scope-type-vars scope-type-vars} (symbol$ ["" ($_ text/compose "__gensym__" prefix (nat/encode seed))]))})) @@ -3575,7 +3579,7 @@ (function [state] (let [{#info info #source source #current-module _ #modules modules #scopes scopes #type-context types #host host - #seed seed #expected expected #cursor cursor + #seed seed #expected expected #cursor cursor #extensions extensions #scope-type-vars scope-type-vars} state] (case (get name modules) (#Some module) @@ -3638,7 +3642,7 @@ (function [state] (let [{#info info #source source #current-module _ #modules modules #scopes scopes #type-context types #host host - #seed seed #expected expected #cursor cursor + #seed seed #expected expected #cursor cursor #extensions extensions #scope-type-vars scope-type-vars} state] (case expected (#Some type) @@ -4165,7 +4169,7 @@ (let [modules (case state {#info info #source source #current-module _ #modules modules #scopes scopes #type-context types #host host - #seed seed #expected expected #cursor cursor + #seed seed #expected expected #cursor cursor #extensions extensions #scope-type-vars scope-type-vars} modules)] (case (get module modules) @@ -4219,7 +4223,7 @@ (case state {#info info #source source #current-module _ #modules modules #scopes scopes #type-context types #host host - #seed seed #expected expected #cursor cursor + #seed seed #expected expected #cursor cursor #extensions extensions #scope-type-vars scope-type-vars} (find (: (-> Scope (Maybe Type)) (function [env] @@ -4242,7 +4246,7 @@ (let [[v-prefix v-name] name {#info info #source source #current-module _ #modules modules #scopes scopes #type-context types #host host - #seed seed #expected expected #cursor cursor + #seed seed #expected expected #cursor cursor #extensions extensions #scope-type-vars scope-type-vars} state] (case (get v-prefix modules) #None @@ -4261,7 +4265,7 @@ (let [[v-prefix v-name] name {#info info #source source #current-module _ #modules modules #scopes scopes #type-context types #host host - #seed seed #expected expected #cursor cursor + #seed seed #expected expected #cursor cursor #extensions extensions #scope-type-vars scope-type-vars} state] (case (get v-prefix modules) #None @@ -4314,7 +4318,7 @@ (#Right [compiler (#Var type-id)]) (let [{#info _ #source _ #current-module _ #modules _ #scopes _ #type-context type-context #host _ - #seed _ #expected _ #cursor _ + #seed _ #expected _ #cursor _ #extensions extensions #scope-type-vars _} compiler {#ex-counter _ #var-counter _ #var-bindings var-bindings} type-context] (case (find-type-var type-id var-bindings) @@ -5639,7 +5643,7 @@ (case state {#info info #source source #current-module _ #modules modules #scopes scopes #type-context types #host host - #seed seed #expected expected #cursor cursor + #seed seed #expected expected #cursor cursor #extensions extensions #scope-type-vars scope-type-vars} (#Right state scope-type-vars) )) diff --git a/stdlib/source/lux/world/file.lux b/stdlib/source/lux/world/file.lux index b33cf9540..1c295da08 100644 --- a/stdlib/source/lux/world/file.lux +++ b/stdlib/source/lux/world/file.lux @@ -29,7 +29,8 @@ (setLastModified [long] #io #try boolean) (canRead [] #io #try boolean) (canWrite [] #io #try boolean) - (canExecute [] #io #try boolean)) + (canExecute [] #io #try boolean) + (#static separator String)) (host.import java/lang/AutoCloseable (close [] #io #try void)) @@ -116,3 +117,5 @@ (-> i.Instant File (Process Bool)) (java/io/File::setLastModified [(|> time i.relative d.to-millis)] (java/io/File::new file))) + +(def: #export separator Text java/io/File::separator) |