diff options
author | Eduardo Julian | 2019-05-28 18:43:43 -0400 |
---|---|---|
committer | Eduardo Julian | 2019-05-28 18:43:43 -0400 |
commit | a420abd8ef1d5a008a5a0b6f75590cab2a9baac5 (patch) | |
tree | e94bc0a604113f1838d034fb36628dae27a20974 /new-luxc/source/luxc/lang/translation/jvm/procedure/common.lux | |
parent | 5635aa3482001fd137b9deee42514b803ba21f75 (diff) |
Implemented machinery for "lux syntax char case!".
Diffstat (limited to 'new-luxc/source/luxc/lang/translation/jvm/procedure/common.lux')
-rw-r--r-- | new-luxc/source/luxc/lang/translation/jvm/procedure/common.lux | 65 |
1 files changed, 62 insertions, 3 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)))) |