diff options
Diffstat (limited to 'new-luxc/source/luxc/lang/translation.lux')
| -rw-r--r-- | new-luxc/source/luxc/lang/translation.lux | 179 |
1 files changed, 179 insertions, 0 deletions
diff --git a/new-luxc/source/luxc/lang/translation.lux b/new-luxc/source/luxc/lang/translation.lux new file mode 100644 index 000000000..4fcc3ccb2 --- /dev/null +++ b/new-luxc/source/luxc/lang/translation.lux @@ -0,0 +1,179 @@ +(;module: + lux + (lux (control [monad #+ do]) + (concurrency ["T" task]) + (data ["e" error] + [text "text/" Hash<Text>] + text/format + (coll [dict])) + [meta] + [host] + [io] + (world [file #+ File])) + (luxc ["&" base] + [";L" host] + ["&;" io] + ["&;" module] + ["&;" eval] + (lang ["&;" syntax] + (analysis [";A" expression] + [";A" common]) + (synthesis [";S" expression]) + (translation [";T" runtime] + [";T" statement] + [";T" common] + [";T" expression] + [";T" eval])) + )) + +(def: analyse + (&;Analyser) + (expressionA;analyser &eval;eval)) + +(def: (generate code) + (-> Code (Meta Unit)) + (case code + (^ [_ (#;Form (list [_ (#;Text "lux def")] + [_ (#;Symbol ["" def-name])] + valueC + metaC))]) + (do meta;Monad<Meta> + [[_ metaA] (&;with-scope + (&;with-expected-type Code + (analyse metaC))) + metaI (expressionT;generate (expressionS;synthesize metaA)) + metaV (evalT;eval metaI) + [_ valueT valueA] (&;with-scope + (if (meta;type? (:! Code metaV)) + (&;with-expected-type Type + (do @ + [valueA (analyse valueC)] + (wrap [Type valueA]))) + (commonA;with-unknown-type + (analyse valueC)))) + valueI (expressionT;generate (expressionS;synthesize valueA)) + _ (&;with-scope + (statementT;generate-def def-name valueT valueI metaI (:! Code metaV)))] + (wrap [])) + + (^ [_ (#;Form (list [_ (#;Text "lux program")] + [_ (#;Symbol ["" program-args])] + programC))]) + (do meta;Monad<Meta> + [[_ programA] (&;with-scope + (&;with-expected-type (type (io;IO Unit)) + (analyse programC))) + programI (expressionT;generate (expressionS;synthesize programA))] + (statementT;generate-program program-args programI)) + + _ + (&;fail (format "Unrecognized statement: " (%code code))))) + +(def: (exhaust action) + (All [a] (-> (Meta a) (Meta Unit))) + (do meta;Monad<Meta> + [result action] + (exhaust action))) + +(def: prelude Text "lux") + +(def: (with-active-compilation [module-name file-name source-code] action) + (All [a] (-> [Text Text Text] (Meta a) (Meta a))) + (do meta;Monad<Meta> + [#let [init-cursor [file-name +1 +0]] + output (&;with-source-code [init-cursor +0 source-code] + action) + _ (&module;flag-compiled! module-name)] + (wrap output))) + +(def: parse + (Meta Code) + (function [compiler] + (case (&syntax;parse (get@ #;source compiler)) + (#e;Error error) + (#e;Error error) + + (#e;Success [source' output]) + (#e;Success [(set@ #;source source' compiler) + output])))) + +(def: (generate-module source-dirs module-name target-dir compiler) + (-> (List File) Text File Compiler (T;Task Compiler)) + (do T;Monad<Task> + [_ (&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)]] + (case (meta;run' compiler + (do meta;Monad<Meta> + [[_ artifacts _] (&module;with-module module-hash module-name + (commonT;with-artifacts + (with-active-compilation [module-name + file-name + file-content] + (exhaust + (do @ + [code parse + #let [[cursor _] code]] + (&;with-cursor cursor + (generate code)))))))] + (wrap artifacts) + ## (&module;generate-descriptor module-name) + )) + (#e;Success [compiler artifacts ## module-descriptor + ]) + (do @ + [## _ (&io;write-module module-name module-descriptor) + _ (monad;map @ (function [[class-name class-bytecode]] + (&io;write-file target-dir class-name class-bytecode)) + (dict;entries artifacts))] + (wrap compiler)) + + (#e;Error error) + (T;fail error)))) + +(def: init-cursor Cursor ["" +1 +0]) + +(def: #export init-type-context + Type-Context + {#;ex-counter +0 + #;var-counter +0 + #;var-bindings (list)}) + +(def: #export init-info + Info + {#;target "JVM" + #;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)}) + +(def: #export (generate-program program target sources) + (-> Text File (List File) (T;Task Unit)) + (do T;Monad<Task> + [compiler (|> (case (runtimeT;generate (init-compiler (io;run hostL;init-host))) + (#e;Error error) + (T;fail error) + + (#e;Success [compiler [runtime-bc function-bc]]) + (do @ + [_ (&io;prepare-target target) + _ (&io;write-file target hostL;runtime-class runtime-bc) + _ (&io;write-file target hostL;function-class function-bc)] + (wrap compiler))) + (: (T;Task Compiler)) + (:: @ map (generate-module sources prelude target)) (:: @ join) + (:: @ map (generate-module sources program target)) (:: @ join)) + #let [_ (log! "Compilation complete!")]] + (wrap []))) |