- Initial Ruby back-end implementation.

1 files changed, 385 insertions, 0 deletions

diff --git a/new-luxc/source/luxc/lang/translation/ruby/runtime.jvm.lux b/new-luxc/source/luxc/lang/translation/ruby/runtime.jvm.lux
new file mode 100644
index 000000000..190b9cf6a
--- /dev/null
+++ b/new-luxc/source/luxc/lang/translation/ruby/runtime.jvm.lux
@@ -0,0 +1,385 @@
+(.module:
+  lux
+  (lux (control ["p" parser "p/" Monad<Parser>]
+                [monad #+ do])
+       (data text/format
+             (coll [list "list/" Monad<List>]))
+       [macro]
+       (macro [code]
+              ["s" syntax #+ syntax:])
+       [io #+ Process])
+  [//]
+  (luxc [lang]
+        (lang (host [ruby #+ Ruby Expression Statement]))))
+
+(def: prefix Text "LuxRuntime")
+
+(def: #export unit Expression (%t //.unit))
+
+(def: (flag value)
+  (-> Bool Ruby)
+  (if value
+    (ruby.string "")
+    ruby.nil))
+
+(def: (variant' tag last? value)
+  (-> Expression Expression Expression Expression)
+  (ruby.dictionary (list [(ruby.string //.variant-tag-field) tag]
+                         [(ruby.string //.variant-flag-field) last?]
+                         [(ruby.string //.variant-value-field) value])))
+
+(def: #export (variant tag last? value)
+  (-> Nat Bool Expression Expression)
+  (variant' (%i (nat-to-int tag)) (flag last?) value))
+
+(def: #export none
+  Expression
+  (variant +0 false unit))
+
+(def: #export some
+  (-> Expression Expression)
+  (variant +1 true))
+
+(def: #export left
+  (-> Expression Expression)
+  (variant +0 false))
+
+(def: #export right
+  (-> Expression Expression)
+  (variant +1 true))
+
+(type: Runtime Ruby)
+
+(def: declaration
+  (s.Syntax [Text (List Text)])
+  (p.either (p.seq s.local-symbol (p/wrap (list)))
+            (s.form (p.seq s.local-symbol (p.some s.local-symbol)))))
+
+(syntax: (runtime: [[name args] declaration]
+           definition)
+  (let [implementation (code.local-symbol (format "@@" name))
+        runtime (code.text (format "__" prefix "__" (lang.normalize-name name)))
+        argsC+ (list/map code.local-symbol args)
+        argsLC+ (list/map (|>> lang.normalize-name code.text) args)
+        declaration (` ((~ (code.local-symbol name))
+                        (~+ argsC+)))
+        type (` (-> (~+ (list.repeat (list.size argsC+) (` ruby.Ruby)))
+                    ruby.Ruby))]
+    (wrap (list (` (def: #export (~ declaration)
+                     (~ type)
+                     (ruby.apply (~ runtime) (list (~+ argsC+)))))
+                (` (def: (~ implementation)
+                     Ruby
+                     (~ (case argsC+
+                          #.Nil
+                          (` (ruby.set! (list (~ runtime)) (~ definition)))
+
+                          _
+                          (` (let [(~' @) (~ runtime)
+                                   (~+ (|> (list.zip2 argsC+ argsLC+)
+                                           (list/map (function [[left right]] (list left right)))
+                                           list/join))]
+                               (ruby.function! (~ runtime)
+                                               (list (~+ argsLC+))
+                                               (~ definition))))))))))))
+
+(runtime: (lux//try op)
+  (ruby.begin! (ruby.block! (list (ruby.set! (list "value") (ruby.call (list unit) op))
+                                  (ruby.return! (right "value"))))
+               (list [(list) "error"
+                      (ruby.return! (left (ruby.field "message" "error")))])))
+
+(runtime: (lux//program-args program-args)
+  (ruby.block! (list (ruby.set! (list "inputs") none)
+                     (ruby.for-in! "value" program-args
+                                   (ruby.set! (list "inputs") (some (ruby.array (list "value" "inputs")))))
+                     (ruby.return! "inputs"))))
+
+(def: runtime//lux
+  Runtime
+  (format @@lux//try "\n"
+          @@lux//program-args "\n"))
+
+(runtime: (product//left product index)
+  (ruby.block! (list (ruby.set! (list "index_min_length") (ruby.+ (ruby.int 1) index))
+                     (ruby.if! (ruby.> "index_min_length" (ruby.length product))
+                               ## No need for recursion
+                               (ruby.return! (ruby.nth index product))
+                               ## Needs recursion
+                               (ruby.return! (product//left (ruby.nth (ruby.- (ruby.int 1)
+                                                                              (ruby.length product))
+                                                                      product)
+                                                            (ruby.- (ruby.length product)
+                                                                    "index_min_length")))))))
+
+(runtime: (product//right product index)
+  (ruby.block! (list (ruby.set! (list "index_min_length") (ruby.+ (ruby.int 1) index))
+                     (ruby.cond! (list [(ruby.= "index_min_length" (ruby.length product))
+                                        ## Last element.
+                                        (ruby.return! (ruby.nth index product))]
+                                       [(ruby.< "index_min_length" (ruby.length product))
+                                        ## Needs recursion
+                                        (ruby.return! (product//right (ruby.nth (ruby.- (ruby.int 1)
+                                                                                        (ruby.length product))
+                                                                                product)
+                                                                      (ruby.- (ruby.length product)
+                                                                              "index_min_length")))])
+                                 ## Must slice
+                                 (ruby.return! (ruby.array-range index (ruby.length product) product))))))
+
+(runtime: (sum//get sum wantedTag wantsLast)
+  (let [no-match! (ruby.return! ruby.nil)
+        sum-tag (ruby.nth (ruby.string //.variant-tag-field) sum)
+        sum-flag (ruby.nth (ruby.string //.variant-flag-field) sum)
+        sum-value (ruby.nth (ruby.string //.variant-value-field) sum)
+        is-last? (ruby.= (ruby.string "") sum-flag)
+        test-recursion! (ruby.if! is-last?
+                                  ## Must recurse.
+                                  (ruby.return! (sum//get sum-value (ruby.- sum-tag wantedTag) wantsLast))
+                                  no-match!)]
+    (ruby.cond! (list [(ruby.= sum-tag wantedTag)
+                       (ruby.if! (ruby.= wantsLast sum-flag)
+                                 (ruby.return! sum-value)
+                                 test-recursion!)]
+
+                      [(ruby.> sum-tag wantedTag)
+                       test-recursion!]
+
+                      [(ruby.and (ruby.< sum-tag wantedTag)
+                                 (ruby.= (ruby.string "") wantsLast))
+                       (ruby.return! (variant' (ruby.- wantedTag sum-tag) sum-flag sum-value))])
+
+                no-match!)))
+
+(def: runtime//adt
+  Runtime
+  (format @@product//left "\n"
+          @@product//right "\n"
+          @@sum//get "\n"))
+
+(runtime: (bit//count subject)
+  (ruby.block! (list (ruby.set! (list "count") (ruby.int 0))
+                     (ruby.while! (ruby.> (ruby.int 0) subject)
+                                  (ruby.block! (list (ruby.set! (list "count") (ruby.+ (ruby.% (ruby.int 2) subject)
+                                                                                       "count"))
+                                                     (ruby.set! (list subject) (ruby./ (ruby.int 2) subject)))))
+                     (ruby.return! "count"))))
+
+(runtime: (bit//shift-right param subject)
+  (let [mask (|> (ruby.int 1)
+                 (ruby.bit-shl (ruby.- param (ruby.int 64)))
+                 (ruby.- (ruby.int 1)))]
+    (ruby.return! (|> subject
+                      (ruby.bit-shr param)
+                      (ruby.bit-and mask)))))
+
+(def: runtime//bit
+  Runtime
+  (format @@bit//count
+          @@bit//shift-right))
+
+(def: high (-> Expression Expression) (bit//shift-right (ruby.int 32)))
+(def: low  (-> Expression Expression) (ruby.bit-and "0xFFFFFFFF"))
+
+(runtime: (nat//< param subject)
+  (ruby.block! (list (ruby.set! (list "ph") (high param))
+                     (ruby.set! (list "sh") (high subject))
+                     (ruby.return! (ruby.or (ruby.< "ph" "sh")
+                                            (ruby.and (ruby.= "ph" "sh")
+                                                      (ruby.< (low param) (low subject))))))))
+
+(runtime: (nat/// param subject)
+  (ruby.if! (ruby.< (ruby.int 0) param)
+            (ruby.if! (nat//< param subject)
+                      (ruby.return! (ruby.int 0))
+                      (ruby.return! (ruby.int 1)))
+            (ruby.block! (list (ruby.set! (list "quotient") (|> subject
+                                                                (ruby.bit-shr (ruby.int 1))
+                                                                (ruby./ param)
+                                                                (ruby.bit-shl (ruby.int 1))))
+                               (ruby.set! (list "remainder") (ruby.- (ruby.* param "quotient")
+                                                                     subject))
+                               (ruby.if! (ruby.not (nat//< param "remainder"))
+                                         (ruby.return! (ruby.+ (ruby.int 1) "quotient"))
+                                         (ruby.return! "quotient"))))))
+
+(runtime: (nat//% param subject)
+  (let [flat (|> subject
+                 (nat/// param)
+                 (ruby.* param))]
+    (ruby.return! (ruby.- flat subject))))
+
+(def: runtime//nat
+  Runtime
+  (format @@nat//<
+          @@nat///
+          @@nat//%))
+
+(runtime: (deg//* param subject)
+  (ruby.block! (list (ruby.set! (list "sL") (low subject))
+                     (ruby.set! (list "sH") (high subject))
+                     (ruby.set! (list "pL") (low param))
+                     (ruby.set! (list "pH") (high param))
+                     (ruby.set! (list "bottom") (bit//shift-right (ruby.int 32)
+                                                                  (ruby.* "pL" "sL")))
+                     (ruby.set! (list "middle") (ruby.+ (ruby.* "pL" "sH")
+                                                        (ruby.* "pH" "sL")))
+                     (ruby.set! (list "top") (ruby.* "pH" "sH"))
+                     (ruby.return! (|> "bottom"
+                                       (ruby.+ "middle")
+                                       high
+                                       (ruby.+ "top"))))))
+
+(runtime: (deg//leading-zeroes input)
+  (ruby.block! (list (ruby.set! (list "zeroes") (ruby.int 64))
+                     (ruby.while! (ruby.not (ruby.= (ruby.int 0) input))
+                                  (ruby.block! (list (ruby.set! (list "zeroes") (ruby.- (ruby.int 1) "zeroes"))
+                                                     (ruby.set! (list input) (bit//shift-right (ruby.int 1) input)))))
+                     (ruby.return! "zeroes"))))
+
+(runtime: (deg/// param subject)
+  (ruby.if! (ruby.= param subject)
+            (ruby.return! (ruby.int -1))
+            (ruby.block! (list (ruby.set! (list "min_shift")
+                                          (ruby.send "min" (list)
+                                                     (ruby.array (list (deg//leading-zeroes param)
+                                                                       (deg//leading-zeroes subject)))))
+                               (ruby.return! (|> (ruby.bit-shl "min_shift" subject)
+                                                 (ruby./ (|> param (ruby.bit-shl "min_shift") low))
+                                                 (ruby.bit-shl (ruby.int 32))))))))
+
+(runtime: (deg//from-frac input)
+  (let [->int (ruby.send "floor" (list))]
+    (ruby.block! (list (ruby.set! (list "two32") (ruby.pow (ruby.float 32.0) (ruby.float 2.0)))
+                       (ruby.set! (list "shifted") (|> input
+                                                       (ruby.% (ruby.float 1.0))
+                                                       (ruby.* "two32")))
+                       (ruby.set! (list "low") (|> "shifted"
+                                                   (ruby.% (ruby.float 1.0))
+                                                   (ruby.* "two32")
+                                                   ->int))
+                       (ruby.set! (list "high") (|> "shifted" ->int))
+                       (ruby.return! (ruby.+ (ruby.bit-shl (ruby.int 32) "high")
+                                             "low"))))))
+
+(def: runtime//deg
+  Runtime
+  (format @@deg//*
+          @@deg//leading-zeroes
+          @@deg///
+          @@deg//from-frac))
+
+(runtime: (text//index subject param start)
+  (ruby.block! (list (ruby.set! (list "idx") (ruby.send "index" (list param start) subject))
+                     (ruby.if! (ruby.= ruby.nil "idx")
+                               (ruby.return! none)
+                               (ruby.return! (some "idx"))))))
+
+(runtime: (text//clip text from to)
+  (ruby.if! ($_ ruby.and
+                (ruby.>= (ruby.int 0) from)
+                (ruby.< (ruby.send "length" (list) text) from)
+                (ruby.>= (ruby.int 0) to)
+                (ruby.< (ruby.send "length" (list) text) to)
+                (ruby.<= to from))
+            (ruby.return! (some (ruby.array-range from to text)))
+            (ruby.return! none)))
+
+(runtime: (text//char text idx)
+  (ruby.if! (ruby.and (ruby.>= (ruby.int 0) idx)
+                      (ruby.< (ruby.send "length" (list) text) idx))
+            (ruby.return! (some (ruby.send "ord" (list)
+                                           (ruby.array-range idx idx text))))
+            (ruby.return! none)))
+
+(def: runtime//text
+  Runtime
+  (format @@text//index
+          @@text//clip
+          @@text//char))
+
+(def: (check-index-out-of-bounds array idx body!)
+  (-> Expression Expression Statement Statement)
+  (ruby.if! (ruby.<= (ruby.length array)
+                     idx)
+            body!
+            (ruby.raise (ruby.string "Array index out of bounds!"))))
+
+(runtime: (array//get array idx)
+  (<| (check-index-out-of-bounds array idx)
+      (ruby.block! (list (ruby.set! (list "temp") (ruby.nth idx array))
+                         (ruby.if! (ruby.= ruby.nil "temp")
+                                   (ruby.return! none)
+                                   (ruby.return! (some "temp")))))))
+
+(runtime: (array//put array idx value)
+  (<| (check-index-out-of-bounds array idx)
+      (ruby.block! (list (ruby.set-nth! idx value array)
+                         (ruby.return! array)))))
+
+(def: runtime//array
+  Runtime
+  (format @@array//get
+          @@array//put))
+
+(def: #export atom//field Text "_lux_atom")
+
+(runtime: (atom//compare-and-swap atom old new)
+  (let [atom//field (ruby.string atom//field)]
+    (ruby.if! (ruby.= old (ruby.nth atom//field atom))
+              (ruby.block! (list (ruby.set-nth! atom//field new atom)
+                                 (ruby.return! (ruby.bool true))))
+              (ruby.return! (ruby.bool false)))))
+
+(def: runtime//atom
+  Runtime
+  (format @@atom//compare-and-swap "\n"))
+
+(runtime: (box//write value box)
+  (ruby.block! (list (ruby.set-nth! (ruby.int 0) value box)
+                     (ruby.return! ..unit))))
+
+(def: runtime//box
+  Runtime
+  (format @@box//write))
+
+(runtime: (process//future procedure)
+  (ruby.and (format "(Thread.new {"
+                    (ruby.statement (ruby.call (list ..unit) procedure))
+                    "})")
+            ..unit))
+
+(runtime: (process//schedule milli-seconds procedure)
+  (ruby.and (format "(Thread.new {"
+                    (ruby.statement (ruby.apply "sleep" (list (ruby./ (ruby.float 1_000.0) milli-seconds))))
+                    (ruby.statement (ruby.call (list ..unit) procedure))
+                    "})")
+            ..unit))
+
+(def: runtime//process
+  Runtime
+  (format @@process//future
+          @@process//schedule))
+
+(def: runtime
+  Runtime
+  (format runtime//lux "\n"
+          runtime//adt "\n"
+          runtime//bit "\n"
+          runtime//nat "\n"
+          runtime//deg "\n"
+          runtime//text "\n"
+          runtime//array "\n"
+          runtime//atom "\n"
+          runtime//box "\n"
+          runtime//process "\n"
+          ))
+
+(def: #export artifact Text (format prefix ".rb"))
+
+(def: #export translate
+  (Meta (Process Unit))
+  (do macro.Monad<Meta>
+    [_ //.init-module-buffer
+     _ (//.save runtime)]
+    (//.save-module! artifact)))