diff options
Diffstat (limited to '')
| -rw-r--r-- | new-luxc/source/luxc/lang/translation/js/case.jvm.lux | 185 |
1 files changed, 185 insertions, 0 deletions
diff --git a/new-luxc/source/luxc/lang/translation/js/case.jvm.lux b/new-luxc/source/luxc/lang/translation/js/case.jvm.lux new file mode 100644 index 000000000..a005a45a1 --- /dev/null +++ b/new-luxc/source/luxc/lang/translation/js/case.jvm.lux @@ -0,0 +1,185 @@ +(.module: + lux + (lux (control [monad #+ do]) + (data text/format + (coll [list "list/" Fold<List>]))) + (luxc (lang ["ls" synthesis])) + [//] + (// [".T" runtime] + [".T" primitive] + [".T" reference])) + +(def: #export (translate-let translate valueS register bodyS) + (-> (-> ls.Synthesis (Meta //.Expression)) ls.Synthesis Nat ls.Synthesis + (Meta //.Expression)) + (do macro.Monad<Meta> + [valueJS (translate valueS) + bodyJS (translate bodyS)] + (wrap (format "(function() {" + "var " (referenceT.variable register) " = " valueJS ";" + "return " bodyJS ";" + "})()")))) + +(def: #export (translate-record-get translate valueS path) + (-> (-> ls.Synthesis (Meta //.Expression)) ls.Synthesis (List [Nat Bool]) + (Meta //.Expression)) + (do macro.Monad<Meta> + [valueJS (translate valueS)] + (wrap (list/fold (function [source [idx tail?]] + (let [method (if tail? runtimeT.product//right runtimeT.product//left)] + (format method "(" source "," idx ")"))) + (format "(" valueJS ")") + path)))) + +(def: #export (translate-if translate testS thenS elseS) + (-> (-> ls.Synthesis (Meta //.Expression)) ls.Synthesis ls.Synthesis ls.Synthesis + (Meta //.Expression)) + (do macro.Monad<Meta> + [testJS (translate testS) + thenJS (translate thenS) + elseJS (translate elseS)] + (wrap (format "(" testJS " ? " thenJS " : " elseJS ")")))) + +(def: savepoint + //.Expression + "pm_cursor_savepoint") + +(def: cursor + //.Expression + "pm_cursor") + +(def: (push-cursor value) + (-> //.Expression //.Expression) + (format cursor ".push(" value ");")) + +(def: save-cursor + //.Statement + (format savepoint ".push(" cursor ".slice());")) + +(def: restore-cursor + //.Statement + (format cursor " = " savepoint ".pop();")) + +(def: peek-cursor + //.Expression + (format cursor "[" cursor ".length - 1]")) + +(def: pop-cursor + //.Statement + (format cursor ".pop();")) + +(def: pm-error + //.Expression + (%t "PM-ERROR")) + +(def: fail-pattern-matching + //.Statement + (format "throw " pm-error ";")) + +(def: (translate-pattern-matching' translate path) + (-> (-> ls.Synthesis (Meta //.Expression)) Code (Meta //.Expression)) + (case path + (^code ("lux case exec" (~ bodyS))) + (do macro.Monad<Meta> + [bodyJS (translate bodyS)] + (wrap (format "return " bodyJS ";"))) + + (^code ("lux case pop")) + (wrap pop-cursor) + + (^code ("lux case bind" (~ [_ (#.Nat register)]))) + (wrap (format "var " (referenceT.variable register) " = " peek-cursor ";")) + + (^template [<tag> <translate>] + [_ (<tag> value)] + (do macro.Monad<Meta> + [valueJS (<translate> value)] + (wrap (format "if(!" (format runtimeT.int//= "(" peek-cursor "," valueJS ")") ") { " fail-pattern-matching " }")))) + ([#.Nat primitiveT.translate-nat] + [#.Int primitiveT.translate-int] + [#.Deg primitiveT.translate-deg]) + + (^template [<tag> <format>] + (<tag> value) + (wrap (format "if(" peek-cursor " !== " (<format> value) ") { " fail-pattern-matching " }"))) + ([#.Bool %b] + [#.Frac %f] + [#.Text %t]) + + (^template [<pm> <getter>] + (^code (<pm> (~ [_ (#.Nat idx)]))) + (wrap (push-cursor (format <getter> "(" peek-cursor "," (|> idx nat-to-int %i) ")")))) + (["lux case tuple left" runtimeT.product//left] + ["lux case tuple right" runtimeT.product//right]) + + (^template [<pm> <flag>] + (^code (<pm> (~ [_ (#.Nat idx)]))) + (wrap (format "temp = " runtimeT.sum//get "(" peek-cursor "," (|> idx nat-to-int %i) "," <flag> ");" + "if(temp !== null) {" + (push-cursor "temp") + "}" + "else {" + fail-pattern-matching + "}"))) + (["lux case variant left" "null"] + ["lux case variant right" "\"\""]) + + (^code ("lux case seq" (~ leftP) (~ rightP))) + (do macro.Monad<Meta> + [leftJS (translate-pattern-matching' translate leftP) + rightJS (translate-pattern-matching' translate rightP)] + (wrap (format leftJS rightJS))) + + (^code ("lux case alt" (~ leftP) (~ rightP))) + (do macro.Monad<Meta> + [leftJS (translate-pattern-matching' translate leftP) + rightJS (translate-pattern-matching' translate rightP)] + (wrap (format "try {" + save-cursor + leftJS + "}" + "catch(ex) {" + "if(ex === " pm-error ") {" + restore-cursor + rightJS + "}" + "else {" + "throw ex;" + "}" + "}"))) + )) + +(def: report-pattern-matching-error + //.Statement + (format "if(ex === " pm-error ") {" + "throw \"Invalid expression for pattern-matching.\";" + "}" + "else {" + "throw ex;" + "}")) + +(def: (translate-pattern-matching translate path) + (-> (-> ls.Synthesis (Meta //.Expression)) Code (Meta //.Expression)) + (do macro.Monad<Meta> + [pmJS (translate-pattern-matching' translate path)] + (wrap (format "try {" pmJS "}" + "catch(ex) {" + report-pattern-matching-error + "}")))) + +(def: (initialize-pattern-matching stack-init) + (-> //.Expression //.Statement) + (format "var temp;" + "var " cursor " = [" stack-init "];" + "var " savepoint " = [];")) + +(def: #export (translate-case translate valueS path) + (-> (-> ls.Synthesis (Meta //.Expression)) ls.Synthesis Code (Meta //.Expression)) + (do macro.Monad<Meta> + [valueJS (translate valueS) + pmJS (translate-pattern-matching translate path)] + (wrap (format "(function() {" + "\"use strict\";" + (initialize-pattern-matching valueJS) + pmJS + "})()")))) |