From f8d6348b3fec0c55768ebcd8dba446949b8a4ef7 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Fri, 27 Apr 2018 19:46:44 -0400
Subject: - WIP: - Initial PHP back-end implementation.

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

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

diff --git a/new-luxc/source/luxc/lang/translation/php/function.jvm.lux b/new-luxc/source/luxc/lang/translation/php/function.jvm.lux
new file mode 100644
index 000000000..7d0baa4d5
--- /dev/null
+++ b/new-luxc/source/luxc/lang/translation/php/function.jvm.lux
@@ -0,0 +1,81 @@
+(.module:
+  lux
+  (lux (control [monad #+ do]
+                pipe)
+       (data [product]
+             [text]
+             text/format
+             (coll [list "list/" Functor<List> Fold<List>]))
+       [macro])
+  (luxc ["&" lang]
+        (lang ["ls" synthesis #+ Synthesis Arity]
+              [".L" variable #+ Register Variable]
+              (host ["_" php #+ Expression GExpression CExpression Statement])))
+  [//]
+  (// [".T" reference]))
+
+(def: #export (translate-apply translate functionS argsS+)
+  (-> //.Translator Synthesis (List Synthesis) (Meta CExpression))
+  (do macro.Monad<Meta>
+    [functionO (translate functionS)
+     argsO+ (monad.map @ translate argsS+)]
+    (wrap (_.apply argsO+ functionO))))
+
+(def: @curried (_.var "curried"))
+
+(def: (input-declaration! register)
+  (-> Register Statement)
+  (_.set! (referenceT.variable (n/inc register))
+          (_.nth (|> register nat-to-int _.int)
+                 @curried)))
+
+(def: (with-closure @function inits function-definition!)
+  (-> GExpression (List Expression) Statement (Meta Expression))
+  (case inits
+    #.Nil
+    (do macro.Monad<Meta>
+      [_ (//.save function-definition!)]
+      (wrap @function))
+
+    _
+    (do macro.Monad<Meta>
+      []
+      (wrap (_.apply inits
+                     (_.function (|> (list.enumerate inits)
+                                     (list/map (|>> product.left referenceT.closure)))
+                       (|> function-definition!
+                           (_.then! (_.return! @function)))))))))
+
+(def: #export (translate-function translate env arity bodyS)
+  (-> //.Translator (List Variable) Arity Synthesis (Meta Expression))
+  (do macro.Monad<Meta>
+    [[function-name bodyO] (//.with-sub-context
+                             (do @
+                               [function-name //.context]
+                               (//.with-anchor [function-name +1]
+                                 (translate bodyS))))
+     closureO+ (monad.map @ referenceT.translate-variable env)
+     #let [@function (_.global function-name)
+           self-init! (_.set! (referenceT.variable +0) @function)
+           args-inits! (|> (list.n/range +0 (n/dec arity))
+                           (list/map input-declaration!)
+                           (list/fold _.then! self-init!))
+           arityO (|> arity nat-to-int _.int)
+           @num_args (_.var "num_args")]]
+    (with-closure @function closureO+
+      (_.function! @function (list)
+                   (|> (_.set! @num_args _.func-num-args/0)
+                       (_.then! (_.set! @curried _.func-get-args/0))
+                       (_.then! (_.if! (|> @num_args (_.= arityO))
+                                       (|> args-inits!
+                                           (_.then! (_.return! bodyO)))
+                                       (_.if! (|> @num_args (_.> arityO))
+                                              (let [arity-args (_.array-slice/3 @curried (_.int 0) arityO)
+                                                    output-func-args (_.array-slice/2 @curried arityO)]
+                                                (_.return! (_.call-user-func-array/2 (_.call-user-func-array/2 @function arity-args)
+                                                                                     output-func-args)))
+                                              (let [@missing (_.var "missing")]
+                                                (_.return! (_.function (list)
+                                                             (|> (_.set! @missing _.func-get-args/0)
+                                                                 (_.then! (_.return! (_.call-user-func-array/2 @function
+                                                                                                               (_.array-merge/+ @curried (list @missing)))))))))))))))))
-- 
cgit v1.2.3