- Initial Ruby back-end implementation.

1 files changed, 174 insertions, 0 deletions

diff --git a/new-luxc/source/luxc/lang/translation/ruby/case.jvm.lux b/new-luxc/source/luxc/lang/translation/ruby/case.jvm.lux
new file mode 100644
index 000000000..016038d03
--- /dev/null
+++ b/new-luxc/source/luxc/lang/translation/ruby/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 [ruby #+ Ruby Expression Statement])))
+  [//]
+  (// [".T" runtime]
+      [".T" primitive]
+      [".T" reference]))
+
+(def: (expression-block body)
+  (-> Statement Expression)
+  (ruby.call (list)
+             (ruby.lambda #.None (list)
+                     body)))
+
+(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
+           (ruby.block! (list (ruby.set! (list (referenceT.variable register)) valueO)
+                              (ruby.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 (ruby.int (:! Int idx)))))
+                     valueO
+                     path))))
+
+(def: #export (translate-if testO thenO elseO)
+  (-> Expression Expression Expression Expression)
+  (expression-block
+   (ruby.if! testO
+             (ruby.return! thenO)
+             (ruby.return! elseO))))
+
+(def: savepoint
+  Expression
+  "pm_cursor_savepoint")
+
+(def: cursor
+  Expression
+  "pm_cursor")
+
+(def: (push-cursor! value)
+  (-> Expression Statement)
+  (ruby.statement (ruby.send "push" (list value) cursor)))
+
+(def: save-cursor!
+  Statement
+  (ruby.statement
+   (ruby.send "push"
+              (list (ruby.array-range (ruby.int 0) (ruby.int -1) cursor))
+              savepoint)))
+
+(def: restore-cursor!
+  Statement
+  (ruby.set! (list cursor) (ruby.send "pop" (list) savepoint)))
+
+(def: cursor-top
+  Expression
+  (ruby.nth (ruby.- (ruby.int 1)
+                    (ruby.length cursor))
+            cursor))
+
+(def: pop-cursor!
+  Statement
+  (ruby.statement (ruby.send "pop" (list) cursor)))
+
+(def: pm-error
+  Expression
+  (ruby.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 (ruby.return! bodyO)))
+
+    (^code ("lux case pop"))
+    (meta/wrap pop-cursor!)
+
+    (^code ("lux case bind" (~ [_ (#.Nat register)])))
+    (meta/wrap (ruby.set! (list (referenceT.variable register)) cursor-top))
+
+    (^template [<tag> <format>]
+      [_ (<tag> value)]
+      (meta/wrap (ruby.when! (ruby.not (ruby.= (|> value <format>) cursor-top))
+                             (ruby.raise pm-error))))
+    ([#.Nat  (<| ruby.int (:! Int))]
+     [#.Int  ruby.int]
+     [#.Deg  (<| ruby.int (:! Int))]
+     [#.Bool ruby.bool]
+     [#.Frac ruby.float]
+     [#.Text ruby.string])
+
+    (^template [<pm> <getter>]
+      (^code (<pm> (~ [_ (#.Nat idx)])))
+      (meta/wrap (push-cursor! (<getter> cursor-top (ruby.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 (ruby.block! (list (ruby.set! (list "temp") (runtimeT.sum//get cursor-top (ruby.int (:! Int idx)) <flag>))
+                                    (ruby.if! (ruby.not (ruby.= ruby.nil "temp"))
+                                              (push-cursor! "temp")
+                                              (ruby.raise pm-error))))))
+    (["lux case variant left" ruby.nil]
+     ["lux case variant right" (ruby.string "")])
+
+    (^code ("lux case seq" (~ leftP) (~ rightP)))
+    (do macro.Monad<Meta>
+      [leftO (translate-pattern-matching' translate leftP)
+       rightO (translate-pattern-matching' translate rightP)]
+      (wrap (ruby.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 (ruby.begin! (ruby.block! (list save-cursor!
+                                            leftO))
+                         (list [(list) "alt_error" (ruby.if! (ruby.= pm-error (ruby.field "message" "alt_error"))
+                                                             (ruby.block! (list restore-cursor!
+                                                                                rightO))
+                                                             (ruby.raise "alt_error"))]))))
+
+    _
+    (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 (ruby.begin! pattern-matching
+                       (list [(list) "alt_error"
+                              (ruby.if! (ruby.= pm-error (ruby.field "message" "alt_error"))
+                                        (ruby.raise (ruby.string "Invalid expression for pattern-matching."))
+                                        (ruby.raise "alt_error"))])))))
+
+(def: (initialize-pattern-matching stack-init)
+  (-> Expression Statement)
+  (ruby.block! (list (ruby.set! (list cursor) (ruby.array (list stack-init)))
+                     (ruby.set! (list savepoint) (ruby.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
+           (ruby.block! (list (initialize-pattern-matching valueO)
+                              pattern-matching))))))