From dff34f01e838475b817803ec856661fe8940e5c0 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Fri, 12 Mar 2021 05:45:44 -0400
Subject: Almost done with PHP.
---
compilers.md | 8 +
lux-php/source/program.lux | 94 +------
stdlib/source/lux/control/concurrency/atom.lux | 10 +-
stdlib/source/lux/control/thread.lux | 3 +-
stdlib/source/lux/data/collection/array.lux | 15 +-
stdlib/source/lux/data/text/encoding.lux | 16 +-
stdlib/source/lux/debug.lux | 41 ++-
stdlib/source/lux/host.php.lux | 307 +++++++++++++++++++++
stdlib/source/lux/math.lux | 32 +++
stdlib/source/lux/math/random.lux | 4 +-
stdlib/source/lux/target/php.lux | 52 +++-
.../language/lux/phase/extension/analysis/php.lux | 168 +++++++++++
.../lux/phase/extension/generation/php/common.lux | 103 +++----
.../lux/phase/extension/generation/php/host.lux | 256 +++++++----------
.../compiler/language/lux/phase/generation/php.lux | 86 ++++--
.../language/lux/phase/generation/php/case.lux | 88 +++---
.../language/lux/phase/generation/php/function.lux | 32 ++-
.../language/lux/phase/generation/php/loop.lux | 92 +++---
.../language/lux/phase/generation/php/runtime.lux | 121 +++++---
.../lux/phase/generation/php/structure.lux | 13 +-
.../language/lux/phase/generation/ruby/case.lux | 12 +-
stdlib/source/lux/type.lux | 4 +-
stdlib/source/lux/type/check.lux | 4 +-
stdlib/source/lux/world/file.lux | 220 ++++++++++++++-
stdlib/source/lux/world/program.lux | 42 ++-
stdlib/source/test/lux.lux | 3 +-
stdlib/source/test/lux/control/remember.lux | 2 +-
stdlib/source/test/lux/extension.lux | 6 +-
stdlib/source/test/lux/host.php.lux | 24 ++
29 files changed, 1379 insertions(+), 479 deletions(-)
create mode 100644 stdlib/source/lux/host.php.lux
create mode 100644 stdlib/source/test/lux/host.php.lux
diff --git a/compilers.md b/compilers.md
index d757f123b..ae558bbea 100644
--- a/compilers.md
+++ b/compilers.md
@@ -11,9 +11,17 @@ cd ~/lux/lux-php/ && lein clean && lein lux auto test
```
## Develop
+## NOTE: Must set lux/control/concurrency/thread.parallelism = 1 before compiling to make sure JPHP doesn't cause trouble.
cd ~/lux/lux-php/ \
&& lein clean \
&& lein lux auto build
+
+## Build JVM-based compiler
+## NOTE: Must set lux/control/concurrency/thread.parallelism = 1 before compiling to make sure JPHP doesn't cause trouble.
+cd ~/lux/lux-php/ \
+&& lein clean \
+&& lein lux build \
+&& mv target/program.jar jvm_based_compiler.jar
```
## Try
diff --git a/lux-php/source/program.lux b/lux-php/source/program.lux
index 29fadec16..14a1646a0 100644
--- a/lux-php/source/program.lux
+++ b/lux-php/source/program.lux
@@ -222,12 +222,8 @@
(php/runtime/memory/StringMemory::new ""))
(def: (lux_structure value)
- (-> (Array java/lang/Object)
- ## php/runtime/memory/ArrayMemory
- php/runtime/Memory
- )
+ (-> (Array java/lang/Object) php/runtime/Memory)
(`` (host.object [] php/runtime/Memory
- ## php/runtime/memory/ArrayMemory
[program/StructureValue]
[{php/runtime/Memory$Type php/runtime/Memory$Type::ARRAY}]
## Methods
@@ -240,54 +236,6 @@
java/lang/String
(debug.inspect value))
- ## (php/runtime/memory/ArrayMemory
- ## [] (get self {key php/runtime/Memory})
- ## php/runtime/Memory
- ## (exec
- ## (debug.log! (format "{lux_structure#get}" text.new_line
- ## (exception.construct ..unknown_kind_of_object key)))
- ## (error! "OOPS!")))
-
- ## (php/runtime/memory/ArrayMemory
- ## [] (getOrCreate self {key php/runtime/Memory})
- ## php/runtime/memory/ReferenceMemory
- ## (exec
- ## (debug.log! (format "{lux_structure#getOrCreate}" text.new_line
- ## (exception.construct ..unknown_kind_of_object key)))
- ## (error! "OOPS!")))
-
- ## (php/runtime/memory/ArrayMemory
- ## [] (getOrCreateAsShortcut self {key php/runtime/Memory})
- ## php/runtime/memory/ReferenceMemory
- ## (exec
- ## (debug.log! (format "{lux_structure#getOrCreateAsShortcut}" text.new_line
- ## (exception.construct ..unknown_kind_of_object key)))
- ## (error! "OOPS!")))
-
- ## (php/runtime/memory/ArrayMemory
- ## [] (getByScalarOrCreateAsShortcut self {key java/lang/Object})
- ## php/runtime/memory/ReferenceMemory
- ## (exec
- ## (debug.log! (format "{lux_structure#getByScalarOrCreateAsShortcut}" text.new_line
- ## (exception.construct ..unknown_kind_of_object key)))
- ## (error! "OOPS!")))
-
- ## (php/runtime/memory/ArrayMemory
- ## [] (getByScalarOrCreate self {key java/lang/Object})
- ## php/runtime/memory/ReferenceMemory
- ## (exec
- ## (debug.log! (format "{lux_structure#getByScalarOrCreate}" text.new_line
- ## (exception.construct ..unknown_kind_of_object key)))
- ## (error! "OOPS!")))
-
- ## (php/runtime/memory/ArrayMemory
- ## [] (getByScalar self {key java/lang/Object})
- ## php/runtime/memory/ReferenceMemory
- ## (exec
- ## (debug.log! (format "{lux_structure#getByScalar}" text.new_line
- ## (exception.construct ..unknown_kind_of_object key)))
- ## (error! "OOPS!")))
-
(php/runtime/Memory
[] (valueOfIndex self
{trace php/runtime/env/TraceInfo}
@@ -312,16 +260,6 @@
))
(undefined))))
- ## (php/runtime/Memory
- ## [] (valueOfIndexAsShortcut self
- ## {trace php/runtime/env/TraceInfo}
- ## {index php/runtime/Memory})
- ## php/runtime/Memory
- ## (exec
- ## (debug.log! (format "{lux_structure#valueOfIndexAsShortcut}" text.new_line
- ## (exception.construct ..unknown_kind_of_object index)))
- ## (error! "OOPS!")))
-
(php/runtime/Memory
[] (valueOfIndex self
{trace php/runtime/env/TraceInfo}
@@ -488,14 +426,6 @@
(new [])])
(def: (ensure_macro macro)
- ## (-> Macro (Maybe php/runtime/lang/Closure))
- ## (do maybe.monad
- ## [object_memory (|> macro
- ## (:coerce java/lang/Object)
- ## (host.check php/runtime/memory/ObjectMemory))]
- ## (|> object_memory
- ## php/runtime/memory/ObjectMemory::value
- ## (host.check php/runtime/lang/Closure)))
(-> Macro (Maybe php/runtime/memory/ObjectMemory))
(|> macro
(:coerce java/lang/Object)
@@ -540,32 +470,20 @@
(io (let [run! (: (-> (_.Code Any) (Try Any))
(function (recur code)
(do try.monad
- [output (case (javax/script/ScriptEngine::eval (format "<?php " (_.code code)) ..interpreter)
- (#try.Success output)
- (#try.Success output)
-
- (#try.Failure error)
- (exec
- ("lux io log" "(#try.Failure error)")
- ("lux io log" (_.code code))
- (#try.Failure error)))]
+ [output (javax/script/ScriptEngine::eval (format "<?php " (_.code code)) ..interpreter)]
(..read output))))]
(: (Host _.Expression _.Statement)
(structure
(def: (evaluate! context code)
(run! (_.return code)))
- (def: (execute! code)
- (exec
- ("lux io log" (_.code code))
- (run! code)))
+ (def: execute! run!)
(def: (define! context input)
(let [global (reference.artifact context)
@global (_.global global)]
(do try.monad
- [#let [definition (_.; (_.set @global input))
- _ ("lux io log" (_.code definition))]
+ [#let [definition (_.; (_.set @global input))]
_ (run! definition)
value (run! (_.return @global))]
(wrap [global value definition]))))
@@ -582,7 +500,7 @@
(run! (_.return (_.var (reference.artifact context)))))))))))
(def: platform
- (IO (Platform _.Location _.Expression _.Statement))
+ (IO (Platform [Nat _.Label] _.Expression _.Statement))
(do io.monad
[host ..host]
(wrap {#platform.&file_system (file.async file.default)
@@ -660,7 +578,7 @@
generation.bundle
extension/bundle.empty
..program
- [_.Location _.Expression _.Statement]
+ [(& Nat _.Label) _.Expression _.Statement]
..extender
service
[(packager.package (_.manual "")
diff --git a/stdlib/source/lux/control/concurrency/atom.lux b/stdlib/source/lux/control/concurrency/atom.lux
index 350554437..8a46413da 100644
--- a/stdlib/source/lux/control/concurrency/atom.lux
+++ b/stdlib/source/lux/control/concurrency/atom.lux
@@ -26,17 +26,21 @@
(with_expansions [<new> (for {@.js "js array new"
@.python "python array new"
@.lua "lua array new"
- @.ruby "ruby array new"}
+ @.ruby "ruby array new"
+ @.php "php array new"}
(as_is))
<write> (for {@.js "js array write"
@.python "python array write"
@.lua "lua array write"
- @.ruby "ruby array write"}
+ @.ruby "ruby array write"
+ @.php "php array write"}
(as_is))
+
<read> (for {@.js "js array read"
@.python "python array read"
@.lua "lua array read"
- @.ruby "ruby array read"}
+ @.ruby "ruby array read"
+ @.php "php array read"}
(as_is))]
(abstract: #export (Atom a)
(with_expansions [<jvm> (java/util/concurrent/atomic/AtomicReference a)]
diff --git a/stdlib/source/lux/control/thread.lux b/stdlib/source/lux/control/thread.lux
index 6be40ef63..52c0062eb 100644
--- a/stdlib/source/lux/control/thread.lux
+++ b/stdlib/source/lux/control/thread.lux
@@ -45,7 +45,8 @@
@.js ("js array read" 0 (:representation box))
@.python ("python array read" 0 (:representation box))
@.lua ("lua array read" 0 (:representation box))
- @.ruby ("ruby array read" 0 (:representation box))})))
+ @.ruby ("ruby array read" 0 (:representation box))
+ @.php ("php array read" 0 (:representation box))})))
(def: #export (write value box)
(All [a] (-> a (All [!] (-> (Box ! a) (Thread ! Any)))))
diff --git a/stdlib/source/lux/data/collection/array.lux b/stdlib/source/lux/data/collection/array.lux
index b9162e53a..73c6767e4 100644
--- a/stdlib/source/lux/data/collection/array.lux
+++ b/stdlib/source/lux/data/collection/array.lux
@@ -48,7 +48,8 @@
@.js ("js array new" size)
@.python ("python array new" size)
@.lua ("lua array new" size)
- @.ruby ("ruby array new" size)}))
+ @.ruby ("ruby array new" size)
+ @.php ("php array new" size)}))
(def: #export (size array)
(All [a] (-> (Array a) Nat))
@@ -67,7 +68,8 @@
@.js ("js array length" array)
@.python ("python array length" array)
@.lua ("lua array length" array)
- @.ruby ("ruby array length" array)}))
+ @.ruby ("ruby array length" array)
+ @.php ("php array length" array)}))
(template: (!read <read> <null?>)
(let [output (<read> index array)]
@@ -96,7 +98,8 @@
@.js (!read "js array read" "js object undefined?")
@.python (!read "python array read" "python object none?")
@.lua (!read "lua array read" "lua object nil?")
- @.ruby (!read "ruby array read" "ruby object nil?")})
+ @.ruby (!read "ruby array read" "ruby object nil?")
+ @.php (!read "php array read" "php object null?")})
#.None))
(def: #export (write! index value array)
@@ -114,7 +117,8 @@
@.js ("js array write" index value array)
@.python ("python array write" index value array)
@.lua ("lua array write" index value array)
- @.ruby ("ruby array write" index value array)}))
+ @.ruby ("ruby array write" index value array)
+ @.php ("php array write" index value array)}))
(def: #export (delete! index array)
(All [a]
@@ -129,7 +133,8 @@
@.js ("js array delete" index array)
@.python ("python array delete" index array)
@.lua ("lua array delete" index array)
- @.ruby ("ruby array delete" index array)})
+ @.ruby ("ruby array delete" index array)
+ @.php ("php array delete" index array)})
array))
)
diff --git a/stdlib/source/lux/data/text/encoding.lux b/stdlib/source/lux/data/text/encoding.lux
index 88bbea138..4622c8be9 100644
--- a/stdlib/source/lux/data/text/encoding.lux
+++ b/stdlib/source/lux/data/text/encoding.lux
@@ -201,7 +201,11 @@
(bytes [] Binary))
(host.import: Array #as RubyArray
- (pack [Text] RubyString)))}
+ (pack [Text] RubyString)))
+
+ @.php
+ (as_is (host.import: (unpack [host.String host.String] Binary))
+ (def: php_byte_array_format "C*"))}
(as_is)))
(def: (utf8\encode value)
@@ -242,7 +246,10 @@
(|> value
(:coerce RubyString)
(RubyString::encode ["UTF-8"])
- (RubyString::bytes []))}))
+ (RubyString::bytes []))
+
+ @.php
+ (..unpack [..php_byte_array_format value])}))
(def: (utf8\decode value)
(-> Binary (Try Text))
@@ -278,6 +285,11 @@
(RubyArray::pack ["C*"])
(:coerce RubyString)
(RubyString::force_encoding ["UTF-8"])
+ #try.Success)
+
+ @.php
+ (|> value
+ ("php pack" ..php_byte_array_format)
#try.Success)})))
(structure: #export utf8
diff --git a/stdlib/source/lux/debug.lux b/stdlib/source/lux/debug.lux
index 47d62fd34..29919a588 100644
--- a/stdlib/source/lux/debug.lux
+++ b/stdlib/source/lux/debug.lux
@@ -85,7 +85,12 @@
(as_is (import: Class)
(import: Object
- (type [] Class)))}))
+ (type [] Class)))
+
+ @.php
+ (as_is (import: (gettype [.Any] host.String))
+ (import: (strval [.Any] host.String)))
+ }))
(def: Inspector (-> Any Text))
@@ -195,7 +200,7 @@
(if (or ("python object none?" variant_tag)
("python object none?" variant_value))
(..str value)
- (|> (format (|> variant_tag (:coerce .Int) %.int)
+ (|> (format (|> variant_tag (:coerce .Nat) %.nat)
" " (|> variant_flag "python object none?" not %.bit)
" " (inspect variant_value))
(text.enclose ["(" ")"]))))
@@ -228,7 +233,7 @@
(if (not (or ("lua object nil?" variant_tag)
("lua object nil?" variant_flag)
("lua object nil?" variant_value)))
- (|> (format (|> variant_tag (:coerce .Int) %.int)
+ (|> (format (|> variant_tag (:coerce .Nat) %.nat)
" " (%.bit (not ("lua object nil?" variant_flag)))
" " (inspect variant_value))
(text.enclose ["(" ")"]))
@@ -260,7 +265,7 @@
(if (not (or ("ruby object nil?" variant_tag)
("ruby object nil?" variant_flag)
("ruby object nil?" variant_value)))
- (|> (format (|> variant_tag (:coerce .Int) %.int)
+ (|> (format (|> variant_tag (:coerce .Nat) %.nat)
" " (%.bit (not ("ruby object nil?" variant_flag)))
" " (inspect variant_value))
(text.enclose ["(" ")"]))
@@ -271,6 +276,34 @@
## else
(:coerce Text ("ruby object do" "to_s" value))))))
+
+ @.php
+ (case (..gettype value)
+ (^template [<type_of> <then>]
+ [<type_of>
+ (`` (|> value (~~ (template.splice <then>))))])
+ (["boolean" [(:coerce .Bit) %.bit]]
+ ["integer" [(:coerce .Int) %.int]]
+ ["double" [(:coerce .Frac) %.frac]]
+ ["string" [(:coerce .Text) %.text]]
+ ["NULL" [(new> "null" [])]]
+ ["array" [(inspect_tuple inspect)]])
+
+ "object"
+ (let [variant_tag ("php object get" "_lux_tag" value)
+ variant_flag ("php object get" "_lux_flag" value)
+ variant_value ("php object get" "_lux_value" value)]
+ (if (not (or ("php object null?" variant_tag)
+ ("php object null?" variant_flag)
+ ("php object null?" variant_value)))
+ (|> (format (|> variant_tag (:coerce .Nat) %.nat)
+ " " (%.bit (not ("php object null?" variant_flag)))
+ " " (inspect variant_value))
+ (text.enclose ["(" ")"]))
+ (..strval value)))
+
+ _
+ (..strval value))
})))
(exception: #export (cannot_represent_value {type Type})
diff --git a/stdlib/source/lux/host.php.lux b/stdlib/source/lux/host.php.lux
new file mode 100644
index 000000000..ac0daf9c5
--- /dev/null
+++ b/stdlib/source/lux/host.php.lux
@@ -0,0 +1,307 @@
+(.module:
+ [lux (#- Alias)
+ ["." meta]
+ ["@" target]
+ [abstract
+ [monad (#+ do)]]
+ [control
+ ["." io]
+ ["<>" parser ("#\." monad)
+ ["<.>" code (#+ Parser)]]]
+ [data
+ ["." product]
+ ["." maybe]
+ ["." text
+ ["%" format (#+ format)]]
+ [collection
+ ["." list ("#\." functor fold)]]]
+ [type
+ abstract]
+ [macro (#+ with_gensyms)
+ [syntax (#+ syntax:)]
+ ["." code]
+ ["." template]]])
+
+(abstract: #export (Object brand) Any)
+
+(template [<name>]
+ [(with_expansions [<brand> (template.identifier [<name> "'"])]
+ (abstract: #export <brand> Any)
+ (type: #export <name>
+ (..Object <brand>)))]
+
+ [Null]
+ [Function]
+ )
+
+(template [<name> <type>]
+ [(type: #export <name>
+ <type>)]
+
+ [Boolean Bit]
+ [Integer Int]
+ [Float Frac]
+ [String Text]
+ )
+
+(type: Nullable
+ [Bit Code])
+
+(def: nullable
+ (Parser Nullable)
+ (let [token (' #?)]
+ (<| (<>.and (<>.parses? (<code>.this! token)))
+ (<>.after (<>.not (<code>.this! token)))
+ <code>.any)))
+
+(type: Alias
+ Text)
+
+(def: alias
+ (Parser Alias)
+ (<>.after (<code>.this! (' #as)) <code>.local_identifier))
+
+(type: Field
+ [Bit Text (Maybe Alias) Nullable])
+
+(def: static!
+ (Parser Any)
+ (<code>.this! (' #static)))
+
+(def: field
+ (Parser Field)
+ (<code>.form ($_ <>.and
+ (<>.parses? ..static!)
+ <code>.local_identifier
+ (<>.maybe ..alias)
+ ..nullable)))
+
+(def: constant
+ (Parser Field)
+ (<code>.form ($_ <>.and
+ (<>\wrap true)
+ <code>.local_identifier
+ (<>.maybe ..alias)
+ ..nullable)))
+
+(type: Common_Method
+ {#name Text
+ #alias (Maybe Alias)
+ #inputs (List Nullable)
+ #io? Bit
+ #try? Bit
+ #output Nullable})
+
+(type: Static_Method Common_Method)
+(type: Virtual_Method Common_Method)
+
+(type: Method
+ (#Static Static_Method)
+ (#Virtual Virtual_Method))
+
+(def: common_method
+ (Parser Common_Method)
+ ($_ <>.and
+ <code>.local_identifier
+ (<>.maybe ..alias)
+ (<code>.tuple (<>.some ..nullable))
+ (<>.parses? (<code>.this! (' #io)))
+ (<>.parses? (<code>.this! (' #try)))
+ ..nullable))
+
+(def: static_method
+ (<>.after ..static! ..common_method))
+
+(def: method
+ (Parser Method)
+ (<code>.form (<>.or ..static_method
+ ..common_method)))
+
+(type: Member
+ (#Field Field)
+ (#Method Method))
+
+(def: member
+ (Parser Member)
+ ($_ <>.or
+ ..field
+ ..method
+ ))
+
+(def: input_variables
+ (-> (List Nullable) (List [Bit Code]))
+ (|>> list.enumeration
+ (list\map (function (_ [idx [nullable? type]])
+ [nullable? (|> idx %.nat code.local_identifier)]))))
+
+(def: (nullable_type [nullable? type])
+ (-> Nullable Code)
+ (if nullable?
+ (` (.Maybe (~ type)))
+ type))
+
+(def: (with_null g!temp [nullable? input])
+ (-> Code [Bit Code] Code)
+ (if nullable?
+ (` (case (~ input)
+ (#.Some (~ g!temp))
+ (~ g!temp)
+
+ #.Null
+ ("php object null")))
+ input))
+
+(def: (without_null g!temp [nullable? outputT] output)
+ (-> Code Nullable Code Code)
+ (if nullable?
+ (` (let [(~ g!temp) (~ output)]
+ (if ("php object null?" (~ g!temp))
+ #.None
+ (#.Some (~ g!temp)))))
+ (` (let [(~ g!temp) (~ output)]
+ (if (not ("php object null?" (~ g!temp)))
+ (~ g!temp)
+ (.error! "Null is an invalid value!"))))))
+
+(type: Import
+ (#Class Text (Maybe Alias) (List Member))
+ (#Function Static_Method)
+ (#Constant Field))
+
+(def: import
+ (Parser Import)
+ ($_ <>.or
+ ($_ <>.and
+ <code>.local_identifier
+ (<>.maybe ..alias)
+ (<>.some member))
+ (<code>.form ..common_method)
+ ..constant
+ ))
+
+(syntax: #export (try expression)
+ {#.doc (doc (case (try (risky_computation input))
+ (#.Right success)
+ (do_something success)
+
+ (#.Left error)
+ (recover_from_failure error)))}
+ (wrap (list (` ("lux try" ((~! io.io) (~ expression)))))))
+
+(def: (with_io with? without)
+ (-> Bit Code Code)
+ (if with?
+ (` (io.io (~ without)))
+ without))
+
+(def: (io_type io? rawT)
+ (-> Bit Code Code)
+ (if io?
+ (` (io.IO (~ rawT)))
+ rawT))
+
+(def: (with_try with? without_try)
+ (-> Bit Code Code)
+ (if with?
+ (` (..try (~ without_try)))
+ without_try))
+
+(def: (try_type try? rawT)
+ (-> Bit Code Code)
+ (if try?
+ (` (.Either .Text (~ rawT)))
+ rawT))
+
+(def: (make_function g!method g!temp source inputsT io? try? outputT)
+ (-> Code Code Code (List Nullable) Bit Bit Nullable Code)
+ (let [g!inputs (input_variables inputsT)]
+ (` (def: ((~ g!method)
+ [(~+ (list\map product.right g!inputs))])
+ (-> [(~+ (list\map nullable_type inputsT))]
+ (~ (|> (nullable_type outputT)
+ (try_type try?)
+ (io_type io?))))
+ (:assume
+ (~ (<| (with_io io?)
+ (with_try try?)
+ (without_null g!temp outputT)
+ (` ("php apply"
+ (:coerce ..Function (~ source))
+ (~+ (list\map (with_null g!temp) g!inputs)))))))))))
+
+(syntax: #export (import: {import ..import})
+ (with_gensyms [g!temp]
+ (case import
+ (#Class [class alias members])
+ (with_gensyms [g!object]
+ (let [qualify (: (-> Text Code)
+ (|>> (format (maybe.default class alias) "::") code.local_identifier))
+ g!type (code.local_identifier (maybe.default class alias))
+ class_import (` ("php constant" (~ (code.text class))))]
+ (wrap (list& (` (type: (~ g!type)
+ (..Object (primitive (~ (code.text class))))))
+ (list\map (function (_ member)
+ (case member
+ (#Field [static? field alias fieldT])
+ (if static?
+ (` ((~! syntax:) ((~ (qualify (maybe.default field alias))))
+ (\ (~! meta.monad) (~' wrap)
+ (list (` (.:coerce (~ (nullable_type fieldT))
+ ("php constant" (~ (code.text (format class "::" field))))))))))
+ (` (def: ((~ (qualify field))
+ (~ g!object))
+ (-> (~ g!type)
+ (~ (nullable_type fieldT)))
+ (:assume
+ (~ (without_null g!temp fieldT (` ("php object get" (~ (code.text field))
+ (:coerce (..Object .Any) (~ g!object))))))))))
+
+ (#Method method)
+ (case method
+ (#Static [method alias inputsT io? try? outputT])
+ (..make_function (qualify (maybe.default method alias))
+ g!temp
+ (` ("php object get" (~ (code.text method))
+ (:coerce (..Object .Any)
+ ("php constant" (~ (code.text (format class "::" method)))))))
+ inputsT
+ io?
+ try?
+ outputT)
+
+ (#Virtual [method alias inputsT io? try? outputT])
+ (let [g!inputs (input_variables inputsT)]
+ (` (def: ((~ (qualify (maybe.default method alias)))
+ [(~+ (list\map product.right g!inputs))]
+ (~ g!object))
+ (-> [(~+ (list\map nullable_type inputsT))]
+ (~ g!type)
+ (~ (|> (nullable_type outputT)
+ (try_type try?)
+ (io_type io?))))
+ (:assume
+ (~ (<| (with_io io?)
+ (with_try try?)
+ (without_null g!temp outputT)
+ (` ("php object do"
+ (~ (code.text method))
+ (~ g!object)
+ (~+ (list\map (with_null g!temp) g!inputs)))))))))))))
+ members)))))
+
+ (#Function [name alias inputsT io? try? outputT])
+ (let [imported (` ("php constant" (~ (code.text name))))]
+ (wrap (list (..make_function (code.local_identifier (maybe.default name alias))
+ g!temp
+ imported
+ inputsT
+ io?
+ try?
+ outputT))))
+
+ (#Constant [_ name alias fieldT])
+ (let [imported (` ("php constant" (~ (code.text name))))]
+ (wrap (list (` ((~! syntax:) ((~ (code.local_identifier (maybe.default name alias))))
+ (\ (~! meta.monad) (~' wrap)
+ (list (` (.:coerce (~ (nullable_type fieldT)) (~ imported))))))))))
+ )))
diff --git a/stdlib/source/lux/math.lux b/stdlib/source/lux/math.lux
index 7193b417f..420e0bc83 100644
--- a/stdlib/source/lux/math.lux
+++ b/stdlib/source/lux/math.lux
@@ -213,6 +213,38 @@
(def: #export (pow param subject)
(-> Frac Frac Frac)
(:coerce Frac ("ruby object do" "**" subject param))))
+
+ @.php
+ (as_is (template [<name> <method>]
+ [(def: #export <name>
+ (-> Frac Frac)
+ (|>> ("php apply" ("php constant" <method>))
+ (:coerce Frac)))]
+
+ [cos "cos"]
+ [sin "sin"]
+ [tan "tan"]
+
+ [acos "acos"]
+ [asin "asin"]
+ [atan "atan"]
+
+ [exp "exp"]
+ [log "log"]
+
+ [ceil "ceil"]
+ [floor "floor"]
+
+ [root/2 "sqrt"]
+ )
+
+ (def: #export (pow param subject)
+ (-> Frac Frac Frac)
+ (:coerce Frac ("php apply" ("php constant" "pow") subject param)))
+
+ (def: #export root/3
+ (-> Frac Frac)
+ (..pow ("lux f64 /" +3.0 +1.0))))
})
(def: #export (round input)
diff --git a/stdlib/source/lux/math/random.lux b/stdlib/source/lux/math/random.lux
index 68c33e91c..39fab5a29 100644
--- a/stdlib/source/lux/math/random.lux
+++ b/stdlib/source/lux/math/random.lux
@@ -4,10 +4,8 @@
[hash (#+ Hash)]
[functor (#+ Functor)]
[apply (#+ Apply)]
- ["." monad (#+ do Monad)]]
+ ["." monad (#+ Monad do)]]
[data
- ["." product]
- ["." maybe]
["." text (#+ Char) ("#\." monoid)
["." unicode #_
["#" set]]]
diff --git a/stdlib/source/lux/target/php.lux b/stdlib/source/lux/target/php.lux
index 1b1b91e88..b1eb0b553 100644
--- a/stdlib/source/lux/target/php.lux
+++ b/stdlib/source/lux/target/php.lux
@@ -97,6 +97,7 @@
[Access [Location' Computation' Expression' Code]]
[Constant [Location' Computation' Expression' Code]]
[Global [Location' Computation' Expression' Code]]
+ [Label [Code]]
)
(type: #export Argument
@@ -113,9 +114,23 @@
(-> Text Var)
(|>> (format "$") :abstraction))
- (def: #export constant
- (-> Text Constant)
- (|>> :abstraction))
+ (template [<name> <type>]
+ [(def: #export <name>
+ (-> Text <type>)
+ (|>> :abstraction))]
+
+ [constant Constant]
+ [label Label]
+ )
+
+ (def: #export (set_label label)
+ (-> Label Statement)
+ (:abstraction (format (:representation label) ":")))
+
+ (def: #export (go_to label)
+ (-> Label Statement)
+ (:abstraction
+ (format "goto " (:representation label) ..statement_suffix)))
(def: #export null
Literal
@@ -129,7 +144,11 @@
(def: #export int
(-> Int Literal)
- (|>> %.int :abstraction))
+ (.let [to_hex (\ n.hex encode)]
+ (|>> .nat
+ to_hex
+ (format "0x")
+ :abstraction)))
(def: #export float
(-> Frac Literal)
@@ -160,6 +179,7 @@
[text.new_line "\n"]
[text.carriage_return "\r"]
[text.double_quote (format "\" text.double_quote)]
+ ["$" "\$"]
))
)))
@@ -247,7 +267,8 @@
["phpversion"]]]
[1
- [["is_null"]
+ [["var_dump"]
+ ["is_null"]
["empty"]
["count"]
["array_pop"]
@@ -262,7 +283,8 @@
["iconv_strlen"] ["strlen"]]]
[2
- [["call_user_func_array"]
+ [["intdiv"]
+ ["call_user_func_array"]
["array_slice"]
["array_push"]
["pack"]
@@ -270,7 +292,8 @@
["iconv_strpos"] ["strpos"]]]
[3
- [["array_slice"]
+ [["array_fill"]
+ ["array_slice"]
["array_splice"]
["iconv"]
["iconv_strpos"] ["strpos"]
@@ -309,9 +332,15 @@
(|> (format "new " (:representation constructor) (arguments inputs))
:abstraction))
+ (def: #export (the field object)
+ (-> Text Expression Computation)
+ (|> (format (:representation object) "->" field)
+ :abstraction))
+
(def: #export (do method inputs object)
(-> Text (List Expression) Expression Computation)
- (|> (format (:representation object) "->" method (arguments inputs))
+ (|> (format (:representation (..the method object))
+ (..arguments inputs))
:abstraction))
(def: #export (nth idx array)
@@ -340,7 +369,8 @@
[or "||"]
[and "&&"]
- [= "==="]
+ [== "=="]
+ [=== "==="]
[< "<"]
[<= "<="]
[> ">"]
@@ -487,6 +517,10 @@
[break "break"]
[continue "continue"]
)
+
+ (def: #export splat
+ (-> Expression Expression)
+ (|>> :representation (format "...") :abstraction))
)
(def: #export (cond clauses else!)
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
index 466c8daea..70437ea89 100644
--- 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
@@ -27,8 +27,176 @@
[///
["." phase]]]]]])
+(def: array::new
+ Handler
+ (custom
+ [<c>.any
+ (function (_ extension phase archive lengthC)
+ (do phase.monad
+ [lengthA (analysis/type.with_type Nat
+ (phase archive lengthC))
+ [var_id varT] (analysis/type.with_env check.var)
+ _ (analysis/type.infer (type (Array varT)))]
+ (wrap (#analysis.Extension extension (list lengthA)))))]))
+
+(def: array::length
+ Handler
+ (custom
+ [<c>.any
+ (function (_ extension phase archive arrayC)
+ (do phase.monad
+ [[var_id varT] (analysis/type.with_env check.var)
+ arrayA (analysis/type.with_type (type (Array varT))
+ (phase archive arrayC))
+ _ (analysis/type.infer Nat)]
+ (wrap (#analysis.Extension extension (list arrayA)))))]))
+
+(def: array::read
+ Handler
+ (custom
+ [(<>.and <c>.any <c>.any)
+ (function (_ extension phase archive [indexC arrayC])
+ (do phase.monad
+ [indexA (analysis/type.with_type Nat
+ (phase archive indexC))
+ [var_id varT] (analysis/type.with_env check.var)
+ arrayA (analysis/type.with_type (type (Array varT))
+ (phase archive arrayC))
+ _ (analysis/type.infer varT)]
+ (wrap (#analysis.Extension extension (list indexA arrayA)))))]))
+
+(def: array::write
+ Handler
+ (custom
+ [($_ <>.and <c>.any <c>.any <c>.any)
+ (function (_ extension phase archive [indexC valueC arrayC])
+ (do phase.monad
+ [indexA (analysis/type.with_type Nat
+ (phase archive indexC))
+ [var_id varT] (analysis/type.with_env check.var)
+ valueA (analysis/type.with_type varT
+ (phase archive valueC))
+ arrayA (analysis/type.with_type (type (Array varT))
+ (phase archive arrayC))
+ _ (analysis/type.infer (type (Array varT)))]
+ (wrap (#analysis.Extension extension (list indexA valueA arrayA)))))]))
+
+(def: array::delete
+ Handler
+ (custom
+ [($_ <>.and <c>.any <c>.any)
+ (function (_ extension phase archive [indexC arrayC])
+ (do phase.monad
+ [indexA (analysis/type.with_type Nat
+ (phase archive indexC))
+ [var_id varT] (analysis/type.with_env check.var)
+ arrayA (analysis/type.with_type (type (Array varT))
+ (phase archive arrayC))
+ _ (analysis/type.infer (type (Array varT)))]
+ (wrap (#analysis.Extension extension (list indexA arrayA)))))]))
+
+(def: bundle::array
+ Bundle
+ (<| (bundle.prefix "array")
+ (|> bundle.empty
+ (bundle.install "new" array::new)
+ (bundle.install "length" array::length)
+ (bundle.install "read" array::read)
+ (bundle.install "write" array::write)
+ (bundle.install "delete" array::delete)
+ )))
+
+(def: Null
+ (for {@.php host.Null}
+ Any))
+
+(def: Object
+ (for {@.php (type (host.Object Any))}
+ Any))
+
+(def: Function
+ (for {@.php host.Function}
+ Any))
+
+(def: object::get
+ Handler
+ (custom
+ [($_ <>.and <c>.text <c>.any)
+ (function (_ extension phase archive [fieldC objectC])
+ (do phase.monad
+ [objectA (analysis/type.with_type ..Object
+ (phase archive objectC))
+ _ (analysis/type.infer .Any)]
+ (wrap (#analysis.Extension extension (list (analysis.text fieldC)
+ objectA)))))]))
+
+(def: object::do
+ Handler
+ (custom
+ [($_ <>.and <c>.text <c>.any (<>.some <c>.any))
+ (function (_ extension phase archive [methodC objectC inputsC])
+ (do {! phase.monad}
+ [objectA (analysis/type.with_type ..Object
+ (phase archive objectC))
+ inputsA (monad.map ! (|>> (phase archive) (analysis/type.with_type Any)) inputsC)
+ _ (analysis/type.infer .Any)]
+ (wrap (#analysis.Extension extension (list& (analysis.text methodC)
+ objectA
+ inputsA)))))]))
+
+(def: bundle::object
+ Bundle
+ (<| (bundle.prefix "object")
+ (|> bundle.empty
+ (bundle.install "get" object::get)
+ (bundle.install "do" object::do)
+ (bundle.install "null" (/.nullary ..Null))
+ (bundle.install "null?" (/.unary Any Bit))
+ )))
+
+(def: php::constant
+ Handler
+ (custom
+ [<c>.text
+ (function (_ extension phase archive name)
+ (do phase.monad
+ [_ (analysis/type.infer Any)]
+ (wrap (#analysis.Extension extension (list (analysis.text name))))))]))
+
+(def: php::apply
+ Handler
+ (custom
+ [($_ <>.and <c>.any (<>.some <c>.any))
+ (function (_ extension phase archive [abstractionC inputsC])
+ (do {! phase.monad}
+ [abstractionA (analysis/type.with_type ..Function
+ (phase archive abstractionC))
+ inputsA (monad.map ! (|>> (phase archive) (analysis/type.with_type Any)) inputsC)
+ _ (analysis/type.infer Any)]
+ (wrap (#analysis.Extension extension (list& abstractionA inputsA)))))]))
+
+(def: php::pack
+ Handler
+ (custom
+ [($_ <>.and <c>.any <c>.any)
+ (function (_ extension phase archive [formatC dataC])
+ (do {! phase.monad}
+ [formatA (analysis/type.with_type Text
+ (phase archive formatC))
+ dataA (analysis/type.with_type (type (Array (I64 Any)))
+ (phase archive dataC))
+ _ (analysis/type.infer Text)]
+ (wrap (#analysis.Extension extension (list formatA dataA)))))]))
+
(def: #export bundle
Bundle
(<| (bundle.prefix "php")
(|> bundle.empty
+ (dictionary.merge bundle::array)
+ (dictionary.merge bundle::object)
+
+ (bundle.install "constant" php::constant)
+ (bundle.install "apply" php::apply)
+ (bundle.install "pack" php::pack)
+ (bundle.install "script universe" (/.nullary .Bit))
)))
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
index 572f1f2a8..7dbc8bacc 100644
--- 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
@@ -13,6 +13,7 @@
["%" format (#+ format)]]
[collection
["." dictionary]
+ ["." set]
["." list ("#\." functor fold)]]]
[math
[number
@@ -26,10 +27,12 @@
[generation
[extension (#+ Nullary Unary Binary Trinary
nullary unary binary trinary)]
+ ["." reference]
["//" php #_
- ["#." runtime (#+ Operation Phase Handler Bundle Generator)]]]
+ ["#." runtime (#+ Operation Phase Handler Bundle Generator)]
+ ["#." case]]]
[//
- [synthesis (#+ %synthesis)]
+ ["." synthesis (#+ %synthesis)]
["." generation]
[///
["#" phase]]]]])
@@ -50,45 +53,55 @@
(template: (!unary function)
(|>> list _.apply/* (|> (_.constant 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))))]))
+## 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)
+ [[context_module context_artifact] elseG] (generation.with_new_context archive
+ (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? _.null total)
+ clause
+ (_.or clause total)))
+ _.null))
+ branchG])))
+ conditionals))
+ #let [foreigns (|> conditionals
+ (list\map (|>> product.right synthesis.path/then //case.dependencies))
+ (list& (//case.dependencies (synthesis.path/then else)))
+ list.concat
+ (set.from_list _.hash)
+ set.to_list)
+ @expression (_.constant (reference.artifact [context_module context_artifact]))
+ directive (_.define_function @expression (list& (_.parameter @input) (list\map _.reference foreigns))
+ (list\fold (function (_ [test then] else)
+ (_.if test (_.return then) else))
+ (_.return elseG)
+ conditionalsG))]
+ _ (generation.execute! directive)
+ _ (generation.save! (%.nat context_artifact) directive)]
+ (wrap (_.apply/* (list& inputG foreigns) @expression))))]))
(def: lux_procs
Bundle
(|> /.empty
- ## (/.install "syntax char case!" lux::syntax_char_case!)
- (/.install "is" (binary (product.uncurry _.=)))
- ## (/.install "try" (unary //runtime.lux//try))
+ (/.install "syntax char case!" lux::syntax_char_case!)
+ (/.install "is" (binary (product.uncurry _.===)))
+ (/.install "try" (unary //runtime.lux//try))
))
(def: i64_procs
@@ -100,12 +113,13 @@
(/.install "xor" (binary (product.uncurry _.bit_xor)))
(/.install "left-shift" (binary (product.uncurry _.bit_shl)))
(/.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 _.*)))
- (/.install "/" (binary (product.uncurry _./)))
+ (/.install "/" (binary (function (_ [parameter subject])
+ (_.intdiv/2 [subject parameter]))))
(/.install "%" (binary (product.uncurry _.%)))
(/.install "f64" (unary (_./ (_.float +1.0))))
(/.install "char" (unary //runtime.i64//char))
@@ -124,7 +138,7 @@
(/.install "*" (binary (product.uncurry _.*)))
(/.install "/" (binary (product.uncurry _./)))
(/.install "%" (binary ..f64//%))
- (/.install "=" (binary (product.uncurry _.=)))
+ (/.install "=" (binary (product.uncurry _.==)))
(/.install "<" (binary (product.uncurry _.<)))
(/.install "i64" (unary _.intval/1))
(/.install "encode" (unary _.strval/1))
@@ -142,7 +156,7 @@
Bundle
(<| (/.prefix "text")
(|> /.empty
- (/.install "=" (binary (product.uncurry _.=)))
+ (/.install "=" (binary (product.uncurry _.==)))
(/.install "<" (binary (product.uncurry _.<)))
(/.install "concat" (binary (product.uncurry (function.flip _.concat))))
(/.install "index" (trinary ..text//index))
@@ -151,11 +165,6 @@
(/.install "clip" (trinary ..text//clip))
)))
-(def: io//log!
- (Unary Expression)
- (|>> _.print/1
- (_.or //runtime.unit)))
-
(def: io//current-time
(Nullary Expression)
(|>> _.time/0
@@ -165,7 +174,7 @@
Bundle
(<| (/.prefix "io")
(|> /.empty
- (/.install "log" (unary ..io//log!))
+ (/.install "log" (unary //runtime.io//log!))
(/.install "error" (unary //runtime.io//throw!))
(/.install "current-time" (nullary ..io//current-time)))))
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
index fef37539e..f523f1647 100644
--- 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
@@ -32,168 +32,106 @@
["//#" /// #_
["#." 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: (array::new size)
+ (Unary Expression)
+ (//runtime.tuple//make size (_.array_fill/3 [(_.int +0) size _.null])))
+
+(def: array::length
+ (Unary Expression)
+ //runtime.array//length)
+
+(def: (array::read [indexG arrayG])
+ (Binary Expression)
+ (_.nth 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 _.null 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::null object::null? _.null]
+ )
+
+(def: object
+ Bundle
+ (<| (/.prefix "object")
+ (|> /.empty
+ (/.install "get" object::get)
+ (/.install "do" object::do)
+ (/.install "null" (nullary object::null))
+ (/.install "null?" (unary object::null?))
+ )))
+
+(def: php::constant
+ (custom
+ [<s>.text
+ (function (_ extension phase archive name)
+ (\ ////////phase.monad wrap (_.constant name)))]))
+
+(def: php::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: php::pack
+ (custom
+ [($_ <>.and <s>.any <s>.any)
+ (function (_ extension phase archive [formatS dataS])
+ (do {! ////////phase.monad}
+ [formatG (phase archive formatS)
+ dataG (phase archive dataS)]
+ (wrap (_.pack/2 [formatG (_.splat dataG)]))))]))
(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))))
+ (dictionary.merge ..array)
+ (dictionary.merge ..object)
+
+ (/.install "constant" php::constant)
+ (/.install "apply" php::apply)
+ (/.install "pack" php::pack)
+ (/.install "script universe" (nullary (function.constant (_.bool reference.universe))))
)))
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 c310de4a9..654c07bdf 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
@@ -20,39 +20,83 @@
["#." extension]
["/#" // #_
[analysis (#+)]
- ["." synthesis]
+ ["#." synthesis]
["//#" /// #_
["#." phase ("#\." monad)]
[reference (#+)
[variable (#+)]]]]]]])
-(def: #export (generate archive synthesis)
+(def: (statement expression archive synthesis)
+ Phase!
+ (case synthesis
+ (^template [<tag>]
+ [(^ (<tag> value))
+ (//////phase\map _.return (expression archive synthesis))])
+ ([////synthesis.bit]
+ [////synthesis.i64]
+ [////synthesis.f64]
+ [////synthesis.text]
+ [////synthesis.variant]
+ [////synthesis.tuple]
+ [#////synthesis.Reference]
+ [////synthesis.branch/get]
+ [////synthesis.function/apply]
+ [#////synthesis.Extension])
+
+ (^ (////synthesis.branch/case case))
+ (/case.case! statement expression archive case)
+
+ (^template [<tag> <generator>]
+ [(^ (<tag> value))
+ (<generator> statement expression archive value)])
+ ([////synthesis.branch/let /case.let!]
+ [////synthesis.branch/if /case.if!]
+ [////synthesis.loop/scope /loop.scope!]
+ [////synthesis.loop/recur /loop.recur!])
+
+ (^ (////synthesis.function/abstraction abstraction))
+ (//////phase\map _.return (/function.function statement expression archive abstraction))
+ ))
+
+(exception: #export cannot-recur-as-an-expression)
+
+(def: #export (expression archive synthesis)
Phase
(case synthesis
(^template [<tag> <generator>]
[(^ (<tag> value))
(//////phase\wrap (<generator> value))])
- ([synthesis.bit /primitive.bit]
- [synthesis.i64 /primitive.i64]
- [synthesis.f64 /primitive.f64]
- [synthesis.text /primitive.text])
+ ([////synthesis.bit /primitive.bit]
+ [////synthesis.i64 /primitive.i64]
+ [////synthesis.f64 /primitive.f64]
+ [////synthesis.text /primitive.text])
- (#synthesis.Reference value)
+ (#////synthesis.Reference value)
(//reference.reference /reference.system archive value)
(^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 archive generate extension)))
+ (<generator> expression archive value)])
+ ([////synthesis.variant /structure.variant]
+ [////synthesis.tuple /structure.tuple]
+ [////synthesis.branch/let /case.let]
+ [////synthesis.branch/if /case.if]
+ [////synthesis.branch/get /case.get]
+ [////synthesis.function/apply /function.apply])
+
+ (^template [<tag> <generator>]
+ [(^ (<tag> value))
+ (<generator> statement expression archive value)])
+ ([////synthesis.branch/case /case.case]
+ [////synthesis.loop/scope /loop.scope]
+ [////synthesis.function/abstraction /function.function])
+
+ (^ (////synthesis.loop/recur _))
+ (//////phase.throw ..cannot-recur-as-an-expression [])
+
+ (#////synthesis.Extension extension)
+ (///extension.apply archive expression extension)))
+
+(def: #export generate
+ Phase
+ ..expression)
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 b04d8e766..419c0ed2f 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
@@ -41,20 +41,47 @@
(-> Register Var)
(|>> (///reference.foreign //reference.system) :assume))
-(def: #export (let generate archive [valueS register bodyS])
+(def: #export (let expression archive [valueS register bodyS])
(Generator [Synthesis Register Synthesis])
(do ///////phase.monad
- [valueG (generate archive valueS)
- bodyG (generate archive bodyS)]
+ [valueG (expression archive valueS)
+ bodyG (expression archive bodyS)]
(wrap (|> bodyG
(list (_.set (..register register) valueG))
_.array/*
(_.nth (_.int +1))))))
-(def: #export (get generate archive [pathP valueS])
+(def: #export (let! statement expression archive [valueS register bodyS])
+ (Generator! [Synthesis Register Synthesis])
+ (do ///////phase.monad
+ [valueO (expression archive valueS)
+ body! (statement expression archive bodyS)]
+ (wrap ($_ _.then
+ (_.; (_.set (..register register) valueO))
+ body!))))
+
+(def: #export (if expression archive [testS thenS elseS])
+ (Generator [Synthesis Synthesis Synthesis])
+ (do ///////phase.monad
+ [testG (expression archive testS)
+ thenG (expression archive thenS)
+ elseG (expression archive elseS)]
+ (wrap (_.? testG thenG elseG))))
+
+(def: #export (if! statement expression archive [testS thenS elseS])
+ (Generator! [Synthesis Synthesis Synthesis])
+ (do ///////phase.monad
+ [test! (expression archive testS)
+ then! (statement expression archive thenS)
+ else! (statement expression archive elseS)]
+ (wrap (_.if test!
+ then!
+ else!))))
+
+(def: #export (get expression archive [pathP valueS])
(Generator [(List Member) Synthesis])
(do ///////phase.monad
- [valueG (generate archive valueS)]
+ [valueG (expression archive valueS)]
(wrap (list\fold (function (_ side source)
(.let [method (.case side
(^template [<side> <accessor>]
@@ -64,15 +91,7 @@
[#.Right //runtime.tuple//right]))]
(method source)))
valueG
- pathP))))
-
-(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))))
+ (list.reverse pathP)))))
(def: @savepoint (_.var "lux_pm_savepoint"))
(def: @cursor (_.var "lux_pm_cursor"))
@@ -139,12 +158,12 @@
..restore!
post!)))
-(def: (pattern_matching' generate archive)
- (-> Phase Archive Path (Operation Statement))
+(def: (pattern_matching' statement expression archive)
+ (Generator! Path)
(function (recur pathP)
(.case pathP
(#/////synthesis.Then bodyS)
- (\ ///////phase.monad map _.return (generate archive bodyS))
+ (statement expression archive bodyS)
#/////synthesis.Pop
(///////phase\wrap ..pop!)
@@ -175,8 +194,8 @@
[clauses (monad.map ! (function (_ [match then])
(do !
[then! (recur then)]
- (wrap [(_.= (|> match <format>)
- ..peek)
+ (wrap [(_.=== (|> match <format>)
+ ..peek)
then!])))
(#.Cons cons))]
(wrap (_.cond clauses ..fail!)))])
@@ -228,10 +247,10 @@
([/////synthesis.path/seq _.then]
[/////synthesis.path/alt ..alternation]))))
-(def: (pattern_matching generate archive pathP)
- (-> Phase Archive Path (Operation Statement))
+(def: (pattern_matching statement expression archive pathP)
+ (Generator! Path)
(do ///////phase.monad
- [iteration! (pattern_matching' generate archive pathP)]
+ [iteration! (pattern_matching' statement expression archive pathP)]
(wrap ($_ _.then
(_.do_while (_.bool false)
iteration!)
@@ -254,20 +273,25 @@
(#///////variable.Foreign register)
(..capture register))))))
-(def: #export (case generate archive [valueS pathP])
- (Generator [Synthesis Path])
+(def: #export (case! statement expression archive [valueS pathP])
+ (Generator! [Synthesis Path])
+ (do ///////phase.monad
+ [stack_init (expression archive valueS)
+ pattern_matching! (pattern_matching statement expression archive pathP)]
+ (wrap ($_ _.then
+ (_.; (_.set @cursor (_.array/* (list stack_init))))
+ (_.; (_.set @savepoint (_.array/* (list))))
+ pattern_matching!))))
+
+(def: #export (case statement expression archive [valueS pathP])
+ (-> Phase! (Generator [Synthesis Path]))
(do {! ///////phase.monad}
- [initG (generate archive valueS)
- [[case_module case_artifact] pattern_matching!] (/////generation.with_new_context archive
- (pattern_matching generate archive pathP))
+ [[[case_module case_artifact] case!] (/////generation.with_new_context archive
+ (case! statement expression archive [valueS pathP]))
#let [@case (_.constant (///reference.artifact [case_module case_artifact]))
@dependencies+ (..dependencies (/////synthesis.path/seq (/////synthesis.path/then valueS)
pathP))
- directive (<| (_.define_function @case (list\map _.parameter @dependencies+))
- ($_ _.then
- (_.; (_.set @cursor (_.array/* (list initG))))
- (_.; (_.set @savepoint (_.array/* (list))))
- pattern_matching!))]
+ directive (_.define_function @case (list\map _.parameter @dependencies+) case!)]
_ (/////generation.execute! directive)
_ (/////generation.save! (%.nat case_artifact) directive)]
(wrap (_.apply/* @dependencies+ @case))))
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 66d9eb37d..c6fa5687c 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
@@ -11,7 +11,7 @@
[collection
["." list ("#\." functor fold)]]]
[target
- ["_" php (#+ Var Global Expression Argument Statement)]]]
+ ["_" php (#+ Var Global Expression Argument Label Statement)]]]
["." // #_
["#." runtime (#+ Operation Phase Phase! Generator)]
["#." reference]
@@ -42,6 +42,10 @@
(def: input
(|>> inc //case.register))
+(def: (@scope function_name)
+ (-> Context Label)
+ (_.label (format (///reference.artifact function_name) "_scope")))
+
(def: (with_closure inits @selfG @selfL body!)
(-> (List Expression) Global Var Statement [Statement Expression])
(case inits
@@ -53,28 +57,29 @@
_
(let [@inits (|> (list.enumeration inits)
- (list\map (|>> product.left ..capture _.reference)))]
- [(_.; (_.set @selfG (_.closure (list) @inits
+ (list\map (|>> product.left ..capture)))]
+ [(_.; (_.set @selfG (_.closure (list) (list\map _.parameter @inits)
($_ _.then
- (_.; (_.set @selfL (_.closure (list& (_.reference @selfL) @inits)
+ (_.; (_.set @selfL (_.closure (list& (_.reference @selfL) (list\map _.reference @inits))
(list)
body!)))
(_.return @selfL)))))
(_.apply/* inits @selfG)])))
-(def: #export (function expression archive [environment arity bodyS])
- (Generator (Abstraction Synthesis))
+(def: #export (function statement expression archive [environment arity bodyS])
+ (-> Phase! (Generator (Abstraction Synthesis)))
(do {! ///////phase.monad}
- [[function_name bodyG] (/////generation.with_new_context archive
+ [[function_name body!] (/////generation.with_new_context archive
(do !
- [function_name (\ ! map ///reference.artifact
- (/////generation.context archive))]
- (/////generation.with_anchor (_.global function_name)
- (expression archive bodyS))))
+ [@scope (\ ! map ..@scope
+ (/////generation.context archive))]
+ (/////generation.with_anchor [1 @scope]
+ (statement expression archive bodyS))))
closureG+ (monad.map ! (expression archive) environment)
#let [@curried (_.var "curried")
arityG (|> arity .int _.int)
@num_args (_.var "num_args")
+ @scope (..@scope function_name)
@selfG (_.global (///reference.artifact function_name))
@selfL (_.var (///reference.artifact function_name))
initialize_self! (_.; (_.set (//case.register 0) @selfL))
@@ -88,10 +93,11 @@
($_ _.then
(_.; (_.set @num_args (_.func_num_args/0 [])))
(_.; (_.set @curried (_.func_get_args/0 [])))
- (_.cond (list [(|> @num_args (_.= arityG))
+ (_.cond (list [(|> @num_args (_.=== arityG))
($_ _.then
initialize!
- (_.return bodyG))]
+ (_.set_label @scope)
+ body!)]
[(|> @num_args (_.> arityG))
(let [arity_inputs (_.array_slice/3 [@curried (_.int +0) arityG])
extra_inputs (_.array_slice/2 [@curried arityG])
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 cdac65275..30e325363 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,16 +4,16 @@
["." monad (#+ do)]]
[data
["." product]
- [text
+ ["." text
["%" format (#+ format)]]
[collection
- ["." list ("#\." functor)]
+ ["." list ("#\." functor fold)]
["." set]]]
[math
[number
["n" nat]]]
[target
- ["_" php (#+ Var Expression Statement)]]]
+ ["_" php (#+ Var Expression Label Statement)]]]
["." // #_
[runtime (#+ Operation Phase Phase! Generator Generator!)]
["#." case]
@@ -32,8 +32,41 @@
[reference
[variable (#+ Register)]]]]]]])
-(def: #export (scope expression archive [start initsS+ bodyS])
- (Generator (Scope Synthesis))
+(def: @scope
+ (-> Nat Label)
+ (|>> %.nat (format "scope") _.label))
+
+(def: (setup offset bindings body)
+ (-> Register (List Expression) Statement Statement)
+ (|> bindings
+ list.enumeration
+ (list\map (function (_ [register value])
+ (let [variable (//case.register (n.+ offset register))]
+ (_.; (_.set variable value)))))
+ list.reverse
+ (list\fold _.then body)))
+
+(def: #export (scope! statement expression archive [start initsS+ bodyS])
+ (Generator! (Scope Synthesis))
+ (case initsS+
+ ## function/false/non-independent loop
+ #.Nil
+ (statement expression archive bodyS)
+
+ ## true loop
+ _
+ (do {! ///////phase.monad}
+ [@scope (\ ! map ..@scope /////generation.next)
+ initsO+ (monad.map ! (expression archive) initsS+)
+ body! (/////generation.with_anchor [start @scope]
+ (statement expression archive bodyS))]
+ (wrap (..setup start initsO+
+ ($_ _.then
+ (_.set_label @scope)
+ body!))))))
+
+(def: #export (scope statement expression archive [start initsS+ bodyS])
+ (-> Phase! (Generator (Scope Synthesis)))
(case initsS+
## function/false/non-independent loop
#.Nil
@@ -42,15 +75,12 @@
## true loop
_
(do {! ///////phase.monad}
- [initsO+ (monad.map ! (expression archive) initsS+)
- [[loop_module loop_artifact] bodyO] (/////generation.with_new_context archive
- (do !
- [loop_context (/////generation.context archive)]
- (/////generation.with_anchor (_.var (///reference.artifact loop_context))
- (expression archive bodyS))))
+ [[[loop_module loop_artifact] scope!] (/////generation.with_new_context archive
+ (..scope! statement expression archive [start initsS+ bodyS]))
#let [locals (|> initsS+
list.enumeration
(list\map (|>> product.left (n.+ start) //case.register _.parameter)))
+ @loop (_.constant (///reference.artifact [loop_module loop_artifact]))
[directive instantiation] (: [Statement Expression]
(case (|> (synthesis.path/then bodyS)
//case.dependencies
@@ -58,30 +88,30 @@
(set.difference (set.from_list _.hash (list\map product.right locals)))
set.to_list)
#.Nil
- (let [@loop (_.var (///reference.artifact [loop_module loop_artifact]))]
- [(_.; (_.set @loop
- (_.closure (list (_.reference @loop))
- locals
- (_.return bodyO))))
- @loop])
+ [(_.define_function @loop (list) scope!)
+ @loop]
foreigns
- (let [@loop (_.constant (///reference.artifact [loop_module loop_artifact]))]
- [(<| (_.define_function @loop (list\map _.parameter foreigns))
- (let [@loop (_.var (///reference.artifact [loop_module loop_artifact]))]
- (_.return (_.set @loop
- (_.closure (list& (_.reference @loop)
- (list\map _.reference foreigns))
- locals
- (_.return bodyO))))))
- (_.apply/* foreigns @loop)])))]
+ [(<| (_.define_function @loop (list\map _.parameter foreigns))
+ (_.return (_.closure (list\map _.parameter foreigns) (list) scope!)))
+ (_.apply/* foreigns @loop)]))]
_ (/////generation.execute! directive)
_ (/////generation.save! (%.nat loop_artifact) directive)]
- (wrap (_.apply/* initsO+ instantiation)))))
+ (wrap (_.apply/* (list) instantiation)))))
+
+(def: @temp
+ (_.var "lux_recur_values"))
-(def: #export (recur expression archive argsS+)
- (Generator (List Synthesis))
+(def: #export (recur! statement expression archive argsS+)
+ (Generator! (List Synthesis))
(do {! ///////phase.monad}
- [@scope /////generation.anchor
+ [[offset @scope] /////generation.anchor
argsO+ (monad.map ! (expression archive) argsS+)]
- (wrap (_.apply/* argsO+ @scope))))
+ (wrap ($_ _.then
+ (_.; (_.set @temp (_.array/* argsO+)))
+ (..setup offset
+ (|> argsO+
+ list.enumeration
+ (list\map (function (_ [idx _])
+ (_.nth (_.int (.int idx)) @temp))))
+ (_.go_to @scope))))))
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 7b3e55481..5e1c36112 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
@@ -22,7 +22,7 @@
[number (#+ hex)
["." i64]]]
["@" target
- ["_" php (#+ Expression Location Constant Var Computation Literal Statement)]]]
+ ["_" php (#+ Expression Label Constant Var Computation Literal Statement)]]]
["." /// #_
["#." reference]
["//#" /// #_
@@ -38,7 +38,7 @@
(template [<name> <base>]
[(type: #export <name>
- (<base> Location Expression Statement))]
+ (<base> [Nat Label] Expression Statement))]
[Operation /////generation.Operation]
[Phase /////generation.Phase]
@@ -128,6 +128,12 @@
(list (~+ (list\map (|>> (~) [false] (`)) inputsC)))
(~ code))))))))))))))))
+(runtime: (io//log! message)
+ ($_ _.then
+ (_.echo message)
+ (_.echo (_.string text.new_line))
+ (_.return ..unit)))
+
(runtime: (io//throw! message)
($_ _.then
(_.throw (_.new (_.constant "Exception") (list message)))
@@ -136,15 +142,39 @@
(def: runtime//io
Statement
($_ _.then
+ @io//log!
@io//throw!
))
(def: #export tuple_size_field
"_lux_size")
-(def: tuple_size
+(def: #export tuple_size
(_.nth (_.string ..tuple_size_field)))
+(def: jphp?
+ (_.=== (_.string "5.6.99") (_.phpversion/0 [])))
+
+(runtime: (array//length array)
+ ## TODO: Get rid of this as soon as JPHP is no longer necessary.
+ (_.if ..jphp?
+ (_.if (..tuple_size array)
+ (_.return (..tuple_size array))
+ (_.return (_.count/1 array)))
+ (_.return (_.count/1 array))))
+
+(runtime: (array//write idx value array)
+ ($_ _.then
+ (_.; (_.set (_.nth idx array) value))
+ (_.return array)))
+
+(def: runtime//array
+ Statement
+ ($_ _.then
+ @array//length
+ @array//write
+ ))
+
(def: last_index
(|>> ..tuple_size (_.- (_.int +1))))
@@ -167,20 +197,37 @@
## Needs recursion
<recur>)))))
+ ## TODO: Get rid of this as soon as JPHP is no longer necessary.
+ (runtime: (tuple//slice offset input)
+ (with_vars [size index output]
+ ($_ _.then
+ (_.; (_.set size (..array//length input)))
+ (_.; (_.set index (_.int +0)))
+ (_.; (_.set output (_.array/* (list))))
+ (<| (_.while (|> index (_.+ offset) (_.< size)))
+ ($_ _.then
+ (_.; (_.set (_.nth index output) (_.nth (_.+ offset index) input)))
+ (_.; (_.set index (_.+ (_.int +1) index)))
+ ))
+ (_.return (..tuple//make (_.- offset size) output))
+ )))
+
(runtime: (tuple//right lefts tuple)
(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)
+ (_.cond (list [(_.=== last_index_right right_index)
(_.return (_.nth right_index tuple))]
[(_.> last_index_right right_index)
## Needs recursion.
<recur>])
- ($_ _.then
- (_.echo (_.string (format "[tuple//right] _.array_slice/2" text.new_line)))
- (_.return (_.array_slice/2 [tuple right_index]))))
+ (_.if ..jphp?
+ (_.return (..tuple//make (_.- right_index (..tuple_size tuple))
+ (..tuple//slice right_index tuple)))
+ (_.return (..tuple//make (_.- right_index (..tuple_size tuple))
+ (_.array_slice/2 [tuple right_index])))))
)))))
(def: #export variant_tag_field "_lux_tag")
@@ -222,7 +269,7 @@
## sum_flag (_.nth (_.int +1) sum)
sum_value (_.nth (_.string ..variant_value_field) sum)
## sum_value (_.nth (_.int +2) sum)
- is_last? (_.= ..unit sum_flag)
+ is_last? (_.=== ..unit sum_flag)
test_recursion! (_.if is_last?
## Must recurse.
($_ _.then
@@ -230,15 +277,15 @@
(_.; (_.set sum sum_value)))
no_match!)]
(<| (_.while (_.bool true))
- (_.cond (list [(_.= sum_tag wantedTag)
- (_.if (_.= wantsLast sum_flag)
+ (_.cond (list [(_.=== sum_tag wantedTag)
+ (_.if (_.=== wantsLast sum_flag)
(_.return sum_value)
test_recursion!)]
[(_.< wantedTag sum_tag)
test_recursion!]
- [(_.= ..unit wantsLast)
+ [(_.=== ..unit wantsLast)
(_.return (sum//make (_.- wantedTag sum_tag) sum_flag sum_value))])
no_match!))))
@@ -247,6 +294,7 @@
($_ _.then
@tuple//make
@tuple//left
+ @tuple//slice
@tuple//right
@sum//make
@sum//get
@@ -281,12 +329,13 @@
(let [mask (|> (_.int +1)
(_.bit_shl (_.- param (_.int +64)))
(_.- (_.int +1)))]
- (_.return (|> subject
- (_.bit_and mask)
- (_.bit_shr param)))))
-
-(def: jphp?
- (_.= (_.string "5.6.99") (_.phpversion/0 [])))
+ ($_ _.then
+ (_.; (_.set param (_.bit_and (_.int +63) param)))
+ (_.if (_.=== (_.int +0) param)
+ (_.return subject)
+ (_.return (|> subject
+ (_.bit_and mask)
+ (_.bit_shr param)))))))
(runtime: (i64//char code)
(_.if ..jphp?
@@ -314,12 +363,12 @@
(_.if ..jphp?
($_ _.then
(_.; (_.set idx (_.strpos/3 [subject param start])))
- (_.if (_.= (_.bool false) idx)
+ (_.if (_.=== (_.bool false) idx)
(_.return ..none)
(_.return (..some idx))))
($_ _.then
(_.; (_.set idx (_.iconv_strpos/3 [subject param start])))
- (_.if (_.= (_.bool false) idx)
+ (_.if (_.=== (_.bool false) idx)
(_.return ..none)
(_.return (..some idx)))))))
@@ -335,15 +384,14 @@
(runtime: (text//char idx text)
(_.if (|> idx (within? (text//size text)))
- (let [code_point (: (-> Expression Computation)
- (|>> [(_.string "UTF-8") (_.string "UTF-32LE")]
- _.iconv/3
- [(_.string "V")]
- _.unpack/2
- (_.nth (_.int +1))))]
- (_.if ..jphp?
- (_.return (code_point (_.substr/3 [text idx (_.int +1)])))
- (_.return (code_point (_.iconv_substr/3 [text idx (_.int +1)])))))
+ (_.if ..jphp?
+ (_.return (_.ord/1 (_.substr/3 [text idx (_.int +1)])))
+ (_.return (|> (_.iconv_substr/3 [text idx (_.int +1)])
+ [(_.string "UTF-8") (_.string "UTF-32LE")]
+ _.iconv/3
+ [(_.string "V")]
+ _.unpack/2
+ (_.nth (_.int +1)))))
(_.throw (_.new (_.constant "Exception") (list (_.string "[Lux Error] Cannot get char from text."))))))
(def: runtime//text
@@ -359,14 +407,14 @@
(with_vars [output]
($_ _.then
(_.; (_.set output (_.floatval/1 value)))
- (_.if (_.= (_.float +0.0) output)
+ (_.if (_.=== (_.float +0.0) output)
(_.if ($_ _.or
- (_.= (_.string "0.0") output)
- (_.= (_.string "+0.0") output)
- (_.= (_.string "-0.0") output)
- (_.= (_.string "0") output)
- (_.= (_.string "+0") output)
- (_.= (_.string "-0") output))
+ (_.=== (_.string "0.0") output)
+ (_.=== (_.string "+0.0") output)
+ (_.=== (_.string "-0.0") output)
+ (_.=== (_.string "0") output)
+ (_.=== (_.string "+0") output)
+ (_.=== (_.string "-0") output))
(_.return (..some output))
(_.return ..none))
(_.return (..some output)))
@@ -380,7 +428,7 @@
(def: check_necessary_conditions!
Statement
- (let [i64_support? (_.= (_.int +8) (_.constant "PHP_INT_SIZE"))
+ (let [i64_support? (_.=== (_.int +8) (_.constant "PHP_INT_SIZE"))
i64_error (_.string (format "Cannot run program!" text.new_line
"Lux/PHP programs require 64-bit PHP builds!"))]
(_.when (_.not i64_support?)
@@ -390,6 +438,7 @@
Statement
($_ _.then
check_necessary_conditions!
+ runtime//array
runtime//adt
runtime//lux
runtime//i64
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 307417c6c..ed4fe4ae1 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
@@ -2,6 +2,9 @@
[lux #*
[abstract
["." monad (#+ do)]]
+ [data
+ [collection
+ ["." list]]]
[target
["_" php (#+ Expression)]]]
["." // #_
@@ -23,9 +26,13 @@
(generate archive singletonS)
_
- (|> elemsS+
- (monad.map ///////phase.monad (generate archive))
- (///////phase\map _.array/*))))
+ (let [size (_.int (.int (list.size elemsS+)))]
+ (|> elemsS+
+ (monad.map ///////phase.monad (generate archive))
+ ## (///////phase\map (|>> (list& (_.key_value (_.string //runtime.tuple_size_field) size))
+ ## _.array/*))
+ (///////phase\map (|>> _.array/*
+ (//runtime.tuple//make size)))))))
(def: #export (variant generate archive [lefts right? valueS])
(Generator (Variant Synthesis))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/case.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/case.lux
index e21957afe..2249874b5 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/case.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/case.lux
@@ -129,13 +129,7 @@
Statement
(_.set (list @cursor) (|> @savepoint (_.do "pop" (list)))))
-(def: #export symbol
- (_.symbol "lux_break"))
-
-(def: fail!
- _.break
- ## (_.throw/1 ..symbol)
- )
+(def: fail! _.break)
(def: (multi_pop! pops)
(-> Nat Statement)
@@ -161,7 +155,6 @@
(def: (with_looping in_closure? g!once g!continue? body!)
(-> Bit LVar LVar Statement Statement)
- ## (_.catch ..symbol body!)
(.if in_closure?
($_ _.then
(_.while (_.bool true)
@@ -178,8 +171,7 @@
(_.set (list g!continue?) (_.bool true))
_.break)))
(_.when g!continue?
- _.next)))
- )
+ _.next))))
(def: (alternation in_closure? g!once g!continue? pre! post!)
(-> Bit LVar LVar Statement Statement Statement)
diff --git a/stdlib/source/lux/type.lux b/stdlib/source/lux/type.lux
index ee7140e8b..77060876f 100644
--- a/stdlib/source/lux/type.lux
+++ b/stdlib/source/lux/type.lux
@@ -1,5 +1,6 @@
(.module: {#.doc "Basic functionality for working with types."}
[lux (#- function)
+ ["@" target]
[abstract
[equivalence (#+ Equivalence)]
[monad (#+ Monad do)]]
@@ -175,7 +176,8 @@
(Equivalence Type)
(def: (= x y)
- (or (is? x y)
+ (or (for {@.php false} ## TODO: Remove this once JPHP is gone.
+ (is? x y))
(case [x y]
[(#.Primitive xname xparams) (#.Primitive yname yparams)]
(and (text\= xname yname)
diff --git a/stdlib/source/lux/type/check.lux b/stdlib/source/lux/type/check.lux
index 8f79817c0..c308d49c0 100644
--- a/stdlib/source/lux/type/check.lux
+++ b/stdlib/source/lux/type/check.lux
@@ -1,5 +1,6 @@
(.module: {#.doc "Type-checking functionality."}
[lux #*
+ ["@" target]
[abstract
[functor (#+ Functor)]
[apply (#+ Apply)]
@@ -548,7 +549,8 @@
(def: #export (check' assumptions expected actual)
{#.doc "Type-check to ensure that the 'expected' type subsumes the 'actual' type."}
(Checker Type)
- (if (is? expected actual)
+ (if (for {@.php false} ## TODO: Remove this once JPHP is gone.
+ (is? expected actual))
(check\wrap assumptions)
(with type_check_failed [expected actual]
(case [expected actual]
diff --git a/stdlib/source/lux/world/file.lux b/stdlib/source/lux/world/file.lux
index 0d6958d23..52a56aa04 100644
--- a/stdlib/source/lux/world/file.lux
+++ b/stdlib/source/lux/world/file.lux
@@ -15,10 +15,11 @@
[security
["!" capability (#+ capability:)]]]
[data
+ ["." bit ("#\." equivalence)]
["." product]
["." maybe]
["." binary (#+ Binary)]
- ["." text
+ ["." text ("#\." equivalence)
["%" format (#+ format)]]
[collection
["." array (#+ Array)]
@@ -1350,6 +1351,223 @@
..default_separator)
))
)
+
+ @.php
+ (as_is (host.import: (FILE_APPEND Int))
+ ## https://www.php.net/manual/en/dir.constants.php
+ (host.import: (DIRECTORY_SEPARATOR host.String))
+ ## https://www.php.net/manual/en/function.pack.php
+ ## https://www.php.net/manual/en/function.unpack.php
+ (host.import: (unpack [host.String host.String] Binary))
+ ## https://www.php.net/manual/en/ref.filesystem.php
+ ## https://www.php.net/manual/en/function.file-get-contents.php
+ (host.import: (file_get_contents [Path] #io #try host.String))
+ ## https://www.php.net/manual/en/function.file-put-contents.php
+ (host.import: (file_put_contents [Path host.String Int] #io #try host.Integer))
+ (host.import: (filemtime [Path] #io #try host.Integer))
+ (host.import: (filesize [Path] #io #try host.Integer))
+ (host.import: (is_executable [Path] #io #try host.Boolean))
+ (host.import: (touch [Path host.Integer] #io #try host.Boolean))
+ (host.import: (rename [Path Path] #io #try host.Boolean))
+ (host.import: (unlink [Path] #io #try host.Boolean))
+
+ ## https://www.php.net/manual/en/function.rmdir.php
+ (host.import: (rmdir [Path] #io #try host.Boolean))
+ ## https://www.php.net/manual/en/function.scandir.php
+ (host.import: (scandir [Path] #io #try (Array Path)))
+ ## https://www.php.net/manual/en/function.is-file.php
+ (host.import: (is_file [Path] #io #try host.Boolean))
+ ## https://www.php.net/manual/en/function.is-dir.php
+ (host.import: (is_dir [Path] #io #try host.Boolean))
+ ## https://www.php.net/manual/en/function.mkdir.php
+ (host.import: (mkdir [Path] #io #try host.Boolean))
+
+ (def: byte_array_format "C*")
+ (def: default_separator (..DIRECTORY_SEPARATOR))
+
+ (template [<name>]
+ [(exception: #export (<name> {file Path})
+ (exception.report
+ ["Path" file]))]
+
+ [cannot_write_to_file]
+ )
+
+ (`` (structure: (file path)
+ (-> Path (File IO))
+
+ (~~ (template [<name> <mode>]
+ [(def: <name>
+ (..can_modify
+ (function (<name> data)
+ (do {! (try.with io.monad)}
+ [outcome (..file_put_contents [path ("php pack" ..byte_array_format data) <mode>])]
+ (if (bit\= false (:coerce Bit outcome))
+ (\ io.monad wrap (exception.throw ..cannot_write_to_file [path]))
+ (wrap []))))))]
+
+ [over_write +0]
+ [append (..FILE_APPEND)]
+ ))
+
+ (def: content
+ (..can_query
+ (function (_ _)
+ (do {! (try.with io.monad)}
+ [data (..file_get_contents [path])]
+ (if (bit\= false (:coerce Bit data))
+ (\ io.monad wrap (exception.throw ..cannot_find_file [path]))
+ (wrap (..unpack [..byte_array_format data])))))))
+
+ (def: name
+ (..can_see
+ (function (_ _)
+ (|> path
+ (text.split_all_with ..default_separator)
+ list.reverse
+ list.head
+ (maybe.default path)))))
+
+ (def: path
+ (..can_see
+ (function (_ _)
+ path)))
+
+ (~~ (template [<capability> <name> <ffi> <pipeline>]
+ [(def: <name>
+ (<capability>
+ (function (_ _)
+ (do {! (try.with io.monad)}
+ [value (<ffi> [path])]
+ (if (bit\= false (:coerce Bit value))
+ (\ io.monad wrap (exception.throw ..cannot_find_file [path]))
+ (wrap (`` (|> value (~~ (template.splice <pipeline>))))))))))]
+
+ [..can_query size ..filesize [.nat]]
+ [..can_query last_modified ..filemtime [(i.* +1,000) duration.from_millis instant.absolute]]
+ ))
+
+ (def: can_execute?
+ (..can_query
+ (function (_ _)
+ (..is_executable [path]))))
+
+ (def: modify
+ (..can_modify
+ (function (_ moment)
+ (do {! (try.with io.monad)}
+ [verdict (..touch [path (|> moment instant.relative duration.to_millis (i./ +1,000))])]
+ (if (bit\= false (:coerce Bit verdict))
+ (\ io.monad wrap (exception.throw ..cannot_find_file [path]))
+ (wrap []))))))
+
+ (def: move
+ (..can_open
+ (function (_ destination)
+ (do {! (try.with io.monad)}
+ [verdict (..rename [path destination])]
+ (if (bit\= false (:coerce Bit verdict))
+ (\ io.monad wrap (exception.throw ..cannot_find_file [path]))
+ (wrap (file destination)))))))
+
+ (def: delete
+ (..can_delete
+ (function (_ _)
+ (do {! (try.with io.monad)}
+ [verdict (..unlink [path])]
+ (if (bit\= false (:coerce Bit verdict))
+ (\ io.monad wrap (exception.throw ..cannot_find_file [path]))
+ (wrap []))))))
+ ))
+
+ (`` (structure: (directory path)
+ (-> Path (Directory IO))
+
+ (def: scope
+ (..can_see
+ (function (_ _)
+ path)))
+
+ (~~ (template [<name> <test> <constructor> <capability>]
+ [(def: <name>
+ (..can_query
+ (function (_ _)
+ (do {! (try.with io.monad)}
+ [children (..scandir [path])]
+ (loop [input (|> children
+ array.to_list
+ (list.filter (function (_ child)
+ (not (or (text\= "." child)
+ (text\= ".." child))))))
+ output (: (List (<capability> IO))
+ (list))]
+ (case input
+ #.Nil
+ (wrap output)
+
+ (#.Cons head tail)
+ (do !
+ [verdict (<test> head)]
+ (if verdict
+ (recur tail (#.Cons (<constructor> head) output))
+ (recur tail output)))))))))]
+
+ [files ..is_file ..file File]
+ [directories ..is_dir directory Directory]
+ ))
+
+ (def: discard
+ (..can_delete
+ (function (_ _)
+ (do {! (try.with io.monad)}
+ [verdict (..rmdir [path])]
+ (if (bit\= false (:coerce Bit verdict))
+ (\ io.monad wrap (exception.throw ..cannot_find_directory [path]))
+ (wrap []))))))
+ ))
+
+ (`` (structure: #export default
+ (System IO)
+
+ (~~ (template [<name> <test> <constructor> <exception>]
+ [(def: <name>
+ (..can_open
+ (function (_ path)
+ (do {! (try.with io.monad)}
+ [verdict (<test> path)]
+ (\ io.monad wrap
+ (if verdict
+ (#try.Success (<constructor> path))
+ (exception.throw <exception> [path])))))))]
+
+ [file ..is_file ..file ..cannot_find_file]
+ [directory ..is_dir ..directory ..cannot_find_directory]
+ ))
+
+ (def: create_file
+ (..can_open
+ (function (_ path)
+ (do {! (try.with io.monad)}
+ [verdict (..touch [path (|> instant.now io.run instant.relative duration.to_millis (i./ +1,000))])]
+ (\ io.monad wrap
+ (if verdict
+ (#try.Success (..file path))
+ (exception.throw ..cannot_create_file [path])))))))
+
+ (def: create_directory
+ (..can_open
+ (function (_ path)
+ (do {! (try.with io.monad)}
+ [verdict (..mkdir path)]
+ (\ io.monad wrap
+ (if verdict
+ (#try.Success (..directory path))
+ (exception.throw ..cannot_create_directory [path])))))))
+
+ (def: separator
+ ..default_separator)
+ ))
+ )
}))
(template [<get> <signature> <create> <find> <exception>]
diff --git a/stdlib/source/lux/world/program.lux b/stdlib/source/lux/world/program.lux
index acaf36711..d6fe4c2e3 100644
--- a/stdlib/source/lux/world/program.lux
+++ b/stdlib/source/lux/world/program.lux
@@ -14,6 +14,7 @@
[parser
["." environment (#+ Environment)]]]
[data
+ ["." bit ("#\." equivalence)]
["." maybe]
["." text
["%" format (#+ format)]]
@@ -216,7 +217,19 @@
(#static home [] #io Path))
(host.import: Kernel #as RubyKernel
- (#static exit [Int] #io Nothing)))}
+ (#static exit [Int] #io Nothing)))
+
+ @.php
+ (as_is (host.import: (exit [Int] #io Nothing))
+ ## https://www.php.net/manual/en/function.exit.php
+ (host.import: (getcwd [] #io host.String))
+ ## https://www.php.net/manual/en/function.getcwd.php
+ (host.import: (getenv #as getenv/1 [host.String] #io host.String))
+ (host.import: (getenv #as getenv/0 [] #io (Array host.String)))
+ ## https://www.php.net/manual/en/function.getenv.php
+ ## https://www.php.net/manual/en/function.array-keys.php
+ (host.import: (array_keys [(Array host.String)] (Array host.String)))
+ )}
(as_is)))
(structure: #export default
@@ -254,7 +267,15 @@
(list\map (function (_ variable)
[variable (RubyEnv::fetch [variable])]))
(dictionary.from_list text.hash)
- io.io)}
+ io.io)
+ @.php (do io.monad
+ [environment (..getenv/0 [])]
+ (wrap (|> environment
+ ..array_keys
+ array.to_list
+ (list\map (function (_ variable)
+ [variable ("php array read" (:coerce Nat variable) environment)]))
+ (dictionary.from_list text.hash))))}
## TODO: Replace dummy implementation.
(io.io environment.empty))))
@@ -270,7 +291,12 @@
<default>)
@.python (os/path::expanduser ["~"])
@.lua (..run_command "~" "echo ~")
- @.ruby (RubyDir::home [])}
+ @.ruby (RubyDir::home [])
+ @.php (do io.monad
+ [output (..getenv/1 ["HOME"])]
+ (wrap (if (bit\= false (:coerce Bit output))
+ "~"
+ output)))}
## TODO: Replace dummy implementation.
<default>)))
@@ -294,7 +320,12 @@
(if (is? default on_windows)
(..run_command default "pwd")
(wrap on_windows)))
- @.ruby (RubyFileUtils::pwd [])}
+ @.ruby (RubyFileUtils::pwd [])
+ @.php (do io.monad
+ [output (..getcwd [])]
+ (wrap (if (bit\= false (:coerce Bit output))
+ "."
+ output)))}
## TODO: Replace dummy implementation.
(io.io <default>))))
@@ -314,4 +345,5 @@
(..default_exit! code))
@.python (os::_exit [code])
@.lua (os/exit [code])
- @.ruby (RubyKernel::exit [code])}))))
+ @.ruby (RubyKernel::exit [code])
+ @.php (..exit [code])}))))
diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux
index ef6177deb..8d9f68922 100644
--- a/stdlib/source/test/lux.lux
+++ b/stdlib/source/test/lux.lux
@@ -184,7 +184,8 @@
@.js on_valid_host
@.python on_valid_host
@.lua on_valid_host
- @.ruby on_valid_host}
+ @.ruby on_valid_host
+ @.php on_valid_host}
on_default))))))
(def: conversion_tests
diff --git a/stdlib/source/test/lux/control/remember.lux b/stdlib/source/test/lux/control/remember.lux
index bfe18fa5b..1002e3a11 100644
--- a/stdlib/source/test/lux/control/remember.lux
+++ b/stdlib/source/test/lux/control/remember.lux
@@ -28,7 +28,7 @@
["." /]})
(def: deadline (Random Date) random.date)
-(def: message (Random Text) (random\map %.nat random.nat))
+(def: message (Random Text) (random.ascii/lower 10))
(def: focus (Random Code) (random\map code.text (random.ascii/upper 10)))
(def: (to_remember macro deadline message focus)
diff --git a/stdlib/source/test/lux/extension.lux b/stdlib/source/test/lux/extension.lux
index 450570c20..cdd934e3e 100644
--- a/stdlib/source/test/lux/extension.lux
+++ b/stdlib/source/test/lux/extension.lux
@@ -6,7 +6,8 @@
["." js]
["." python]
["." lua]
- ["." ruby]]
+ ["." ruby]
+ ["." php]]
[abstract
[monad (#+ do)]]
[control
@@ -67,7 +68,8 @@
@.js (js.string self)
@.python (python.unicode self)
@.lua (lua.string self)
- @.ruby (ruby.string self)})))))
+ @.ruby (ruby.string self)
+ @.php (php.string self)})))))
(for {@.old
(as_is)}
diff --git a/stdlib/source/test/lux/host.php.lux b/stdlib/source/test/lux/host.php.lux
new file mode 100644
index 000000000..0b6cac81b
--- /dev/null
+++ b/stdlib/source/test/lux/host.php.lux
@@ -0,0 +1,24 @@
+(.module:
+ [lux #*
+ ["_" test (#+ Test)]
+ [abstract
+ [monad (#+ do)]]
+ [control
+ ["." try]]
+ [data
+ ["." text ("#\." equivalence)]]
+ [math
+ ["." random (#+ Random)]
+ [number
+ ["." nat]
+ ["." frac]]]]
+ {1
+ ["." /]})
+
+(def: #export test
+ Test
+ (do {! random.monad}
+ []
+ (<| (_.covering /._)
+ (_.test "TBD"
+ true))))
--
cgit v1.2.3