diff options
Diffstat (limited to 'new-luxc/source/luxc/lang/translation.lux')
| -rw-r--r-- | new-luxc/source/luxc/lang/translation.lux | 268 |
1 files changed, 134 insertions, 134 deletions
diff --git a/new-luxc/source/luxc/lang/translation.lux b/new-luxc/source/luxc/lang/translation.lux index 86b9842b6..07f1fe533 100644 --- a/new-luxc/source/luxc/lang/translation.lux +++ b/new-luxc/source/luxc/lang/translation.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control [monad #+ do] ["ex" exception #+ exception:]) @@ -16,160 +16,160 @@ [io #+ IO Process io] (world [file #+ File])) (luxc ["&" lang] - ["&;" io] - (lang [";L" module] - [";L" host] - [";L" macro] + ["&." io] + (lang [".L" module] + [".L" host] + [".L" macro] (host ["$" jvm]) - (analysis [";A" expression] - [";A" common]) - (synthesis [";S" expression]) - (translation [";T" runtime] - [";T" statement] - [";T" common] - [";T" expression] - [";T" eval] - [";T" imports]) - ["&;" eval]) + (analysis [".A" expression] + [".A" common]) + (synthesis [".S" expression]) + (translation [".T" runtime] + [".T" statement] + [".T" common] + [".T" expression] + [".T" eval] + [".T" imports]) + ["&." eval]) )) (def: analyse - (&;Analyser) - (expressionA;analyser &eval;eval)) + (&.Analyser) + (expressionA.analyser &eval.eval)) (exception: #export Macro-Expansion-Failed) (exception: #export Unrecognized-Statement) (exception: #export Invalid-Alias) (def: (process-annotations annsC) - (-> Code (Meta [$;Inst Code])) - (do macro;Monad<Meta> - [[_ annsA] (&;with-scope - (&;with-type Code + (-> Code (Meta [$.Inst Code])) + (do macro.Monad<Meta> + [[_ annsA] (&.with-scope + (&.with-type Code (analyse annsC))) - annsI (expressionT;translate (expressionS;synthesize annsA)) - annsV (evalT;eval annsI)] + annsI (expressionT.translate (expressionS.synthesize annsA)) + annsV (evalT.eval annsI)] (wrap [annsI (:! Code annsV)]))) (def: (switch-compiler new-compiler) (-> Compiler (Meta Aliases)) (function [old-compiler] - ((do macro;Monad<Meta> - [this macro;current-module] - (wrap (|> this (get@ #;module-aliases) (dict;from-list text;Hash<Text>) (: Aliases)))) + ((do macro.Monad<Meta> + [this macro.current-module] + (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 []) + (^multi [[_ (#.Record pairs)] [_ (#.Symbol _)]] + (|> pairs list.size (n/= +1))) + (:: macro.Monad<Meta> wrap []) _ - (&;throw Invalid-Alias def-name))) + (&.throw Invalid-Alias def-name))) (def: #export (translate translate-module aliases code) (-> (-> Text Compiler (Process Compiler)) Aliases Code (Meta Aliases)) (case code - (^code ((~ [_ (#;Symbol macro-name)]) (~@ args))) - (do macro;Monad<Meta> - [?macro (&;with-error-tracking - (macro;find-macro macro-name))] + (^code ((~ [_ (#.Symbol macro-name)]) (~@ args))) + (do macro.Monad<Meta> + [?macro (&.with-error-tracking + (macro.find-macro macro-name))] (case ?macro - (#;Some macro) + (#.Some macro) (do @ [expansion (: (Meta (List Code)) (function [compiler] - (case (macroL;expand macro args compiler) - (#e;Error error) - ((&;throw Macro-Expansion-Failed error) compiler) + (case (macroL.expand macro args compiler) + (#e.Error error) + ((&.throw Macro-Expansion-Failed error) compiler) output output))) - expansion-aliases (monad;map @ (translate translate-module aliases) expansion)] - (if (dict;empty? aliases) + expansion-aliases (monad.map @ (translate translate-module aliases) expansion)] + (if (dict.empty? aliases) (loop [expansion-aliases expansion-aliases] (case expansion-aliases - #;Nil + #.Nil (wrap aliases) - (#;Cons head tail) - (if (dict;empty? head) + (#.Cons head tail) + (if (dict.empty? head) (recur tail) (wrap head)))) (wrap aliases))) - #;None - (&;throw Unrecognized-Statement (%code code)))) + #.None + (&.throw Unrecognized-Statement (%code code)))) - (^code ("lux def" (~ [_ (#;Symbol ["" def-name])]) (~ valueC) (~ annsC))) - (hostL;with-context def-name - (&;with-fresh-type-env - (do macro;Monad<Meta> + (^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) + (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))] + _ (&.with-scope + (statementT.translate-def def-name Void id annsI annsV))] (wrap aliases)) - #;None + #.None (do @ - [[_ valueT valueA] (&;with-scope - (if (macro;type? (:! Code annsV)) + [[_ valueT valueA] (&.with-scope + (if (macro.type? (:! Code annsV)) (do @ - [valueA (&;with-type Type + [valueA (&.with-type Type (analyse valueC))] (wrap [Type valueA])) - (commonA;with-unknown-type + (commonA.with-unknown-type (analyse valueC)))) - valueT (&;with-type-env - (tc;clean valueT)) + 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)))) + ## "SYNTHESIS: " (%code (expressionS.synthesize valueA)))) ## [])] - valueI (expressionT;translate (expressionS;synthesize valueA)) - _ (&;with-scope - (statementT;translate-def def-name valueT valueI annsI annsV))] + 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> + (do macro.Monad<Meta> [[annsI annsV] (process-annotations annsC) - process (importsT;translate-imports translate-module annsV)] - (case (io;run process) - (#e;Success compiler') + process (importsT.translate-imports translate-module annsV)] + (case (io.run process) + (#e.Success compiler') (switch-compiler compiler') - (#e;Error error) - (macro;fail error))) + (#e.Error error) + (macro.fail error))) - (^code ("lux program" (~ [_ (#;Symbol ["" program-args])]) (~ programC))) - (do macro;Monad<Meta> - [[_ programA] (&;with-scope - (&;with-type (type (io;IO Unit)) + (^code ("lux program" (~ [_ (#.Symbol ["" program-args])]) (~ programC))) + (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)] + programI (expressionT.translate (expressionS.synthesize programA)) + _ (statementT.translate-program program-args programI)] (wrap aliases)) _ - (&;throw Unrecognized-Statement (%code code)))) + (&.throw Unrecognized-Statement (%code code)))) (def: (forgive-eof action) (-> (Meta Unit) (Meta Unit)) (function [compiler] (case (action compiler) - (#e;Error error) - (if (ex;match? syntax;End-Of-File error) - (#e;Success [compiler []]) - (#e;Error error)) + (#e.Error error) + (if (ex.match? syntax.End-Of-File error) + (#e.Success [compiler []]) + (#e.Error error)) output output))) @@ -178,103 +178,103 @@ (def: (with-active-compilation [module-name file-name source-code] action) (All [a] (-> [Text Text Text] (Meta a) (Meta a))) - (do macro;Monad<Meta> + (do macro.Monad<Meta> [#let [init-cursor [file-name +1 +0]] - output (&;with-source-code [init-cursor +0 source-code] + output (&.with-source-code [init-cursor +0 source-code] action) - _ (moduleL;flag-compiled! module-name)] + _ (moduleL.flag-compiled! module-name)] (wrap output))) (def: (read current-module aliases) (-> Text Aliases (Meta Code)) (function [compiler] - (case (syntax;read current-module aliases (get@ #;source compiler)) - (#e;Error error) - (#e;Error error) + (case (syntax.read current-module aliases (get@ #.source compiler)) + (#e.Error error) + (#e.Error error) - (#e;Success [source' output]) - (#e;Success [(set@ #;source source' compiler) + (#e.Success [source' output]) + (#e.Success [(set@ #.source source' compiler) output])))) (def: #export (translate-module source-dirs target-dir module-name compiler) (-> (List File) File Text Compiler (Process Compiler)) - (do io;Monad<Process> - [## _ (&io;prepare-module target-dir module-name) - [file-name file-content] (&io;read-module source-dirs module-name) + (do io.Monad<Process> + [## _ (&io.prepare-module target-dir module-name) + [file-name file-content] (&io.read-module source-dirs module-name) #let [module-hash (text/hash file-content) 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 + (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>))] + (dict.new text.Hash<Text>))] (do @ [code (read module-name aliases) #let [[cursor _] code] - aliases' (&;with-cursor cursor + aliases' (&.with-cursor cursor (translate translate-module aliases code))] (forgive-eof (recur aliases'))))))))] (wrap artifacts))) - (#e;Success [compiler artifacts]) + (#e.Success [compiler artifacts]) (do @ - [## _ (monad;map @ (function [[class-name class-bytecode]] - ## (&io;write-file target-dir class-name class-bytecode)) - ## (dict;entries artifacts)) + [## _ (monad.map @ (function [[class-name class-bytecode]] + ## (&io.write-file target-dir class-name class-bytecode)) + ## (dict.entries artifacts)) ] (wrap compiler)) - (#e;Error error) - (io;fail error)))) + (#e.Error error) + (io.fail error)))) (def: init-cursor Cursor ["" +1 +0]) (def: #export init-type-context Type-Context - {#;ex-counter +0 - #;var-counter +0 - #;var-bindings (list)}) + {#.ex-counter +0 + #.var-counter +0 + #.var-bindings (list)}) (def: #export init-info Info - {#;target (for {"JVM" "JVM" + {#.target (for {"JVM" "JVM" "JS" "JS"}) - #;version &;version - #;mode #;Build}) + #.version &.version + #.mode #.Build}) (def: #export (init-compiler host) - (-> commonT;Host Compiler) - {#;info init-info - #;source [init-cursor +0 ""] - #;cursor init-cursor - #;current-module #;None - #;modules (list) - #;scopes (list) - #;type-context init-type-context - #;expected #;None - #;seed +0 - #;scope-type-vars (list) - #;host (:! Void host)}) + (-> commonT.Host Compiler) + {#.info init-info + #.source [init-cursor +0 ""] + #.cursor init-cursor + #.current-module #.None + #.modules (list) + #.scopes (list) + #.type-context init-type-context + #.expected #.None + #.seed +0 + #.scope-type-vars (list) + #.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) + (-> (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) - (#e;Success [compiler [runtime-bc function-bc]]) + (#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)] + [_ (&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)) + (: (T.Task Compiler)) + (:: @ map (|>> (translate-module sources target prelude) P.future)) (:: @ join) + (:: @ map (|>> (translate-module sources target program) P.future)) (:: @ join)) #let [_ (log! "Compilation complete!")]] (wrap []))) |