aboutsummaryrefslogtreecommitdiff
path: root/stdlib
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux/target/scheme.lux152
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/scheme.lux34
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/scheme.lux17
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/scheme/common.lux198
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/scheme/host.lux39
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/case.lux14
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/function.lux26
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/loop.lux4
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/runtime.lux5
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/structure.lux12
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme.lux100
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/case.lux262
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/function.lux132
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/loop.lux77
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/reference.lux10
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/runtime.lux302
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/structure.lux48
-rw-r--r--stdlib/source/test/lux.lux10
18 files changed, 911 insertions, 531 deletions
diff --git a/stdlib/source/lux/target/scheme.lux b/stdlib/source/lux/target/scheme.lux
index b5cf7c76d..ecdaa7324 100644
--- a/stdlib/source/lux/target/scheme.lux
+++ b/stdlib/source/lux/target/scheme.lux
@@ -1,16 +1,17 @@
(.module:
- [lux (#- Code Global int or and if function cond let)
+ [lux (#- Code int or and if function cond let)
[control
[pipe (#+ new> cond> case>)]]
[data
- [number
- ["f" frac]]
["." text
["%" format (#+ format)]]
[collection
["." list ("#\." functor fold)]]]
[macro
["." template]]
+ [math
+ [number
+ ["f" frac]]]
[type
abstract]])
@@ -28,7 +29,6 @@
[(abstract: #export <brand> Any)
(`` (type: #export <type> (|> <brand> (~~ (template.splice <super>+)))))]
- [Global Global' [Expression' Code]]
[Var Var' [Expression' Code]]
[Computation Computation' [Expression' Code]]
)
@@ -37,9 +37,17 @@
{#mandatory (List Var)
#rest (Maybe Var)})
- (def: #export code (-> (Code Any) Text) (|>> :representation))
+ (def: #export manual
+ (-> Text Code)
+ (|>> :abstraction))
- (def: #export var (-> Text Var) (|>> :abstraction))
+ (def: #export code
+ (-> (Code Any) Text)
+ (|>> :representation))
+
+ (def: #export var
+ (-> Text Var)
+ (|>> :abstraction))
(def: (arguments [mandatory rest])
(-> Arguments (Code Any))
@@ -53,14 +61,14 @@
(|> (format " . " (:representation rest))
(format (|> mandatory
(list\map ..code)
- (text.join-with " ")))
+ (text.join_with " ")))
(text.enclose ["(" ")"])
:abstraction))
#.None
(|> mandatory
(list\map ..code)
- (text.join-with " ")
+ (text.join_with " ")
(text.enclose ["(" ")"])
:abstraction)))
@@ -80,34 +88,34 @@
(def: #export float
(-> Frac Computation)
- (|>> (cond> [(f.= f.positive-infinity)]
+ (|>> (cond> [(f.= f.positive_infinity)]
[(new> "+inf.0" [])]
- [(f.= f.negative-infinity)]
+ [(f.= f.negative_infinity)]
[(new> "-inf.0" [])]
- [f.not-a-number?]
+ [f.not_a_number?]
[(new> "+nan.0" [])]
## else
[%.frac])
:abstraction))
- (def: #export positive-infinity Computation (..float f.positive-infinity))
- (def: #export negative-infinity Computation (..float f.negative-infinity))
- (def: #export not-a-number Computation (..float f.not-a-number))
+ (def: #export positive_infinity Computation (..float f.positive_infinity))
+ (def: #export negative_infinity Computation (..float f.negative_infinity))
+ (def: #export not_a_number Computation (..float f.not_a_number))
(def: sanitize
(-> Text Text)
(`` (|>> (~~ (template [<find> <replace>]
- [(text.replace-all <find> <replace>)]
+ [(text.replace_all <find> <replace>)]
[text.alarm "\a"]
- [text.back-space "\b"]
+ [text.back_space "\b"]
[text.tab "\t"]
- [text.new-line "\n"]
- [text.carriage-return "\r"]
- [text.double-quote (format "\" text.double-quote)]
+ [text.new_line "\n"]
+ [text.carriage_return "\r"]
+ [text.double_quote (format "\" text.double_quote)]
["\" "\\"]
["|" "\|"]
))
@@ -121,36 +129,32 @@
(-> Text Computation)
(|>> (format "'") :abstraction))
- (def: #export global
- (-> Text Global)
- (|>> :abstraction))
-
(def: form
(-> (List (Code Any)) Code)
(|>> (list\map ..code)
- (text.join-with " ")
+ (text.join_with " ")
(text.enclose ["(" ")"])
:abstraction))
- (def: #export (apply/* func args)
- (-> Expression (List Expression) Computation)
+ (def: #export (apply/* args func)
+ (-> (List Expression) Expression Computation)
(..form (#.Cons func args)))
(template [<name> <function>]
- [(def: #export <name>
+ [(def: #export (<name> members)
(-> (List Expression) Computation)
- (apply/* (..global <function>)))]
+ (..apply/* members (..var <function>)))]
[vector/* "vector"]
[list/* "list"]
)
- (def: #export (apply/0 func)
+ (def: #export apply/0
(-> Expression Computation)
- (..apply/* func (list)))
+ (..apply/* (list)))
- (template [<lux-name> <scheme-name>]
- [(def: #export <lux-name> (apply/0 (..global <scheme-name>)))]
+ (template [<lux_name> <scheme_name>]
+ [(def: #export <lux_name> (apply/0 (..var <scheme_name>)))]
[newline/0 "newline"]
)
@@ -159,10 +163,10 @@
[(`` (def: #export (<apply> function)
(-> Expression (~~ (template.splice <type>+)) Computation)
(.function (_ (~~ (template.splice <arg>+)))
- (..apply/* function (list (~~ (template.splice <arg>+)))))))
+ (..apply/* (list (~~ (template.splice <arg>+))) function))))
(`` (template [<definition> <function>]
- [(def: #export <definition> (<apply> (..global <function>)))]
+ [(def: #export <definition> (<apply> (..var <function>)))]
(~~ (template.splice <function>+))))]
@@ -177,12 +181,12 @@
[car/1 "car"]
[cdr/1 "cdr"]
[raise/1 "raise"]
- [error-object-message/1 "error-object-message"]
- [make-vector/1 "make-vector"]
- [vector-length/1 "vector-length"]
+ [error_object_message/1 "error-object-message"]
+ [make_vector/1 "make-vector"]
+ [vector_length/1 "vector-length"]
[not/1 "not"]
- [string-length/1 "string-length"]
- [string-hash/1 "string-hash"]
+ [string_length/1 "string-length"]
+ [string_hash/1 "string-hash"]
[reverse/1 "reverse"]
[display/1 "display"]
[exit/1 "exit"]]]
@@ -190,19 +194,19 @@
[apply/2 [_0 _1] [Expression Expression]
[[append/2 "append"]
[cons/2 "cons"]
- [make-vector/2 "make-vector"]
- ## [vector-ref/2 "vector-ref"]
- [list-tail/2 "list-tail"]
+ [make_vector/2 "make-vector"]
+ ## [vector_ref/2 "vector-ref"]
+ [list_tail/2 "list-tail"]
[map/2 "map"]
- [string-ref/2 "string-ref"]
- [string-append/2 "string-append"]]]
+ [string_ref/2 "string-ref"]
+ [string_append/2 "string-append"]]]
[apply/3 [_0 _1 _2] [Expression Expression Expression]
[[substring/3 "substring"]
- [vector-set!/3 "vector-set!"]]]
+ [vector_set!/3 "vector-set!"]]]
[apply/5 [_0 _1 _2 _3 _4] [Expression Expression Expression Expression Expression]
- [[vector-copy!/5 "vector-copy!"]]]
+ [[vector_copy!/5 "vector-copy!"]]]
)
## TODO: define "vector-ref/2" like a normal apply/2 function.
@@ -218,14 +222,14 @@
## 1. To carry on, and then, when it's time to compile the compiler
## itself into Scheme, switch from 'invoke' to normal 'vector-ref'.
## Either way, the 'invoke' needs to go away.
- (def: #export (vector-ref/2 vector index)
+ (def: #export (vector_ref/2 vector index)
(-> Expression Expression Computation)
(..form (list (..var "invoke") vector (..symbol "getRaw") index)))
- (template [<lux-name> <scheme-name>]
- [(def: #export (<lux-name> param subject)
+ (template [<lux_name> <scheme_name>]
+ [(def: #export (<lux_name> param subject)
(-> Expression Expression Computation)
- (..apply/2 (..global <scheme-name>) subject param))]
+ (..apply/2 (..var <scheme_name>) subject param))]
[=/2 "="]
[eq?/2 "eq?"]
@@ -244,25 +248,25 @@
[remainder/2 "remainder"]
[quotient/2 "quotient"]
[mod/2 "mod"]
- [arithmetic-shift/2 "arithmetic-shift"]
- [bit-and/2 "bitwise-and"]
- [bit-or/2 "bitwise-ior"]
- [bit-xor/2 "bitwise-xor"]
+ [arithmetic_shift/2 "arithmetic-shift"]
+ [bit_and/2 "bitwise-and"]
+ [bit_or/2 "bitwise-ior"]
+ [bit_xor/2 "bitwise-xor"]
)
- (template [<lux-name> <scheme-name>]
- [(def: #export <lux-name>
+ (template [<lux_name> <scheme_name>]
+ [(def: #export <lux_name>
(-> (List Expression) Computation)
- (|>> (list& (..global <scheme-name>)) ..form))]
+ (|>> (list& (..var <scheme_name>)) ..form))]
[or "or"]
[and "and"]
)
- (template [<lux-name> <scheme-name> <var> <pre>]
- [(def: #export (<lux-name> bindings body)
+ (template [<lux_name> <scheme_name> <var> <pre>]
+ [(def: #export (<lux_name> bindings body)
(-> (List [<var> Expression]) Expression Computation)
- (..form (list (..global <scheme-name>)
+ (..form (list (..var <scheme_name>)
(|> bindings
(list\map (.function (_ [binding/name binding/value])
(..form (list (|> binding/name <pre>)
@@ -273,18 +277,18 @@
[let "let" Var (<|)]
[let* "let*" Var (<|)]
[letrec "letrec" Var (<|)]
- [let-values "let-values" Arguments ..arguments]
- [let*-values "let*-values" Arguments ..arguments]
- [letrec-values "letrec-values" Arguments ..arguments]
+ [let_values "let-values" Arguments ..arguments]
+ [let*_values "let*-values" Arguments ..arguments]
+ [letrec_values "letrec-values" Arguments ..arguments]
)
(def: #export (if test then else)
(-> Expression Expression Expression Computation)
- (..form (list (..global "if") test then else)))
+ (..form (list (..var "if") test then else)))
(def: #export (when test then)
(-> Expression Expression Computation)
- (..form (list (..global "when") test then)))
+ (..form (list (..var "when") test then)))
(def: #export (cond clauses else)
(-> (List [Expression Expression]) Expression Computation)
@@ -297,31 +301,31 @@
(def: #export (lambda arguments body)
(-> Arguments Expression Computation)
- (..form (list (..global "lambda")
+ (..form (list (..var "lambda")
(..arguments arguments)
body)))
- (def: #export (define-function name arguments body)
+ (def: #export (define_function name arguments body)
(-> Var Arguments Expression Computation)
- (..form (list (..global "define")
+ (..form (list (..var "define")
(|> arguments
(update@ #mandatory (|>> (#.Cons name)))
..arguments)
body)))
- (def: #export (define-constant name value)
+ (def: #export (define_constant name value)
(-> Var Expression Computation)
- (..form (list (..global "define") name value)))
+ (..form (list (..var "define") name value)))
(def: #export begin
(-> (List Expression) Computation)
- (|>> (#.Cons (..global "begin")) ..form))
+ (|>> (#.Cons (..var "begin")) ..form))
(def: #export (set! name value)
(-> Var Expression Computation)
- (..form (list (..global "set!") name value)))
+ (..form (list (..var "set!") name value)))
- (def: #export (with-exception-handler handler body)
+ (def: #export (with_exception_handler handler body)
(-> Expression Expression Computation)
- (..form (list (..global "with-exception-handler") handler body)))
+ (..form (list (..var "with-exception-handler") handler body)))
)
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/scheme.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/scheme.lux
new file mode 100644
index 000000000..1c0a89df5
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/scheme.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
+ ["_" scheme]]]
+ [//
+ ["/" lux (#+ custom)]
+ [//
+ ["." bundle]
+ [//
+ ["." analysis #_
+ ["#/." type]]
+ [//
+ ["." analysis (#+ Analysis Operation Phase Handler Bundle)]
+ [///
+ ["." phase]]]]]])
+
+(def: #export bundle
+ Bundle
+ (<| (bundle.prefix "scheme")
+ (|> bundle.empty
+ )))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/scheme.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/scheme.lux
new file mode 100644
index 000000000..945e90e57
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/scheme.lux
@@ -0,0 +1,17 @@
+(.module:
+ [lux #*
+ [data
+ [collection
+ ["." dictionary]]]]
+ ["." / #_
+ ["#." common]
+ ["#." host]
+ [////
+ [generation
+ [scheme
+ [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/scheme/common.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/scheme/common.lux
new file mode 100644
index 000000000..6a13e29bb
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/scheme/common.lux
@@ -0,0 +1,198 @@
+(.module:
+ [lux #*
+ [abstract
+ ["." monad (#+ do)]]
+ [control
+ ["." function]
+ ["." try]
+ ["<>" parser
+ ["<s>" synthesis (#+ Parser)]]]
+ [data
+ ["." product]
+ ["." text
+ ["%" format (#+ format)]]
+ [collection
+ ["." dictionary]
+ ["." set]
+ ["." list ("#\." functor fold)]]]
+ [math
+ [number
+ ["f" frac]]]
+ ["@" target
+ ["_" scheme (#+ Expression)]]]
+ ["." //// #_
+ ["/" bundle]
+ ["/#" // #_
+ ["." extension]
+ [generation
+ [extension (#+ Nullary Unary Binary Trinary
+ nullary unary binary trinary)]
+ ["." reference]
+ ["//" scheme #_
+ ["#." runtime (#+ Operation Phase Handler Bundle Generator)]
+ ["#." case]]]
+ [//
+ ["." 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/* (|> (_.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)
+## [[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))
+## ))
+
+## (def: (left_shift [parameter subject])
+## (Binary Expression)
+## (_.bit_shl (_.% (_.int +64) parameter) subject))
+
+## (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 ..left_shift))
+## (/.install "right-shift" (binary (product.uncurry //runtime.i64//right_shift)))
+## (/.install "=" (binary (product.uncurry _.==)))
+## (/.install "<" (binary (product.uncurry _.<)))
+## (/.install "+" (binary (product.uncurry //runtime.i64//+)))
+## (/.install "-" (binary (product.uncurry //runtime.i64//-)))
+## (/.install "*" (binary (product.uncurry //runtime.i64//*)))
+## (/.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))
+## )))
+
+## (def: (f64//% [parameter subject])
+## (Binary Expression)
+## (_.fmod/2 [subject parameter]))
+
+## (def: (f64//encode subject)
+## (Unary Expression)
+## (_.number_format/2 [subject (_.int +17)]))
+
+## (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 _.*)))
+## (/.install "/" (binary (product.uncurry _./)))
+## (/.install "%" (binary ..f64//%))
+## (/.install "i64" (unary _.intval/1))
+## (/.install "encode" (unary ..f64//encode))
+## (/.install "decode" (unary //runtime.f64//decode)))))
+
+## (def: (text//clip [paramO extraO subjectO])
+## (Trinary Expression)
+## (//runtime.text//clip paramO extraO subjectO))
+
+## (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))
+## (/.install "char" (binary (product.uncurry //runtime.text//char)))
+## (/.install "clip" (trinary ..text//clip))
+## )))
+
+## (def: io//current-time
+## (Nullary Expression)
+## (|>> _.time/0
+## (_.* (_.int +1,000))))
+
+## (def: io_procs
+## Bundle
+## (<| (/.prefix "io")
+## (|> /.empty
+## (/.install "log" (unary //runtime.io//log!))
+## (/.install "error" (unary //runtime.io//throw!))
+## (/.install "current-time" (nullary ..io//current-time)))))
+
+(def: #export bundle
+ Bundle
+ (<| (/.prefix "lux")
+ (|> /.empty
+ ## (dictionary.merge 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/scheme/host.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/scheme/host.lux
new file mode 100644
index 000000000..0a05436c2
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/scheme/host.lux
@@ -0,0 +1,39 @@
+(.module:
+ [lux #*
+ [abstract
+ ["." monad (#+ do)]]
+ [control
+ ["." function]
+ ["<>" parser
+ ["<s>" synthesis (#+ Parser)]]]
+ [data
+ [collection
+ ["." dictionary]
+ ["." list]]
+ [text
+ ["%" format (#+ format)]]]
+ [target
+ ["_" scheme (#+ Var Expression)]]]
+ ["." // #_
+ ["#." common (#+ custom)]
+ ["//#" /// #_
+ ["/" bundle]
+ ["/#" // #_
+ ["." extension]
+ [generation
+ [extension (#+ Nullary Unary Binary Trinary
+ nullary unary binary trinary)]
+ ["." reference]
+ ["//" scheme #_
+ ["#." runtime (#+ Operation Phase Handler Bundle
+ with_vars)]]]
+ ["/#" // #_
+ ["." generation]
+ ["//#" /// #_
+ ["#." phase]]]]]])
+
+(def: #export bundle
+ Bundle
+ (<| (/.prefix "scheme")
+ (|> /.empty
+ )))
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 419c0ed2f..137c72c71 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
@@ -57,7 +57,7 @@
[valueO (expression archive valueS)
body! (statement expression archive bodyS)]
(wrap ($_ _.then
- (_.; (_.set (..register register) valueO))
+ (_.set! (..register register) valueO)
body!))))
(def: #export (if expression archive [testS thenS elseS])
@@ -121,7 +121,7 @@
(def: restore!
Statement
- (_.; (_.set @cursor (_.array_pop/1 @savepoint))))
+ (_.set! @cursor (_.array_pop/1 @savepoint)))
(def: fail! _.break)
@@ -135,7 +135,7 @@
[(def: (<name> simple? idx)
(-> Bit Nat Statement)
($_ _.then
- (_.; (_.set @temp (|> idx <prep> .int _.int (//runtime.sum//get ..peek <flag>))))
+ (_.set! @temp (|> idx <prep> .int _.int (//runtime.sum//get ..peek <flag>)))
(.if simple?
(_.when (_.is_null/1 @temp)
fail!)
@@ -169,7 +169,7 @@
(///////phase\wrap ..pop!)
(#/////synthesis.Bind register)
- (///////phase\wrap (_.; (_.set (..register register) ..peek)))
+ (///////phase\wrap (_.set! (..register register) ..peek))
(#/////synthesis.Bit_Fork when thenP elseP)
(do {! ///////phase.monad}
@@ -227,7 +227,7 @@
(do ///////phase.monad
[then! (recur thenP)]
(///////phase\wrap ($_ _.then
- (_.; (_.set (..register register) ..peek_and_pop))
+ (_.set! (..register register) ..peek_and_pop)
then!)))
## (^ (/////synthesis.!multi_pop nextP))
@@ -279,8 +279,8 @@
[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))))
+ (_.set! @cursor (_.array/* (list stack_init)))
+ (_.set! @savepoint (_.array/* (list)))
pattern_matching!))))
(def: #export (case statement expression archive [valueS pathP])
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 c6fa5687c..8dad09d37 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
@@ -51,19 +51,19 @@
(case inits
#.Nil
[($_ _.then
- (_.; (_.set @selfL (_.closure (list (_.reference @selfL)) (list) body!)))
- (_.; (_.set @selfG @selfL)))
+ (_.set! @selfL (_.closure (list (_.reference @selfL)) (list) body!))
+ (_.set! @selfG @selfL))
@selfG]
_
(let [@inits (|> (list.enumeration inits)
(list\map (|>> product.left ..capture)))]
- [(_.; (_.set @selfG (_.closure (list) (list\map _.parameter @inits)
- ($_ _.then
- (_.; (_.set @selfL (_.closure (list& (_.reference @selfL) (list\map _.reference @inits))
- (list)
- body!)))
- (_.return @selfL)))))
+ [(_.set! @selfG (_.closure (list) (list\map _.parameter @inits)
+ ($_ _.then
+ (_.set! @selfL (_.closure (list& (_.reference @selfL) (list\map _.reference @inits))
+ (list)
+ body!))
+ (_.return @selfL))))
(_.apply/* inits @selfG)])))
(def: #export (function statement expression archive [environment arity bodyS])
@@ -82,17 +82,17 @@
@scope (..@scope function_name)
@selfG (_.global (///reference.artifact function_name))
@selfL (_.var (///reference.artifact function_name))
- initialize_self! (_.; (_.set (//case.register 0) @selfL))
+ initialize_self! (_.set! (//case.register 0) @selfL)
initialize! (list\fold (.function (_ post pre!)
($_ _.then
pre!
- (_.; (_.set (..input post) (_.nth (|> post .int _.int) @curried)))))
+ (_.set! (..input post) (_.nth (|> post .int _.int) @curried))))
initialize_self!
(list.indices arity))]
#let [[definition instantiation] (..with_closure closureG+ @selfG @selfL
($_ _.then
- (_.; (_.set @num_args (_.func_num_args/0 [])))
- (_.; (_.set @curried (_.func_get_args/0 [])))
+ (_.set! @num_args (_.func_num_args/0 []))
+ (_.set! @curried (_.func_get_args/0 []))
(_.cond (list [(|> @num_args (_.=== arityG))
($_ _.then
initialize!
@@ -107,7 +107,7 @@
(let [@missing (_.var "missing")]
(_.return (<| (_.closure (list (_.reference @selfL) (_.reference @curried)) (list))
($_ _.then
- (_.; (_.set @missing (_.func_get_args/0 [])))
+ (_.set! @missing (_.func_get_args/0 []))
(_.return (_.call_user_func_array/2 [@selfL (_.array_merge/+ @curried (list @missing))])))))))
))]
_ (/////generation.execute! definition)
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 d3e91b925..41289ed58 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
@@ -42,7 +42,7 @@
list.enumeration
(list\map (function (_ [register value])
(let [variable (//case.register (n.+ offset register))]
- (_.; (_.set variable value)))))
+ (_.set! variable value))))
list.reverse
(list\fold _.then body)))
@@ -112,7 +112,7 @@
[[offset @scope] /////generation.anchor
argsO+ (monad.map ! (expression archive) argsS+)]
(wrap ($_ _.then
- (_.; (_.set @temp (_.array/* argsO+)))
+ (_.set! @temp (_.array/* argsO+))
(..setup offset
(|> argsO+
list.enumeration
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 651e3854f..d5e831e09 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
@@ -55,9 +55,6 @@
(type: #export (Generator! i)
(-> Phase! Phase Archive i (Operation Statement)))
-(def: prefix
- "LuxRuntime")
-
(def: #export unit
(_.string /////synthesis.unit))
@@ -597,8 +594,6 @@
runtime//io
))
-(def: #export artifact ..prefix)
-
(def: #export generate
(Operation [Registry Output])
(do ///////phase.monad
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 ed4fe4ae1..5f7a4e358 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
@@ -16,28 +16,26 @@
["//#" /// #_
["#." phase ("#\." monad)]]]])
-(def: #export (tuple generate archive elemsS+)
+(def: #export (tuple expression archive elemsS+)
(Generator (Tuple Synthesis))
(case elemsS+
#.Nil
(///////phase\wrap (//primitive.text /////synthesis.unit))
(#.Cons singletonS #.Nil)
- (generate archive singletonS)
+ (expression archive singletonS)
_
(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/*))
+ (monad.map ///////phase.monad (expression archive))
(///////phase\map (|>> _.array/*
(//runtime.tuple//make size)))))))
-(def: #export (variant generate archive [lefts right? valueS])
+(def: #export (variant expression archive [lefts right? valueS])
(Generator (Variant Synthesis))
(let [tag (if right?
(inc lefts)
lefts)]
(///////phase\map (//runtime.variant tag right?)
- (generate archive valueS))))
+ (expression archive valueS))))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme.lux
index a6e03cfd4..be476cf74 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme.lux
@@ -1,60 +1,60 @@
(.module:
[lux #*
[abstract
- [monad (#+ do)]]]
- [/
+ [monad (#+ do)]]
+ [control
+ ["." exception (#+ exception:)]]
+ [target
+ ["_" scheme]]]
+ ["." / #_
[runtime (#+ Phase)]
- ["." primitive]
- ["." structure]
- ["." reference ("#\." system)]
- ["." function]
- ["." case]
- ["." loop]
- ["." ///
- ["." extension]
- [//
- ["." synthesis]]]])
-
-(def: #export (generate synthesis)
+ ["#." 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)
-
- (#synthesis.Reference value)
- (reference\reference value)
-
- (^ (synthesis.branch/case case))
- (case.case generate case)
-
- (^ (synthesis.branch/let let))
- (case.let generate let)
+ (//////phase\wrap (<generator> value))])
+ ([////synthesis.bit /primitive.bit]
+ [////synthesis.i64 /primitive.i64]
+ [////synthesis.f64 /primitive.f64]
+ [////synthesis.text /primitive.text])
- (^ (synthesis.branch/if if))
- (case.if generate if)
+ (#////synthesis.Reference value)
+ (//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)
-
- (#synthesis.Extension extension)
- (extension.apply generate extension)))
+ (^template [<tag> <generator>]
+ [(^ (<tag> value))
+ (<generator> generate 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]
+
+ [////synthesis.branch/case /case.case]
+ [////synthesis.loop/scope /loop.scope]
+ [////synthesis.loop/recur /loop.recur]
+ [////synthesis.function/abstraction /function.function])
+
+ (#////synthesis.Extension extension)
+ (///extension.apply archive generate extension)
+ ))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/case.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/case.lux
index 5f460b749..8f7d8a8b1 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/case.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/case.lux
@@ -1,43 +1,66 @@
(.module:
[lux (#- case let if)
[abstract
- [monad (#+ do)]]
- [control
- ["ex" exception (#+ exception:)]]
+ ["." monad (#+ do)]]
[data
- ["." number]
- ["." text]
+ ["." product]
+ ["." text
+ ["%" format (#+ format)]]
[collection
- ["." list ("#\." functor fold)]]]
+ ["." list ("#\." functor fold)]
+ ["." set]]]
+ [math
+ [number
+ ["i" int]]]
[target
["_" scheme (#+ Expression Computation Var)]]]
["." // #_
- ["#." runtime (#+ Operation Phase)]
+ ["#." runtime (#+ Operation Phase Generator)]
+ ["#." reference]
["#." primitive]
- ["#/" // #_
+ ["/#" // #_
["#." reference]
- ["#/" // ("#\." monad)
- ["#/" // #_
- [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))
-
-(def: #export (let generate [valueS register bodyS])
- (-> Phase [Synthesis Register Synthesis]
- (Operation Computation))
- (do ////.monad
- [valueO (generate valueS)
- bodyO (generate bodyS)]
+ (-> Register Var)
+ (|>> (///reference.local //reference.system) :assume))
+
+(def: #export capture
+ (-> Register Var)
+ (|>> (///reference.foreign //reference.system) :assume))
+
+(def: #export (let expression archive [valueS register bodyS])
+ (Generator [Synthesis Register Synthesis])
+ (do ///////phase.monad
+ [valueO (expression archive valueS)
+ bodyO (expression archive bodyS)]
(wrap (_.let (list [(..register register) valueO])
bodyO))))
-(def: #export (record-get generate valueS pathP)
- (-> Phase Synthesis (List (Either Nat Nat))
- (Operation Expression))
- (do ////.monad
- [valueO (generate valueS)]
+(def: #export (if expression archive [testS thenS elseS])
+ (Generator [Synthesis Synthesis Synthesis])
+ (do ///////phase.monad
+ [testO (expression archive testS)
+ thenO (expression archive thenS)
+ elseO (expression archive elseS)]
+ (wrap (_.if testO thenO elseO))))
+
+(def: #export (get expression archive [pathP valueS])
+ (Generator [(List Member) Synthesis])
+ (do ///////phase.monad
+ [valueO (expression archive valueS)]
(wrap (list\fold (function (_ side source)
(.let [method (.case side
(^template [<side> <accessor>]
@@ -47,27 +70,18 @@
[#.Right //runtime.tuple//right]))]
(method source)))
valueO
- pathP))))
-
-(def: #export (if generate [testS thenS elseS])
- (-> Phase [Synthesis Synthesis Synthesis]
- (Operation Computation))
- (do ////.monad
- [testO (generate testS)
- thenO (generate thenS)
- elseO (generate elseS)]
- (wrap (_.if testO thenO elseO))))
+ (list.reverse pathP)))))
(def: @savepoint (_.var "lux_pm_cursor_savepoint"))
(def: @cursor (_.var "lux_pm_cursor"))
(def: @temp (_.var "lux_pm_temp"))
-(def: @alt-error (_.var "alt_error"))
+(def: @alt_error (_.var "alt_error"))
(def: (push! value var)
(-> Expression Var Computation)
(_.set! var (_.cons/2 value var)))
-(def: (push-cursor! value)
+(def: (push_cursor! value)
(-> Expression Computation)
(push! value @cursor))
@@ -75,97 +89,123 @@
(-> Var Computation)
(_.set! var var))
-(def: save-cursor!
+(def: save_cursor!
Computation
(push! @cursor @savepoint))
-(def: restore-cursor!
+(def: restore_cursor!
Computation
(_.set! @cursor (_.car/1 @savepoint)))
-(def: cursor-top
+(def: peek
Computation
(_.car/1 @cursor))
-(def: pop-cursor!
+(def: pop_cursor!
Computation
(pop! @cursor))
-(def: pm-error (_.string "PM-ERROR"))
+(def: pm_error
+ (_.string "PM-ERROR"))
-(def: fail-pm! (_.raise/1 pm-error))
+(def: fail!
+ (_.raise/1 pm_error))
-(def: (pm-catch handler)
+(def: (pm_catch handler)
(-> Expression Computation)
- (_.lambda [(list @alt-error) #.None]
- (_.if (|> @alt-error (_.eqv?/2 pm-error))
+ (_.lambda [(list @alt_error) #.None]
+ (_.if (|> @alt_error (_.eqv?/2 pm_error))
handler
- (_.raise/1 @alt-error))))
-
-(def: (pattern-matching' generate pathP)
- (-> Phase Path (Operation Expression))
- (.case pathP
- (^ (/////synthesis.path/then bodyS))
- (generate bodyS)
-
- #/////synthesis.Pop
- (////\wrap pop-cursor!)
-
- (#/////synthesis.Bind register)
- (////\wrap (_.define-constant (..register register) ..cursor-top))
-
- (^template [<tag> <format> <=>]
- [(^ (<tag> value))
- (////\wrap (_.when (|> value <format> (<=> cursor-top) _.not/1)
- fail-pm!))])
- ([/////synthesis.path/bit //primitive.bit _.eqv?/2]
- [/////synthesis.path/i64 (<| //primitive.i64 .int) _.=/2]
- [/////synthesis.path/f64 //primitive.f64 _.=/2]
- [/////synthesis.path/text //primitive.text _.eqv?/2])
-
- (^template [<pm> <flag> <prep>]
- [(^ (<pm> idx))
- (////\wrap (_.let (list [@temp (|> idx <prep> .int _.int (//runtime.sum//get cursor-top <flag>))])
- (_.if (_.null?/1 @temp)
- fail-pm!
- (push-cursor! @temp))))])
- ([/////synthesis.side/left _.nil (<|)]
- [/////synthesis.side/right (_.string "") inc])
-
- (^template [<pm> <getter>]
- [(^ (<pm> idx))
- (////\wrap (push-cursor! (<getter> (_.int (.int idx)) cursor-top)))])
- ([/////synthesis.member/left //runtime.tuple//left]
- [/////synthesis.member/right //runtime.tuple//right])
-
- (^template [<tag> <computation>]
- [(^ (<tag> leftP rightP))
- (do ////.monad
- [leftO (pattern-matching' generate leftP)
- rightO (pattern-matching' generate rightP)]
- (wrap <computation>))])
- ([/////synthesis.path/seq (_.begin (list leftO
- rightO))]
- [/////synthesis.path/alt (_.with-exception-handler
- (pm-catch (_.begin (list restore-cursor!
- rightO)))
- (_.lambda [(list) #.None]
- (_.begin (list save-cursor!
- leftO))))])))
-
-(def: (pattern-matching generate pathP)
- (-> Phase Path (Operation Computation))
- (do ////.monad
- [pattern-matching! (pattern-matching' generate pathP)]
- (wrap (_.with-exception-handler
- (pm-catch (_.raise/1 (_.string "Invalid expression for pattern-matching.")))
+ (_.raise/1 @alt_error))))
+
+(def: (pattern_matching' expression archive)
+ (Generator Path)
+ (function (recur pathP)
+ (.case pathP
+ (#/////synthesis.Then bodyS)
+ (expression archive bodyS)
+
+ #/////synthesis.Pop
+ (///////phase\wrap pop_cursor!)
+
+ (#/////synthesis.Bind register)
+ (///////phase\wrap (_.define_constant (..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 _.=/2]
+ [#/////synthesis.F64_Fork //primitive.f64 _.=/2]
+ [#/////synthesis.Text_Fork //primitive.text _.eqv?/2])
+
+ (^template [<pm> <flag> <prep>]
+ [(^ (<pm> idx))
+ (///////phase\wrap (_.let (list [@temp (|> idx <prep> .int _.int (//runtime.sum//get ..peek <flag>))])
+ (_.if (_.null?/1 @temp)
+ ..fail!
+ (push_cursor! @temp))))])
+ ([/////synthesis.side/left _.nil (<|)]
+ [/////synthesis.side/right (_.string "") inc])
+
+ (^template [<pm> <getter>]
+ [(^ (<pm> idx))
+ (///////phase\wrap (push_cursor! (<getter> (_.int (.int idx)) ..peek)))])
+ ([/////synthesis.member/left //runtime.tuple//left]
+ [/////synthesis.member/right //runtime.tuple//right])
+
+ (^template [<tag> <computation>]
+ [(^ (<tag> leftP rightP))
+ (do ///////phase.monad
+ [leftO (recur leftP)
+ rightO (recur rightP)]
+ (wrap <computation>))])
+ ([/////synthesis.path/seq (_.begin (list leftO
+ rightO))]
+ [/////synthesis.path/alt (_.with_exception_handler
+ (pm_catch (_.begin (list restore_cursor!
+ rightO)))
+ (_.lambda [(list) #.None]
+ (_.begin (list save_cursor!
+ leftO))))]))))
+
+(def: (pattern_matching expression archive pathP)
+ (Generator Path)
+ (do ///////phase.monad
+ [pattern_matching! (pattern_matching' expression archive pathP)]
+ (wrap (_.with_exception_handler
+ (pm_catch (_.raise/1 (_.string "Invalid expression for pattern-matching.")))
(_.lambda [(list) #.None]
- pattern-matching!)))))
+ pattern_matching!)))))
-(def: #export (case generate [valueS pathP])
- (-> Phase [Synthesis Path] (Operation Computation))
- (do {! ////.monad}
- [valueO (generate valueS)]
+(def: #export (case expression archive [valueS pathP])
+ (Generator [Synthesis Path])
+ (do {! ///////phase.monad}
+ [valueO (expression archive valueS)]
(<| (\ ! map (_.let (list [@cursor (_.list/* (list valueO))]
[@savepoint (_.list/* (list))])))
- (pattern-matching generate pathP))))
+ (pattern_matching expression archive pathP))))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/function.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/function.lux
index 97725a8f2..edcdb89b4 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/function.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/function.lux
@@ -6,50 +6,52 @@
pipe]
[data
["." product]
- [text
+ ["." text
["%" format (#+ format)]]
[collection
- ["." list ("#\." functor)]]]
+ ["." list ("#\." functor fold)]]]
[target
["_" scheme (#+ Expression Computation Var)]]]
["." // #_
- ["#." runtime (#+ Operation Phase)]
+ ["#." runtime (#+ Operation Phase Generator)]
["#." reference]
["#." case]
- ["#/" //
+ ["/#" // #_
["#." reference]
- ["#/" // ("#\." monad)
- ["#/" // #_
- [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 Computation))
- (do {! ////.monad}
- [functionO (generate functionS)
- argsO+ (monad.map ! generate argsS+)]
- (wrap (_.apply/* functionO argsO+))))
+(def: #export (apply expression archive [functionS argsS+])
+ (Generator (Application Synthesis))
+ (do {! ///////phase.monad}
+ [functionO (expression archive functionS)
+ argsO+ (monad.map ! (expression archive) argsS+)]
+ (wrap (_.apply/* argsO+ functionO))))
-(def: #export capture
- (///reference.foreign _.var))
+(def: capture
+ (-> Register Var)
+ (|>> (///reference.foreign //reference.system) :assume))
-(def: (with-closure function-name inits function-definition)
- (-> Text (List Expression) Computation (Operation Computation))
- (////\wrap
+(def: (with_closure inits function_definition)
+ (-> (List Expression) Computation (Operation Computation))
+ (///////phase\wrap
(case inits
#.Nil
- function-definition
+ function_definition
_
- (let [@closure (_.var (format function-name "___CLOSURE"))]
- (_.letrec (list [@closure
- (_.lambda [(|> (list.enumeration inits)
- (list\map (|>> product.left ..capture)))
- #.None]
- function-definition)])
- (_.apply/* @closure inits))))))
+ (|> function_definition
+ (_.lambda [(|> (list.enumeration inits)
+ (list\map (|>> product.left ..capture)))
+ #.None])
+ (_.apply/* inits)))))
(def: @curried (_.var "curried"))
(def: @missing (_.var "missing"))
@@ -57,42 +59,42 @@
(def: input
(|>> inc //case.register))
-(def: #export (function generate [environment arity bodyS])
- (-> Phase (Abstraction Synthesis) (Operation Computation))
- (do {! ////.monad}
- [[function-name bodyO] (///.with-context
+(def: #export (function expression archive [environment arity bodyS])
+ (Generator (Abstraction Synthesis))
+ (do {! ///////phase.monad}
+ [[function_name bodyO] (/////generation.with_new_context archive
(do !
- [function-name ///.context]
- (///.with-anchor (_.var function-name)
- (generate bodyS))))
- closureO+ (: (Operation (List Expression))
- (monad.map ! (\ //reference.system variable) environment))
+ [@self (\ ! map (|>> ///reference.artifact _.var)
+ (/////generation.context archive))]
+ (/////generation.with_anchor @self
+ (expression archive bodyS))))
+ closureO+ (monad.map ! (expression archive) environment)
#let [arityO (|> arity .int _.int)
- apply-poly (.function (_ args func)
- (_.apply/2 (_.global "apply") func args))
- @num-args (_.var "num_args")
- @function (_.var function-name)]]
- (with-closure function-name closureO+
- (_.letrec (list [@function (_.lambda [(list) (#.Some @curried)]
- (_.let (list [@num-args (_.length/1 @curried)])
- (<| (_.if (|> @num-args (_.=/2 arityO))
- (<| (_.let (list [(//case.register 0) @function]))
- (_.let-values (list [[(|> (list.indices arity)
- (list\map ..input))
- #.None]
- (_.apply/2 (_.global "apply") (_.global "values") @curried)]))
- bodyO))
- (_.if (|> @num-args (_.>/2 arityO))
- (let [arity-args (//runtime.slice (_.int +0) arityO @curried)
- output-func-args (//runtime.slice arityO
- (|> @num-args (_.-/2 arityO))
- @curried)]
- (|> @function
- (apply-poly arity-args)
- (apply-poly output-func-args))))
- ## (|> @num-args (_.</2 arityO))
- (_.lambda [(list) (#.Some @missing)]
- (|> @function
- (apply-poly (_.append/2 @curried @missing)))))
- ))])
- @function))))
+ apply_poly (.function (_ args func)
+ (_.apply/2 (_.var "apply") func args))
+ @num_args (_.var "num_args")
+ @self (_.var (///reference.artifact function_name))]]
+ (with_closure closureO+
+ (_.letrec (list [@self (_.lambda [(list) (#.Some @curried)]
+ (_.let (list [@num_args (_.length/1 @curried)])
+ (<| (_.if (|> @num_args (_.=/2 arityO))
+ (<| (_.let (list [(//case.register 0) @self]))
+ (_.let_values (list [[(|> (list.indices arity)
+ (list\map ..input))
+ #.None]
+ (_.apply/2 (_.var "apply") (_.var "values") @curried)]))
+ bodyO))
+ (_.if (|> @num_args (_.>/2 arityO))
+ (let [arity_args (//runtime.slice (_.int +0) arityO @curried)
+ output_func_args (//runtime.slice arityO
+ (|> @num_args (_.-/2 arityO))
+ @curried)]
+ (|> @self
+ (apply_poly arity_args)
+ (apply_poly output_func_args))))
+ ## (|> @num_args (_.</2 arityO))
+ (_.lambda [(list) (#.Some @missing)]
+ (|> @self
+ (apply_poly (_.append/2 @curried @missing)))))
+ ))])
+ @self))))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/loop.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/loop.lux
index 053a32c15..633b0da5a 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/loop.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/loop.lux
@@ -4,39 +4,60 @@
["." monad (#+ do)]]
[data
["." product]
- ["." text]
- [number
- ["n" nat]]
+ ["." text
+ ["%" format (#+ format)]]
[collection
- ["." list ("#\." functor)]]]
+ ["." list ("#\." functor fold)]
+ ["." set (#+ Set)]]]
+ [math
+ [number
+ ["n" nat]]]
[target
["_" scheme (#+ Computation Var)]]]
["." // #_
- [runtime (#+ Operation Phase)]
+ [runtime (#+ Operation Phase Generator)]
["#." case]
- ["#/" //
- ["#/" //
- [//
- [synthesis (#+ Scope Synthesis)]]]]])
+ ["/#" // #_
+ ["#." reference]
+ ["/#" // #_
+ [synthesis
+ ["." case]]
+ ["/#" // #_
+ ["."synthesis (#+ Scope Synthesis)]
+ ["#." generation]
+ ["//#" /// #_
+ ["#." phase]
+ [meta
+ [archive (#+ Archive)]]
+ [reference
+ [variable (#+ Register)]]]]]]])
+
+(def: @scope
+ (_.var "scope"))
-(def: @scope (_.var "scope"))
+(def: #export (scope expression archive [start initsS+ bodyS])
+ (Generator (Scope Synthesis))
+ (case initsS+
+ ## function/false/non-independent loop
+ #.Nil
+ (expression archive bodyS)
-(def: #export (scope generate [start initsS+ bodyS])
- (-> Phase (Scope Synthesis) (Operation Computation))
- (do {! ////.monad}
- [initsO+ (monad.map ! generate initsS+)
- bodyO (///.with-anchor @scope
- (generate bodyS))]
- (wrap (_.letrec (list [@scope (_.lambda [(|> initsS+
- list.enumeration
- (list\map (|>> product.left (n.+ start) //case.register)))
- #.None]
- bodyO)])
- (_.apply/* @scope initsO+)))))
+ ## true loop
+ _
+ (do {! ///////phase.monad}
+ [initsO+ (monad.map ! (expression archive) initsS+)
+ bodyO (/////generation.with_anchor @scope
+ (expression archive bodyS))]
+ (wrap (_.letrec (list [@scope (_.lambda [(|> initsS+
+ list.enumeration
+ (list\map (|>> product.left (n.+ start) //case.register)))
+ #.None]
+ bodyO)])
+ (_.apply/* initsO+ @scope))))))
-(def: #export (recur generate argsS+)
- (-> Phase (List Synthesis) (Operation Computation))
- (do {! ////.monad}
- [@scope ///.anchor
- argsO+ (monad.map ! generate argsS+)]
- (wrap (_.apply/* @scope argsO+))))
+(def: #export (recur expression archive argsS+)
+ (Generator (List Synthesis))
+ (do {! ///////phase.monad}
+ [@scope /////generation.anchor
+ argsO+ (monad.map ! (expression archive) argsS+)]
+ (wrap (_.apply/* argsO+ @scope))))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/reference.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/reference.lux
index b9add2e48..4e8ae26cf 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/reference.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/reference.lux
@@ -3,8 +3,10 @@
[target
["_" scheme (#+ Expression)]]]
[///
- ["." reference]])
+ [reference (#+ System)]])
-(def: #export system
- (reference.system (: (-> Text Expression) _.global)
- (: (-> Text Expression) _.var)))
+(structure: #export system
+ (System Expression)
+
+ (def: constant _.var)
+ (def: variable _.var))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/runtime.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/runtime.lux
index 45dcd3eb2..d6ae1cffd 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/runtime.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/runtime.lux
@@ -1,47 +1,65 @@
(.module:
- [lux #*
+ [lux (#- Location inc)
+ ["." meta]
[abstract
- [monad (#+ do)]]
+ ["." monad (#+ do)]]
[control
["." function]
- ["p" parser ("#\." monad)
- ["s" code (#+ Parser)]]]
+ ["<>" parser
+ ["<.>" code]]]
[data
- [number (#+ hex)]
- [text
- ["%" format (#+ format)]]
+ ["." product]
+ ["." text ("#\." hash)
+ ["%" format (#+ format)]
+ ["." encoding]]
[collection
- ["." list ("#\." monad)]]]
- [macro
- ["." code]
- [syntax (#+ syntax:)]]
- [target
+ ["." list ("#\." functor)]
+ ["." row]]]
+ ["." macro
+ [syntax (#+ syntax:)]
+ ["." code]]
+ [math
+ [number (#+ hex)
+ ["." i64]]]
+ ["@" target
["_" scheme (#+ Expression Computation Var)]]]
- ["." ///
- ["#/" //
- ["#/" // #_
- [analysis (#+ Variant)]
- ["#." name]
- ["#." synthesis]]]])
+ ["." /// #_
+ ["#." reference]
+ ["//#" /// #_
+ [analysis (#+ Variant)]
+ ["#." synthesis (#+ Synthesis)]
+ ["#." generation]
+ ["//#" ///
+ ["#." phase]
+ [reference
+ [variable (#+ Register)]]
+ [meta
+ [archive (#+ Output Archive)
+ ["." artifact (#+ Registry)]]]]]])
+
+(def: module_id
+ 0)
(template [<name> <base>]
[(type: #export <name>
(<base> Var Expression Expression))]
- [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)))
-(def: unit (_.string /////synthesis.unit))
+(def: unit
+ (_.string /////synthesis.unit))
(def: (flag value)
(-> Bit Computation)
(if value
- (_.string "")
+ ..unit
_.nil))
(def: (variant' tag last? value)
@@ -70,44 +88,54 @@
(-> Expression Computation)
(|>> [0 #1] ..variant))
-(def: declaration
- (Parser [Text (List Text)])
- (p.either (p.and s.local-identifier (p\wrap (list)))
- (s.form (p.and s.local-identifier (p.some s.local-identifier)))))
-
-(syntax: (runtime: {[name args] declaration}
- definition)
- (let [implementation (code.local-identifier (format "@@" name))
- runtime (format prefix "__" (/////name.normalize name))
- @runtime (` (_.var (~ (code.text runtime))))
- argsC+ (list\map code.local-identifier args)
- argsLC+ (list\map (|>> /////name.normalize (format "LRV__") code.text (~) (_.var) (`))
- args)
- declaration (` ((~ (code.local-identifier name))
- (~+ argsC+)))
- type (` (-> (~+ (list.repeat (list.size argsC+) (` _.Expression)))
- _.Computation))]
- (wrap (list (` (def: (~' #export) (~ declaration)
- (~ type)
- (~ (case argsC+
- #.Nil
- @runtime
-
- _
- (` (_.apply/* (~ @runtime) (list (~+ argsC+))))))))
- (` (def: (~ implementation)
- _.Computation
- (~ (case argsC+
- #.Nil
- (` (_.define-constant (~ @runtime) [(list) #.None] (~ definition)))
-
- _
- (` (let [(~+ (|> (list.zip/2 argsC+ argsLC+)
- (list\map (function (_ [left right])
- (list left right)))
- list\join))]
- (_.define-function (~ @runtime) [(list (~+ argsLC+)) #.None]
- (~ definition))))))))))))
+(syntax: #export (with_vars {vars (<code>.tuple (<>.some <code>.local_identifier))}
+ body)
+ (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)))))))
+
+(syntax: (runtime: {declaration (<>.or <code>.local_identifier
+ (<code>.form (<>.and <code>.local_identifier
+ (<>.some <code>.local_identifier))))}
+ code)
+ (do meta.monad
+ [runtime_id meta.count]
+ (macro.with_gensyms [g!_]
+ (let [runtime (code.local_identifier (///reference.artifact [..module_id runtime_id]))
+ runtime_name (` (_.var (~ (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)))
+ _.Computation
+ (_.define_constant (~ runtime_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)))
+ _.Computation
+ (..with_vars [(~+ inputsC)]
+ (_.define_function (~ runtime_name) [(list (~+ inputsC)) #.None]
+ (~ code))))))))))))))
(runtime: (slice offset length list)
(<| (_.if (_.null?/1 list)
@@ -123,113 +151,104 @@
(_.cdr/1 list))))
_.nil))
-(syntax: #export (with-vars {vars (s.tuple (p.many s.local-identifier))}
- body)
- (wrap (list (` (let [(~+ (|> vars
- (list\map (function (_ var)
- (list (code.local-identifier var)
- (` (_.var (~ (code.text (format "LRV__" (/////name.normalize var)))))))))
- list\join))]
- (~ body))))))
-
(runtime: (lux//try op)
- (with-vars [error]
- (_.with-exception-handler
+ (with_vars [error]
+ (_.with_exception_handler
(_.lambda [(list error) #.None]
(..left error))
(_.lambda [(list) #.None]
- (..right (_.apply/* op (list ..unit)))))))
+ (..right (_.apply/* (list ..unit) op))))))
-(runtime: (lux//program-args program-args)
- (with-vars [@loop @input @output]
+(runtime: (lux//program_args program_args)
+ (with_vars [@loop @input @output]
(_.letrec (list [@loop (_.lambda [(list @input @output) #.None]
(_.if (_.eqv?/2 _.nil @input)
@output
(_.apply/2 @loop (_.cdr/1 @input) (..some (_.vector/* (list (_.car/1 @input) @output))))))])
- (_.apply/2 @loop (_.reverse/1 program-args) ..none))))
+ (_.apply/2 @loop (_.reverse/1 program_args) ..none))))
(def: runtime//lux
Computation
- (_.begin (list @@lux//try
- @@lux//program-args)))
+ (_.begin (list @lux//try
+ @lux//program_args)))
-(def: last-index
+(def: last_index
(-> Expression Computation)
(|>> _.length/1 (_.-/2 (_.int +1))))
(runtime: (tuple//left lefts tuple)
- (with-vars [last-index-right]
+ (with_vars [last_index_right]
(_.begin
- (list (_.define-constant last-index-right (..last-index tuple))
- (_.if (_.>/2 lefts last-index-right)
+ (list (_.define_constant last_index_right (..last_index tuple))
+ (_.if (_.>/2 lefts last_index_right)
## No need for recursion
- (_.vector-ref/2 tuple lefts)
+ (_.vector_ref/2 tuple lefts)
## Needs recursion
- (tuple//left (_.-/2 last-index-right lefts)
- (_.vector-ref/2 tuple last-index-right)))))))
+ (tuple//left (_.-/2 last_index_right lefts)
+ (_.vector_ref/2 tuple last_index_right)))))))
(runtime: (tuple//right lefts tuple)
- (with-vars [last-index-right right-index @slice]
+ (with_vars [last_index_right right_index @slice]
(_.begin
- (list (_.define-constant last-index-right (..last-index tuple))
- (_.define-constant right-index (_.+/2 (_.int +1) lefts))
- (_.cond (list [(_.=/2 last-index-right right-index)
- (_.vector-ref/2 tuple right-index)]
- [(_.>/2 last-index-right right-index)
+ (list (_.define_constant last_index_right (..last_index tuple))
+ (_.define_constant right_index (_.+/2 (_.int +1) lefts))
+ (_.cond (list [(_.=/2 last_index_right right_index)
+ (_.vector_ref/2 tuple right_index)]
+ [(_.>/2 last_index_right right_index)
## Needs recursion.
- (tuple//right (_.-/2 last-index-right lefts)
- (_.vector-ref/2 tuple last-index-right))])
+ (tuple//right (_.-/2 last_index_right lefts)
+ (_.vector_ref/2 tuple last_index_right))])
(_.begin
- (list (_.define-constant @slice (_.make-vector/1 (_.-/2 right-index (_.length/1 tuple))))
- (_.vector-copy!/5 @slice (_.int +0) tuple right-index (_.length/1 tuple))
+ (list (_.define_constant @slice (_.make_vector/1 (_.-/2 right_index (_.length/1 tuple))))
+ (_.vector_copy!/5 @slice (_.int +0) tuple right_index (_.length/1 tuple))
@slice))))
)))
-(runtime: (sum//get sum last? wanted-tag)
- (with-vars [sum-tag sum-flag sum-value]
- (let [no-match _.nil
- is-last? (|> sum-flag (_.eqv?/2 (_.string "")))
- test-recursion (_.if is-last?
+(runtime: (sum//get sum last? wanted_tag)
+ (with_vars [sum_tag sum_flag sum_value]
+ (let [no_match _.nil
+ is_last? (|> sum_flag (_.eqv?/2 ..unit))
+ test_recursion (_.if is_last?
## Must recurse.
- (sum//get sum-value
+ (sum//get sum_value
last?
- (|> wanted-tag (_.-/2 sum-tag)))
- no-match)]
- (<| (_.let (list [sum-tag (_.car/1 sum)]
- [sum-value (_.cdr/1 sum)]))
- (_.let (list [sum-flag (_.car/1 sum-value)]
- [sum-value (_.cdr/1 sum-value)]))
- (_.if (|> wanted-tag (_.=/2 sum-tag))
- (_.if (|> sum-flag (_.eqv?/2 last?))
- sum-value
- test-recursion))
- (_.if (|> wanted-tag (_.>/2 sum-tag))
- test-recursion)
- (_.if (_.and (list (|> last? (_.eqv?/2 (_.string "")))
- (|> wanted-tag (_.</2 sum-tag))))
- (variant' (|> sum-tag (_.-/2 wanted-tag)) sum-flag sum-value))
- no-match))))
+ (|> wanted_tag (_.-/2 sum_tag)))
+ no_match)]
+ (<| (_.let (list [sum_tag (_.car/1 sum)]
+ [sum_value (_.cdr/1 sum)]))
+ (_.let (list [sum_flag (_.car/1 sum_value)]
+ [sum_value (_.cdr/1 sum_value)]))
+ (_.if (|> wanted_tag (_.=/2 sum_tag))
+ (_.if (|> sum_flag (_.eqv?/2 last?))
+ sum_value
+ test_recursion))
+ (_.if (|> wanted_tag (_.>/2 sum_tag))
+ test_recursion)
+ (_.if (_.and (list (|> last? (_.eqv?/2 ..unit))
+ (|> wanted_tag (_.</2 sum_tag))))
+ (variant' (|> sum_tag (_.-/2 wanted_tag)) sum_flag sum_value))
+ no_match))))
(def: runtime//adt
Computation
- (_.begin (list @@tuple//left
- @@tuple//right
- @@sum//get)))
+ (_.begin (list @tuple//left
+ @tuple//right
+ @sum//get)))
-(runtime: (i64//logical-right-shift shift input)
+(runtime: (i64//logical_right_shift shift input)
(_.if (_.=/2 (_.int +0) shift)
input
(|> input
- (_.arithmetic-shift/2 (_.*/2 (_.int -1) shift))
- (_.bit-and/2 (_.int (hex "+7FFFFFFFFFFFFFFF"))))))
+ (_.arithmetic_shift/2 (_.*/2 (_.int -1) shift))
+ (_.bit_and/2 (_.int (hex "+7FFFFFFFFFFFFFFF"))))))
(def: runtime//bit
Computation
- (_.begin (list @@i64//logical-right-shift)))
+ (_.begin (list @i64//logical_right_shift)))
(runtime: (frac//decode input)
- (with-vars [@output]
- (_.let (list [@output ((_.apply/1 (_.global "string->number")) input)])
+ (with_vars [@output]
+ (_.let (list [@output ((_.apply/1 (_.var "string->number")) input)])
(_.if (_.and (list (_.not/1 (_.=/2 @output @output))
(_.not/1 (_.eqv?/2 (_.string "+nan.0") input))))
..none
@@ -238,19 +257,19 @@
(def: runtime//frac
Computation
(_.begin
- (list @@frac//decode)))
+ (list @frac//decode)))
-(runtime: (io//current-time _)
- (|> (_.apply/* (_.global "current-second") (list))
+(runtime: (io//current_time _)
+ (|> (_.apply/0 (_.var "current-second"))
(_.*/2 (_.int +1,000))
_.exact/1))
(def: runtime//io
- (_.begin (list @@io//current-time)))
+ (_.begin (list @io//current_time)))
(def: runtime
Computation
- (_.begin (list @@slice
+ (_.begin (list @slice
runtime//lux
runtime//bit
runtime//adt
@@ -259,9 +278,14 @@
)))
(def: #export generate
- (Operation Any)
- (///.with-buffer
- (do ////.monad
- [_ (///.execute! ..runtime)
- _ (///.save! ..prefix ..runtime)]
- (///.save-buffer! ""))))
+ (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/scheme/structure.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/structure.lux
index bb11d2e1f..951fa494d 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/structure.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/structure.lux
@@ -2,36 +2,38 @@
[lux #*
[abstract
["." monad (#+ do)]]
+ [data
+ [collection
+ ["." list]]]
[target
["_" scheme (#+ Expression)]]]
- [//
- ["." runtime (#+ Operation Phase)]
- ["." primitive]
- ["." ///
- [//
- [analysis (#+ Variant Tuple)]
- ["." synthesis (#+ Synthesis)]]]])
+ ["." // #_
+ ["#." runtime (#+ Operation Phase Generator)]
+ ["#." primitive]
+ ["///#" //// #_
+ [analysis (#+ Variant Tuple)]
+ ["#." synthesis (#+ Synthesis)]
+ ["//#" /// #_
+ ["#." phase ("#\." monad)]]]])
-(def: #export (tuple generate elemsS+)
- (-> Phase (Tuple Synthesis) (Operation Expression))
+(def: #export (tuple expression 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)
+ (expression archive singletonS)
_
- (do {! ///.monad}
- [elemsT+ (monad.map ! generate elemsS+)]
- (wrap (_.vector/* elemsT+)))))
+ (|> elemsS+
+ (monad.map ///////phase.monad (expression archive))
+ (///////phase\map _.vector/*))))
-(def: #export (variant generate [lefts right? valueS])
- (-> Phase (Variant Synthesis) (Operation Expression))
- (do ///.monad
- [valueT (generate valueS)]
- (wrap (runtime.variant [(if right?
- (inc lefts)
- lefts)
- right?
- valueT]))))
+(def: #export (variant expression archive [lefts right? valueS])
+ (Generator (Variant Synthesis))
+ (let [tag (if right?
+ (inc lefts)
+ lefts)]
+ (///////phase\map (|>> [tag right?] //runtime.variant)
+ (expression archive valueS))))
diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux
index 8d9f68922..8532b3e12 100644
--- a/stdlib/source/test/lux.lux
+++ b/stdlib/source/test/lux.lux
@@ -11,7 +11,9 @@
[monad (#+ do)]
[predicate (#+ Predicate)]]
[control
- ["." io (#+ io)]]
+ ["." io (#+ io)]
+ [concurrency
+ ["." atom (#+ Atom)]]]
[data
["." name]
[text
@@ -52,12 +54,14 @@
(def: identity
Test
(do {! random.monad}
- [self (random.unicode 1)]
+ [#let [object (: (Random (Atom Text))
+ (\ ! map atom.atom (random.unicode 1)))]
+ self object]
($_ _.and
(_.test "Every value is identical to itself."
(is? self self))
(do !
- [other (random.unicode 1)]
+ [other object]
(_.test "Values created separately can't be identical."
(not (is? self other))))
)))