From bf47bd7b3d4f70bc3a481761b8e9ff074313fb44 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 3 May 2017 18:17:00 -0400 Subject: - WIP: Implemented more functionality. - Lots of refactorings. --- new-luxc/source/luxc/compiler.lux | 154 ++++++++++++++++++++++++++------------ 1 file changed, 107 insertions(+), 47 deletions(-) (limited to 'new-luxc/source/luxc/compiler.lux') diff --git a/new-luxc/source/luxc/compiler.lux b/new-luxc/source/luxc/compiler.lux index 205c62df0..4ac865786 100644 --- a/new-luxc/source/luxc/compiler.lux +++ b/new-luxc/source/luxc/compiler.lux @@ -1,14 +1,15 @@ (;module: lux (lux (control monad) - [io #- run] + (concurrency ["P" promise]) (data ["E" error] - [text "T/" Eq] + [text "T/" Hash] text/format) [macro #+ Monad]) (luxc ["&" base] ["&;" io] ["&;" module] + ["&;" parser] (compiler ["&&;" runtime] ["&&;" statement]) )) @@ -36,60 +37,119 @@ [result action] (exhaust action))) -(def: (compile-module source-dirs module-name compiler-state) - (-> (List &;Path) Text Compiler (IO (Error Compiler))) - (do Monad - [[file-name file-content] (&io;read-module source-dirs module-name) - #let [file-hash (T/hash file-content)] - #let [result (macro;run compiler-state - (do Monad - [module-exists? (&module;exists? module-name)] - (if module-exists? - (&;fail (format "Cannot re-define a module: " module-name)) - (wrap []))))]] - (case result - (#E;Success [compiler-state _]) - (let [result (macro;run compiler-state - (do Monad - [_ (&module;create module-name file-hash) - _ (&module;flag-active module-name) - _ (if (T/= "lux" module-name) - &&runtime;compile-runtime - (wrap [])) - _ (exhaust - (do @ - [ast parse] - (compile ast))) - _ (&module;flag-compiled module-name)] - (&module;generate-module file-hash module-name)))] - (case result - (#E;Success [compiler-state module-descriptor]) - (do @ - [_ (&io;write-module module-name module-descriptor)] - (wrap (#E;Success compiler-state))) +(def: (ensure-new-module! file-hash module-name) + (-> Nat Text (Lux Unit)) + (do Monad + [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 + [_ (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 AST) + (function [compiler] + (case (&parser;parse (get@ #;source compiler)) + (#E;Error error) + (#E;Error error) + + (#E;Success [source' output]) + (#E;Success [(set@ #;source source' compiler) + output])))) + +(def: (compile-module source-dirs module-name compiler) + (-> (List &;Path) Text Compiler (P;Promise (E;Error Compiler))) + (do P;Monad + [?input (&io;read-module source-dirs module-name)] + (case ?input + (#E;Success [file-name file-content]) + (let [compilation (do Monad + [_ (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) + (#E;Success [compiler module-descriptor]) + (do @ + [## _ (&io;write-module module-name module-descriptor) + ] + (wrap (#E;Success compiler))) + (#E;Error error) (wrap (#E;Error error)))) - + (#E;Error error) (wrap (#E;Error error))))) -(def: (or-crash! action) - (All [a] (-> (IO (E;Error a)) (IO a))) - (do Monad - [result action] - (case result - (#E;Success output) - (wrap output) +(type: Host Unit) + +(def: init-host Host []) + +(def: init-cursor Cursor ["" +0 +0]) + +(def: init-type-context + Type-Context + {#;ex-counter +0 + #;var-counter +0 + #;var-bindings (list)}) +(def: compiler-version Text "0.6.0") + +(def: init-compiler-info + Compiler-Info + {#;compiler-version compiler-version + #;compiler-mode #;Release}) + +(def: (init-compiler host) + (-> 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 (E;Error a)) (P;Promise a))) + (do P;Monad + [?output action] + (case ?output (#E;Error error) - (error! (format "Compilation failed:\n" error))))) + (error! error) + + (#E;Success output) + (wrap output)))) (def: #export (compile-program mode program target sources) - (-> &;Mode &;Path &;Path (List &;Path) (IO Unit)) - (do Monad - [#let [compiler-state (init-compiler-state mode host-state)] - compiler-state (or-crash! (compile-module source-dirs "lux" compiler-state)) - compiler-state (or-crash! (compile-module source-dirs program compiler-state)) + (-> &;Mode &;Path &;Path (List &;Path) (P;Promise Unit)) + (do P;Monad + [#let [compiler (init-compiler init-host)] + _ (or-crash! (&&runtime;compile-runtime [])) + compiler (or-crash! (compile-module sources prelude compiler)) + compiler (or-crash! (compile-module sources program compiler)) #let [_ (log! "Compilation complete!")]] (wrap []))) -- cgit v1.2.3