- WIP: - Initial PHP back-end implementation [missing procedures].

8 files changed, 79 insertions, 47 deletions

diff --git a/new-luxc/test/test/luxc/common.lux b/new-luxc/test/test/luxc/common.lux
index 7a6cabe73..633263243 100644
--- a/new-luxc/test/test/luxc/common.lux
+++ b/new-luxc/test/test/luxc/common.lux
@@ -44,11 +44,16 @@
                            ##         [".T_scheme" eval]
                            ##         [".T_scheme" runtime]
                            ##         [".T_scheme" statement])
-                           [common-lisp]
-                           (common-lisp [".T_common-lisp" expression]
-                                        [".T_common-lisp" eval]
-                                        [".T_common-lisp" runtime]
-                                        [".T_common-lisp" statement])
+                           ## [common-lisp]
+                           ## (common-lisp [".T_common-lisp" expression]
+                           ##              [".T_common-lisp" eval]
+                           ##              [".T_common-lisp" runtime]
+                           ##              [".T_common-lisp" statement])
+                           [php]
+                           (php [".T_php" expression]
+                                [".T_php" eval]
+                                [".T_php" runtime]
+                                [".T_php" statement])
                            ))))
 
 (type: #export Runner (-> Synthesis (e.Error Top)))
@@ -68,7 +73,8 @@
   ## [init-python python.init]
   ## [init-r r.init]
   ## [init-scheme scheme.init]
-  [init-common-lisp common-lisp.init]
+  ## [init-common-lisp common-lisp.init]
+  [init-php php.init]
   )
 
 (def: (runner translate-runtime translate-expression eval init)
@@ -118,5 +124,8 @@
 ## (def: #export run-scheme (runner runtimeT_scheme.translate expressionT_scheme.translate evalT_scheme.eval init-scheme))
 ## (def: #export def-scheme (definer runtimeT_scheme.translate expressionT_scheme.translate evalT_scheme.eval init-scheme statementT_scheme.translate-def))
 
-(def: #export run-common-lisp (runner runtimeT_common-lisp.translate expressionT_common-lisp.translate evalT_common-lisp.eval init-common-lisp))
-(def: #export def-common-lisp (definer runtimeT_common-lisp.translate expressionT_common-lisp.translate evalT_common-lisp.eval init-common-lisp statementT_common-lisp.translate-def))
+## (def: #export run-common-lisp (runner runtimeT_common-lisp.translate expressionT_common-lisp.translate evalT_common-lisp.eval init-common-lisp))
+## (def: #export def-common-lisp (definer runtimeT_common-lisp.translate expressionT_common-lisp.translate evalT_common-lisp.eval init-common-lisp statementT_common-lisp.translate-def))
+
+(def: #export run-php (runner runtimeT_php.translate expressionT_php.translate evalT_php.eval init-php))
+(def: #export def-php (definer runtimeT_php.translate expressionT_php.translate evalT_php.eval init-php statementT_php.translate-def))
diff --git a/new-luxc/test/test/luxc/lang/translation/case.lux b/new-luxc/test/test/luxc/lang/translation/case.lux
index bca451332..2964edbe4 100644
--- a/new-luxc/test/test/luxc/lang/translation/case.lux
+++ b/new-luxc/test/test/luxc/lang/translation/case.lux
@@ -67,7 +67,7 @@
               ))))
 
 (def: (pattern-matching-spec run)
-  (-> (-> ls.Synthesis (e.Error Top)) Test)
+  (-> Runner Test)
   (do r.Monad<Random>
     [[valueS pathS] gen-case
      to-bind r.nat]
@@ -94,7 +94,8 @@
 
                          (#e.Error error)
                          (exec (log! error)
-                           false)))))))
+                           false))))
+        )))
 
 ## (context: "[JVM] Pattern-matching."
 ##   (<| (times +100)
@@ -124,6 +125,10 @@
 ##   (<| (times +100)
 ##       (pattern-matching-spec run-scheme)))
 
-(context: "[Common Lisp] Pattern-matching."
+## (context: "[Common Lisp] Pattern-matching."
+##   (<| (times +100)
+##       (pattern-matching-spec run-common-lisp)))
+
+(context: "[PHP] Pattern-matching."
   (<| (times +100)
-      (pattern-matching-spec run-common-lisp)))
+      (pattern-matching-spec run-php)))
diff --git a/new-luxc/test/test/luxc/lang/translation/common.lux b/new-luxc/test/test/luxc/lang/translation/common.lux
index ad10fb8bd..dbd7b6d50 100644
--- a/new-luxc/test/test/luxc/lang/translation/common.lux
+++ b/new-luxc/test/test/luxc/lang/translation/common.lux
@@ -608,6 +608,10 @@
 ##   (<| (times +100)
 ##       (all-specs run-scheme)))
 
-(context: "[Common Lisp] Common procedures."
+## (context: "[Common Lisp] Common procedures."
+##   (<| (times +100)
+##       (all-specs run-common-lisp)))
+
+(context: "[PHP] Common procedures."
   (<| (times +100)
-      (all-specs run-common-lisp)))
+      (all-specs run-php)))
diff --git a/new-luxc/test/test/luxc/lang/translation/function.lux b/new-luxc/test/test/luxc/lang/translation/function.lux
index d3a32534b..f671f2503 100644
--- a/new-luxc/test/test/luxc/lang/translation/function.lux
+++ b/new-luxc/test/test/luxc/lang/translation/function.lux
@@ -33,8 +33,12 @@
                          ((~ (code.int (nat-to-int (n/inc arg)))))))]]
     (wrap [arity arg functionS])))
 
+(def: upper-alpha-ascii
+  (r.Random Nat)
+  (|> r.nat (:: r.Functor<Random> map (|>> (n/% +26) (n/+ +65)))))
+
 (def: (function-spec run)
-  (-> (-> ls.Synthesis (e.Error Top)) Test)
+  (-> Runner Test)
   (do r.Monad<Random>
     [[arity arg functionS] gen-function
      cut-off (|> r.nat (:: @ map (n/% arity)))
@@ -120,5 +124,5 @@
 ##       (function-spec run-common-lisp)))
 
 (context: "[PHP] Function."
-  (<| (times +1)
+  (<| (times +100)
       (function-spec run-php)))
diff --git a/new-luxc/test/test/luxc/lang/translation/primitive.lux b/new-luxc/test/test/luxc/lang/translation/primitive.lux
index a430c3866..b9454ce24 100644
--- a/new-luxc/test/test/luxc/lang/translation/primitive.lux
+++ b/new-luxc/test/test/luxc/lang/translation/primitive.lux
@@ -21,7 +21,7 @@
   (|> r.nat (:: r.Functor<Random> map (|>> (n/% +91) (n/max +65)))))
 
 (def: (spec run)
-  (-> (-> Synthesis (e.Error Top)) Test)
+  (-> Runner Test)
   (do r.Monad<Random>
     [%bool% r.bool
      %nat% r.nat
diff --git a/new-luxc/test/test/luxc/lang/translation/reference.lux b/new-luxc/test/test/luxc/lang/translation/reference.lux
index 8579663b4..7364e33eb 100644
--- a/new-luxc/test/test/luxc/lang/translation/reference.lux
+++ b/new-luxc/test/test/luxc/lang/translation/reference.lux
@@ -19,12 +19,14 @@
                            ## (python [".T_python" statement])
                            ## (r [".T_r" statement])
                            ## (scheme [".T_scheme" statement])
-                           (common-lisp [".T_common-lisp" statement]))))
+                           ## (common-lisp [".T_common-lisp" statement])
+                           (php [".T_php" statement])
+                           )))
   (test/luxc common))
 
 (def: upper-alpha-ascii
   (r.Random Nat)
-  (|> r.nat (:: r.Functor<Random> map (|>> (n/% +91) (n/max +65)))))
+  (|> r.nat (:: r.Functor<Random> map (|>> (n/% +26) (n/+ +65)))))
 
 (def: ident-part
   (r.Random Text)
@@ -51,8 +53,7 @@
 (def: (variables-spec run)
   (-> Runner Test)
   (do r.Monad<Random>
-    [module-name (|> (r.text +5) (r.filter (|>> (text.contains? "/") not)))
-     register (|> r.nat (:: @ map (n/% +100)))
+    [register (|> r.nat (:: @ map (n/% +100)))
      value r.int]
     (test "Can refer to local variables/registers."
           (|> (run (` ("lux let" (~ (code.nat register)) (~ (code.int value))
@@ -97,6 +98,10 @@
 ##   (<| (times +100)
 ##       (references-spec run-scheme def-scheme)))
 
-(context: "[Common Lisp] References."
+## (context: "[Common Lisp] References."
+##   (<| (times +100)
+##       (references-spec run-common-lisp def-common-lisp)))
+
+(context: "[PHP] References."
   (<| (times +100)
-      (references-spec run-common-lisp def-common-lisp)))
+      (references-spec run-php def-php)))
diff --git a/new-luxc/test/test/luxc/lang/translation/structure.lux b/new-luxc/test/test/luxc/lang/translation/structure.lux
index 033553f3d..0619d6894 100644
--- a/new-luxc/test/test/luxc/lang/translation/structure.lux
+++ b/new-luxc/test/test/luxc/lang/translation/structure.lux
@@ -23,7 +23,7 @@
 (host.import java/lang/Integer)
 
 (def: (tuples-spec run)
-  (-> (-> Synthesis (e.Error Top)) Test)
+  (-> Runner Test)
   (do r.Monad<Random>
     [size (|> r.nat (:: @ map (|>> (n/% +10) (n/max +2))))
      tuple-in (r.list size r.int)]
@@ -41,7 +41,7 @@
                        false))))))
 
 (def: (variants-spec run)
-  (-> (-> Synthesis (e.Error Top)) Test)
+  (-> Runner Test)
   (do r.Monad<Random>
     [num-tags (|> r.nat (:: @ map (|>> (n/% +10) (n/max +2))))
      tag-in (|> r.nat (:: @ map (n/% num-tags)))
@@ -72,7 +72,7 @@
                        false))))))
 
 (def: (structure-spec run)
-  (-> (-> Synthesis (e.Error Top)) Test)
+  (-> Runner Test)
   ($_ seq
       (tuples-spec run)
       (variants-spec run)))
diff --git a/new-luxc/test/tests.lux b/new-luxc/test/tests.lux
index 886d3d05d..586869c45 100644
--- a/new-luxc/test/tests.lux
+++ b/new-luxc/test/tests.lux
@@ -5,30 +5,35 @@
        (concurrency [promise])
        [cli #+ program:]
        [test])
-  (test (luxc (lang (analysis ["_.A" primitive]
-                              ["_.A" structure]
-                              ["_.A" reference]
-                              ["_.A" case]
-                              ["_.A" function]
-                              ["_.A" type]
-                              (procedure ["_.A" common]
-                                         ["_.A" host]))
-                    (synthesis ["_.S" primitive]
-                               ["_.S" structure]
-                               (case ["_.S" special])
-                               ["_.S" function]
-                               ["_.S" procedure]
-                               ["_.S" loop])
-                    (translation ["_.T" primitive]
-                                 ["_.T" structure]
-                                 ["_.T" function]
-                                 ["_.T" case]
-                                 ["_.T" reference]
+  (test (luxc (lang ## (analysis ["_.A" primitive]
+                    ##           ["_.A" structure]
+                    ##           ["_.A" reference]
+                    ##           ["_.A" case]
+                    ##           ["_.A" function]
+                    ##           ["_.A" type]
+                    ##           (procedure ["_.A" common]
+                    ##                      ["_.A" host]))
+                    ## (synthesis ["_.S" primitive]
+                    ##            ["_.S" structure]
+                    ##            (case ["_.S" special])
+                    ##            ["_.S" function]
+                    ##            ["_.S" procedure]
+                    ##            ["_.S" loop])
+                    (translation ## ["_.T" primitive]
+                                 ## ["_.T" structure]
+                                 ## ["_.T" function]
+                                 ## ["_.T" reference]
+                                 ## ["_.T" case]
                                  ["_.T" common]
-                                 ["_.T" jvm]
-                                 ["_.T" js]
+                                 ## ["_.T" jvm]
+                                 ## ["_.T" js]
                                  ## ["_.T" lua]
                                  ## ["_.T" ruby]
+                                 ## ["_.T" python]
+                                 ## ["_.T" r]
+                                 ## ["_.T" scheme]
+                                 ## ["_.T" common-lisp]
+                                 ## ["_.T" php]
                                  ))
               )))