From 9cd2927a4f6175784e081d6b512d3e900c8069e7 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Mon, 12 Jun 2017 21:14:55 -0400 Subject: - Renamed the "compilation" phase as the "generation" phase. - Implemented compilation of primitives. - Implemented compilation of structures. --- new-luxc/source/luxc/compiler.lux | 222 -------------------------------------- 1 file changed, 222 deletions(-) delete mode 100644 new-luxc/source/luxc/compiler.lux (limited to 'new-luxc/source/luxc/compiler.lux') diff --git a/new-luxc/source/luxc/compiler.lux b/new-luxc/source/luxc/compiler.lux deleted file mode 100644 index 55fe3c738..000000000 --- a/new-luxc/source/luxc/compiler.lux +++ /dev/null @@ -1,222 +0,0 @@ -(;module: - lux - (lux (control monad) - (concurrency ["A" atom] - ["P" promise]) - (data ["R" result] - [text "T/" Hash] - text/format - (coll ["D" dict] - [array #+ Array])) - [macro #+ Monad] - host - [io]) - (luxc ["&" base] - ["&;" io] - ["&;" module] - ["&;" parser] - (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 - [result action] - (exhaust action))) - -(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 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 - [?input (&io;read-module source-dirs module-name)] - (case ?input - (#R;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) - (#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) - -(jvm-import java.lang.reflect.AccessibleObject - (setAccessible [boolean] void)) - -(jvm-import java.lang.reflect.Method - (invoke [Object (Array Object)] #try Object)) - -(jvm-import (java.lang.Class a) - (getDeclaredMethod [String (Array (Class Object))] #try Method)) - -(jvm-import java.lang.Object - (getClass [] (Class Object))) - -(jvm-import java.lang.Integer - (#static TYPE (Class Integer))) - -(jvm-import java.lang.ClassLoader) - -(def: ClassLoader::defineClass - Method - (case (Class.getDeclaredMethod ["defineClass" - (|> (array (Class Object) +4) - (array-store +0 (:! (Class Object) (class-for String))) - (array-store +1 (Object.getClass [] (array byte +0))) - (array-store +2 (:! (Class Object) Integer.TYPE)) - (array-store +3 (:! (Class Object) Integer.TYPE)))] - (class-for java.lang.ClassLoader)) - (#R;Success method) - (do-to method - (AccessibleObject.setAccessible [true])) - - (#R;Error error) - (error! error))) - -(def: (memory-class-loader store) - (-> &&common;Class-Store ClassLoader) - (object ClassLoader [] - [] - (ClassLoader (findClass [class-name String]) void - (case (|> store A;get io;run (D;get class-name)) - (#;Some bytecode) - (case (Method.invoke [(:! Object _jvm_this) - (array;from-list (list (:! Object class-name) - (:! Object bytecode) - (:! Object (l2i 0)) - (:! Object (l2i (nat-to-int (array-length bytecode))))))] - ClassLoader::defineClass) - (#R;Success output) - [] - - (#R;Error error) - (error! error)) - - _ - (error! (format "Unknown class: " class-name)))))) - -(def: (init-host _) - (-> Top &&common;Host) - (let [store (: &&common;Class-Store - (A;atom (D;new text;Hash)))] - {#&&common;visitor #;None - #&&common;loader (memory-class-loader store) - #&&common;store store})) - -(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 #;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 - [?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 - [#let [compiler (init-compiler (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 []))) -- cgit v1.2.3