diff options
Diffstat (limited to 'new-luxc/source/luxc/lang/translation/lua/case.jvm.lux')
| -rw-r--r-- | new-luxc/source/luxc/lang/translation/lua/case.jvm.lux | 175 |
1 files changed, 0 insertions, 175 deletions
diff --git a/new-luxc/source/luxc/lang/translation/lua/case.jvm.lux b/new-luxc/source/luxc/lang/translation/lua/case.jvm.lux deleted file mode 100644 index af4e61b7c..000000000 --- a/new-luxc/source/luxc/lang/translation/lua/case.jvm.lux +++ /dev/null @@ -1,175 +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 [lua #+ Lua Expression Statement]))) - [//] - (// [".T" runtime] - [".T" primitive] - [".T" reference])) - -(def: (expression-block body) - (-> Statement Expression) - (lua.apply (lua.function (list) - body) - (list))) - -(def: #export (translate-let translate register valueS bodyS) - (-> (-> ls.Synthesis (Meta Expression)) Nat ls.Synthesis ls.Synthesis - (Meta Expression)) - (do macro.Monad<Meta> - [valueO (translate valueS) - bodyO (translate bodyS)] - (wrap (expression-block - (lua.block! (list (lua.local! (referenceT.variable register) (#.Some valueO)) - (lua.return! bodyO))))))) - -(def: #export (translate-record-get translate valueS path) - (-> (-> ls.Synthesis (Meta Expression)) ls.Synthesis (List [Nat Bit]) - (Meta Expression)) - (do macro.Monad<Meta> - [valueO (translate valueS)] - (wrap (list/fold (function (_ [idx tail?] source) - (let [method (if tail? - runtimeT.product//right - runtimeT.product//left)] - (method source (lua.int (:coerce Int idx))))) - valueO - path)))) - -(def: #export (translate-if testO thenO elseO) - (-> Expression Expression Expression Expression) - (expression-block - (lua.if! testO - (lua.return! thenO) - (lua.return! elseO)))) - -(def: savepoint - Expression - "pm_cursor_savepoint") - -(def: cursor - Expression - "pm_cursor") - -(def: (push-cursor! value) - (-> Expression Expression) - (lua.apply "table.insert" (list cursor value))) - -(def: save-cursor! - Statement - (lua.apply "table.insert" (list savepoint (runtimeT.array//copy cursor)))) - -(def: restore-cursor! - Statement - (lua.set! cursor (lua.apply "table.remove" (list savepoint)))) - -(def: cursor-top - Expression - (lua.nth (lua.length cursor) cursor)) - -(def: pop-cursor! - Statement - (lua.apply "table.remove" (list cursor))) - -(def: pm-error - Expression - (lua.string "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> - [bodyO (translate bodyS)] - (wrap (lua.return! bodyO))) - - (^code ("lux case pop")) - (meta/wrap pop-cursor!) - - (^code ("lux case bind" (~ [_ (#.Nat register)]))) - (meta/wrap (lua.local! (referenceT.variable register) (#.Some cursor-top))) - - (^template [<tag> <format>] - [_ (<tag> value)] - (meta/wrap (lua.when! (lua.not (lua.= (|> value <format>) cursor-top)) - (lua.return! pm-error)))) - ([#.Nat (<| lua.int (:coerce Int))] - [#.Int lua.int] - [#.Rev (<| lua.int (:coerce Int))] - [#.Bit lua.bool] - [#.Frac lua.float] - [#.Text lua.string]) - - (^template [<pm> <getter>] - (^code (<pm> (~ [_ (#.Nat idx)]))) - (meta/wrap (push-cursor! (<getter> cursor-top (lua.int (:coerce Int idx)))))) - (["lux case tuple left" runtimeT.product//left] - ["lux case tuple right" runtimeT.product//right]) - - (^template [<pm> <flag>] - (^code (<pm> (~ [_ (#.Nat idx)]))) - (meta/wrap (lua.block! (list (lua.set! "temp" (runtimeT.sum//get cursor-top (lua.int (:coerce Int idx)) <flag>)) - (lua.if! (lua.= lua.nil "temp") - (lua.return! pm-error) - (push-cursor! "temp")))))) - (["lux case variant left" lua.nil] - ["lux case variant right" (lua.string "")]) - - (^code ("lux case seq" (~ leftP) (~ rightP))) - (do macro.Monad<Meta> - [leftO (translate-pattern-matching' translate leftP) - rightO (translate-pattern-matching' translate rightP)] - (wrap (lua.block! (list leftO rightO)))) - - (^code ("lux case alt" (~ leftP) (~ rightP))) - (do macro.Monad<Meta> - [leftO (translate-pattern-matching' translate leftP) - rightO (translate-pattern-matching' translate rightP)] - (wrap (lua.block! (list (format "local alt_success, alt_value = " (lua.apply "pcall" (list (lua.function (list) - (lua.block! (list save-cursor! - leftO))))) ";") - (lua.if! "alt_success" - (lua.return! "alt_value") - (lua.if! (lua.= pm-error "alt_value") - (lua.block! (list restore-cursor! - rightO)) - (lua.error "alt_value"))))))) - - _ - (lang.throw Unrecognized-Path (%code path)) - )) - -(def: (translate-pattern-matching translate path) - (-> (-> ls.Synthesis (Meta Expression)) Code (Meta Expression)) - (do macro.Monad<Meta> - [pattern-matching (translate-pattern-matching' translate path)] - (wrap (lua.block! (list (format "local success, value = pcall(function () " pattern-matching " end);") - (lua.if! "success" - (lua.return! "value") - (lua.if! (lua.= pm-error "value") - (lua.error (lua.string "Invalid expression for pattern-matching.")) - (lua.error "value")))))))) - -(def: (initialize-pattern-matching stack-init) - (-> Expression Statement) - (lua.block! (list (lua.local! "temp" #.None) - (lua.local! cursor (#.Some (lua.array (list stack-init)))) - (lua.local! savepoint (#.Some (lua.array (list))))))) - -(def: #export (translate-case translate valueS path) - (-> (-> ls.Synthesis (Meta Expression)) ls.Synthesis Code (Meta Expression)) - (do macro.Monad<Meta> - [valueO (translate valueS) - pattern-matching (translate-pattern-matching translate path)] - (wrap (expression-block - (lua.block! (list (initialize-pattern-matching valueO) - pattern-matching)))))) |