aboutsummaryrefslogtreecommitdiff
path: root/lux-r/source/luxc/lang/translation/r/expression.jvm.lux
diff options
context:
space:
mode:
Diffstat (limited to 'lux-r/source/luxc/lang/translation/r/expression.jvm.lux')
-rw-r--r--lux-r/source/luxc/lang/translation/r/expression.jvm.lux88
1 files changed, 88 insertions, 0 deletions
diff --git a/lux-r/source/luxc/lang/translation/r/expression.jvm.lux b/lux-r/source/luxc/lang/translation/r/expression.jvm.lux
new file mode 100644
index 000000000..3c41fbe63
--- /dev/null
+++ b/lux-r/source/luxc/lang/translation/r/expression.jvm.lux
@@ -0,0 +1,88 @@
+(.module:
+ lux
+ (lux (control [monad #+ do]
+ ["ex" exception #+ exception:]
+ ["p" parser])
+ (data ["e" error]
+ text/format)
+ [macro]
+ (macro ["s" syntax]))
+ (luxc ["&" lang]
+ (lang [".L" variable #+ Variable Register]
+ [".L" extension]
+ ["ls" synthesis]
+ (host [r #+ Expression])))
+ [//]
+ (// [".T" runtime]
+ [".T" primitive]
+ [".T" structure]
+ [".T" reference]
+ [".T" function]
+ [".T" case]
+ [".T" procedure])
+ )
+
+(template [<name>]
+ [(exception: #export (<name> {message Text})
+ message)]
+
+ [Invalid-Function-Syntax]
+ [Unrecognized-Synthesis]
+ )
+
+(def: #export (translate synthesis)
+ (-> ls.Synthesis (Meta Expression))
+ (case synthesis
+ (^code [])
+ (:: macro.Monad<Meta> wrap runtimeT.unit)
+
+ (^template [<tag> <generator>]
+ [_ (<tag> value)]
+ (<generator> value))
+ ([#.Bit primitiveT.translate-bit]
+ [#.Nat primitiveT.translate-nat]
+ [#.Int primitiveT.translate-int]
+ [#.Rev primitiveT.translate-rev]
+ [#.Frac primitiveT.translate-frac]
+ [#.Text primitiveT.translate-text])
+
+ (^code ((~ [_ (#.Nat tag)]) (~ [_ (#.Bit last?)]) (~ valueS)))
+ (structureT.translate-variant translate tag last? valueS)
+
+ (^code [(~ singleton)])
+ (translate singleton)
+
+ (^code [(~+ members)])
+ (structureT.translate-tuple translate members)
+
+ (^ [_ (#.Form (list [_ (#.Int var)]))])
+ (referenceT.translate-variable var)
+
+ [_ (#.Identifier definition)]
+ (referenceT.translate-definition definition)
+
+ (^code ("lux let" (~ [_ (#.Nat register)]) (~ inputS) (~ exprS)))
+ (caseT.translate-let translate register inputS exprS)
+
+ (^code ("lux case" (~ inputS) (~ pathPS)))
+ (caseT.translate-case translate inputS pathPS)
+
+ (^code ("lux function" (~ [_ (#.Nat arity)]) [(~+ environment)] (~ bodyS)))
+ (case (s.run environment (p.some s.int))
+ (#e.Success environment)
+ (functionT.translate-function translate environment arity bodyS)
+
+ _
+ (&.throw Invalid-Function-Syntax (%code synthesis)))
+
+ (^code ("lux call" (~ functionS) (~+ argsS)))
+ (functionT.translate-apply translate functionS argsS)
+
+ (^code ((~ [_ (#.Text procedure)]) (~+ argsS)))
+ (procedureT.translate-procedure translate procedure argsS)
+ ## (do macro.Monad<Meta>
+ ## [translation (extensionL.find-translation procedure)]
+ ## (translation argsS))
+
+ _
+ (&.throw Unrecognized-Synthesis (%code synthesis))))