diff options
author | Eduardo Julian | 2017-06-12 21:14:55 -0400 |
---|---|---|
committer | Eduardo Julian | 2017-06-12 21:14:55 -0400 |
commit | 9cd2927a4f6175784e081d6b512d3e900c8069e7 (patch) | |
tree | d1fe512bc84ea1e3a50ad86eeb3265771edd23c6 /new-luxc/source/luxc/generator.lux | |
parent | c50667a431a5ca67328a230f0c59956dc6ff43fa (diff) |
- Renamed the "compilation" phase as the "generation" phase.
- Implemented compilation of primitives.
- Implemented compilation of structures.
Diffstat (limited to 'new-luxc/source/luxc/generator.lux')
-rw-r--r-- | new-luxc/source/luxc/generator.lux | 158 |
1 files changed, 158 insertions, 0 deletions
diff --git a/new-luxc/source/luxc/generator.lux b/new-luxc/source/luxc/generator.lux new file mode 100644 index 000000000..d095023ff --- /dev/null +++ b/new-luxc/source/luxc/generator.lux @@ -0,0 +1,158 @@ +(;module: + lux + (lux (control monad) + (concurrency ["A" atom] + ["P" promise]) + (data ["R" result] + [text "T/" Hash<Text>] + text/format + (coll ["D" dict] + [array #+ Array])) + [macro #+ Monad<Lux>] + host + [io]) + (luxc ["&" base] + ["&;" io] + ["&;" module] + ["&;" parser] + ["&;" host] + (compiler ["&&;" runtime] + ["&&;" statement] + ["&&;" common]) + )) + +(def: (compile ast) + (-> Code (Lux Unit)) + (case ast + (^ [_ (#;Form (list [_ (#;Symbol ["" "_lux_def"])] + [_ (#;Symbol ["" def-name])] + def-value + def-meta))]) + (&&statement;compile-def def-name def-value def-meta) + + (^ [_ (#;Form (list [_ (#;Symbol ["" "_lux_program"])] + [_ (#;Symbol ["" prog-args])] + prog-body))]) + (&&statement;compile-program prog-args prog-body) + + _ + (&;fail (format "Unrecognized statement: " (%code ast))))) + +(def: (exhaust action) + (All [a] (-> (Lux a) (Lux Unit))) + (do Monad<Lux> + [result action] + (exhaust action))) + +(def: (ensure-new-module! file-hash module-name) + (-> Nat Text (Lux Unit)) + (do Monad<Lux> + [module-exists? (macro;module-exists? module-name) + _ (: (Lux Unit) + (if module-exists? + (&;fail (format "Cannot re-define a module: " module-name)) + (wrap []))) + _ (&module;create file-hash module-name)] + (wrap []))) + +(def: prelude Text "lux") + +(def: (with-active-compilation [module-name file-name source-code] action) + (All [a] (-> [Text Text Text] (Lux a) (Lux a))) + (do Monad<Lux> + [_ (ensure-new-module! (T/hash source-code) module-name) + #let [init-cursor [file-name +0 +0]] + output (&;with-source-code [init-cursor source-code] + action) + _ (&module;flag-compiled! module-name)] + (wrap output))) + +(def: parse + (Lux Code) + (function [compiler] + (case (&parser;parse (get@ #;source compiler)) + (#R;Error error) + (#R;Error error) + + (#R;Success [source' output]) + (#R;Success [(set@ #;source source' compiler) + output])))) + +(def: (compile-module source-dirs module-name compiler) + (-> (List &;Path) Text Compiler (P;Promise (R;Result Compiler))) + (do P;Monad<Promise> + [?input (&io;read-module source-dirs module-name)] + (case ?input + (#R;Success [file-name file-content]) + (let [compilation (do Monad<Lux> + [_ (with-active-compilation [module-name + file-name + file-content] + (exhaust + (do @ + [ast parse] + (compile ast))))] + (wrap []) + ## (&module;generate-descriptor module-name) + )] + (case (macro;run' compiler compilation) + (#R;Success [compiler module-descriptor]) + (do @ + [## _ (&io;write-module module-name module-descriptor) + ] + (wrap (#R;Success compiler))) + + (#R;Error error) + (wrap (#R;Error error)))) + + (#R;Error error) + (wrap (#R;Error error))))) + +(jvm-import org.objectweb.asm.MethodVisitor) + +(def: init-cursor Cursor ["" +0 +0]) + +(def: init-type-context + Type-Context + {#;ex-counter +0 + #;var-counter +0 + #;var-bindings (list)}) + +(def: init-compiler-info + Compiler-Info + {#;compiler-version &;compiler-version + #;compiler-mode #;Build}) + +(def: (init-compiler host) + (-> &&common;Host Compiler) + {#;info init-compiler-info + #;source [init-cursor ""] + #;cursor init-cursor + #;modules (list) + #;scopes (list) + #;type-context init-type-context + #;expected #;None + #;seed +0 + #;scope-type-vars (list) + #;host (:! Void host)}) + +(def: (or-crash! action) + (All [a] (-> (P;Promise (R;Result a)) (P;Promise a))) + (do P;Monad<Promise> + [?output action] + (case ?output + (#R;Error error) + (error! error) + + (#R;Success output) + (wrap output)))) + +(def: #export (compile-program program target sources) + (-> &;Path &;Path (List &;Path) (P;Promise Unit)) + (do P;Monad<Promise> + [#let [compiler (init-compiler (&host;init-host []))] + compiler (or-crash! (&&runtime;compile-runtime compiler)) + compiler (or-crash! (compile-module sources prelude compiler)) + compiler (or-crash! (compile-module sources program compiler)) + #let [_ (log! "Compilation complete!")]] + (wrap []))) |