diff options
Diffstat (limited to 'new-luxc/source/luxc/lang')
| -rw-r--r-- | new-luxc/source/luxc/lang/translation/js/case.jvm.lux | 191 |
1 files changed, 0 insertions, 191 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 deleted file mode 100644 index e8fdcb00c..000000000 --- a/new-luxc/source/luxc/lang/translation/js/case.jvm.lux +++ /dev/null @@ -1,191 +0,0 @@ -(.module: - lux - (lux (control [monad #+ do] - ["ex" exception #+ exception:]) - (data text/format - (coll [list "list/" Fold<List>])) - [macro #+ "meta/" Monad<Meta>]) - (luxc [lang] - (lang ["ls" synthesis] - (host [js #+ JS Expression Statement]))) - [//] - (// [".T" runtime] - [".T" primitive] - [".T" reference])) - -(def: #export (translate-let translate register valueS bodyS) - (-> (-> ls.Synthesis (Meta Expression)) Nat ls.Synthesis 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 Bit]) - (Meta Expression)) - (do macro.Monad<Meta> - [valueJS (translate valueS)] - (wrap (list/fold (function (_ [idx tail?] source) - (let [method (if tail? runtimeT.product//right runtimeT.product//left)] - (format method "(" source "," (|> idx .int %i) ")"))) - (format "(" valueJS ")") - path)))) - -(def: #export (translate-if testJS thenJS elseJS) - (-> Expression Expression Expression - Expression) - (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 ";")) - -(exception: #export (Unrecognized-Path {message Text}) - message) - -(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")) - (meta/wrap pop-cursor) - - (^code ("lux case bind" (~ [_ (#.Nat register)]))) - (meta/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] - [#.Rev primitiveT.translate-rev]) - - (^template [<tag> <format>] - [_ (<tag> value)] - (meta/wrap (format "if(" peek-cursor " !== " (<format> value) ") { " fail-pattern-matching " }"))) - ([#.Bit %b] - [#.Frac %f] - [#.Text %t]) - - (^template [<pm> <getter>] - (^code (<pm> (~ [_ (#.Nat idx)]))) - (meta/wrap (push-cursor (format <getter> "(" peek-cursor "," (|> idx .int %i) ")")))) - (["lux case tuple left" runtimeT.product//left] - ["lux case tuple right" runtimeT.product//right]) - - (^template [<pm> <flag>] - (^code (<pm> (~ [_ (#.Nat idx)]))) - (meta/wrap (format "temp = " runtimeT.sum//get "(" peek-cursor "," (|> idx .int %i) "," <flag> ");" - "if(temp == null) {" - fail-pattern-matching - "}" - "else {" - (push-cursor "temp") - "}"))) - (["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;" - "}" - "}"))) - - _ - (lang.throw Unrecognized-Path (%code path)) - )) - -(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 - "})()")))) |