diff options
author | Eduardo Julian | 2017-10-31 23:39:49 -0400 |
---|---|---|
committer | Eduardo Julian | 2017-10-31 23:39:49 -0400 |
commit | 15121222d570f8fe3c5a326208e4f0bad737e63c (patch) | |
tree | 88c93ed1f4965fd0e80677df5553a0d47e521963 /new-luxc/source/luxc/lang/analysis/expression.lux | |
parent | a269ea72337852e8e57bd427773baed111ad6e92 (diff) |
- Re-organized analysis.
Diffstat (limited to 'new-luxc/source/luxc/lang/analysis/expression.lux')
-rw-r--r-- | new-luxc/source/luxc/lang/analysis/expression.lux | 141 |
1 files changed, 141 insertions, 0 deletions
diff --git a/new-luxc/source/luxc/lang/analysis/expression.lux b/new-luxc/source/luxc/lang/analysis/expression.lux new file mode 100644 index 000000000..e3a623089 --- /dev/null +++ b/new-luxc/source/luxc/lang/analysis/expression.lux @@ -0,0 +1,141 @@ +(;module: + lux + (lux (control [monad #+ do] + ["ex" exception #+ exception:]) + (data ["e" error] + [product] + text/format) + [meta] + (meta [type] + (type ["tc" check])) + [host]) + (luxc ["&" base] + [";L" host] + (lang ["la" analysis]) + ["&;" module] + (generator [";G" common])) + (.. [";A" common] + [";A" function] + [";A" primitive] + [";A" reference] + [";A" structure] + [";A" procedure])) + +(for {"JVM" (as-is (host;import java.lang.reflect.Method + (invoke [Object (Array Object)] #try Object)) + (host;import (java.lang.Class c) + (getMethod [String (Array (Class Object))] #try Method)) + (host;import java.lang.Object + (getClass [] (Class Object)) + (toString [] String)) + (def: _object-class (Class Object) (host;class-for Object)) + (def: _apply-args + (Array (Class Object)) + (|> (host;array (Class Object) +2) + (host;array-write +0 _object-class) + (host;array-write +1 _object-class))) + (def: (call-macro macro inputs) + (-> Macro (List Code) (Meta (List Code))) + (do meta;Monad<Meta> + [class (commonG;load-class hostL;function-class)] + (function [compiler] + (do e;Monad<Error> + [apply-method (Class.getMethod ["apply" _apply-args] class) + output (Method.invoke [(:! Object macro) + (|> (host;array Object +2) + (host;array-write +0 (:! Object inputs)) + (host;array-write +1 (:! Object compiler)))] + apply-method)] + (:! (e;Error [Compiler (List Code)]) + output)))))) + }) + +(exception: #export Macro-Expression-Must-Have-Single-Expansion) +(exception: #export Unrecognized-Syntax) + +(def: #export (analyser eval) + (-> &;Eval &;Analyser) + (: (-> Code (Meta la;Analysis)) + (function analyse [ast] + (do meta;Monad<Meta> + [expectedT meta;expected-type] + (let [[cursor ast'] ast] + ## The cursor must be set in the compiler for the sake + ## of having useful error messages. + (&;with-cursor cursor + (case ast' + (^template [<tag> <analyser>] + (<tag> value) + (<analyser> value)) + ([#;Bool primitiveA;analyse-bool] + [#;Nat primitiveA;analyse-nat] + [#;Int primitiveA;analyse-int] + [#;Deg primitiveA;analyse-deg] + [#;Frac primitiveA;analyse-frac] + [#;Text primitiveA;analyse-text]) + + (^ (#;Tuple (list))) + primitiveA;analyse-unit + + ## Singleton tuples are equivalent to the element they contain. + (^ (#;Tuple (list singleton))) + (analyse singleton) + + (^ (#;Tuple elems)) + (structureA;analyse-product analyse elems) + + (^ (#;Record pairs)) + (structureA;analyse-record analyse pairs) + + (#;Symbol reference) + (referenceA;analyse-reference reference) + + (^ (#;Form (list& [_ (#;Text proc-name)] proc-args))) + (procedureA;analyse-procedure analyse eval proc-name proc-args) + + (^template [<tag> <analyser>] + (^ (#;Form (list& [_ (<tag> tag)] + values))) + (case values + (#;Cons value #;Nil) + (<analyser> analyse tag value) + + _ + (<analyser> analyse tag (` [(~@ values)])))) + ([#;Nat structureA;analyse-sum] + [#;Tag structureA;analyse-tagged-sum]) + + (#;Tag tag) + (structureA;analyse-tagged-sum analyse tag (' [])) + + (^ (#;Form (list& func args))) + (do meta;Monad<Meta> + [[funcT =func] (commonA;with-unknown-type + (analyse func))] + (case =func + [_ (#;Symbol def-name)] + (do @ + [[def-type def-anns def-value] (meta;find-def def-name)] + (if (meta;macro? def-anns) + (do @ + [expansion (function [compiler] + (case (call-macro (:! Macro def-value) args compiler) + (#e;Success [compiler' output]) + (#e;Success [compiler' output]) + + (#e;Error error) + ((&;fail error) compiler)))] + (case expansion + (^ (list single)) + (analyse single) + + _ + (&;throw Macro-Expression-Must-Have-Single-Expansion (%code ast)))) + (functionA;analyse-apply analyse funcT =func args))) + + _ + (functionA;analyse-apply analyse funcT =func args))) + + _ + (&;throw Unrecognized-Syntax (%code ast)) + ))))))) |