diff options
Diffstat (limited to '')
6 files changed, 135 insertions, 113 deletions
diff --git a/stdlib/source/lux/tool/compiler/default/evaluation.lux b/stdlib/source/lux/tool/compiler/default/evaluation.lux index 1f21304ca..68fda1e7d 100644 --- a/stdlib/source/lux/tool/compiler/default/evaluation.lux +++ b/stdlib/source/lux/tool/compiler/default/evaluation.lux @@ -10,7 +10,8 @@ ["." phase [analysis (#+ Operation) [".A" expression] - ["." type]] + ["." type] + [macro (#+ Expander)]] ["." synthesis [".S" expression]] ["." translation]]]) @@ -18,19 +19,21 @@ (type: #export Eval (-> Nat Type Code (Operation Any))) -(def: #export (evaluator synthesis-state translation-state translate) +(def: #export (evaluator expander synthesis-state translation-state translate) (All [anchor expression statement] - (-> synthesis.State+ + (-> Expander + synthesis.State+ (translation.State+ anchor expression statement) (translation.Phase anchor expression statement) Eval)) - (function (eval count type exprC) - (do phase.monad - [exprA (type.with-type type - (expressionA.compile exprC))] - (phase.lift (do error.monad - [exprS (|> exprA expressionS.phase (phase.run synthesis-state))] - (phase.run translation-state - (do phase.monad - [exprO (translate exprS)] - (translation.evaluate! (format "eval" (%n count)) exprO)))))))) + (let [analyze (expressionA.phase expander)] + (function (eval count type exprC) + (do phase.monad + [exprA (type.with-type type + (analyze exprC))] + (phase.lift (do error.monad + [exprS (|> exprA expressionS.phase (phase.run synthesis-state))] + (phase.run translation-state + (do phase.monad + [exprO (translate exprS)] + (translation.evaluate! (format "eval" (%n count)) exprO))))))))) diff --git a/stdlib/source/lux/tool/compiler/default/init.lux b/stdlib/source/lux/tool/compiler/default/init.lux index 8375c4642..8d23b6a4a 100644 --- a/stdlib/source/lux/tool/compiler/default/init.lux +++ b/stdlib/source/lux/tool/compiler/default/init.lux @@ -21,6 +21,7 @@ ["." phase ["." analysis ["." module] + [macro (#+ Expander)] [".A" expression]] ["." synthesis [".S" expression]] @@ -52,34 +53,36 @@ #.version //.version #.mode #.Build}) -(def: refresh +(def: (refresh expander) (All [anchor expression statement] - (statement.Operation anchor expression statement Any)) + (-> Expander (statement.Operation anchor expression statement Any))) (do phase.monad [[bundle state] phase.get-state - #let [eval (evaluation.evaluator (get@ [#statement.synthesis #statement.state] state) + #let [eval (evaluation.evaluator expander + (get@ [#statement.synthesis #statement.state] state) (get@ [#statement.translation #statement.state] state) (get@ [#statement.translation #statement.phase] state))]] - (phase.set-state [statementE.bundle + (phase.set-state [bundle (update@ [#statement.analysis #statement.state] (: (-> analysis.State+ analysis.State+) (|>> product.right [(analysisE.bundle eval)])) state)]))) -(def: #export (state host translate translation-bundle) +(def: #export (state expander host translate translation-bundle) (All [anchor expression statement] - (-> (translation.Host expression statement) + (-> Expander + (translation.Host expression statement) (translation.Phase anchor expression statement) (translation.Bundle anchor expression statement) (statement.State+ anchor expression statement))) (let [synthesis-state [synthesisE.bundle synthesis.init] translation-state [translation-bundle (translation.state host)] - eval (evaluation.evaluator synthesis-state translation-state translate) + eval (evaluation.evaluator expander synthesis-state translation-state translate) analysis-state [(analysisE.bundle eval) (analysis.state ..info host)]] [statementE.bundle {#statement.analysis {#statement.state analysis-state - #statement.phase expressionA.compile} + #statement.phase (expressionA.phase expander)} #statement.synthesis {#statement.state synthesis-state #statement.phase expressionS.phase} #statement.translation {#statement.state translation-state @@ -126,22 +129,23 @@ (|>> module.set-compiled statement.lift-analysis)) - (def: (iteration reader) - (-> Reader <Operation>) - (do phase.monad - [code (statement.lift-analysis - (..read reader)) - _ (totalS.phase code)] - ..refresh)) - - (def: (loop module) - (-> Module <Operation>) + (def: (iteration expander reader) + (-> Expander Reader <Operation>) + (let [execute (totalS.phase expander)] + (do phase.monad + [code (statement.lift-analysis + (..read reader)) + _ (execute code)] + (..refresh expander)))) + + (def: (loop expander module) + (-> Expander Module <Operation>) (do phase.monad [reader (statement.lift-analysis (..reader module syntax.no-aliases))] (function (_ state) (.loop [state state] - (case (..iteration reader state) + (case (..iteration expander reader state) (#error.Success [state' output]) (recur state') @@ -150,12 +154,12 @@ (#error.Success [state []]) (ex.with-stack ///.cannot-compile module (#error.Failure error)))))))) - (def: (compile hash input) - (-> Nat ///.Input <Operation>) + (def: (compile expander hash input) + (-> Expander Nat ///.Input <Operation>) (do phase.monad [#let [module (get@ #///.module input)] _ (..begin hash input) - _ (..loop module)] + _ (..loop expander module)] (..end module))) (def: (default-dependencies prelude input) @@ -165,9 +169,9 @@ (list prelude))) ) -(def: #export (compiler prelude state) +(def: #export (compiler expander prelude state) (All [anchor expression statement] - (-> Module + (-> Expander Module (statement.State+ anchor expression statement) (Instancer .Module))) (function (_ key parameters input) @@ -180,7 +184,7 @@ (: (All [anchor expression statement] (statement.Operation anchor expression statement .Module)) (do phase.monad - [_ (compile hash input)] + [_ (compile expander hash input)] (statement.lift-analysis (extension.lift macro.current-module))))) diff --git a/stdlib/source/lux/tool/compiler/default/platform.lux b/stdlib/source/lux/tool/compiler/default/platform.lux index 22c50ddec..d751d2321 100644 --- a/stdlib/source/lux/tool/compiler/default/platform.lux +++ b/stdlib/source/lux/tool/compiler/default/platform.lux @@ -12,6 +12,8 @@ ["." syntax] ["/." // ["." phase + [analysis + [macro (#+ Expander)]] ["." translation] ["." statement]] ["." cli (#+ Configuration)] @@ -40,13 +42,14 @@ <State+> (as-is (statement.State+ anchor expression statement)) <Bundle> (as-is (translation.Bundle anchor expression statement))] - (def: #export (initialize platform translation-bundle) + (def: #export (initialize expander platform translation-bundle) (All [! anchor expression statement] - (-> <Platform> <Bundle> (! (Error <State+>)))) + (-> Expander <Platform> <Bundle> (! (Error <State+>)))) (|> platform (get@ #runtime) statement.lift-translation - (phase.run' (init.state (get@ #host platform) + (phase.run' (init.state expander + (get@ #host platform) (get@ #phase platform) translation-bundle)) (:: error.functor map product.left) @@ -78,9 +81,9 @@ ## (io.fail error)) ) - (def: #export (compile platform configuration state) + (def: #export (compile expander platform configuration state) (All [! anchor expression statement] - (-> <Platform> Configuration <State+> (! (Error Any)))) + (-> Expander <Platform> Configuration <State+> (! (Error Any)))) (let [monad (get@ #&monad platform)] (do monad [input (context.read monad @@ -92,8 +95,8 @@ ] (wrap (do error.monad [input input - #let [compiler (init.compiler syntax.prelude state) - compilation (compiler init.key (list) input)]] + #let [compile (init.compiler expander syntax.prelude state) + compilation (compile init.key (list) input)]] (case ((get@ #///.process compilation) archive.empty) (#error.Success more|done) @@ -107,7 +110,7 @@ (#error.Failure error) (#error.Failure error)))) - ## (case (compiler input) + ## (case (compile input) ## (#error.Failure error) ## (:: monad wrap (#error.Failure error)) diff --git a/stdlib/source/lux/tool/compiler/phase/analysis/expression.lux b/stdlib/source/lux/tool/compiler/phase/analysis/expression.lux index 82c9cd65b..f79d36f4f 100644 --- a/stdlib/source/lux/tool/compiler/phase/analysis/expression.lux +++ b/stdlib/source/lux/tool/compiler/phase/analysis/expression.lux @@ -15,7 +15,7 @@ ["//." reference] ["." case] ["." function] - ["//." macro] + ["//." macro (#+ Expander)] ["/." // ["." extension] [// @@ -79,8 +79,8 @@ _ (else code'))) -(def: (compile|others compile code') - (-> Phase (-> (Code' (Ann Cursor)) (Operation Analysis))) +(def: (compile|others expander compile code') + (-> Expander Phase (-> (Code' (Ann Cursor)) (Operation Analysis))) (case code' (#.Identifier reference) (//reference.reference reference) @@ -107,7 +107,7 @@ (case ?macro (#.Some macro) (do @ - [expansion (extension.lift (//macro.expand-one def-name macro argsC+))] + [expansion (extension.lift (//macro.expand-one expander def-name macro argsC+))] (compile expansion)) _ @@ -119,11 +119,12 @@ _ (///.throw unrecognized-syntax [.dummy-cursor code']))) -(def: #export (compile code) - Phase - (let [[cursor code'] code] - ## The cursor must be set in the state for the sake - ## of having useful error messages. - (//.with-cursor cursor - (compile|primitive (compile|structure compile (compile|others compile)) - code')))) +(def: #export (phase expander) + (-> Expander Phase) + (function (compile code) + (let [[cursor code'] code] + ## The cursor must be set in the state for the sake + ## of having useful error messages. + (//.with-cursor cursor + (compile|primitive (compile|structure compile (compile|others expander compile)) + code'))))) diff --git a/stdlib/source/lux/tool/compiler/phase/analysis/macro.lux b/stdlib/source/lux/tool/compiler/phase/analysis/macro.lux index 18455b837..aae26ada7 100644 --- a/stdlib/source/lux/tool/compiler/phase/analysis/macro.lux +++ b/stdlib/source/lux/tool/compiler/phase/analysis/macro.lux @@ -27,50 +27,59 @@ (list/map (|>> %code (format text.new-line text.tab))) (text.join-with ""))])) -(import: java/lang/reflect/Method - (invoke [Object (Array Object)] #try Object)) +(import: #long java/lang/reflect/Method + (invoke [java/lang/Object (Array java/lang/Object)] #try java/lang/Object)) -(import: (java/lang/Class c) - (getMethod [String (Array (Class Object))] #try Method)) +(import: #long (java/lang/Class c) + (getMethod [java/lang/String (Array (java/lang/Class java/lang/Object))] #try java/lang/reflect/Method)) -(import: java/lang/Object - (getClass [] (Class Object))) +(import: #long java/lang/Object + (getClass [] (java/lang/Class java/lang/Object))) (def: _object-class - (Class Object) - (host.class-for Object)) + (java/lang/Class java/lang/Object) + (host.class-for java/lang/Object)) (def: _apply-args - (Array (Class Object)) - (|> (host.array (Class Object) 2) + (Array (java/lang/Class java/lang/Object)) + (|> (host.array (java/lang/Class java/lang/Object) 2) (host.array-write 0 _object-class) (host.array-write 1 _object-class))) -(def: #export (expand name macro inputs) - (-> Name Macro (List Code) (Meta (List Code))) +(type: #export Expander + (-> Macro (List Code) Lux (Error (Error [Lux (List Code)])))) + +(def: #export (jvm macro inputs lux) + Expander + (do error.monad + [apply-method (|> macro + (:coerce java/lang/Object) + (java/lang/Object::getClass) + (java/lang/Class::getMethod "apply" _apply-args))] + (:coerce (Error (Error [Lux (List Code)])) + (java/lang/reflect/Method::invoke + (:coerce java/lang/Object macro) + (|> (host.array java/lang/Object 2) + (host.array-write 0 (:coerce java/lang/Object inputs)) + (host.array-write 1 (:coerce java/lang/Object lux))) + apply-method)))) + +(def: #export (expand expander name macro inputs) + (-> Expander Name Macro (List Code) (Meta (List Code))) (function (_ state) (do error.monad - [apply-method (|> macro - (:coerce Object) - (Object::getClass) - (Class::getMethod "apply" _apply-args)) - output (Method::invoke (:coerce Object macro) - (|> (host.array Object 2) - (host.array-write 0 (:coerce Object inputs)) - (host.array-write 1 (:coerce Object state))) - apply-method)] - (case (:coerce (Error [Lux (List Code)]) - output) + [output (expander macro inputs state)] + (case output (#error.Success output) (#error.Success output) (#error.Failure error) ((///.throw expansion-failed [name inputs error]) state))))) -(def: #export (expand-one name macro inputs) - (-> Name Macro (List Code) (Meta Code)) +(def: #export (expand-one expander name macro inputs) + (-> Expander Name Macro (List Code) (Meta Code)) (do macro.monad - [expansion (expand name macro inputs)] + [expansion (expand expander name macro inputs)] (case expansion (^ (list single)) (wrap single) diff --git a/stdlib/source/lux/tool/compiler/phase/statement/total.lux b/stdlib/source/lux/tool/compiler/phase/statement/total.lux index 542be5408..da2cc387c 100644 --- a/stdlib/source/lux/tool/compiler/phase/statement/total.lux +++ b/stdlib/source/lux/tool/compiler/phase/statement/total.lux @@ -12,45 +12,47 @@ ["." analysis ["." expression] ["." type] - ["///." macro]] + ["///." macro (#+ Expander)]] ["." extension]]]) (exception: #export (not-a-statement {code Code}) (ex.report ["Statement" (%code code)])) -(exception: #export (not-a-macro {code Code}) +(exception: #export (not-a-macro-call {code Code}) (ex.report ["Code" (%code code)])) (exception: #export (macro-was-not-found {name Name}) (ex.report ["Name" (%name name)])) -(def: #export (phase code) - Phase - (case code - (^ [_ (#.Form (list& [_ (#.Text name)] inputs))]) - (extension.apply phase [name inputs]) +(def: #export (phase expander) + (-> Expander Phase) + (let [analyze (expression.phase expander)] + (function (compile code) + (case code + (^ [_ (#.Form (list& [_ (#.Text name)] inputs))]) + (extension.apply compile [name inputs]) - (^ [_ (#.Form (list& macro inputs))]) - (do ///.monad - [expansion (//.lift-analysis - (do @ - [macroA (type.with-type Macro - (expression.compile macro))] - (case macroA - (^ (analysis.constant macro-name)) + (^ [_ (#.Form (list& macro inputs))]) + (do ///.monad + [expansion (//.lift-analysis (do @ - [?macro (extension.lift (macro.find-macro macro-name)) - macro (case ?macro - (#.Some macro) - (wrap macro) - - #.None - (///.throw macro-was-not-found macro-name))] - (extension.lift (///macro.expand macro-name macro inputs))) - - _ - (///.throw not-a-macro code))))] - (monad.map @ phase expansion)) + [macroA (type.with-type Macro + (analyze macro))] + (case macroA + (^ (analysis.constant macro-name)) + (do @ + [?macro (extension.lift (macro.find-macro macro-name)) + macro (case ?macro + (#.Some macro) + (wrap macro) + + #.None + (///.throw macro-was-not-found macro-name))] + (extension.lift (///macro.expand expander macro-name macro inputs))) + + _ + (///.throw not-a-macro-call code))))] + (monad.map @ compile expansion)) - _ - (///.throw not-a-statement code))) + _ + (///.throw not-a-statement code))))) |