aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/lang
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--new-luxc/source/luxc/lang/extension/statement.lux156
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/statement.jvm.lux73
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
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-24 18:29:04 +0000