aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/lang/translation
diff options
context:
space:
mode:
Diffstat (limited to 'new-luxc/source/luxc/lang/translation')
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/procedure/common.lux65
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/procedure/host.lux84
2 files changed, 98 insertions, 51 deletions
diff --git a/new-luxc/source/luxc/lang/translation/jvm/procedure/common.lux b/new-luxc/source/luxc/lang/translation/jvm/procedure/common.lux
index ea67a0d4a..34462d9ba 100644
--- a/new-luxc/source/luxc/lang/translation/jvm/procedure/common.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm/procedure/common.lux
@@ -3,19 +3,23 @@
[abstract
["." monad (#+ do)]]
[control
- ["p" parser]
+ ["<>" parser
+ ["<s>" synthesis (#+ Parser)]]
["ex" exception (#+ exception:)]]
[data
+ ["." product]
+ ["." error]
["." text
format]
[collection
+ ["." list ("#@." monad)]
["." dictionary]]]
[target
[jvm
["_t" type (#+ Type Method)]]]
[tool
[compiler
- ["." synthesis (#+ Synthesis)]
+ ["." synthesis (#+ Synthesis %synthesis)]
["." phase
[generation
[extension (#+ Nullary Unary Binary Trinary Variadic
@@ -26,11 +30,24 @@
[luxc
[lang
[host
- ["$" jvm (#+ Label Inst Bundle)
+ ["$" jvm (#+ Label Inst Def Handler Bundle Operation Phase)
["_" inst]]]]]
["." ///
["." runtime]])
+(def: #export (custom [parser handler])
+ (All [s]
+ (-> [(Parser s)
+ (-> Text Phase s (Operation Inst))]
+ Handler))
+ (function (_ extension-name phase input)
+ (case (<s>.run input parser)
+ (#error.Success input')
+ (handler extension-name phase input')
+
+ (#error.Failure error)
+ (phase.throw extension.invalid-syntax [extension-name %synthesis input]))))
+
(import: java/lang/Double
(#static MIN_VALUE Double)
(#static MAX_VALUE Double))
@@ -58,6 +75,47 @@
(def: unitI Inst (_.string synthesis.unit))
+## TODO: Get rid of this ASAP
+(def: lux::syntax-char-case!
+ (..custom [($_ <>.and
+ <s>.any
+ <s>.any
+ (<>.some (<s>.tuple ($_ <>.and
+ (<s>.tuple (<>.many <s>.i64))
+ <s>.any))))
+ (function (_ extension-name phase [input else conditionals])
+ (<| _.with-label (function (_ @end))
+ _.with-label (function (_ @else))
+ (do phase.monad
+ [inputG (phase input)
+ elseG (phase else)
+ conditionalsG+ (: (Operation (List [(List [Int Label])
+ Inst]))
+ (monad.map @ (function (_ [chars branch])
+ (do @
+ [branchG (phase branch)]
+ (wrap (<| _.with-label (function (_ @branch))
+ [(list@map (function (_ char)
+ [(.int char) @branch])
+ chars)
+ (|>> (_.label @branch)
+ branchG
+ (_.GOTO @end))]))))
+ conditionals))
+ #let [table (|> conditionalsG+
+ (list@map product.left)
+ list@join)
+ conditionalsG (|> conditionalsG+
+ (list@map product.right)
+ _.fuse)]]
+ (wrap (|>> inputG (_.unwrap #_t.Long) _.L2I
+ (_.LOOKUPSWITCH @else table)
+ conditionalsG
+ (_.label @else)
+ elseG
+ (_.label @end)
+ )))))]))
+
(def: (lux::is [referenceI sampleI])
(Binary Inst)
(|>> referenceI
@@ -251,6 +309,7 @@
(def: bundle::lux
Bundle
(|> (: Bundle bundle.empty)
+ (bundle.install "syntax char case!" lux::syntax-char-case!)
(bundle.install "is" (binary lux::is))
(bundle.install "try" (unary lux::try))))
diff --git a/new-luxc/source/luxc/lang/translation/jvm/procedure/host.lux b/new-luxc/source/luxc/lang/translation/jvm/procedure/host.lux
index e57101660..83cbd017b 100644
--- a/new-luxc/source/luxc/lang/translation/jvm/procedure/host.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm/procedure/host.lux
@@ -6,7 +6,7 @@
["." exception (#+ exception:)]
["<>" parser ("#@." monad)
["<t>" text]
- ["<s>" synthesis]]]
+ ["<s>" synthesis (#+ Parser)]]]
[data
["." product]
["." maybe]
@@ -46,25 +46,14 @@
["$" jvm (#+ Label Inst Def Handler Bundle Operation Phase)
["_" inst]
["_." def]]]]]
- ["." /// #_
- ["#." reference]
- ["#." function]])
+ ["." // #_
+ [common (#+ custom)]
+ ["/#" // #_
+ ["#." reference]
+ ["#." function]]])
(exception: #export invalid-syntax-for-argument-generation)
-(def: (custom [parser handler])
- (All [s]
- (-> [(<s>.Parser s)
- (-> Text Phase s (Operation Inst))]
- Handler))
- (function (_ extension-name phase input)
- (case (<s>.run input parser)
- (#error.Success input')
- (handler extension-name phase input')
-
- (#error.Failure error)
- (phase.throw extension.invalid-syntax [extension-name %synthesis input]))))
-
(template [<name> <inst>]
[(def: <name>
Inst
@@ -322,13 +311,14 @@
(def: (primitive-array-length-handler jvm-primitive)
(-> Type Handler)
- (..custom [<s>.any
- (function (_ extension-name generate arrayS)
- (do phase.monad
- [arrayI (generate arrayS)]
- (wrap (|>> arrayI
- (_.CHECKCAST (jvm.descriptor (jvm.array 1 jvm-primitive)))
- _.ARRAYLENGTH))))]))
+ (..custom
+ [<s>.any
+ (function (_ extension-name generate arrayS)
+ (do phase.monad
+ [arrayI (generate arrayS)]
+ (wrap (|>> arrayI
+ (_.CHECKCAST (jvm.descriptor (jvm.array 1 jvm-primitive)))
+ _.ARRAYLENGTH))))]))
(def: (array::length::object extension-name generate inputs)
Handler
@@ -543,18 +533,16 @@
_
(phase.throw extension.invalid-syntax [extension-name %synthesis inputs])))
-(def: (object::instance? extension-name generate inputs)
+(def: object::instance?
Handler
- (case inputs
- (^ (list (synthesis.text class) objectS))
- (do phase.monad
- [objectI (generate objectS)]
- (wrap (|>> objectI
- (_.INSTANCEOF class)
- (_.wrap #jvm.Boolean))))
-
- _
- (phase.throw extension.invalid-syntax [extension-name %synthesis inputs])))
+ (..custom
+ [($_ <>.and <s>.text <s>.any)
+ (function (_ extension-name generate [class objectS])
+ (do phase.monad
+ [objectI (generate objectS)]
+ (wrap (|>> objectI
+ (_.INSTANCEOF class)
+ (_.wrap #jvm.Boolean)))))]))
(def: (object::cast extension-name generate inputs)
Handler
@@ -813,20 +801,20 @@
)))
(def: var
- (<s>.Parser Var)
+ (Parser Var)
<s>.text)
(def: bound
- (<s>.Parser Bound)
+ (Parser Bound)
(<>.or (<s>.constant! ["" ">"])
(<s>.constant! ["" "<"])))
(def: (class' generic)
- (-> (<s>.Parser Generic) (<s>.Parser Class))
+ (-> (Parser Generic) (Parser Class))
(<s>.tuple (<>.and <s>.text (<>.some generic))))
(def: generic
- (<s>.Parser Generic)
+ (Parser Generic)
(<>.rec
(function (_ generic)
(let [wildcard (<>.or (<s>.constant! ["" "?"])
@@ -837,11 +825,11 @@
(class' generic))))))
(def: class
- (<s>.Parser Class)
+ (Parser Class)
(class' ..generic))
(def: primitive
- (<s>.Parser Primitive)
+ (Parser Primitive)
($_ <>.or
(<s>.constant! ["" reflection.boolean])
(<s>.constant! ["" reflection.byte])
@@ -854,7 +842,7 @@
))
(def: jvm-type
- (<s>.Parser Type)
+ (Parser Type)
(<>.rec
(function (_ jvm-type)
($_ <>.or
@@ -863,28 +851,28 @@
(<s>.tuple jvm-type)))))
(def: constructor-arg
- (<s>.Parser (Typed Synthesis))
+ (Parser (Typed Synthesis))
(<s>.tuple (<>.and ..jvm-type <s>.any)))
(def: annotation-parameter
- (<s>.Parser (/.Annotation-Parameter Synthesis))
+ (Parser (/.Annotation-Parameter Synthesis))
(<s>.tuple (<>.and <s>.text <s>.any)))
(def: annotation
- (<s>.Parser (/.Annotation Synthesis))
+ (Parser (/.Annotation Synthesis))
(<s>.tuple (<>.and <s>.text (<>.some ..annotation-parameter))))
(def: argument
- (<s>.Parser Argument)
+ (Parser Argument)
(<s>.tuple (<>.and <s>.text ..jvm-type)))
(def: return
- (<s>.Parser Return)
+ (Parser Return)
(<>.or (<s>.constant! ["" jvm.void-descriptor])
..jvm-type))
(def: overriden-method-definition
- (<s>.Parser [Environment (/.Overriden-Method Synthesis)])
+ (Parser [Environment (/.Overriden-Method Synthesis)])
(<s>.tuple (do <>.monad
[ownerT ..class
name <s>.text