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.

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

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

diff --git a/new-luxc/source/luxc/lang/translation/js/function.jvm.lux b/new-luxc/source/luxc/lang/translation/js/function.jvm.lux
new file mode 100644
index 000000000..4debb077b
--- /dev/null
+++ b/new-luxc/source/luxc/lang/translation/js/function.jvm.lux
@@ -0,0 +1,75 @@
+(.module:
+  lux
+  (lux (control [monad #+ do])
+       (data [text]
+             text/format
+             (coll [list "list/" Functor<List>]))
+       [macro])
+  (luxc ["&" lang]
+        (lang ["ls" synthesis]
+              [".L" variable #+ Variable]))
+  [//]
+  (// [".T" reference]
+      [".T" loop]))
+
+(def: #export (translate-apply translate functionS argsS+)
+  (-> (-> ls.Synthesis (Meta //.Expression)) ls.Synthesis (List ls.Synthesis) (Meta //.Expression))
+  (do macro.Monad<Meta>
+    [functionJS (translate functionS)
+     argsJS+ (monad.map @ translate argsS+)]
+    (wrap (format functionJS "(" (text.join-with "," argsJS+) ")"))))
+
+(def: (input-declaration register)
+  (format "var " (referenceT.variable (n/inc register)) " = arguments[" (|> register nat-to-int %i) "];"))
+
+(def: (with-closure inits function)
+  (-> (List //.Expression) //.Expression //.Expression)
+  (let [closure (case inits
+                  #.Nil
+                  (list)
+
+                  _
+                  (|> (list.n/range +0 (n/dec (list.size inits)))
+                      (list/map referenceT.closure)))]
+    (format "(function(" (text.join-with "," closure) ") {"
+            "return " function
+            ";})(" (text.join-with "," inits) ")")))
+
+(def: #export (translate-function translate env arity bodyS)
+  (-> (-> ls.Synthesis (Meta //.Expression))
+      (List Variable) ls.Arity ls.Synthesis
+      (Meta //.Expression))
+  (do macro.Monad<Meta>
+    [[function-name bodyJS] (hostL.with-sub-context
+                              (translate bodyS))
+     closureJS+ (monad.map @ translate env)
+     #let [args-initsJS+ (|> (list.n/range +0 (n/dec arity))
+                             (list/map input-declaration)
+                             (text.join-with ""))
+           selfJS (format "var " (referenceT.variable +0) " = " function-name ";")
+           loop-startJs (format "var " loopT.loop-name " = " function-name ";")
+           arityJS (|> arity nat-to-int %i)]]
+    (wrap (<| (with-closure closureJS+)
+              (format "(function " function-name "() {"
+                      "\"use strict\";"
+                      "var num_args = arguments.length;"
+                      "if(num_args == " arity ") {"
+                      selfJS
+                      loop-startJs
+                      args-initsJS+
+                      (format "while(true) {"
+                              "return " bodyJS ";"
+                              "}")
+                      "}"
+                      "else if(num_args > " arityJS ") {"
+                      "return " function-name ".apply(null, [].slice.call(arguments,0," arityJS "))"
+                      ".apply(null, [].slice.call(arguments," arityJS "));"
+                      "}"
+                      ## Less than arity
+                      "else {"
+                      "var curried = [].slice.call(arguments);"
+                      "return function() { "
+                      "return " function-name ".apply(null, curried.concat([].slice.call(arguments)));"
+                      " };"
+                      "}"
+                      "})")))))
-- 
cgit v1.2.3