aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source
diff options
context:
space:
mode:
authorEduardo Julian2021-02-22 01:46:40 -0400
committerEduardo Julian2021-02-22 01:46:40 -0400
commit565e7fae85379e4d2e4daacc51eb1f8796c738c1 (patch)
treea306f40f45be76359481a30cc7dc83f405c12716 /stdlib/source
parentcfa75870e67e7759bba47f25b3fd7dd252f9341e (diff)
Updates for PHP compiler.
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux/target/lua.lux11
-rw-r--r--stdlib/source/lux/target/php.lux246
-rw-r--r--stdlib/source/lux/target/python.lux15
-rw-r--r--stdlib/source/lux/test.lux4
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/php.lux34
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/lua/common.lux2
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/php.lux17
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/php/common.lux185
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/php/host.lux199
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/runtime.lux9
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/php.lux94
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/case.lux313
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/function.lux169
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/loop.lux55
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/primitive.lux2
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/reference.lux13
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/runtime.lux334
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/structure.lux38
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux6
-rw-r--r--stdlib/source/lux/tool/compiler/reference.lux4
-rw-r--r--stdlib/source/test/lux.lux6
-rw-r--r--stdlib/source/test/lux/macro/template.lux8
22 files changed, 1151 insertions, 613 deletions
diff --git a/stdlib/source/lux/target/lua.lux b/stdlib/source/lux/target/lua.lux
index 29d4b82b3..4213cd339 100644
--- a/stdlib/source/lux/target/lua.lux
+++ b/stdlib/source/lux/target/lua.lux
@@ -232,9 +232,14 @@
[">>" bit_shr]
)
- (def: #export (not subject)
- (-> Expression Expression)
- (:abstraction (format "(not " (:representation subject) ")")))
+ (template [<name> <unary>]
+ [(def: #export (<name> subject)
+ (-> Expression Expression)
+ (:abstraction (format "(" <unary> " " (:representation subject) ")")))]
+
+ [not "not"]
+ [negate "-"]
+ )
(template [<name> <type>]
[(def: #export <name>
diff --git a/stdlib/source/lux/target/php.lux b/stdlib/source/lux/target/php.lux
index d0622f6c8..4cb2f0602 100644
--- a/stdlib/source/lux/target/php.lux
+++ b/stdlib/source/lux/target/php.lux
@@ -1,30 +1,44 @@
(.module:
- [lux (#- Code Global static int if cond or and not comment for)
+ [lux (#- Location Code Global static int if cond or and not comment for)
+ ["@" target]
+ ["." host]
[control
[pipe (#+ case> cond> new>)]]
[data
- [number
- ["f" frac]]
["." text
["%" format (#+ format)]]
[collection
["." list ("#\." functor fold)]]]
[macro
["." template]]
+ [math
+ [number
+ ["f" frac]]]
[type
abstract]])
-(def: input-separator ", ")
-(def: statement-suffix ";")
+(def: input_separator ", ")
+(def: statement_suffix ";")
+
+(.for {@.old (as_is (host.import: java/lang/CharSequence)
+ (host.import: java/lang/String
+ ["#::."
+ (replace [java/lang/CharSequence java/lang/CharSequence] java/lang/String)]))}
+ (as_is))
(def: nest
(-> Text Text)
- (|>> (format text.new-line)
- (text.replace-all text.new-line (format text.new-line text.tab))))
+ (.let [nested_new_line (format text.new_line text.tab)]
+ (.for {@.old (|>> (format text.new_line)
+ (:coerce java/lang/String)
+ (java/lang/String::replace (:coerce java/lang/CharSequence text.new_line)
+ (:coerce java/lang/CharSequence nested_new_line)))}
+ (|>> (format text.new_line)
+ (text.replace_all text.new_line nested_new_line)))))
(def: block
(-> Text Text)
- (|>> ..nest (text.enclose ["{" (format text.new-line "}")])))
+ (|>> ..nest (text.enclose ["{" (format text.new_line "}")])))
(def: group
(-> Text Text)
@@ -41,28 +55,27 @@
(-> (Code Any) Text)
(|>> :representation))
- (template [<type> <super>]
- [(with-expansions [<brand> (template.identifier [<type> "'"])]
- (`` (abstract: #export (<brand> brand) Any))
- (`` (type: #export (<type> brand)
- (<super> (<brand> brand)))))]
+ (template [<type> <super>+]
+ [(with_expansions [<brand> (template.identifier [<type> "'"])]
+ (abstract: (<brand> brand) Any)
+ (`` (type: #export <type> (|> Any <brand> (~~ (template.splice <super>+))))))]
- [Expression Code]
- [Computation Expression]
- [Location Computation]
+ [Expression [Code]]
+ [Computation [Expression' Code]]
+ [Location [Computation' Expression' Code]]
+ [Statement [Code]]
)
- (template [<type> <super>]
- [(with-expansions [<brand> (template.identifier [<type> "'"])]
- (`` (abstract: #export <brand> Any))
- (`` (type: #export <type> (<super> <brand>))))]
-
- [Literal Computation]
- [Var Location]
- [Constant Location]
- [Global Location]
- [Access Location]
- [Statement Code]
+ (template [<type> <super>+]
+ [(with_expansions [<brand> (template.identifier [<type> "'"])]
+ (abstract: #export <brand> Any)
+ (`` (type: #export <type> (|> <brand> (~~ (template.splice <super>+))))))]
+
+ [Literal [Computation' Expression' Code]]
+ [Var [Location' Computation' Expression' Code]]
+ [Access [Location' Computation' Expression' Code]]
+ [Constant [Location' Computation' Expression' Code]]
+ [Global [Location' Computation' Expression' Code]]
)
(type: #export Argument
@@ -70,9 +83,9 @@
#var Var})
(def: #export ;
- (-> (Expression Any) Statement)
+ (-> Expression Statement)
(|>> :representation
- (text.suffix ..statement-suffix)
+ (text.suffix ..statement_suffix)
:abstraction))
(def: #export var
@@ -99,13 +112,13 @@
(def: #export float
(-> Frac Literal)
- (|>> (cond> [(f.= f.positive-infinity)]
+ (|>> (cond> [(f.= f.positive_infinity)]
[(new> "+INF" [])]
- [(f.= f.negative-infinity)]
+ [(f.= f.negative_infinity)]
[(new> "-INF" [])]
- [(f.= f.not-a-number)]
+ [(f.= f.not_a_number)]
[(new> "NAN" [])]
## else
@@ -115,32 +128,32 @@
(def: sanitize
(-> Text Text)
(`` (|>> (~~ (template [<find> <replace>]
- [(text.replace-all <find> <replace>)]
+ [(text.replace_all <find> <replace>)]
["\" "\\"]
[text.tab "\t"]
- [text.vertical-tab "\v"]
+ [text.vertical_tab "\v"]
[text.null "\0"]
- [text.back-space "\b"]
- [text.form-feed "\f"]
- [text.new-line "\n"]
- [text.carriage-return "\r"]
- [text.double-quote (format "\" text.double-quote)]
+ [text.back_space "\b"]
+ [text.form_feed "\f"]
+ [text.new_line "\n"]
+ [text.carriage_return "\r"]
+ [text.double_quote (format "\" text.double_quote)]
))
)))
(def: #export string
(-> Text Literal)
(|>> ..sanitize
- (text.enclose [text.double-quote text.double-quote])
+ (text.enclose [text.double_quote text.double_quote])
:abstraction))
(def: arguments
- (-> (List (Expression Any)) Text)
- (|>> (list\map ..code) (text.join-with ..input-separator) ..group))
+ (-> (List Expression) Text)
+ (|>> (list\map ..code) (text.join_with ..input_separator) ..group))
(def: #export (apply/* args func)
- (-> (List (Expression Any)) (Expression Any) (Computation Any))
+ (-> (List Expression) Expression Computation)
(:abstraction
(format (:representation func) (..arguments args))))
@@ -150,7 +163,7 @@
(.if reference?
(format "&" (:representation var))
(:representation var))))
- (text.join-with ..input-separator)
+ (text.join_with ..input_separator)
..group))
(template [<name> <reference?>]
@@ -176,29 +189,29 @@
..group
:abstraction)))
- (template [<apply> <input-var>+ <input-type>+ <function>+]
- [(`` (def: #export (<apply> [(~~ (template.splice <input-var>+))] function)
- (-> [(~~ (template.splice <input-type>+))] (Expression Any) (Computation Any))
- (..apply/* (list (~~ (template.splice <input-var>+))) function)))
+ (template [<apply> <input_var>+ <input_type>+ <function>+]
+ [(`` (def: #export (<apply> [(~~ (template.splice <input_var>+))] function)
+ (-> [(~~ (template.splice <input_type>+))] Expression Computation)
+ (..apply/* (list (~~ (template.splice <input_var>+))) function)))
- (`` (template [<lux-name> <php-name>]
- [(def: #export (<lux-name> args)
- (-> [(~~ (template.splice <input-type>+))] (Computation Any))
- (<apply> args (..constant <php-name>)))]
+ (`` (template [<lux_name> <php_name>]
+ [(def: #export (<lux_name> args)
+ (-> [(~~ (template.splice <input_type>+))] Computation)
+ (<apply> args (..constant <php_name>)))]
(~~ (template.splice <function>+))))]
[apply/0 [] []
- [[func-num-args/0 "func_num_args"]
- [func-get-args/0 "func_get_args"]
+ [[func_num_args/0 "func_num_args"]
+ [func_get_args/0 "func_get_args"]
[time/0 "time"]]]
- [apply/1 [in0] [(Expression Any)]
- [[is-null/1 "is_null"]
+ [apply/1 [in0] [Expression]
+ [[is_null/1 "is_null"]
[empty/1 "empty"]
[count/1 "count"]
[strlen/1 "strlen"]
- [array-pop/1 "array_pop"]
- [array-reverse/1 "array_reverse"]
+ [array_pop/1 "array_pop"]
+ [array_reverse/1 "array_reverse"]
[intval/1 "intval"]
[floatval/1 "floatval"]
[strval/1 "strval"]
@@ -206,52 +219,52 @@
[chr/1 "chr"]
[print/1 "print"]
[exit/1 "exit"]]]
- [apply/2 [in0 in1] [(Expression Any) (Expression Any)]
- [[call-user-func-array/2 "call_user_func_array"]
- [array-slice/2 "array_slice"]
- [array-push/2 "array_push"]]]
- [apply/3 [in0 in1 in2] [(Expression Any) (Expression Any) (Expression Any)]
- [[array-slice/3 "array_slice"]
- [array-splice/3 "array_splice"]
+ [apply/2 [in0 in1] [Expression Expression]
+ [[call_user_func_array/2 "call_user_func_array"]
+ [array_slice/2 "array_slice"]
+ [array_push/2 "array_push"]]]
+ [apply/3 [in0 in1 in2] [Expression Expression Expression]
+ [[array_slice/3 "array_slice"]
+ [array_splice/3 "array_splice"]
[strpos/3 "strpos"]
[substr/3 "substr"]]]
)
(def: #export (array/* values)
- (-> (List (Expression Any)) Literal)
+ (-> (List Expression) Literal)
(|> values
(list\map ..code)
- (text.join-with ..input-separator)
+ (text.join_with ..input_separator)
..group
(format "array")
:abstraction))
- (def: #export (array-merge/+ required optionals)
- (-> (Expression Any) (List (Expression Any)) (Computation Any))
+ (def: #export (array_merge/+ required optionals)
+ (-> Expression (List Expression) Computation)
(..apply/* (list& required optionals) (..constant "array_merge")))
(def: #export (array/** kvs)
- (-> (List [(Expression Any) (Expression Any)]) Literal)
+ (-> (List [Expression Expression]) Literal)
(|> kvs
(list\map (function (_ [key value])
(format (:representation key) " => " (:representation value))))
- (text.join-with ..input-separator)
+ (text.join_with ..input_separator)
..group
(format "array")
:abstraction))
(def: #export (new constructor inputs)
- (-> Constant (List (Expression Any)) (Computation Any))
+ (-> Constant (List Expression) Computation)
(|> (format "new " (:representation constructor) (arguments inputs))
:abstraction))
(def: #export (do method inputs object)
- (-> Text (List (Expression Any)) (Expression Any) (Computation Any))
+ (-> Text (List Expression) Expression Computation)
(|> (format (:representation object) "->" method (arguments inputs))
:abstraction))
(def: #export (nth idx array)
- (-> (Expression Any) (Expression Any) Access)
+ (-> Expression Expression Access)
(|> (format (:representation array) "[" (:representation idx) "]")
:abstraction))
@@ -260,7 +273,7 @@
(|> (..var "GLOBALS") (..nth (..string name)) :transmutation))
(def: #export (? test then else)
- (-> (Expression Any) (Expression Any) (Expression Any) (Computation Any))
+ (-> Expression Expression Expression Computation)
(|> (format (:representation test) " ? "
(:representation then) " : "
(:representation else))
@@ -269,7 +282,7 @@
(template [<name> <op>]
[(def: #export (<name> parameter subject)
- (-> (Expression Any) (Expression Any) (Computation Any))
+ (-> Expression Expression Computation)
(|> (format (:representation subject) " " <op> " " (:representation parameter))
..group
:abstraction))]
@@ -286,49 +299,49 @@
[* "*"]
[/ "/"]
[% "%"]
- [bit-or "|"]
- [bit-and "&"]
- [bit-xor "^"]
- [bit-shl "<<"]
- [bit-shr ">>"]
+ [bit_or "|"]
+ [bit_and "&"]
+ [bit_xor "^"]
+ [bit_shl "<<"]
+ [bit_shr ">>"]
[concat "."]
)
(def: #export not
- (-> (Computation Any) (Computation Any))
+ (-> Computation Computation)
(|>> :representation (format "!") :abstraction))
(def: #export (set var value)
- (-> (Location Any) (Expression Any) (Computation Any))
+ (-> Location Expression Computation)
(|> (format (:representation var) " = " (:representation value))
..group
:abstraction))
(def: #export (set? var)
- (-> Var (Computation Any))
+ (-> Var Computation)
(..apply/1 [var] (..constant "isset")))
(template [<name> <modifier>]
[(def: #export <name>
(-> Var Statement)
- (|>> :representation (format <modifier> " ") (text.suffix ..statement-suffix) :abstraction))]
+ (|>> :representation (format <modifier> " ") (text.suffix ..statement_suffix) :abstraction))]
- [define-global "global"]
+ [define_global "global"]
)
(template [<name> <modifier> <location>]
[(def: #export (<name> location value)
- (-> <location> (Expression Any) Statement)
+ (-> <location> Expression Statement)
(:abstraction (format <modifier> " " (:representation location)
" = " (:representation value)
- ..statement-suffix)))]
+ ..statement_suffix)))]
- [define-static "static" Var]
- [define-constant "const" Constant]
+ [define_static "static" Var]
+ [define_constant "const" Constant]
)
(def: #export (if test then! else!)
- (-> (Expression Any) Statement Statement Statement)
+ (-> Expression Statement Statement Statement)
(:abstraction
(format "if " (..group (:representation test)) " "
(..block (:representation then!))
@@ -336,7 +349,7 @@
(..block (:representation else!)))))
(def: #export (when test then!)
- (-> (Expression Any) Statement Statement)
+ (-> Expression Statement Statement)
(:abstraction
(format "if " (..group (:representation test)) " "
(..block (:representation then!)))))
@@ -345,24 +358,24 @@
(-> Statement Statement Statement)
(:abstraction
(format (:representation pre!)
- text.new-line
+ text.new_line
(:representation post!))))
(def: #export (while test body!)
- (-> (Expression Any) Statement Statement)
+ (-> Expression Statement Statement)
(:abstraction
(format "while " (..group (:representation test)) " "
(..block (:representation body!)))))
- (def: #export (do-while test body!)
- (-> (Expression Any) Statement Statement)
+ (def: #export (do_while test body!)
+ (-> Expression Statement Statement)
(:abstraction
(format "do " (..block (:representation body!))
" while " (..group (:representation test))
- ..statement-suffix)))
+ ..statement_suffix)))
- (def: #export (for-each array value body!)
- (-> (Expression Any) Var Statement Statement)
+ (def: #export (for_each array value body!)
+ (-> Expression Var Statement Statement)
(:abstraction
(format "foreach(" (:representation array)
" as " (:representation value)
@@ -384,15 +397,15 @@
(-> Statement (List Except) Statement)
(:abstraction
(format "try " (..block (:representation body!))
- text.new-line
+ text.new_line
(|> excepts
(list\map catch)
- (text.join-with text.new-line)))))
+ (text.join_with text.new_line)))))
(template [<name> <keyword>]
[(def: #export <name>
- (-> (Expression Any) Statement)
- (|>> :representation (format <keyword> " ") (text.suffix ..statement-suffix) :abstraction))]
+ (-> Expression Statement)
+ (|>> :representation (format <keyword> " ") (text.suffix ..statement_suffix) :abstraction))]
[throw "throw"]
[return "return"]
@@ -400,29 +413,24 @@
)
(def: #export (define name value)
- (-> Constant (Expression Any) (Expression Any))
+ (-> Constant Expression Expression)
(..apply/2 [(|> name :representation ..string)
value]
(..constant "define")))
- (def: #export (define-function name uses arguments body!)
- (-> Constant (List Argument) (List Argument) Statement Statement)
- (let [uses (case uses
- #.Nil
- ""
-
- _
- (format " use " (..parameters uses)))]
- (:abstraction
- (format "function " (:representation name) " " (..parameters arguments)
- uses " "
- (..block (:representation body!))))))
+ (def: #export (define_function name arguments body!)
+ (-> Constant (List Argument) Statement Statement)
+ (:abstraction
+ (format "function " (:representation name)
+ " " (..parameters arguments)
+ " "
+ (..block (:representation body!)))))
(template [<name> <keyword>]
[(def: #export <name>
Statement
(|> <keyword>
- (text.suffix ..statement-suffix)
+ (text.suffix ..statement_suffix)
:abstraction))]
[break "break"]
@@ -431,12 +439,12 @@
)
(def: #export (cond clauses else!)
- (-> (List [(Expression Any) Statement]) Statement Statement)
+ (-> (List [Expression Statement]) Statement Statement)
(list\fold (function (_ [test then!] next!)
(..if test then! next!))
else!
(list.reverse clauses)))
-(def: #export command-line-arguments
+(def: #export command_line_arguments
Var
(..var "argv"))
diff --git a/stdlib/source/lux/target/python.lux b/stdlib/source/lux/target/python.lux
index f8c7157a3..e27ae9b83 100644
--- a/stdlib/source/lux/target/python.lux
+++ b/stdlib/source/lux/target/python.lux
@@ -292,11 +292,16 @@
[and "and"]
)
- (def: #export (not subject)
- (-> (Expression Any) (Computation Any))
- (<| :abstraction
- ## ..expression
- (format "not " (:representation subject))))
+ (template [<name> <unary>]
+ [(def: #export (<name> subject)
+ (-> (Expression Any) (Computation Any))
+ (<| :abstraction
+ ## ..expression
+ (format <unary> " " (:representation subject))))]
+
+ [not "not"]
+ [negate "-"]
+ )
(def: #export (lambda arguments body)
(-> (List (Var Any)) (Expression Any) (Computation Any))
diff --git a/stdlib/source/lux/test.lux b/stdlib/source/lux/test.lux
index 6b0e59d0e..647ae8895 100644
--- a/stdlib/source/lux/test.lux
+++ b/stdlib/source/lux/test.lux
@@ -285,7 +285,7 @@
(list\fold (function (_ short aggregate)
(case aggregate
"" short
- _ (format short ..coverage_separator aggregate)))
+ _ (format aggregate ..coverage_separator short)))
""))
(def: (decode_coverage module encoding)
@@ -297,7 +297,7 @@
(recur tail (set.add [module head] output))
#.None
- output)))
+ (set.add [module remaining] output))))
(template [<macro> <function>]
[(syntax: #export (<macro> {coverage (<c>.tuple (<>.many <c>.any))}
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/php.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/php.lux
new file mode 100644
index 000000000..466c8daea
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/php.lux
@@ -0,0 +1,34 @@
+(.module:
+ [lux #*
+ ["." host]
+ [abstract
+ ["." monad (#+ do)]]
+ [control
+ ["<>" parser
+ ["<c>" code (#+ Parser)]]]
+ [data
+ [collection
+ ["." array (#+ Array)]
+ ["." dictionary]
+ ["." list]]]
+ ["." type
+ ["." check]]
+ ["@" target
+ ["_" php]]]
+ [//
+ ["/" lux (#+ custom)]
+ [//
+ ["." bundle]
+ [//
+ ["." analysis #_
+ ["#/." type]]
+ [//
+ ["." analysis (#+ Analysis Operation Phase Handler Bundle)]
+ [///
+ ["." phase]]]]]])
+
+(def: #export bundle
+ Bundle
+ (<| (bundle.prefix "php")
+ (|> bundle.empty
+ )))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/lua/common.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/lua/common.lux
index 29d3704fe..33a952596 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/lua/common.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/lua/common.lux
@@ -122,7 +122,7 @@
(/.install "-" (binary (product.uncurry _.-)))
(/.install "*" (binary (product.uncurry _.*)))
(/.install "/" (binary (product.uncurry _./)))
- (/.install "%" (binary (product.uncurry _.%)))
+ (/.install "%" (binary (product.uncurry (function.flip (_.apply/2 (_.var "math.fmod"))))))
(/.install "=" (binary (product.uncurry _.=)))
(/.install "<" (binary (product.uncurry _.<)))
(/.install "i64" (unary (!unary "math.floor")))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/php.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/php.lux
new file mode 100644
index 000000000..2f2d75c31
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/php.lux
@@ -0,0 +1,17 @@
+(.module:
+ [lux #*
+ [data
+ [collection
+ ["." dictionary]]]]
+ ["." / #_
+ ["#." common]
+ ["#." host]
+ [////
+ [generation
+ [php
+ [runtime (#+ Bundle)]]]]])
+
+(def: #export bundle
+ Bundle
+ (dictionary.merge /common.bundle
+ /host.bundle))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/php/common.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/php/common.lux
new file mode 100644
index 000000000..ab2f480fe
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/php/common.lux
@@ -0,0 +1,185 @@
+(.module:
+ [lux #*
+ [abstract
+ ["." monad (#+ do)]]
+ [control
+ ["." function]
+ ["." try]
+ ["<>" parser
+ ["<s>" synthesis (#+ Parser)]]]
+ [data
+ ["." product]
+ ["." text
+ ["%" format (#+ format)]]
+ [collection
+ ["." dictionary]
+ ["." list ("#\." functor fold)]]]
+ [math
+ [number
+ ["f" frac]]]
+ ["@" target
+ ["_" php (#+ Expression)]]]
+ ["." //// #_
+ ["/" bundle]
+ ["/#" // #_
+ ["." extension]
+ [generation
+ [extension (#+ Nullary Unary Binary Trinary
+ nullary unary binary trinary)]
+ ["//" php #_
+ ["#." runtime (#+ Operation Phase Handler Bundle Generator)]]]
+ [//
+ [synthesis (#+ %synthesis)]
+ ["." generation]
+ [///
+ ["#" phase]]]]])
+
+(def: #export (custom [parser handler])
+ (All [s]
+ (-> [(Parser s)
+ (-> Text (Generator s))]
+ Handler))
+ (function (_ extension_name phase archive input)
+ (case (<s>.run parser input)
+ (#try.Success input')
+ (handler extension_name phase archive input')
+
+ (#try.Failure error)
+ (/////.throw extension.invalid_syntax [extension_name %synthesis input]))))
+
+## (template: (!unary function)
+## (|>> list _.apply/* (|> (_.var function))))
+
+## ## TODO: Get rid of this ASAP
+## (def: lux::syntax_char_case!
+## (..custom [($_ <>.and
+## <s>.any
+## <s>.any
+## (<>.some (<s>.tuple ($_ <>.and
+## (<s>.tuple (<>.many <s>.i64))
+## <s>.any))))
+## (function (_ extension_name phase archive [input else conditionals])
+## (do {! /////.monad}
+## [inputG (phase archive input)
+## elseG (phase archive else)
+## @input (\ ! map _.var (generation.gensym "input"))
+## conditionalsG (: (Operation (List [Expression Expression]))
+## (monad.map ! (function (_ [chars branch])
+## (do !
+## [branchG (phase archive branch)]
+## (wrap [(|> chars
+## (list\map (|>> .int _.int (_.= @input)))
+## (list\fold (function (_ clause total)
+## (if (is? _.nil total)
+## clause
+## (_.or clause total)))
+## _.nil))
+## branchG])))
+## conditionals))
+## #let [closure (_.closure (list @input)
+## (list\fold (function (_ [test then] else)
+## (_.if test (_.return then) else))
+## (_.return elseG)
+## conditionalsG))]]
+## (wrap (_.apply/1 closure inputG))))]))
+
+## (def: lux_procs
+## Bundle
+## (|> /.empty
+## (/.install "syntax char case!" lux::syntax_char_case!)
+## (/.install "is" (binary (product.uncurry _.=)))
+## (/.install "try" (unary //runtime.lux//try))))
+
+## (def: i64_procs
+## Bundle
+## (<| (/.prefix "i64")
+## (|> /.empty
+## (/.install "and" (binary (product.uncurry _.bit_and)))
+## (/.install "or" (binary (product.uncurry _.bit_or)))
+## (/.install "xor" (binary (product.uncurry _.bit_xor)))
+## (/.install "left-shift" (binary (product.uncurry //runtime.i64//left_shift)))
+## (/.install "right-shift" (binary (product.uncurry //runtime.i64//right_shift)))
+## (/.install "=" (binary (product.uncurry _.=)))
+## (/.install "+" (binary (product.uncurry _.+)))
+## (/.install "-" (binary (product.uncurry _.-)))
+## (/.install "<" (binary (product.uncurry _.<)))
+## (/.install "*" (binary (product.uncurry _.*)))
+## (/.install "/" (binary (product.uncurry //runtime.i64//division)))
+## (/.install "%" (binary (product.uncurry //runtime.i64//remainder)))
+## (/.install "f64" (unary (_./ (_.float +1.0))))
+## (/.install "char" (unary (_.apply/1 (_.var "utf8.char"))))
+## )))
+
+## (def: f64//decode
+## (Unary Expression)
+## (|>> list _.apply/* (|> (_.var "tonumber")) _.return (_.closure (list)) //runtime.lux//try))
+
+## (def: f64_procs
+## Bundle
+## (<| (/.prefix "f64")
+## (|> /.empty
+## (/.install "+" (binary (product.uncurry _.+)))
+## (/.install "-" (binary (product.uncurry _.-)))
+## (/.install "*" (binary (product.uncurry _.*)))
+## (/.install "/" (binary (product.uncurry _./)))
+## (/.install "%" (binary (product.uncurry (function.flip (_.apply/2 (_.var "math.fmod"))))))
+## (/.install "=" (binary (product.uncurry _.=)))
+## (/.install "<" (binary (product.uncurry _.<)))
+## (/.install "i64" (unary (!unary "math.floor")))
+## (/.install "encode" (unary (_.apply/2 (_.var "string.format") (_.string "%.17g"))))
+## (/.install "decode" (unary ..f64//decode)))))
+
+## (def: (text//char [paramO subjectO])
+## (Binary Expression)
+## (//runtime.text//char (_.+ (_.int +1) paramO) subjectO))
+
+## (def: (text//clip [paramO extraO subjectO])
+## (Trinary Expression)
+## (//runtime.text//clip subjectO paramO extraO))
+
+## (def: (text//index [startO partO textO])
+## (Trinary Expression)
+## (//runtime.text//index textO partO startO))
+
+## (def: text_procs
+## Bundle
+## (<| (/.prefix "text")
+## (|> /.empty
+## (/.install "=" (binary (product.uncurry _.=)))
+## (/.install "<" (binary (product.uncurry _.<)))
+## (/.install "concat" (binary (product.uncurry (function.flip _.concat))))
+## (/.install "index" (trinary ..text//index))
+## (/.install "size" (unary //runtime.text//size))
+## ## TODO: Use version below once the Lua compiler becomes self-hosted.
+## ## (/.install "size" (unary (for {@.lua (!unary "utf8.len")}
+## ## (!unary "string.len"))))
+## (/.install "char" (binary ..text//char))
+## (/.install "clip" (trinary ..text//clip))
+## )))
+
+## (def: (io//log! messageO)
+## (Unary Expression)
+## (|> (_.apply/* (list messageO) (_.var "print"))
+## (_.or //runtime.unit)))
+
+## (def: io_procs
+## Bundle
+## (<| (/.prefix "io")
+## (|> /.empty
+## (/.install "log" (unary ..io//log!))
+## (/.install "error" (unary (!unary "error")))
+## (/.install "current-time" (nullary (function.constant (|> (_.var "os.time")
+## (_.apply/* (list))
+## (_.* (_.int +1,000)))))))))
+
+(def: #export bundle
+ Bundle
+ (<| (/.prefix "lux")
+ /.empty
+ ## (|> lux_procs
+ ## (dictionary.merge i64_procs)
+ ## (dictionary.merge f64_procs)
+ ## (dictionary.merge text_procs)
+ ## (dictionary.merge io_procs)
+ ## )
+ ))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/php/host.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/php/host.lux
new file mode 100644
index 000000000..fef37539e
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/php/host.lux
@@ -0,0 +1,199 @@
+(.module:
+ [lux #*
+ [abstract
+ ["." monad (#+ do)]]
+ [control
+ ["." function]
+ ["<>" parser
+ ["<s>" synthesis (#+ Parser)]]]
+ [data
+ [collection
+ ["." dictionary]
+ ["." list]]
+ [text
+ ["%" format (#+ format)]]]
+ [target
+ ["_" php (#+ Var Expression)]]]
+ ["." // #_
+ ["#." common (#+ custom)]
+ ["//#" /// #_
+ ["/" bundle]
+ ["/#" // #_
+ ["." extension]
+ [generation
+ [extension (#+ Nullary Unary Binary Trinary
+ nullary unary binary trinary)]
+ ["." reference]
+ ["//" php #_
+ ["#." runtime (#+ Operation Phase Handler Bundle
+ with_vars)]]]
+ ["/#" // #_
+ ["." generation]
+ ["//#" /// #_
+ ["#." phase]]]]]])
+
+## (def: array::new
+## (Unary Expression)
+## (|>> ["n"] list _.table))
+
+## (def: array::length
+## (Unary Expression)
+## (_.the "n"))
+
+## (def: (array::read [indexG arrayG])
+## (Binary Expression)
+## (_.nth (_.+ (_.int +1) indexG) arrayG))
+
+## (def: (array::write [indexG valueG arrayG])
+## (Trinary Expression)
+## (//runtime.array//write indexG valueG arrayG))
+
+## (def: (array::delete [indexG arrayG])
+## (Binary Expression)
+## (//runtime.array//write indexG _.nil arrayG))
+
+## (def: array
+## Bundle
+## (<| (/.prefix "array")
+## (|> /.empty
+## (/.install "new" (unary array::new))
+## (/.install "length" (unary array::length))
+## (/.install "read" (binary array::read))
+## (/.install "write" (trinary array::write))
+## (/.install "delete" (binary array::delete))
+## )))
+
+## (def: object::get
+## Handler
+## (custom
+## [($_ <>.and <s>.text <s>.any)
+## (function (_ extension phase archive [fieldS objectS])
+## (do ////////phase.monad
+## [objectG (phase archive objectS)]
+## (wrap (_.the fieldS objectG))))]))
+
+## (def: object::do
+## Handler
+## (custom
+## [($_ <>.and <s>.text <s>.any (<>.some <s>.any))
+## (function (_ extension phase archive [methodS objectS inputsS])
+## (do {! ////////phase.monad}
+## [objectG (phase archive objectS)
+## inputsG (monad.map ! (phase archive) inputsS)]
+## (wrap (_.do methodS inputsG objectG))))]))
+
+## (template [<!> <?> <unit>]
+## [(def: <!> (Nullary Expression) (function.constant <unit>))
+## (def: <?> (Unary Expression) (_.= <unit>))]
+
+## [object::nil object::nil? _.nil]
+## )
+
+## (def: object
+## Bundle
+## (<| (/.prefix "object")
+## (|> /.empty
+## (/.install "get" object::get)
+## (/.install "do" object::do)
+## (/.install "nil" (nullary object::nil))
+## (/.install "nil?" (unary object::nil?))
+## )))
+
+## (def: $input
+## (_.var "input"))
+
+## (def: utf8::encode
+## (custom
+## [<s>.any
+## (function (_ extension phase archive inputS)
+## (do {! ////////phase.monad}
+## [inputG (phase archive inputS)]
+## (wrap (_.apply/1 (<| (_.closure (list $input))
+## (_.return (|> (_.var "string.byte")
+## (_.apply/* (list $input (_.int +1) (_.length $input)))
+## (_.apply/1 (_.var "table.pack")))))
+## inputG))))]))
+
+## (def: utf8::decode
+## (custom
+## [<s>.any
+## (function (_ extension phase archive inputS)
+## (do {! ////////phase.monad}
+## [inputG (phase archive inputS)]
+## (wrap (|> inputG
+## (_.apply/1 (_.var "table.unpack"))
+## (_.apply/1 (_.var "string.char"))))))]))
+
+## (def: utf8
+## Bundle
+## (<| (/.prefix "utf8")
+## (|> /.empty
+## (/.install "encode" utf8::encode)
+## (/.install "decode" utf8::decode)
+## )))
+
+## (def: lua::constant
+## (custom
+## [<s>.text
+## (function (_ extension phase archive name)
+## (\ ////////phase.monad wrap (_.var name)))]))
+
+## (def: lua::apply
+## (custom
+## [($_ <>.and <s>.any (<>.some <s>.any))
+## (function (_ extension phase archive [abstractionS inputsS])
+## (do {! ////////phase.monad}
+## [abstractionG (phase archive abstractionS)
+## inputsG (monad.map ! (phase archive) inputsS)]
+## (wrap (_.apply/* inputsG abstractionG))))]))
+
+## (def: lua::power
+## (custom
+## [($_ <>.and <s>.any <s>.any)
+## (function (_ extension phase archive [powerS baseS])
+## (do {! ////////phase.monad}
+## [powerG (phase archive powerS)
+## baseG (phase archive baseS)]
+## (wrap (_.^ powerG baseG))))]))
+
+## (def: lua::import
+## (custom
+## [<s>.text
+## (function (_ extension phase archive module)
+## (\ ////////phase.monad wrap
+## (_.require/1 (_.string module))))]))
+
+## (def: lua::function
+## (custom
+## [($_ <>.and <s>.i64 <s>.any)
+## (function (_ extension phase archive [arity abstractionS])
+## (do {! ////////phase.monad}
+## [abstractionG (phase archive abstractionS)
+## #let [variable (: (-> Text (Operation Var))
+## (|>> generation.gensym
+## (\ ! map _.var)))]
+## g!inputs (monad.map ! (function (_ _)
+## (variable "input"))
+## (list.repeat (.nat arity) []))]
+## (wrap (<| (_.closure g!inputs)
+## _.statement
+## (case (.nat arity)
+## 0 (_.apply/1 abstractionG //runtime.unit)
+## 1 (_.apply/* g!inputs abstractionG)
+## _ (_.apply/1 abstractionG (_.array g!inputs)))))))]))
+
+(def: #export bundle
+ Bundle
+ (<| (/.prefix "php")
+ (|> /.empty
+ ## (dictionary.merge ..array)
+ ## (dictionary.merge ..object)
+ ## (dictionary.merge ..utf8)
+
+ ## (/.install "constant" lua::constant)
+ ## (/.install "apply" lua::apply)
+ ## (/.install "power" lua::power)
+ ## (/.install "import" lua::import)
+ ## (/.install "function" lua::function)
+ ## (/.install "script universe" (nullary (function.constant (_.bool reference.universe))))
+ )))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/runtime.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/runtime.lux
index 14d206e23..20d825912 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/runtime.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/runtime.lux
@@ -115,7 +115,8 @@
list.concat))]
(~ body)))))))
-(def: module_id 0)
+(def: module_id
+ 0)
(syntax: (runtime: {declaration (<>.or <code>.local_identifier
(<code>.form (<>.and <code>.local_identifier
@@ -279,9 +280,9 @@
($_ _.then
(_.local/1 floored (_.// param subject))
(let [potentially_floored? (_.< (_.int +0) floored)
- inexact? (|> floored
- (_.* param)
- (_.= subject)
+ inexact? (|> subject
+ (_.% param)
+ (_.= (_.int +0))
_.not)]
(_.if (_.and potentially_floored?
inexact?)
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php.lux
index f3afe14a6..c310de4a9 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php.lux
@@ -1,60 +1,58 @@
(.module:
[lux #*
[abstract
- [monad (#+ do)]]]
- [/
- [runtime (#+ Phase)]
- ["." primitive]
- ["." structure]
- ["." reference ("#\." system)]
- ["." case]
- ["." loop]
- ["." function]
- ["." ///
- ["." extension]
- [//
- ["." synthesis]]]])
-
-(def: #export (generate synthesis)
+ [monad (#+ do)]]
+ [control
+ ["." exception (#+ exception:)]]
+ [target
+ ["_" php]]]
+ ["." / #_
+ [runtime (#+ Phase Phase!)]
+ ["#." primitive]
+ ["#." structure]
+ ["#." reference]
+ ["#." case]
+ ["#." loop]
+ ["#." function]
+ ["/#" // #_
+ ["#." reference]
+ ["/#" // #_
+ ["#." extension]
+ ["/#" // #_
+ [analysis (#+)]
+ ["." synthesis]
+ ["//#" /// #_
+ ["#." phase ("#\." monad)]
+ [reference (#+)
+ [variable (#+)]]]]]]])
+
+(def: #export (generate archive synthesis)
Phase
(case synthesis
(^template [<tag> <generator>]
[(^ (<tag> value))
- (\ ///.monad wrap (<generator> value))])
- ([synthesis.bit primitive.bit]
- [synthesis.i64 primitive.i64]
- [synthesis.f64 primitive.f64]
- [synthesis.text primitive.text])
-
- (^ (synthesis.variant variantS))
- (structure.variant generate variantS)
-
- (^ (synthesis.tuple members))
- (structure.tuple generate members)
+ (//////phase\wrap (<generator> value))])
+ ([synthesis.bit /primitive.bit]
+ [synthesis.i64 /primitive.i64]
+ [synthesis.f64 /primitive.f64]
+ [synthesis.text /primitive.text])
(#synthesis.Reference value)
- (reference\reference value)
-
- (^ (synthesis.branch/case case))
- (case.case generate case)
-
- (^ (synthesis.branch/let let))
- (case.let generate let)
-
- (^ (synthesis.branch/if if))
- (case.if generate if)
+ (//reference.reference /reference.system archive value)
- (^ (synthesis.loop/scope scope))
- (loop.scope generate scope)
-
- (^ (synthesis.loop/recur updates))
- (loop.recur generate updates)
-
- (^ (synthesis.function/abstraction abstraction))
- (function.function generate abstraction)
-
- (^ (synthesis.function/apply application))
- (function.apply generate application)
+ (^template [<tag> <generator>]
+ [(^ (<tag> value))
+ (<generator> generate archive value)])
+ ([synthesis.variant /structure.variant]
+ [synthesis.tuple /structure.tuple]
+ [synthesis.branch/case /case.case]
+ [synthesis.branch/let /case.let]
+ [synthesis.branch/if /case.if]
+ [synthesis.branch/get /case.get]
+ [synthesis.loop/scope /loop.scope]
+ [synthesis.loop/recur /loop.recur]
+ [synthesis.function/apply /function.apply]
+ [synthesis.function/abstraction /function.function])
(#synthesis.Extension extension)
- (extension.apply generate extension)))
+ (///extension.apply archive generate extension)))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/case.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/case.lux
index 141f651f8..e129af245 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/case.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/case.lux
@@ -1,56 +1,60 @@
(.module:
[lux (#- case let if)
[abstract
- [monad (#+ do)]]
- [control
- ["ex" exception (#+ exception:)]]
+ ["." monad (#+ do)]]
[data
["." product]
["." text
["%" format (#+ format)]]
- [number
- ["n" nat]
- ["i" int]]
[collection
["." list ("#\." functor fold)]
["." set]]]
+ [math
+ [number
+ ["i" int]]]
[target
- ["_" php (#+ Var Expression Statement)]]]
+ ["_" php (#+ Expression Var Statement)]]]
["." // #_
- ["#." runtime (#+ Operation Phase)]
+ ["#." runtime (#+ Operation Phase Phase! Generator Generator!)]
["#." reference]
["#." primitive]
- ["#/" //
+ ["/#" // #_
["#." reference]
- ["#/" // ("#\." monad)
- [synthesis
- ["." case]]
- ["#/" // #_
- ["." reference (#+ Register)]
- ["#." synthesis (#+ Synthesis Path)]]]]])
+ ["/#" // #_
+ ["#." synthesis #_
+ ["#/." case]]
+ ["/#" // #_
+ ["#." synthesis (#+ Member Synthesis Path)]
+ ["#." generation]
+ ["//#" /// #_
+ [reference
+ ["#." variable (#+ Register)]]
+ ["#." phase ("#\." monad)]
+ [meta
+ [archive (#+ Archive)]]]]]]])
(def: #export register
- (///reference.local _.var))
+ (-> Register Var)
+ (|>> (///reference.local //reference.system) :assume))
(def: #export capture
- (///reference.foreign _.var))
-
-(def: #export (let generate [valueS register bodyS])
- (-> Phase [Synthesis Register Synthesis]
- (Operation (Expression Any)))
- (do ////.monad
- [valueG (generate valueS)
- bodyG (generate bodyS)]
+ (-> Register Var)
+ (|>> (///reference.foreign //reference.system) :assume))
+
+(def: #export (let generate archive [valueS register bodyS])
+ (Generator [Synthesis Register Synthesis])
+ (do ///////phase.monad
+ [valueG (generate archive valueS)
+ bodyG (generate archive bodyS)]
(wrap (|> bodyG
(list (_.set (..register register) valueG))
_.array/*
(_.nth (_.int +1))))))
-(def: #export (record-get generate valueS pathP)
- (-> Phase Synthesis (List (Either Nat Nat))
- (Operation (Expression Any)))
- (do ////.monad
- [valueG (generate valueS)]
+(def: #export (get generate archive [pathP valueS])
+ (Generator [(List Member) Synthesis])
+ (do ///////phase.monad
+ [valueG (generate archive valueS)]
(wrap (list\fold (function (_ side source)
(.let [method (.case side
(^template [<side> <accessor>]
@@ -62,13 +66,12 @@
valueG
pathP))))
-(def: #export (if generate [testS thenS elseS])
- (-> Phase [Synthesis Synthesis Synthesis]
- (Operation (Expression Any)))
- (do ////.monad
- [testG (generate testS)
- thenG (generate thenS)
- elseG (generate elseS)]
+(def: #export (if generate archive [testS thenS elseS])
+ (Generator [Synthesis Synthesis Synthesis])
+ (do ///////phase.monad
+ [testG (generate archive testS)
+ thenG (generate archive thenS)
+ elseG (generate archive elseS)]
(wrap (_.? testG thenG elseG))))
(def: @savepoint (_.var "lux_pm_savepoint"))
@@ -76,36 +79,36 @@
(def: @temp (_.var "lux_pm_temp"))
(def: (push! value)
- (-> (Expression Any) Statement)
- (_.; (_.array-push/2 [@cursor value])))
+ (-> Expression Statement)
+ (_.; (_.array_push/2 [@cursor value])))
-(def: peek-and-pop
- (Expression Any)
- (_.array-pop/1 @cursor))
+(def: peek_and_pop
+ Expression
+ (_.array_pop/1 @cursor))
(def: pop!
Statement
- (_.; ..peek-and-pop))
+ (_.; ..peek_and_pop))
(def: peek
- (Expression Any)
+ Expression
(_.nth (|> @cursor _.count/1 (_.- (_.int +1)))
@cursor))
(def: save!
Statement
- (.let [cursor (_.array-slice/2 [@cursor (_.int +0)])]
- (_.; (_.array-push/2 [@savepoint cursor]))))
+ (.let [cursor (_.array_slice/2 [@cursor (_.int +0)])]
+ (_.; (_.array_push/2 [@savepoint cursor]))))
(def: restore!
Statement
- (_.; (_.set @cursor (_.array-pop/1 @savepoint))))
+ (_.; (_.set @cursor (_.array_pop/1 @savepoint))))
(def: fail! _.break)
-(def: (multi-pop! pops)
+(def: (multi_pop! pops)
(-> Nat Statement)
- (_.; (_.array-splice/3 [@cursor
+ (_.; (_.array_splice/3 [@cursor
(_.int +0)
(_.int (i.* -1 (.int pops)))])))
@@ -115,20 +118,20 @@
($_ _.then
(_.; (_.set @temp (|> idx <prep> .int _.int (//runtime.sum//get ..peek <flag>))))
(.if simple?
- (_.when (_.is-null/1 @temp)
+ (_.when (_.is_null/1 @temp)
fail!)
- (_.if (_.is-null/1 @temp)
+ (_.if (_.is_null/1 @temp)
fail!
(..push! @temp)))))]
- [left-choice _.null (<|)]
- [right-choice (_.string "") inc]
+ [left_choice _.null (<|)]
+ [right_choice (_.string "") inc]
)
(def: (alternation pre! post!)
(-> Statement Statement Statement)
($_ _.then
- (_.do-while (_.bool false)
+ (_.do_while (_.bool false)
($_ _.then
..save!
pre!))
@@ -136,103 +139,127 @@
..restore!
post!)))
-(def: (pattern-matching' generate pathP)
- (-> Phase Path (Operation Statement))
- (.case pathP
- (^ (/////synthesis.path/then bodyS))
- (\ ////.monad map _.return (generate bodyS))
-
- #/////synthesis.Pop
- (////\wrap ..pop!)
-
- (#/////synthesis.Bind register)
- (////\wrap (_.; (_.set (..register register) ..peek)))
-
- (^template [<tag> <format>]
- [(^ (<tag> value))
- (////\wrap (_.when (|> value <format> (_.= ..peek) _.not)
- fail!))])
- ([/////synthesis.path/bit //primitive.bit]
- [/////synthesis.path/i64 //primitive.i64]
- [/////synthesis.path/f64 //primitive.f64]
- [/////synthesis.path/text //primitive.text])
-
- (^template [<complex> <simple> <choice>]
- [(^ (<complex> idx))
- (////\wrap (<choice> false idx))
-
- (^ (<simple> idx nextP))
- (|> nextP
- (pattern-matching' generate)
- (\ ////.monad map (_.then (<choice> true idx))))])
- ([/////synthesis.side/left /////synthesis.simple-left-side ..left-choice]
- [/////synthesis.side/right /////synthesis.simple-right-side ..right-choice])
-
- (^ (/////synthesis.member/left 0))
- (////\wrap (|> ..peek (_.nth (_.int +0)) ..push!))
-
- (^template [<pm> <getter>]
- [(^ (<pm> lefts))
- (////\wrap (|> ..peek (<getter> (_.int (.int lefts))) ..push!))])
- ([/////synthesis.member/left //runtime.tuple//left]
- [/////synthesis.member/right //runtime.tuple//right])
-
- (^ (/////synthesis.!bind-top register thenP))
- (do ////.monad
- [then! (pattern-matching' generate thenP)]
- (////\wrap ($_ _.then
- (_.; (_.set (..register register) ..peek-and-pop))
- then!)))
-
- ## (^ (/////synthesis.!multi-pop nextP))
- ## (.let [[extra-pops nextP'] (case.count-pops nextP)]
- ## (do ////.monad
- ## [next! (pattern-matching' generate nextP')]
- ## (////\wrap ($_ _.then
- ## (..multi-pop! (n.+ 2 extra-pops))
- ## next!))))
-
- (^template [<tag> <combinator>]
- [(^ (<tag> preP postP))
- (do ////.monad
- [pre! (pattern-matching' generate preP)
- post! (pattern-matching' generate postP)]
- (wrap (<combinator> pre! post!)))])
- ([/////synthesis.path/seq _.then]
- [/////synthesis.path/alt ..alternation])))
-
-(def: (pattern-matching generate pathP)
- (-> Phase Path (Operation Statement))
- (do ////.monad
- [pattern-matching! (pattern-matching' generate pathP)]
+(def: (pattern_matching' generate archive)
+ (-> Phase Archive Path (Operation Statement))
+ (function (recur pathP)
+ (.case pathP
+ (#/////synthesis.Then bodyS)
+ (\ ///////phase.monad map _.return (generate archive bodyS))
+
+ #/////synthesis.Pop
+ (///////phase\wrap ..pop!)
+
+ (#/////synthesis.Bind register)
+ (///////phase\wrap (_.; (_.set (..register register) ..peek)))
+
+ (#/////synthesis.Bit_Fork when thenP elseP)
+ (do {! ///////phase.monad}
+ [then! (recur thenP)
+ else! (.case elseP
+ (#.Some elseP)
+ (recur elseP)
+
+ #.None
+ (wrap ..fail!))]
+ (wrap (.if when
+ (_.if ..peek
+ then!
+ else!)
+ (_.if ..peek
+ else!
+ then!))))
+
+ (^template [<tag> <format>]
+ [(<tag> cons)
+ (do {! ///////phase.monad}
+ [clauses (monad.map ! (function (_ [match then])
+ (do !
+ [then! (recur then)]
+ (wrap [(_.= (|> match <format>)
+ ..peek)
+ then!])))
+ (#.Cons cons))]
+ (wrap (_.cond clauses ..fail!)))])
+ ([#/////synthesis.I64_Fork //primitive.i64]
+ [#/////synthesis.F64_Fork //primitive.f64]
+ [#/////synthesis.Text_Fork //primitive.text])
+
+ (^template [<complex> <simple> <choice>]
+ [(^ (<complex> idx))
+ (///////phase\wrap (<choice> false idx))
+
+ (^ (<simple> idx nextP))
+ (|> nextP
+ recur
+ (\ ///////phase.monad map (_.then (<choice> true idx))))])
+ ([/////synthesis.side/left /////synthesis.simple_left_side ..left_choice]
+ [/////synthesis.side/right /////synthesis.simple_right_side ..right_choice])
+
+ (^ (/////synthesis.member/left 0))
+ (///////phase\wrap (|> ..peek (_.nth (_.int +0)) ..push!))
+
+ (^template [<pm> <getter>]
+ [(^ (<pm> lefts))
+ (///////phase\wrap (|> ..peek (<getter> (_.int (.int lefts))) ..push!))])
+ ([/////synthesis.member/left //runtime.tuple//left]
+ [/////synthesis.member/right //runtime.tuple//right])
+
+ (^ (/////synthesis.!bind_top register thenP))
+ (do ///////phase.monad
+ [then! (recur thenP)]
+ (///////phase\wrap ($_ _.then
+ (_.; (_.set (..register register) ..peek_and_pop))
+ then!)))
+
+ ## (^ (/////synthesis.!multi_pop nextP))
+ ## (.let [[extra_pops nextP'] (////synthesis/case.count_pops nextP)]
+ ## (do ///////phase.monad
+ ## [next! (recur nextP')]
+ ## (///////phase\wrap ($_ _.then
+ ## (..multi_pop! (n.+ 2 extra_pops))
+ ## next!))))
+
+ (^template [<tag> <combinator>]
+ [(^ (<tag> preP postP))
+ (do ///////phase.monad
+ [pre! (recur preP)
+ post! (recur postP)]
+ (wrap (<combinator> pre! post!)))])
+ ([/////synthesis.path/seq _.then]
+ [/////synthesis.path/alt ..alternation]))))
+
+(def: (pattern_matching generate archive pathP)
+ (-> Phase Archive Path (Operation Statement))
+ (do ///////phase.monad
+ [pattern_matching! (pattern_matching' generate archive pathP)]
(wrap ($_ _.then
- (_.do-while (_.bool false)
- pattern-matching!)
- (_.throw (_.new (_.constant "Exception") (list (_.string case.pattern-matching-error))))))))
+ (_.do_while (_.bool false)
+ pattern_matching!)
+ (_.throw (_.new (_.constant "Exception") (list (_.string ////synthesis/case.pattern_matching_error))))))))
(def: (gensym prefix)
(-> Text (Operation Text))
- (\ ////.monad map (|>> %.nat (format prefix)) ///.next))
+ (\ ///////phase.monad map (|>> %.nat (format prefix)) /////generation.next))
-(def: #export (case generate [valueS pathP])
- (-> Phase [Synthesis Path] (Operation (Expression Any)))
- (do {! ////.monad}
- [initG (generate valueS)
- pattern-matching! (pattern-matching generate pathP)
+(def: #export (case generate archive [valueS pathP])
+ (Generator [Synthesis Path])
+ (do {! ///////phase.monad}
+ [initG (generate archive valueS)
+ pattern_matching! (pattern_matching generate archive pathP)
@case (..gensym "case")
#let [@caseG (_.global @case)
@caseL (_.var @case)]
@init (\ ! map _.var (..gensym "init"))
- #let [@dependencies+ (|> (case.storage pathP)
- (get@ #case.dependencies)
- set.to-list
+ #let [@dependencies+ (|> (////synthesis/case.storage pathP)
+ (get@ #////synthesis/case.dependencies)
+ set.to_list
(list\map (function (_ variable)
- [#0 (.case variable
- (#reference.Local register)
- (..register register)
-
- (#reference.Foreign register)
- (..capture register))])))]
+ [false (.case variable
+ (#///////variable.Local register)
+ (..register register)
+
+ (#///////variable.Foreign register)
+ (..capture register))])))]
#let [directive ($_ _.then
(<| _.;
(_.set @caseL)
@@ -241,9 +268,9 @@
($_ _.then
(_.; (_.set @cursor (_.array/* (list @init))))
(_.; (_.set @savepoint (_.array/* (list))))
- pattern-matching!))
+ pattern_matching!))
(_.; (_.set @caseG @caseL)))]
- _ (///.execute! directive)
- _ (///.save! @case directive)]
+ _ (/////generation.execute! directive)
+ _ (/////generation.save! @case directive)]
(wrap (_.apply/* (list& initG (list\map product.right @dependencies+))
@caseG))))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/function.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/function.lux
index 33660380c..718ee1e79 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/function.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/function.lux
@@ -1,105 +1,124 @@
(.module:
- [lux (#- function)
+ [lux (#- Global function)
[abstract
["." monad (#+ do)]]
[control
pipe]
[data
["." product]
- ["." text]
+ ["." text
+ ["%" format (#+ format)]]
[collection
["." list ("#\." functor fold)]]]
[target
- ["_" php (#+ Argument Expression Statement)]]]
+ ["_" php (#+ Var Global Expression Argument Statement)]]]
["." // #_
- [runtime (#+ Operation Phase)]
+ ["#." runtime (#+ Operation Phase Phase! Generator)]
["#." reference]
["#." case]
- ["#/" //
+ ["/#" // #_
["#." reference]
- ["#/" //
- ["." // #_
- [reference (#+ Register Variable)]
+ ["//#" /// #_
+ [analysis (#+ Variant Tuple Abstraction Application Analysis)]
+ [synthesis (#+ Synthesis)]
+ ["#." generation (#+ Context)]
+ ["//#" /// #_
[arity (#+ Arity)]
- [analysis (#+ Variant Tuple Environment Abstraction Application Analysis)]
- [synthesis (#+ Synthesis)]]]]])
+ ["#." phase ("#\." monad)]
+ [reference
+ [variable (#+ Register Variable)]]]]]])
-(def: #export (apply generate [functionS argsS+])
- (-> Phase (Application Synthesis) (Operation (Expression Any)))
- (do {! ////.monad}
- [functionG (generate functionS)
- argsG+ (monad.map ! generate argsS+)]
+(def: #export (apply expression archive [functionS argsS+])
+ (Generator (Application Synthesis))
+ (do {! ///////phase.monad}
+ [functionG (expression archive functionS)
+ argsG+ (monad.map ! (expression archive) argsS+)]
(wrap (_.apply/* argsG+ functionG))))
-(def: #export capture
- (///reference.foreign _.var))
+(def: capture
+ (-> Register Var)
+ (|>> (///reference.foreign //reference.system) :assume))
(def: input
(|>> inc //case.register))
-(def: #export (function generate [environment arity bodyS])
- (-> Phase (Abstraction Synthesis) (Operation (Expression Any)))
- (do {! ////.monad}
- [[function-name bodyG] (///.with-context
+(def: (with_closure inits @selfG @selfL body!)
+ (-> (List Expression) Global Var Statement [Statement Expression])
+ (case inits
+ #.Nil
+ [($_ _.then
+ (_.; (_.set @selfL (_.closure (list (_.reference @selfL)) (list) body!)))
+ (_.; (_.set @selfG @selfL)))
+ @selfG]
+
+ _
+ (let [@inits (|> (list.enumeration inits)
+ (list\map (|>> product.left ..capture _.reference)))]
+ [(_.; (_.set @selfG (_.closure (list) @inits
+ ($_ _.then
+ (_.; (_.set @selfL (_.closure (list& (_.reference @selfL) @inits)
+ (list)
+ body!)))
+ (_.return @selfL)))))
+ (_.apply/* inits @selfG)])))
+
+(def: #export (function expression archive [environment arity bodyS])
+ (Generator (Abstraction Synthesis))
+ (do {! ///////phase.monad}
+ [[function_name bodyG] (/////generation.with_new_context archive
(do !
- [function-name ///.context]
- (///.with-anchor (_.var function-name)
- (generate bodyS))))
- closureG+ (: (Operation (List Argument))
- (monad.map ! (|>> (\ //reference.system variable)
- (\ ! map _.reference))
- environment))
+ [function_name (\ ! map ///reference.artifact
+ (/////generation.context archive))]
+ (/////generation.with_anchor (_.var function_name)
+ (expression archive bodyS))))
+ closureG+ (monad.map ! (expression archive) environment)
#let [@curried (_.var "curried")
arityG (|> arity .int _.int)
- @num-args (_.var "num_args")
- @selfG (_.global function-name)
- @selfL (_.var function-name)
- initialize-self! (_.; (_.set (//case.register 0) @selfL))
+ @num_args (_.var "num_args")
+ @selfG (_.global (///reference.artifact function_name))
+ @selfL (_.var (///reference.artifact function_name))
+ initialize_self! (_.; (_.set (//case.register 0) @selfL))
initialize! (list\fold (.function (_ post pre!)
($_ _.then
pre!
(_.; (_.set (..input post) (_.nth (|> post .int _.int) @curried)))))
- initialize-self!
+ initialize_self!
(list.indices arity))]
- #let [directive ($_ _.then
- (<| _.;
- (_.set @selfL)
- (_.closure (list& (_.reference @selfL) closureG+) (list))
- ($_ _.then
- (_.echo (_.string "'ello, world! "))
- (_.; (_.set @num-args (_.func-num-args/0 [])))
- (_.echo @num-args) (_.echo (_.string " ~ ")) (_.echo arityG)
- (_.echo (_.string text.new-line))
- (_.; (_.set @curried (_.func-get-args/0 [])))
- (_.cond (list [(|> @num-args (_.= arityG))
- ($_ _.then
- initialize!
- (_.return bodyG))]
- [(|> @num-args (_.> arityG))
- (let [arity-inputs (_.array-slice/3 [@curried (_.int +0) arityG])
- extra-inputs (_.array-slice/2 [@curried arityG])
- next (_.call-user-func-array/2 [@selfL arity-inputs])
- done (_.call-user-func-array/2 [next extra-inputs])]
- ($_ _.then
- (_.echo (_.string "STAGED ")) (_.echo (_.count/1 arity-inputs))
- (_.echo (_.string " + ")) (_.echo (_.count/1 extra-inputs))
- (_.echo (_.string text.new-line))
- (_.echo (_.string "@selfL ")) (_.echo @selfL) (_.echo (_.string text.new-line))
- (_.echo (_.string " next ")) (_.echo next) (_.echo (_.string text.new-line))
- (_.echo (_.string " done ")) (_.echo done) (_.echo (_.string text.new-line))
- (_.return done)))])
- ## (|> @num-args (_.< arityG))
- (let [@missing (_.var "missing")]
- (_.return (<| (_.closure (list (_.reference @selfL) (_.reference @curried)) (list))
- ($_ _.then
- (_.; (_.set @missing (_.func-get-args/0 [])))
- (_.echo (_.string "NEXT ")) (_.echo (_.count/1 @curried))
- (_.echo (_.string " ")) (_.echo (_.count/1 @missing))
- (_.echo (_.string " ")) (_.echo (_.count/1 (_.array-merge/+ @curried (list @missing))))
- (_.echo (_.string text.new-line))
- (_.return (_.call-user-func-array/2 [@selfL (_.array-merge/+ @curried (list @missing))])))))))
- ))
- (_.; (_.set @selfG @selfL)))]
- _ (///.execute! directive)
- _ (///.save! function-name directive)]
- (wrap @selfG)))
+ #let [[definition instantiation] (..with_closure closureG+ @selfG @selfL
+ ($_ _.then
+ (_.echo (_.string "'ello, world! "))
+ (_.; (_.set @num_args (_.func_num_args/0 [])))
+ (_.echo @num_args) (_.echo (_.string " ~ ")) (_.echo arityG)
+ (_.echo (_.string text.new_line))
+ (_.; (_.set @curried (_.func_get_args/0 [])))
+ (_.cond (list [(|> @num_args (_.= arityG))
+ ($_ _.then
+ initialize!
+ (_.return bodyG))]
+ [(|> @num_args (_.> arityG))
+ (let [arity_inputs (_.array_slice/3 [@curried (_.int +0) arityG])
+ extra_inputs (_.array_slice/2 [@curried arityG])
+ next (_.call_user_func_array/2 [@selfL arity_inputs])
+ done (_.call_user_func_array/2 [next extra_inputs])]
+ ($_ _.then
+ (_.echo (_.string "STAGED ")) (_.echo (_.count/1 arity_inputs))
+ (_.echo (_.string " + ")) (_.echo (_.count/1 extra_inputs))
+ (_.echo (_.string text.new_line))
+ (_.echo (_.string "@selfL ")) (_.echo @selfL) (_.echo (_.string text.new_line))
+ (_.echo (_.string " next ")) (_.echo next) (_.echo (_.string text.new_line))
+ (_.echo (_.string " done ")) (_.echo done) (_.echo (_.string text.new_line))
+ (_.return done)))])
+ ## (|> @num_args (_.< arityG))
+ (let [@missing (_.var "missing")]
+ (_.return (<| (_.closure (list (_.reference @selfL) (_.reference @curried)) (list))
+ ($_ _.then
+ (_.; (_.set @missing (_.func_get_args/0 [])))
+ (_.echo (_.string "NEXT ")) (_.echo (_.count/1 @curried))
+ (_.echo (_.string " ")) (_.echo (_.count/1 @missing))
+ (_.echo (_.string " ")) (_.echo (_.count/1 (_.array_merge/+ @curried (list @missing))))
+ (_.echo (_.string text.new_line))
+ (_.return (_.call_user_func_array/2 [@selfL (_.array_merge/+ @curried (list @missing))])))))))
+ ))]
+ _ (/////generation.execute! definition)
+ _ (/////generation.save! (%.nat (product.right function_name)) definition)]
+ (wrap instantiation)))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/loop.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/loop.lux
index a3482d8a7..1bc853e64 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/loop.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/loop.lux
@@ -4,31 +4,40 @@
["." monad (#+ do)]]
[data
["." product]
- [number
- ["n" nat]]
[text
["%" format (#+ format)]]
[collection
- ["." list ("#\." functor)]]]
+ ["." list ("#\." functor)]
+ ["." set]]]
+ [math
+ [number
+ ["n" nat]]]
[target
- ["_" php (#+ Expression)]]]
+ ["_" php (#+ Var Expression Statement)]]]
["." // #_
- [runtime (#+ Operation Phase)]
+ [runtime (#+ Operation Phase Phase! Generator Generator!)]
["#." case]
- ["#/" //
- ["#/" //
- [//
- [synthesis (#+ Scope Synthesis)]]]]])
+ ["/#" // #_
+ ["#." reference]
+ ["//#" /// #_
+ ["."synthesis (#+ Scope Synthesis)]
+ ["#." generation]
+ ["//#" /// #_
+ ["#." phase]
+ [meta
+ [archive (#+ Archive)]]
+ [reference
+ [variable (#+ Register)]]]]]])
-(def: #export (scope generate [start initsS+ bodyS])
- (-> Phase (Scope Synthesis) (Operation (Expression Any)))
- (do {! ////.monad}
- [@loop (\ ! map (|>> %.nat (format "loop")) ///.next)
+(def: #export (scope generate archive [start initsS+ bodyS])
+ (Generator (Scope Synthesis))
+ (do {! ///////phase.monad}
+ [@loop (\ ! map (|>> %.nat (format "loop")) /////generation.next)
#let [@loopG (_.global @loop)
@loopL (_.var @loop)]
- initsO+ (monad.map ! generate initsS+)
- bodyO (///.with-anchor @loopL
- (generate bodyS))
+ initsO+ (monad.map ! (generate archive) initsS+)
+ bodyO (/////generation.with_anchor @loopL
+ (generate archive bodyS))
#let [directive ($_ _.then
(<| _.;
(_.set @loopL)
@@ -38,13 +47,13 @@
(list\map (|>> product.left (n.+ start) //case.register [#0])))
(_.return bodyO)))
(_.; (_.set @loopG @loopL)))]
- _ (///.execute! directive)
- _ (///.save! @loop directive)]
+ _ (/////generation.execute! directive)
+ _ (/////generation.save! @loop directive)]
(wrap (_.apply/* initsO+ @loopG))))
-(def: #export (recur generate argsS+)
- (-> Phase (List Synthesis) (Operation (Expression Any)))
- (do {! ////.monad}
- [@scope ///.anchor
- argsO+ (monad.map ! generate argsS+)]
+(def: #export (recur generate archive argsS+)
+ (Generator (List Synthesis))
+ (do {! ///////phase.monad}
+ [@scope /////generation.anchor
+ argsO+ (monad.map ! (generate archive) argsS+)]
(wrap (_.apply/* argsO+ @scope))))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/primitive.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/primitive.lux
index b5b953ba7..7838ce804 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/primitive.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/primitive.lux
@@ -2,7 +2,7 @@
[lux (#- i64)
[control
[pipe (#+ cond> new>)]]
- [data
+ [math
[number
["." frac]]]
[target
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/reference.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/reference.lux
index 77b9bec74..776245b61 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/reference.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/reference.lux
@@ -2,10 +2,11 @@
[lux #*
[target
["_" php (#+ Expression)]]]
- [//
- [//
- ["." reference]]])
+ [///
+ [reference (#+ System)]])
-(def: #export system
- (reference.system (: (-> Text (Expression Any)) _.global)
- (: (-> Text (Expression Any)) _.var)))
+(structure: #export system
+ (System Expression)
+
+ (def: constant _.global)
+ (def: variable _.var))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/runtime.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/runtime.lux
index 88a8897f2..3a50bba43 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/runtime.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/runtime.lux
@@ -1,62 +1,84 @@
(.module:
- [lux (#- Global inc)
+ [lux (#- Location inc)
+ ["." meta]
[abstract
- [monad (#+ do)]]
+ ["." monad (#+ do)]]
[control
["." function]
- ["p" parser
- ["s" code]]]
+ ["<>" parser
+ ["<.>" code]]]
[data
- [number (#+ hex)
- ["." i64]]
- ["." text
- ["%" format (#+ format)]]
+ ["." product]
+ ["." text ("#\." hash)
+ ["%" format (#+ format)]
+ ["." encoding]]
[collection
- ["." list ("#\." functor)]]]
+ ["." list ("#\." functor)]
+ ["." row]]]
["." macro
- ["." code]
- [syntax (#+ syntax:)]]
- [target
- ["_" php (#+ Expression Var Global Computation Literal Statement)]]]
- ["." ///
- ["//." //
- [//
- ["/////." name]
- ["." synthesis]]]]
- )
+ [syntax (#+ syntax:)]
+ ["." code]]
+ [math
+ [number (#+ hex)
+ ["." i64]]]
+ ["@" target
+ ["_" php (#+ Expression Location Constant Var Computation Literal Statement)]]]
+ ["." /// #_
+ ["#." reference]
+ ["//#" /// #_
+ ["#." synthesis (#+ Synthesis)]
+ ["#." generation]
+ ["//#" ///
+ ["#." phase]
+ [reference
+ [variable (#+ Register)]]
+ [meta
+ [archive (#+ Output Archive)
+ ["." artifact (#+ Registry)]]]]]])
(template [<name> <base>]
[(type: #export <name>
- (<base> Var (Expression Any) Statement))]
+ (<base> Var Expression Statement))]
- [Operation ///.Operation]
- [Phase ///.Phase]
- [Handler ///.Handler]
- [Bundle ///.Bundle]
+ [Operation /////generation.Operation]
+ [Phase /////generation.Phase]
+ [Handler /////generation.Handler]
+ [Bundle /////generation.Bundle]
)
-(def: prefix Text "LuxRuntime")
+(type: #export (Generator i)
+ (-> Phase Archive i (Operation Expression)))
+
+(type: #export Phase!
+ (-> Phase Archive Synthesis (Operation Statement)))
-(def: #export unit (_.string synthesis.unit))
+(type: #export (Generator! i)
+ (-> Phase! Phase Archive i (Operation Statement)))
+
+(def: prefix
+ "LuxRuntime")
+
+(def: #export unit
+ (_.string /////synthesis.unit))
(def: (flag value)
(-> Bit Literal)
(if value
- (_.string "")
+ ..unit
_.null))
-(def: #export variant-tag-field "_lux_tag")
-(def: #export variant-flag-field "_lux_flag")
-(def: #export variant-value-field "_lux_value")
+(def: #export variant_tag_field "_lux_tag")
+(def: #export variant_flag_field "_lux_flag")
+(def: #export variant_value_field "_lux_value")
(def: (variant' tag last? value)
- (-> (Expression Any) (Expression Any) (Expression Any) Literal)
- (_.array/** (list [(_.string ..variant-tag-field) tag]
- [(_.string ..variant-flag-field) last?]
- [(_.string ..variant-value-field) value])))
+ (-> Expression Expression Expression Literal)
+ (_.array/** (list [(_.string ..variant_tag_field) tag]
+ [(_.string ..variant_flag_field) last?]
+ [(_.string ..variant_value_field) value])))
(def: #export (variant tag last? value)
- (-> Nat Bit (Expression Any) Literal)
+ (-> Nat Bit Expression Literal)
(variant' (_.int (.int tag))
(..flag last?)
value))
@@ -66,94 +88,93 @@
(..variant 0 #0 ..unit))
(def: #export some
- (-> (Expression Any) Literal)
+ (-> Expression Literal)
(..variant 1 #1))
(def: #export left
- (-> (Expression Any) Literal)
+ (-> Expression Literal)
(..variant 0 #0))
(def: #export right
- (-> (Expression Any) Literal)
+ (-> Expression Literal)
(..variant 1 #1))
-(def: (runtime-name raw)
- (-> Text [Global Var])
- (let [refined (|> raw
- /////name.normalize
- (format ..prefix "_"))]
- [(_.global refined) (_.var refined)]))
-
(def: (feature name definition)
- (-> [Global Var] (-> [Global Var] Statement) Statement)
+ (-> Constant (-> Constant Statement) Statement)
(definition name))
-(syntax: #export (with-vars {vars (s.tuple (p.some s.local-identifier))}
+(syntax: #export (with_vars {vars (<code>.tuple (<>.some <code>.local_identifier))}
body)
- (wrap (list (` (let [(~+ (|> vars
- (list\map (function (_ var)
- (list (code.local-identifier var)
- (` (_.var (~ (code.text (/////name.normalize var))))))))
- list.concat))]
- (~ body))))))
-
-(syntax: (runtime: {declaration (p.or s.local-identifier
- (s.form (p.and s.local-identifier
- (p.some s.local-identifier))))}
+ (do {! meta.monad}
+ [ids (monad.seq ! (list.repeat (list.size vars) meta.count))]
+ (wrap (list (` (let [(~+ (|> vars
+ (list.zip/2 ids)
+ (list\map (function (_ [id var])
+ (list (code.local_identifier var)
+ (` (_.var (~ (code.text (format "v" (%.nat id)))))))))
+ list.concat))]
+ (~ body)))))))
+
+(def: module_id
+ 0)
+
+(syntax: (runtime: {declaration (<>.or <code>.local_identifier
+ (<code>.form (<>.and <code>.local_identifier
+ (<>.some <code>.local_identifier))))}
code)
- (macro.with-gensyms [g!_ g!G g!L]
- (case declaration
- (#.Left name)
- (let [code-nameC (code.local-identifier (format "@" name))
- runtime-nameC (` (runtime-name (~ (code.text name))))]
- (wrap (list (` (def: #export (~ (code.local-identifier name)) _.Global (~ runtime-nameC)))
- (` (def: (~ code-nameC)
- _.Statement
- (..feature (~ runtime-nameC)
- (function ((~ g!_) [(~ g!G) (~ g!L)])
- (_.; (_.set (~ g!G) (~ code))))))))))
-
- (#.Right [name inputs])
- (let [code-nameC (code.local-identifier (format "@" name))
- runtime-nameC (` (runtime-name (~ (code.text name))))
- inputsC (list\map code.local-identifier inputs)
- inputs-typesC (list\map (function.constant (` (_.Expression Any)))
- inputs)]
- (wrap (list (` (def: #export ((~ (code.local-identifier name)) (~+ inputsC))
- (-> (~+ inputs-typesC) (_.Computation Any))
- (.let [[(~ g!G) (~ g!L)] (~ runtime-nameC)]
- (_.apply/* (list (~+ inputsC)) (~ g!G)))))
- (` (def: (~ code-nameC)
- _.Statement
- (..feature (~ runtime-nameC)
- (function ((~ g!_) [(~ g!G) (~ g!L)])
- (..with-vars [(~+ inputsC)]
- ($_ _.then
- (<| _.;
- (_.set (~ g!L))
- (_.closure (list (_.reference (~ g!L)))
- (list (~+ (|> inputsC
- (list\map (function (_ inputC)
- (` [#0 (~ inputC)]))))))
- (~ code)))
- (_.; (_.set (~ g!G) (~ g!L)))
- ))))))))))))
+ (do meta.monad
+ [runtime_id meta.count]
+ (macro.with_gensyms [g!_]
+ (let [runtime (code.local_identifier (///reference.artifact [..module_id runtime_id]))
+ runtime_name (` (_.constant (~ (code.text (%.code runtime)))))]
+ (case declaration
+ (#.Left name)
+ (macro.with_gensyms [g!_]
+ (let [g!name (code.local_identifier name)]
+ (wrap (list (` (def: #export (~ g!name)
+ Var
+ (~ runtime_name)))
+
+ (` (def: (~ (code.local_identifier (format "@" name)))
+ Statement
+ (..feature (~ runtime_name)
+ (function ((~ g!_) (~ g!name))
+ (_.define (~ g!name) (~ code))))))))))
+
+ (#.Right [name inputs])
+ (macro.with_gensyms [g!_]
+ (let [g!name (code.local_identifier name)
+ inputsC (list\map code.local_identifier inputs)
+ inputs_typesC (list\map (function.constant (` _.Expression))
+ inputs)]
+ (wrap (list (` (def: #export ((~ g!name) (~+ inputsC))
+ (-> (~+ inputs_typesC) Computation)
+ (_.apply/* (list (~+ inputsC)) (~ runtime_name))))
+
+ (` (def: (~ (code.local_identifier (format "@" name)))
+ Statement
+ (..feature (~ runtime_name)
+ (function ((~ g!_) (~ g!_))
+ (..with_vars [(~+ inputsC)]
+ (_.define_function (~ g!_)
+ (list (~+ (list\map (|>> (~) [false] (`)) inputsC)))
+ (~ code))))))))))))))))
(runtime: (lux//try op)
- (with-vars [value]
+ (with_vars [value]
(_.try ($_ _.then
(_.; (_.set value (_.apply/1 [..unit] op)))
(_.return (..right value)))
- (list (with-vars [error]
+ (list (with_vars [error]
{#_.class (_.constant "Exception")
#_.exception error
#_.handler (_.return (..left (_.do "getMessage" (list) error)))})))))
-(runtime: (lux//program-args inputs)
- (with-vars [head tail]
+(runtime: (lux//program_args inputs)
+ (with_vars [head tail]
($_ _.then
(_.; (_.set tail ..none))
- (<| (_.for-each (_.array-reverse/1 inputs) head)
+ (<| (_.for_each (_.array_reverse/1 inputs) head)
(_.; (_.set tail (..some (_.array/* (list head tail))))))
(_.return tail))))
@@ -161,7 +182,7 @@
Statement
($_ _.then
@lux//try
- @lux//program-args
+ @lux//program_args
))
(runtime: (io//throw! message)
@@ -175,71 +196,71 @@
@io//throw!
))
-(def: tuple-size
+(def: tuple_size
_.count/1)
-(def: last-index
- (|>> ..tuple-size (_.- (_.int +1))))
+(def: last_index
+ (|>> ..tuple_size (_.- (_.int +1))))
-(with-expansions [<recur> (as-is ($_ _.then
- (_.; (_.set lefts (_.- last-index-right lefts)))
- (_.; (_.set tuple (_.nth last-index-right tuple)))))]
+(with_expansions [<recur> (as_is ($_ _.then
+ (_.; (_.set lefts (_.- last_index_right lefts)))
+ (_.; (_.set tuple (_.nth last_index_right tuple)))))]
(runtime: (tuple//left lefts tuple)
- (with-vars [last-index-right]
+ (with_vars [last_index_right]
(<| (_.while (_.bool true))
($_ _.then
- (_.; (_.set last-index-right (..last-index tuple)))
- (_.if (_.> lefts last-index-right)
+ (_.; (_.set last_index_right (..last_index tuple)))
+ (_.if (_.> lefts last_index_right)
## No need for recursion
(_.return (_.nth lefts tuple))
## Needs recursion
<recur>)))))
(runtime: (tuple//right lefts tuple)
- (with-vars [last-index-right right-index]
+ (with_vars [last_index_right right_index]
(<| (_.while (_.bool true))
($_ _.then
- (_.; (_.set last-index-right (..last-index tuple)))
- (_.; (_.set right-index (_.+ (_.int +1) lefts)))
- (_.cond (list [(_.= last-index-right right-index)
- (_.return (_.nth right-index tuple))]
- [(_.> last-index-right right-index)
+ (_.; (_.set last_index_right (..last_index tuple)))
+ (_.; (_.set right_index (_.+ (_.int +1) lefts)))
+ (_.cond (list [(_.= last_index_right right_index)
+ (_.return (_.nth right_index tuple))]
+ [(_.> last_index_right right_index)
## Needs recursion.
<recur>])
- (_.return (_.array-slice/2 [tuple right-index])))
+ (_.return (_.array_slice/2 [tuple right_index])))
)))))
(runtime: (sum//get sum wantsLast wantedTag)
- (let [no-match! (_.return _.null)
- sum-tag (_.nth (_.string ..variant-tag-field) sum)
- ## sum-tag (_.nth (_.int +0) sum)
- sum-flag (_.nth (_.string ..variant-flag-field) sum)
- ## sum-flag (_.nth (_.int +1) sum)
- sum-value (_.nth (_.string ..variant-value-field) sum)
- ## sum-value (_.nth (_.int +2) sum)
- is-last? (_.= (_.string "") sum-flag)
- test-recursion! (_.if is-last?
+ (let [no_match! (_.return _.null)
+ sum_tag (_.nth (_.string ..variant_tag_field) sum)
+ ## sum_tag (_.nth (_.int +0) sum)
+ sum_flag (_.nth (_.string ..variant_flag_field) sum)
+ ## sum_flag (_.nth (_.int +1) sum)
+ sum_value (_.nth (_.string ..variant_value_field) sum)
+ ## sum_value (_.nth (_.int +2) sum)
+ is_last? (_.= (_.string "") sum_flag)
+ test_recursion! (_.if is_last?
## Must recurse.
- (_.return (sum//get sum-value wantsLast (_.- sum-tag wantedTag)))
- no-match!)]
+ (_.return (sum//get sum_value wantsLast (_.- sum_tag wantedTag)))
+ no_match!)]
($_ _.then
(_.echo (_.string "sum//get ")) (_.echo (_.count/1 sum))
(_.echo (_.string " ")) (_.echo (_.apply/1 [sum] (_.constant "gettype")))
- (_.echo (_.string " ")) (_.echo sum-tag)
+ (_.echo (_.string " ")) (_.echo sum_tag)
(_.echo (_.string " ")) (_.echo wantedTag)
- (_.echo (_.string text.new-line))
- (_.cond (list [(_.= sum-tag wantedTag)
- (_.if (_.= wantsLast sum-flag)
- (_.return sum-value)
- test-recursion!)]
+ (_.echo (_.string text.new_line))
+ (_.cond (list [(_.= sum_tag wantedTag)
+ (_.if (_.= wantsLast sum_flag)
+ (_.return sum_value)
+ test_recursion!)]
- [(_.> sum-tag wantedTag)
- test-recursion!]
+ [(_.> sum_tag wantedTag)
+ test_recursion!]
- [(_.and (_.< sum-tag wantedTag)
+ [(_.and (_.< sum_tag wantedTag)
(_.= (_.string "") wantsLast))
- (_.return (variant' (_.- wantedTag sum-tag) sum-flag sum-value))])
- no-match!)
+ (_.return (variant' (_.- wantedTag sum_tag) sum_flag sum_value))])
+ no_match!)
)))
(def: runtime//adt
@@ -250,22 +271,22 @@
@sum//get
))
-(runtime: (i64//logic-right-shift param subject)
+(runtime: (i64//logic_right_shift param subject)
(let [mask (|> (_.int +1)
- (_.bit-shl (_.- param (_.int +64)))
+ (_.bit_shl (_.- param (_.int +64)))
(_.- (_.int +1)))]
(_.return (|> subject
- (_.bit-shr param)
- (_.bit-and mask)))))
+ (_.bit_shr param)
+ (_.bit_and mask)))))
(def: runtime//i64
Statement
($_ _.then
- @i64//logic-right-shift
+ @i64//logic_right_shift
))
(runtime: (text//index subject param start)
- (with-vars [idx]
+ (with_vars [idx]
($_ _.then
(_.; (_.set idx (_.strpos/3 [subject param start])))
(_.if (_.= (_.bool false) idx)
@@ -278,19 +299,19 @@
@text//index
))
-(def: check-necessary-conditions!
+(def: check_necessary_conditions!
Statement
(let [condition (_.= (_.int +8)
(_.constant "PHP_INT_SIZE"))
- error-message (_.string (format "Cannot run program!" text.new-line
+ error_message (_.string (format "Cannot run program!" text.new_line
"Lux/PHP programs require 64-bit PHP builds!"))]
(_.when (_.not condition)
- (_.throw (_.new (_.constant "Exception") (list error-message))))))
+ (_.throw (_.new (_.constant "Exception") (list error_message))))))
(def: runtime
Statement
($_ _.then
- check-necessary-conditions!
+ check_necessary_conditions!
runtime//lux
runtime//adt
runtime//i64
@@ -301,9 +322,14 @@
(def: #export artifact ..prefix)
(def: #export generate
- (Operation Any)
- (///.with-buffer
- (do ////.monad
- [_ (///.execute! ..runtime)
- _ (///.save! ..prefix ..runtime)]
- (///.save-buffer! ..artifact))))
+ (Operation [Registry Output])
+ (do ///////phase.monad
+ [_ (/////generation.execute! ..runtime)
+ _ (/////generation.save! (%.nat ..module_id) ..runtime)]
+ (wrap [(|> artifact.empty
+ artifact.resource
+ product.right)
+ (row.row [(%.nat ..module_id)
+ (|> ..runtime
+ _.code
+ (\ encoding.utf8 encode))])])))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/structure.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/structure.lux
index 9748ede02..307417c6c 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/structure.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/structure.lux
@@ -5,32 +5,32 @@
[target
["_" php (#+ Expression)]]]
["." // #_
- ["#." runtime (#+ Operation Phase)]
+ ["#." runtime (#+ Operation Phase Generator)]
["#." primitive]
- ["#//" ///
- ["#/" // #_
- [analysis (#+ Variant Tuple)]
- ["#." synthesis (#+ Synthesis)]]]])
+ ["///#" //// #_
+ [analysis (#+ Variant Tuple)]
+ ["#." synthesis (#+ Synthesis)]
+ ["//#" /// #_
+ ["#." phase ("#\." monad)]]]])
-(def: #export (tuple generate elemsS+)
- (-> Phase (Tuple Synthesis) (Operation (Expression Any)))
+(def: #export (tuple generate archive elemsS+)
+ (Generator (Tuple Synthesis))
(case elemsS+
#.Nil
- (\ ////.monad wrap (//primitive.text /////synthesis.unit))
+ (///////phase\wrap (//primitive.text /////synthesis.unit))
(#.Cons singletonS #.Nil)
- (generate singletonS)
+ (generate archive singletonS)
_
(|> elemsS+
- (monad.map ////.monad generate)
- (\ ////.monad map _.array/*))))
+ (monad.map ///////phase.monad (generate archive))
+ (///////phase\map _.array/*))))
-(def: #export (variant generate [lefts right? valueS])
- (-> Phase (Variant Synthesis) (Operation (Expression Any)))
- (\ ////.monad map
- (//runtime.variant (if right?
- (inc lefts)
- lefts)
- right?)
- (generate valueS)))
+(def: #export (variant generate archive [lefts right? valueS])
+ (Generator (Variant Synthesis))
+ (let [tag (if right?
+ (inc lefts)
+ lefts)]
+ (///////phase\map (//runtime.variant tag right?)
+ (generate archive valueS))))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux
index 1af62cf7e..6d218b137 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux
@@ -314,9 +314,9 @@
($_ _.then
(_.set (list floored) (_.// param subject))
(_.return (let [potentially_floored? (_.< (_.int +0) floored)
- inexact? (|> floored
- (_.* param)
- (_.= subject)
+ inexact? (|> subject
+ (_.% param)
+ (_.= (_.int +0))
_.not)]
(_.? (_.and potentially_floored?
inexact?)
diff --git a/stdlib/source/lux/tool/compiler/reference.lux b/stdlib/source/lux/tool/compiler/reference.lux
index 96cefe81a..856435fe8 100644
--- a/stdlib/source/lux/tool/compiler/reference.lux
+++ b/stdlib/source/lux/tool/compiler/reference.lux
@@ -71,7 +71,9 @@
[constant #..Constant]
)
-(def: #export self Reference (..local 0))
+(def: #export self
+ Reference
+ (..local 0))
(def: #export format
(Format Reference)
diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux
index a39671ea4..0379b8427 100644
--- a/stdlib/source/test/lux.lux
+++ b/stdlib/source/test/lux.lux
@@ -34,7 +34,7 @@
["#." math]
["#." meta]
["#." time]
- ## ["#." tool]
+ ## ["#." tool] ## TODO: Update & expand tests for this
["#." type]
["#." world]
["#." host]
@@ -181,7 +181,9 @@
(n.= on_valid_host
(for {@.old on_valid_host
@.jvm on_valid_host
- @.js on_valid_host}
+ @.js on_valid_host
+ @.python on_valid_host
+ @.lua on_valid_host}
on_default))))))
(def: conversion_tests
diff --git a/stdlib/source/test/lux/macro/template.lux b/stdlib/source/test/lux/macro/template.lux
index b129aaaef..9032453c5 100644
--- a/stdlib/source/test/lux/macro/template.lux
+++ b/stdlib/source/test/lux/macro/template.lux
@@ -41,10 +41,10 @@
[left random.nat
mid random.nat
right random.nat]
- (with_expansions [<module> (as_is [-8.9 +6.7 .5 -4 +3 2 #1 #0 #c b "a"])
- <module>' "-8.9+6.7.5-4+32#1#0cba"
- <short> (as_is ["a" b #c #0 #1 2 +3 -4 .5 +6.7 -8.9])
- <short>' "abc#0#12+3-4.5+6.7-8.9"]
+ (with_expansions [<module> (as_is [.5 -4 +3 2 #1 #0 #c b "a"])
+ <module>' ".5-4+32#1#0cba"
+ <short> (as_is ["a" b #c #0 #1 2 +3 -4 .5])
+ <short>' "abc#0#12+3-4.5"]
($_ _.and
(_.cover [/.splice]
(\ (list.equivalence nat.equivalence) =