diff options
Diffstat (limited to 'new-luxc/source/luxc/lang')
| -rw-r--r-- | new-luxc/source/luxc/lang/extension/statement.lux | 156 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/translation/jvm/statement.jvm.lux | 73 |
2 files changed, 1 insertions, 228 deletions
diff --git a/new-luxc/source/luxc/lang/extension/statement.lux b/new-luxc/source/luxc/lang/extension/statement.lux deleted file mode 100644 index ce1222fed..000000000 --- a/new-luxc/source/luxc/lang/extension/statement.lux +++ /dev/null @@ -1,156 +0,0 @@ -(.module: - lux - (lux (control [monad #+ do] - ["ex" exception #+ exception:]) - (data [text] - text/format - (coll [list "list/" Functor<List>] - (dictionary ["dict" unordered #+ Dict]))) - [macro] - (lang (type ["tc" check])) - [io #+ IO]) - [// #+ Syntheses] - (luxc [lang] - (lang [".L" host] - [".L" scope] - (host ["$" jvm]) - (analysis [".A" common] - [".A" expression]) - (synthesis [".S" expression]) - (translation (jvm [".T" expression] - [".T" statement] - [".T" eval])) - [".L" eval]))) - -(do-template [<name>] - [(exception: #export (<name> {message Text}) - message)] - - [Invalid-Statement] - [Invalid-Alias] - ) - -(def: (throw-invalid-statement procedure inputsC+) - (All [a] (-> Text (List Code) (Meta a))) - (lang.throw Invalid-Statement - (format "Statement: " procedure "\n" - " Inputs:" - (|> inputsC+ - list.enumerate - (list/map (function (_ [idx inputC]) - (format "\n " (%n idx) " " (%code inputC)))) - (text.join-with "")) "\n"))) - -(def: (process-annotations syntheses annsC) - (-> Syntheses Code (Meta [$.Inst Code])) - (do macro.Monad<Meta> - [[_ annsA] (lang.with-scope - (lang.with-type Code - (expressionA.analyser evalL.eval annsC))) - annsI (expressionT.translate (expressionS.synthesize syntheses annsA)) - annsV (evalT.eval annsI)] - (wrap [annsI (:coerce Code annsV)]))) - -(def: (ensure-valid-alias def-name annotations value) - (-> Text Code Code (Meta Any)) - (case [annotations value] - (^multi [[_ (#.Record pairs)] [_ (#.Identifier _)]] - (|> pairs list.size (n/= +1))) - (:: macro.Monad<Meta> wrap []) - - _ - (lang.throw Invalid-Alias def-name))) - -(def: (lux//def procedure) - (-> Text //.Statement) - (function (_ inputsC+) - (case inputsC+ - (^ (list [_ (#.Identifier ["" def-name])] valueC annotationsC)) - (hostL.with-context def-name - (lang.with-fresh-type-env - (do macro.Monad<Meta> - [syntheses //.all-syntheses - [annotationsI annotationsV] (process-annotations syntheses annotationsC)] - (case (macro.get-identifier-ann (name-of #.alias) annotationsV) - (#.Some real-def) - (do @ - [_ (ensure-valid-alias def-name annotationsV valueC) - _ (lang.with-scope - (statementT.translate-def def-name Nothing id annotationsV))] - (wrap [])) - - #.None - (do @ - [[_ valueT valueA] (lang.with-scope - (if (macro.type? (:coerce Code annotationsV)) - (do @ - [valueA (lang.with-type Type - (expressionA.analyser evalL.eval valueC))] - (wrap [Type valueA])) - (commonA.with-unknown-type - (expressionA.analyser evalL.eval valueC)))) - valueT (lang.with-type-env - (tc.clean valueT)) - valueI (expressionT.translate (expressionS.synthesize syntheses valueA)) - _ (lang.with-scope - (statementT.translate-def def-name valueT valueI annotationsV))] - (wrap [])))))) - - _ - (throw-invalid-statement procedure inputsC+)))) - -(def: (lux//program procedure) - (-> Text //.Statement) - (function (_ inputsC+) - (case inputsC+ - (^ (list [_ (#.Identifier ["" args])] programC)) - (do macro.Monad<Meta> - [[_ programA] (<| lang.with-scope - (scopeL.with-local [args (type (List Text))]) - (lang.with-type (type (IO Any))) - (expressionA.analyser evalL.eval programC)) - syntheses //.all-syntheses - programI (expressionT.translate (expressionS.synthesize syntheses programA)) - _ (statementT.translate-program programI)] - (wrap [])) - - _ - (throw-invalid-statement procedure inputsC+)))) - -(do-template [<mame> <type> <installer>] - [(def: (<mame> procedure) - (-> Text //.Statement) - (function (_ inputsC+) - (case inputsC+ - (^ (list [_ (#.Text name)] valueC)) - (do macro.Monad<Meta> - [[_ valueA] (lang.with-scope - (lang.with-type <type> - (expressionA.analyser evalL.eval valueC))) - syntheses //.all-syntheses - valueI (expressionT.translate (expressionS.synthesize syntheses valueA)) - valueV (evalT.eval valueI) - _ (<installer> name (:coerce <type> valueV))] - (wrap [])) - - _ - (throw-invalid-statement procedure inputsC+))))] - - [lux//analysis //.Analysis //.install-analysis] - [lux//synthesis //.Synthesis //.install-synthesis] - [lux//translation //.Translation //.install-translation] - [lux//statement //.Statement //.install-statement]) - -(def: #export defaults - (Dict Text //.Statement) - (`` (|> (dict.new text.Hash<Text>) - (~~ (do-template [<name> <extension>] - [(dict.put <name> (<extension> <name>))] - - ["lux def" lux//def] - ["lux program" lux//program] - ["lux analysis" lux//analysis] - ["lux synthesis" lux//synthesis] - ["lux translation" lux//translation] - ["lux statement" lux//statement] - ))))) diff --git a/new-luxc/source/luxc/lang/translation/jvm/statement.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/statement.jvm.lux index 14208903c..7461d981f 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/statement.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/statement.jvm.lux @@ -7,8 +7,7 @@ [text "text/" Monoid<Text> Hash<Text>] text/format (coll [list "list/" Functor<List> Fold<List>])) - [macro] - [host]) + [macro]) (luxc ["&" lang] ["&." io] (lang (host ["$" jvm] @@ -21,76 +20,6 @@ (// [".T" common] [".T" runtime])) -(do-template [<name>] - [(exception: #export (<name> {message Text}) - message)] - - [Invalid-Definition-Value] - [Cannot-Evaluate-Definition] - ) - -(host.import: java/lang/reflect/Field - (get [#? Object] #try #? Object)) - -(host.import: (java/lang/Class c) - (getField [String] #try Field)) - -(def: #export (translate-def def-name valueT valueI metaV) - (-> Text Type $.Inst Code (Meta Any)) - (do macro.Monad<Meta> - [current-module macro.current-module-name - #let [def-name [current-module def-name]]] - (case (macro.get-identifier-ann (name-of #.alias) metaV) - (#.Some real-def) - (do @ - [[realT realA realV] (macro.find-def real-def) - _ (&module.define def-name [realT metaV realV])] - (wrap [])) - - _ - (do @ - [#let [normal-name (format (&.normalize-name def-name) (%n (text/hash def-name))) - bytecode-name (format current-module "/" normal-name) - class-name (format (text.replace-all "/" "." current-module) "." normal-name) - bytecode ($d.class #$.V1_6 - #$.Public $.finalC - bytecode-name - (list) ["java.lang.Object" (list)] - (list) - (|>> ($d.field #$.Public ($.++F $.finalF $.staticF) commonT.value-field commonT.$Object) - ($d.method #$.Public $.staticM "<clinit>" ($t.method (list) #.None (list)) - (|>> valueI - ($i.PUTSTATIC bytecode-name commonT.value-field commonT.$Object) - $i.RETURN))))] - _ (commonT.store-class class-name bytecode) - class (commonT.load-class class-name) - valueV (: (Meta Any) - (case (do e.Monad<Error> - [field (Class::getField [commonT.value-field] class)] - (Field::get [#.None] field)) - (#e.Success #.None) - (&.throw Invalid-Definition-Value (%name def-name)) - - (#e.Success (#.Some valueV)) - (wrap valueV) - - (#e.Error error) - (&.throw Cannot-Evaluate-Definition - (format "Definition: " (%name def-name) "\n" - "Error:\n" - error)))) - _ (&module.define def-name [valueT metaV valueV]) - _ (if (macro.type? metaV) - (case (macro.declared-tags metaV) - #.Nil - (wrap []) - - tags - (&module.declare-tags tags (macro.export? metaV) (:coerce Type valueV))) - (wrap [])) - #let [_ (log! (format "DEF " (%name def-name)))]] - (commonT.record-artifact (format bytecode-name ".class") bytecode))))) - (def: #export (translate-program programI) (-> $.Inst (Meta Any)) (let [nilI runtimeT.noneI |