diff options
Diffstat (limited to 'new-luxc/source/luxc/lang/extension/statement.lux')
| -rw-r--r-- | new-luxc/source/luxc/lang/extension/statement.lux | 156 |
1 files changed, 0 insertions, 156 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] - ))))) |