- Initial Lua backend implementation.

1 files changed, 174 insertions, 0 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
new file mode 100644
index 000000000..bce4d7bff
--- /dev/null
+++ b/new-luxc/source/luxc/lang/translation/lua/case.jvm.lux
@@ -0,0 +1,174 @@
+(.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 Bool])
+      (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 (:! 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)
+
+(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 (:! Int))]
+     [#.Int  lua.int]
+     [#.Deg  (<| lua.int (:! Int))]
+     [#.Bool lua.bool]
+     [#.Frac lua.float]
+     [#.Text lua.string])
+
+    (^template [<pm> <getter>]
+      (^code (<pm> (~ [_ (#.Nat idx)])))
+      (meta/wrap (push-cursor! (<getter> cursor-top (lua.int (:! 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 (:! Int idx)) <flag>))
+                                   (lua.if! (lua.not (lua.= lua.nil "temp"))
+                                            (push-cursor! "temp")
+                                            (lua.return! pm-error))))))
+    (["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))))))