From 498af2e0123c1ce65e46bf15fe3854266ad58f53 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Sun, 21 Jan 2018 12:58:48 -0400
Subject: - WIP: Host procedures for JS.

---
 .../lang/translation/js/procedure/host.jvm.lux     | 149 +++++++++++++++++++++
 1 file changed, 149 insertions(+)
 create mode 100644 new-luxc/source/luxc/lang/translation/js/procedure/host.jvm.lux

(limited to 'new-luxc/source/luxc/lang/translation/js/procedure/host.jvm.lux')

diff --git a/new-luxc/source/luxc/lang/translation/js/procedure/host.jvm.lux b/new-luxc/source/luxc/lang/translation/js/procedure/host.jvm.lux
new file mode 100644
index 000000000..4ac0d2022
--- /dev/null
+++ b/new-luxc/source/luxc/lang/translation/js/procedure/host.jvm.lux
@@ -0,0 +1,149 @@
+(.module:
+  lux
+  (lux (control [monad #+ do])
+       (data [text]
+             text/format
+             (coll [list "list/" Functor<List>]
+                   [dict #+ Dict]))
+       [macro "macro/" Monad<Meta>])
+  (luxc ["&" lang]
+        (lang ["la" analysis]
+              ["ls" synthesis]))
+  [///]
+  (/// [".T" runtime])
+  (// ["@" common]))
+
+(do-template [<name> <js>]
+  [(def: (<name> _) @.Nullary <js>)]
+
+  [js//null "null"]
+  [js//undefined "undefined"]
+  [js//object "{}"]
+  )
+
+(def: (js//global proc translate inputs)
+  (-> Text @.Proc)
+  (case inputs
+    (^ (list [_ (#.Text name)]))
+    (do macro.Monad<Meta>
+      []
+      (wrap name))
+
+    _
+    (&.throw @.Wrong-Syntax (@.wrong-syntax proc inputs))))
+
+(def: (js//call proc translate inputs)
+  (-> Text @.Proc)
+  (case inputs
+    (^ (list& functionS argsS+))
+    (do macro.Monad<Meta>
+      [functionJS (translate functionS)
+       argsJS+ (monad.map @ translate argsS+)]
+      (wrap (format "(" functionJS ")("
+                    (text.join-with "," argsJS+)
+                    ")")))
+
+    _
+    (&.throw @.Wrong-Syntax (@.wrong-syntax proc inputs))))
+
+(def: js-procs
+  @.Bundle
+  (|> (dict.new text.Hash<Text>)
+      (@.install "null" (@.nullary js//null))
+      (@.install "undefined" (@.nullary js//undefined))
+      (@.install "object" (@.nullary js//object))
+      (@.install "global" js//global)
+      (@.install "call" js//call)))
+
+(def: (object//new proc translate inputs)
+  (-> Text @.Proc)
+  (case inputs
+    (^ (list& constructorS argsS+))
+    (do macro.Monad<Meta>
+      [constructorJS (translate constructorS)
+       argsJS+ (monad.map @ translate argsS+)]
+      (wrap (format "new (" constructorJS ")("
+                    (text.join-with "," argsJS+)
+                    ")")))
+
+    _
+    (&.throw @.Wrong-Syntax (@.wrong-syntax proc inputs))))
+
+(def: (object//call proc translate inputs)
+  (-> Text @.Proc)
+  (case inputs
+    (^ (list& objectS fieldS argsS+))
+    (do macro.Monad<Meta>
+      [objectJS (translate objectS)
+       fieldJS (translate fieldS)
+       argsJS+ (monad.map @ translate argsS+)]
+      (wrap (format runtimeT.js//call
+                    "(" objectJS
+                    "," fieldJS
+                    "," "[" (text.join-with "," argsJS+) "]"
+                    ")")))
+
+    _
+    (&.throw @.Wrong-Syntax (@.wrong-syntax proc inputs))))
+
+(def: (object//get [fieldJS objectJS])
+  @.Binary
+  (format runtimeT.js//get "(" objectJS "," fieldJS ")"))
+
+(def: (object//set [fieldJS valueJS objectJS])
+  @.Trinary
+  (format runtimeT.js//set "(" objectJS "," fieldJS "," valueJS ")"))
+
+(def: (object//delete [fieldJS objectJS])
+  @.Binary
+  (format runtimeT.js//delete "(" objectJS "," fieldJS ")"))
+
+(def: object-procs
+  @.Bundle
+  (<| (@.prefix "object")
+      (|> (dict.new text.Hash<Text>)
+          (@.install "new" object//new)
+          (@.install "call" object//call)
+          (@.install "get" (@.binary object//get))
+          (@.install "set" (@.trinary object//set))
+          (@.install "delete" (@.binary object//delete))
+          )))
+
+(def: (array//literal elementsJS+)
+  @.Variadic
+  (format "[" (text.join-with "," elementsJS+) "]"))
+
+(def: (array//read [indexJS arrayJS])
+  @.Binary
+  (format runtimeT.array//get "(" arrayJS "," indexJS ")"))
+
+(def: (array//write [indexJS valueJS arrayJS])
+  @.Binary
+  (format runtimeT.array//put "(" arrayJS "," indexJS "," valueJS ")"))
+
+(def: (array//delete [indexJS arrayJS])
+  @.Binary
+  (format runtimeT.array//remove "(" arrayJS "," indexJS ")"))
+
+(def: (array//length arrayJS)
+  @.Unary
+  (format arrayJS ".length"))
+
+(def: array-procs
+  @.Bundle
+  (<| (@.prefix "array")
+      (|> (dict.new text.Hash<Text>)
+          (@.install "literal" array//literal)
+          (@.install "read" array//read)
+          (@.install "write" array//write)
+          (@.install "delete" array//delete)
+          (@.install "length" array//length)
+          )))
+
+(def: #export procedures
+  @.Bundle
+  (<| (@.prefix "js")
+      (|> (dict.merge js-procs)
+          (dict.merge object-procs)
+          (dict.merge array-procs)
+          )))
-- 
cgit v1.2.3