aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux/data/text/format.lux8
-rw-r--r--stdlib/source/lux/host/js.lux42
-rw-r--r--stdlib/source/lux/host/python.lux402
-rw-r--r--stdlib/source/lux/macro/template.lux22
-rw-r--r--stdlib/source/lux/tool/compiler/phase/generation/extension.lux58
-rw-r--r--stdlib/source/lux/tool/compiler/phase/generation/js.lux4
-rw-r--r--stdlib/source/lux/tool/compiler/phase/generation/js/case.lux50
-rw-r--r--stdlib/source/lux/tool/compiler/phase/generation/js/extension/common.lux102
-rw-r--r--stdlib/source/lux/tool/compiler/phase/generation/js/extension/host.lux39
-rw-r--r--stdlib/source/lux/tool/compiler/phase/generation/js/function.lux10
-rw-r--r--stdlib/source/lux/tool/compiler/phase/generation/js/runtime.lux5
-rw-r--r--stdlib/source/lux/tool/compiler/phase/generation/python.lux60
-rw-r--r--stdlib/source/lux/tool/compiler/phase/generation/python/case.lux218
-rw-r--r--stdlib/source/lux/tool/compiler/phase/generation/python/extension.lux15
-rw-r--r--stdlib/source/lux/tool/compiler/phase/generation/python/extension/common.lux130
-rw-r--r--stdlib/source/lux/tool/compiler/phase/generation/python/extension/host.lux25
-rw-r--r--stdlib/source/lux/tool/compiler/phase/generation/python/function.lux107
-rw-r--r--stdlib/source/lux/tool/compiler/phase/generation/python/loop.lux40
-rw-r--r--stdlib/source/lux/tool/compiler/phase/generation/python/primitive.lux27
-rw-r--r--stdlib/source/lux/tool/compiler/phase/generation/python/reference.lux11
-rw-r--r--stdlib/source/lux/tool/compiler/phase/generation/python/runtime.lux392
-rw-r--r--stdlib/source/lux/tool/compiler/phase/generation/python/structure.lux36
-rw-r--r--stdlib/source/lux/tool/compiler/phase/synthesis/case.lux124
-rw-r--r--stdlib/source/test/lux.lux7
24 files changed, 1747 insertions, 187 deletions
diff --git a/stdlib/source/lux/data/text/format.lux b/stdlib/source/lux/data/text/format.lux
index 83701c972..f6a53358d 100644
--- a/stdlib/source/lux/data/text/format.lux
+++ b/stdlib/source/lux/data/text/format.lux
@@ -1,7 +1,7 @@
(.module:
[lux #*
[control
- [monad (#+ do Monad)]
+ [monad (#+ do)]
["p" parser]]
[data
["." bit]
@@ -16,7 +16,7 @@
["." xml]
["." json]]
[collection
- ["." list ("#;." monad)]]]
+ ["." list ("#@." monad)]]]
[time
["." instant]
["." duration]
@@ -25,7 +25,7 @@
["." modular]]
["." macro
["." code]
- ["s" syntax (#+ syntax: Syntax)]]
+ ["s" syntax (#+ Syntax syntax:)]]
["." type]])
## [Syntax]
@@ -85,4 +85,4 @@
"(list)"
_
- (format "(list " (text.join-with " " (list;map formatter values)) ")"))))
+ (format "(list " (text.join-with " " (list@map formatter values)) ")"))))
diff --git a/stdlib/source/lux/host/js.lux b/stdlib/source/lux/host/js.lux
index 45f3d42c6..be8759a35 100644
--- a/stdlib/source/lux/host/js.lux
+++ b/stdlib/source/lux/host/js.lux
@@ -123,27 +123,6 @@
(format (:representation function))
:abstraction))
- (do-template [<apply> <arg>+ <type>+ <function>+]
- [(`` (def: #export (<apply> function)
- (-> Expression (~~ (template.splice <type>+)) Computation)
- (.function (_ (~~ (template.splice <arg>+)))
- (..apply/* function (list (~~ (template.splice <arg>+)))))))
-
- (`` (do-template [<definition> <function>]
- [(def: #export <definition> (<apply> (..var <function>)))]
-
- (~~ (template.splice <function>+))))]
-
- [apply/1 [_0] [Expression]
- [[not-a-number? "isNaN"]]]
-
- [apply/2 [_0 _1] [Expression Expression]
- []]
-
- [apply/3 [_0 _1 _2] [Expression Expression Expression]
- []]
- )
-
(def: #export (do method inputs object)
(-> Text (List Expression) Expression Computation)
(apply/* (..the method object) inputs))
@@ -395,3 +374,24 @@
(..if test then! next!))
else!
(list.reverse clauses)))
+
+(do-template [<apply> <arg>+ <type>+ <function>+]
+ [(`` (def: #export (<apply> function)
+ (-> Expression (~~ (template.splice <type>+)) Computation)
+ (.function (_ (~~ (template.splice <arg>+)))
+ (..apply/* function (list (~~ (template.splice <arg>+)))))))
+
+ (`` (do-template [<definition> <function>]
+ [(def: #export <definition> (<apply> (..var <function>)))]
+
+ (~~ (template.splice <function>+))))]
+
+ [apply/1 [_0] [Expression]
+ [[not-a-number? "isNaN"]]]
+
+ [apply/2 [_0 _1] [Expression Expression]
+ []]
+
+ [apply/3 [_0 _1 _2] [Expression Expression Expression]
+ []]
+ )
diff --git a/stdlib/source/lux/host/python.lux b/stdlib/source/lux/host/python.lux
new file mode 100644
index 000000000..afdb923fc
--- /dev/null
+++ b/stdlib/source/lux/host/python.lux
@@ -0,0 +1,402 @@
+(.module:
+ [lux (#- Code not or and list if cond int)
+ [control
+ pipe]
+ [data
+ [number
+ ["." frac]]
+ ["." text
+ format]
+ [collection
+ ["." list ("#@." functor fold)]]]
+ [macro
+ ["." template]
+ ["." code]
+ ["s" syntax (#+ syntax:)]]
+ [type
+ abstract]])
+
+(def: expression (-> Text Text) (text.enclose ["(" ")"]))
+
+(def: nest
+ (-> Text Text)
+ (|>> (format text.new-line)
+ (text.replace-all text.new-line (format text.new-line text.tab))))
+
+(abstract: #export (Code brand)
+ {}
+
+ Text
+
+ (def: #export manual
+ (-> Text Code)
+ (|>> :abstraction))
+
+ (def: #export code
+ (-> (Code Any) Text)
+ (|>> :representation))
+
+ (do-template [<type> <super>]
+ [(with-expansions [<brand> (template.identifier [<type> "'"])]
+ (`` (abstract: #export (<brand> brand) {} Any))
+ (`` (type: #export (<type> brand)
+ (<super> (<brand> brand)))))]
+
+ [Expression Code]
+ [Computation Expression]
+ [Location Computation]
+ [Var Location]
+ [Statement Code]
+ )
+
+ (do-template [<type> <super>]
+ [(with-expansions [<brand> (template.identifier [<type> "'"])]
+ (`` (abstract: #export <brand> {} Any))
+ (`` (type: #export <type> (<super> <brand>))))]
+
+ [Literal Computation]
+ [Access Location]
+ [Loop Statement]
+ [Label Code]
+ )
+
+ (abstract: #export Single {} Any)
+ (abstract: #export Poly {} Any)
+ (abstract: #export Keyword {} Any)
+
+ (type: #export SVar (Var Single))
+ (type: #export PVar (Var Poly))
+ (type: #export KVar (Var Keyword))
+
+ (def: #export var
+ (-> Text SVar)
+ (|>> :abstraction))
+
+ (do-template [<name> <kind> <prefix>]
+ [(def: #export <name>
+ (-> SVar (Var <kind>))
+ (|>> :representation (format <prefix>) :abstraction))]
+
+ [poly Poly "*"]
+ [keyword Keyword "**"]
+ )
+
+ (def: #export none
+ Literal
+ (:abstraction "None"))
+
+ (def: #export bool
+ (-> Bit Literal)
+ (|>> (case> #0 "False"
+ #1 "True")
+ :abstraction))
+
+ (def: #export int
+ (-> Int Literal)
+ (|>> %i :abstraction))
+
+ (def: #export float
+ (-> Frac Literal)
+ (`` (|>> (cond> (~~ (do-template [<lux> <python>]
+ [[(f/= <lux>)]
+ [(new> (format "float(" text.double-quote <python> text.double-quote ")") [])]]
+
+ [frac.positive-infinity "inf"]
+ [frac.negative-infinity "-inf"]
+ [frac.not-a-number "nan"]
+ ))
+
+ ## else
+ [%f])
+ :abstraction)))
+
+ (def: #export string
+ (-> Text Literal)
+ (|>> (text.enclose' text.double-quote) :abstraction))
+
+ (def: (composite-literal left-delimiter right-delimiter entry-serializer)
+ (All [a]
+ (-> Text Text (-> a Text)
+ (-> (List a) Literal)))
+ (function (_ entries)
+ (<| :abstraction
+ ..expression
+ (format left-delimiter
+ (|> entries (list@map entry-serializer) (text.join-with ","))
+ right-delimiter))))
+
+ (do-template [<name> <pre> <post>]
+ [(def: #export <name>
+ (-> (List (Expression Any)) Literal)
+ (composite-literal <pre> <post> ..code))]
+
+ [tuple "(" ")"]
+ [list "[" "]"]
+ )
+
+ (def: #export (slice from to list)
+ (-> (Expression Any) (Expression Any) (Expression Any) Access)
+ (<| :abstraction
+ ..expression
+ (format (:representation list) "[" (:representation from) ":" (:representation to) "]")))
+
+ (def: #export (slice-from from list)
+ (-> (Expression Any) (Expression Any) Access)
+ (<| :abstraction
+ ..expression
+ (format (:representation list) "[" (:representation from) ":]")))
+
+ (def: #export dict
+ (-> (List [(Expression Any) (Expression Any)]) (Computation Any))
+ (composite-literal "{" "}" (.function (_ [k v]) (format (:representation k) " : " (:representation v)))))
+
+ (def: #export (apply/* func args)
+ (-> (Expression Any) (List (Expression Any)) (Computation Any))
+ (<| :abstraction
+ ..expression
+ (format (:representation func) "(" (text.join-with "," (list@map ..code args)) ")")))
+
+ (do-template [<name> <kind> <prefix>]
+ [(def: (<name> var)
+ (-> (Expression Any) Text)
+ (format <prefix> (:representation var)))]
+
+ [splat-poly Poly "*"]
+ [splat-keyword Keyword "**"]
+ )
+
+ (do-template [<name> <splat>]
+ [(def: #export (<name> args extra func)
+ (-> (List (Expression Any)) (Expression Any) (Expression Any) (Computation Any))
+ (<| :abstraction
+ ..expression
+ (format (:representation func)
+ (format "(" (|> args
+ (list@map (function (_ arg) (format (:representation arg) ", ")))
+ (text.join-with ""))
+ (<splat> extra) ")"))))]
+
+ [apply-poly splat-poly]
+ [apply-keyword splat-keyword]
+ )
+
+ (def: #export (the name object)
+ (-> Text (Expression Any) (Computation Any))
+ (:abstraction (format (:representation object) "." name)))
+
+ (def: #export (do method args object)
+ (-> Text (List (Expression Any)) (Expression Any) (Computation Any))
+ (..apply/* (..the method object) args))
+
+ (do-template [<name> <apply>]
+ [(def: #export (<name> args extra method)
+ (-> (List (Expression Any)) (Expression Any) Text
+ (-> (Expression Any) (Computation Any)))
+ (|>> (..the method) (<apply> args extra)))]
+
+ [do-poly apply-poly]
+ [do-keyword apply-keyword]
+ )
+
+ (def: #export (nth idx array)
+ (-> (Expression Any) (Expression Any) Location)
+ (:abstraction (format (:representation array) "[" (:representation idx) "]")))
+
+ (def: #export (? test then else)
+ (-> (Expression Any) (Expression Any) (Expression Any) (Computation Any))
+ (<| :abstraction
+ ..expression
+ (format (:representation then) " if " (:representation test) " else " (:representation else))))
+
+ (do-template [<name> <op>]
+ [(def: #export (<name> param subject)
+ (-> (Expression Any) (Expression Any) (Computation Any))
+ (<| :abstraction
+ ..expression
+ (format (:representation subject) " " <op> " " (:representation param))))]
+
+ [is "is"]
+ [= "=="]
+ [< "<"]
+ [<= "<="]
+ [> ">"]
+ [>= ">="]
+ [+ "+"]
+ [- "-"]
+ [* "*"]
+ [/ "/"]
+ [% "%"]
+ [** "**"]
+ [bit-or "|"]
+ [bit-and "&"]
+ [bit-xor "^"]
+ [bit-shl "<<"]
+ [bit-shr ">>"]
+
+ [or "or"]
+ [and "and"]
+ )
+
+ (def: #export (not subject)
+ (-> (Expression Any) (Computation Any))
+ (<| :abstraction
+ ..expression
+ (format "not " (:representation subject))))
+
+ (def: #export (lambda arguments body)
+ (-> (List (Var Any)) (Expression Any) (Computation Any))
+ (<| :abstraction
+ ..expression
+ (format "lambda " (|> arguments (list@map ..code) (text.join-with ", ")) ": "
+ (:representation body))))
+
+ (def: #export (set vars value)
+ (-> (List (Location Any)) (Expression Any) (Statement Any))
+ (:abstraction
+ (format (|> vars (list@map ..code) (text.join-with ", "))
+ " = "
+ (:representation value))))
+
+ (def: #export (delete where)
+ (-> (Location Any) (Statement Any))
+ (:abstraction (format "del " (:representation where))))
+
+ (def: #export (if test then! else!)
+ (-> (Expression Any) (Statement Any) (Statement Any) (Statement Any))
+ (:abstraction
+ (format "if " (:representation test) ":"
+ (..nest (:representation then!))
+ text.new-line "else:"
+ (..nest (:representation else!)))))
+
+ (def: #export (when test then!)
+ (-> (Expression Any) (Statement Any) (Statement Any))
+ (:abstraction
+ (format "if " (:representation test) ":"
+ (..nest (:representation then!)))))
+
+ (def: #export (then pre! post!)
+ (-> (Statement Any) (Statement Any) (Statement Any))
+ (:abstraction
+ (format (:representation pre!)
+ text.new-line
+ (:representation post!))))
+
+ (do-template [<keyword> <0>]
+ [(def: #export <0>
+ Statement
+ (:abstraction <keyword>))]
+
+ ["break" break]
+ ["continue" continue]
+ )
+
+ (def: #export (while test body!)
+ (-> (Expression Any) (Statement Any) Loop)
+ (:abstraction
+ (format "while " (:representation test) ":"
+ (..nest (:representation body!)))))
+
+ (def: #export (for-in var inputs body!)
+ (-> SVar (Expression Any) (Statement Any) Loop)
+ (:abstraction
+ (format "for " (:representation var) " in " (:representation inputs) ":"
+ (..nest (:representation body!)))))
+
+ (def: #export (statement expression)
+ (-> (Expression Any) (Statement Any))
+ (:abstraction
+ (format (:representation expression) ";")))
+
+ (def: #export no-op!
+ (Statement Any)
+ (:abstraction text.new-line))
+
+ (type: #export Except
+ {#classes (List SVar)
+ #exception SVar
+ #handler (Statement Any)})
+
+ (def: #export (try body! excepts)
+ (-> (Statement Any) (List Except) (Statement Any))
+ (:abstraction
+ (format "try:"
+ (..nest (:representation body!))
+ (|> excepts
+ (list@map (function (_ [classes exception catch!])
+ (format text.new-line "except (" (text.join-with "," (list@map ..code classes))
+ ") as " (:representation exception) ":"
+ (..nest (:representation catch!)))))
+ (text.join-with "")))))
+
+ (do-template [<name> <keyword>]
+ [(def: #export (<name> message)
+ (-> (Expression Any) (Statement Any))
+ (:abstraction
+ (format <keyword> " " (:representation message))))]
+
+ [raise "raise"]
+ [return "return"]
+ [print "print"]
+ )
+
+ (def: #export (def name args body)
+ (-> SVar (List (Ex [k] (Var k))) (Statement Any) (Statement Any))
+ (:abstraction
+ (format "def " (:representation name)
+ "(" (|> args (list@map ..code) (text.join-with ",")) "):"
+ (..nest (:representation body)))))
+
+ (def: #export (import module-name)
+ (-> Text (Statement Any))
+ (:abstraction (format "import " module-name)))
+ )
+
+(def: #export (cond clauses else!)
+ (-> (List [(Expression Any) (Statement Any)]) (Statement Any) (Statement Any))
+ (list@fold (.function (_ [test then!] next!)
+ (..if test then! next!))
+ else!
+ (list.reverse clauses)))
+
+(syntax: (arity-inputs {arity s.nat})
+ (wrap (case arity
+ 0 (.list)
+ _ (|> (dec arity)
+ (list.n/range 0)
+ (list@map (|>> %n code.local-identifier))))))
+
+(syntax: (arity-types {arity s.nat})
+ (wrap (list.repeat arity (` (Expression Any)))))
+
+(do-template [<arity> <function>+]
+ [(with-expansions [<apply> (template.identifier ["apply/" <arity>])
+ <inputs> (arity-inputs <arity>)
+ <types> (arity-types <arity>)
+ <definitions> (template.splice <function>+)]
+ (def: #export (<apply> function <inputs>)
+ (-> (Expression Any) <types> (Computation Any))
+ (..apply/* function (.list <inputs>)))
+
+ (do-template [<function>]
+ [(`` (def: #export (~~ (template.identifier [<function> "/" <arity>]))
+ (<apply> (..var <function>))))]
+
+ <definitions>))]
+
+ [1
+ [["str"]
+ ["ord"]
+ ["float"]
+ ["int"]
+ ["len"]
+ ["chr"]
+ ["repr"]
+ ["Exception"]]]
+
+ [2
+ []]
+
+ [3
+ []]
+ )
diff --git a/stdlib/source/lux/macro/template.lux b/stdlib/source/lux/macro/template.lux
index 1f098ff4a..d0e9714a2 100644
--- a/stdlib/source/lux/macro/template.lux
+++ b/stdlib/source/lux/macro/template.lux
@@ -2,11 +2,17 @@
[lux #*
[control
["." monad (#+ do)]
- ["p" parser]]
+ ["p" parser ("#@." functor)]]
[data
+ ["." bit ("#@." codec)]
["." text]
+ [number
+ ["." nat ("#@." decimal)]
+ ["." int ("#@." decimal)]
+ ["." rev ("#@." decimal)]
+ ["." frac ("#@." decimal)]]
[collection
- ["." list ("#;." monad)]]]]
+ ["." list ("#@." monad)]]]]
["." //
["." code]
["s" syntax (#+ Syntax syntax:)]])
@@ -21,9 +27,9 @@
(list.repeat (list.size locals))
(monad.seq @))]
(wrap (list (` (.with-expansions [(~+ (|> (list.zip2 locals g!locals)
- (list;map (function (_ [name identifier])
+ (list@map (function (_ [name identifier])
(list (code.local-identifier name) (as-is identifier))))
- list;join))]
+ list@join))]
(~ body)))))))
(def: snippet
@@ -31,7 +37,13 @@
($_ p.either
s.text
s.local-identifier
- s.local-tag))
+ s.local-tag
+ (p@map bit@encode s.bit)
+ (p@map nat@encode s.nat)
+ (p@map int@encode s.int)
+ (p@map rev@encode s.rev)
+ (p@map frac@encode s.frac)
+ ))
(def: part
(Syntax (List Text))
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/extension.lux b/stdlib/source/lux/tool/compiler/phase/generation/extension.lux
new file mode 100644
index 000000000..681fd35f8
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/phase/generation/extension.lux
@@ -0,0 +1,58 @@
+(.module:
+ [lux #*
+ [control
+ ["." monad (#+ do)]]
+ [data
+ [collection
+ ["." list ("#@." functor)]]]
+ ["." macro (#+ with-gensyms)
+ ["." code]
+ ["s" syntax (#+ syntax:)]]]
+ ["." //
+ ["#/" //
+ ["#." extension]
+ [//
+ [synthesis (#+ Synthesis)]]]])
+
+(syntax: (Vector {size s.nat} elemT)
+ (wrap (list (` [(~+ (list.repeat size elemT))]))))
+
+(type: #export (Nullary of) (-> (Vector 0 of) of))
+(type: #export (Unary of) (-> (Vector 1 of) of))
+(type: #export (Binary of) (-> (Vector 2 of) of))
+(type: #export (Trinary of) (-> (Vector 3 of) of))
+(type: #export (Variadic of) (-> (List of) of))
+
+(syntax: (arity: {arity s.nat} {name s.local-identifier} type)
+ (with-gensyms [g!_ g!extension g!name g!phase g!inputs g!of g!anchor g!expression g!statement]
+ (do @
+ [g!input+ (monad.seq @ (list.repeat arity (macro.gensym "input")))]
+ (wrap (list (` (def: #export ((~ (code.local-identifier name)) (~ g!extension))
+ (All [(~ g!anchor) (~ g!expression) (~ g!statement)]
+ (-> ((~ type) (~ g!expression)) (//.Handler (~ g!anchor) (~ g!expression) (~ g!statement))))
+ (function ((~ g!_) (~ g!name) (~ g!phase) (~ g!inputs))
+ (case (~ g!inputs)
+ (^ (list (~+ g!input+)))
+ (do ///.monad
+ [(~+ (|> g!input+
+ (list@map (function (_ g!input)
+ (list g!input (` ((~ g!phase) (~ g!input))))))
+ list.concat))]
+ ((~' wrap) ((~ g!extension) [(~+ g!input+)])))
+
+ (~' _)
+ (///.throw ///extension.incorrect-arity [(~ g!name) 1 (list.size (~ g!inputs))]))))))))))
+
+(arity: 0 nullary ..Nullary)
+(arity: 1 unary ..Unary)
+(arity: 2 binary ..Binary)
+(arity: 3 trinary ..Trinary)
+
+(def: #export (variadic extension)
+ (All [anchor expression statement]
+ (-> (Variadic expression) (//.Handler anchor expression statement)))
+ (function (_ extension-name)
+ (function (_ phase inputsS)
+ (do ///.monad
+ [inputsI (monad.map @ phase inputsS)]
+ (wrap (extension inputsI))))))
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/js.lux b/stdlib/source/lux/tool/compiler/phase/generation/js.lux
index 5da2a016e..29c95ff43 100644
--- a/stdlib/source/lux/tool/compiler/phase/generation/js.lux
+++ b/stdlib/source/lux/tool/compiler/phase/generation/js.lux
@@ -6,7 +6,7 @@
[runtime (#+ Phase)]
["." primitive]
["." structure]
- ["." reference ("#;." system)]
+ ["." reference ("#@." system)]
["." function]
["." case]
["." loop]
@@ -33,7 +33,7 @@
(structure.tuple generate members)
(#synthesis.Reference value)
- (reference;reference value)
+ (reference@reference value)
(^ (synthesis.branch/case case))
(case.case generate case)
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/js/case.lux b/stdlib/source/lux/tool/compiler/phase/generation/js/case.lux
index ed2c74a4b..4a28ccb3f 100644
--- a/stdlib/source/lux/tool/compiler/phase/generation/js/case.lux
+++ b/stdlib/source/lux/tool/compiler/phase/generation/js/case.lux
@@ -4,11 +4,10 @@
[monad (#+ do)]
["ex" exception (#+ exception:)]]
[data
- ["." number]
["." text
format]
[collection
- ["." list ("#;." functor fold)]]]
+ ["." list ("#@." functor fold)]]]
[host
["_" js (#+ Expression Computation Var Statement)]]]
["." // #_
@@ -17,7 +16,9 @@
["#." primitive]
["#/" // #_
["#." reference]
- ["#/" // ("#;." monad)
+ ["#/" // ("#@." monad)
+ [synthesis
+ ["." case]]
["#/" // #_
[reference (#+ Register)]
["#." synthesis (#+ Synthesis Path)]]]]])
@@ -32,18 +33,16 @@
[valueO (generate valueS)
bodyO (generate bodyS)]
## TODO: Find some way to do 'let' without paying the price of the closure.
- (wrap (_.apply/* (<| (_.closure (list))
- ($_ _.then
- (_.define (..register register) valueO)
- (_.return bodyO)))
- (list)))))
+ (wrap (_.apply/* (_.closure (list (..register register))
+ (_.return bodyO))
+ (list valueO)))))
(def: #export (record-get generate valueS pathP)
(-> Phase Synthesis (List [Nat Bit])
(Operation Expression))
(do ////.monad
[valueO (generate valueS)]
- (wrap (list;fold (function (_ [idx tail?] source)
+ (wrap (list@fold (function (_ [idx tail?] source)
(.let [method (.if tail?
//runtime.product//right
//runtime.product//left)]
@@ -63,7 +62,6 @@
(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: (push-cursor! value)
(-> Expression Statement)
@@ -98,17 +96,7 @@
(def: fail-pm! _.break)
-(def: (count-pops path)
- (-> Path [Nat Path])
- (.case path
- (^ ($_ /////synthesis.path/seq
- #/////synthesis.Pop
- path'))
- (.let [[pops post-pops] (count-pops path')]
- [(inc pops) post-pops])
-
- _
- [0 path]))
+(exception: #export unrecognized-path)
(def: (multi-pop-cursor! pops)
(-> Nat Statement)
@@ -116,8 +104,6 @@
(_.statement (|> @cursor (_.do "splice" (list (|> @cursor ..length (_.- popsJS))
popsJS))))))
-(exception: #export unrecognized-path)
-
(def: (pattern-matching' generate pathP)
(-> Phase Path (Operation Statement))
(.case pathP
@@ -127,14 +113,14 @@
(wrap (_.return body!)))
#/////synthesis.Pop
- (////;wrap pop-cursor!)
+ (////@wrap pop-cursor!)
(#/////synthesis.Bind register)
- (////;wrap (_.define (..register register) ..peek-cursor))
+ (////@wrap (_.define (..register register) ..peek-cursor))
(^template [<tag> <format> <=>]
(^ (<tag> value))
- (////;wrap (_.when (|> value <format> (<=> ..peek-cursor) _.not)
+ (////@wrap (_.when (|> value <format> (<=> ..peek-cursor) _.not)
fail-pm!)))
([/////synthesis.path/bit //primitive.bit _.=]
[/////synthesis.path/i64 (<| //primitive.i64 .int) //runtime.i64//=]
@@ -143,7 +129,7 @@
(^template [<pm> <flag> <prep>]
(^ (<pm> idx))
- (////;wrap ($_ _.then
+ (////@wrap ($_ _.then
(_.set @temp (|> idx <prep> .int _.i32 (//runtime.sum//get ..peek-cursor <flag>)))
(_.if (_.= _.null @temp)
fail-pm!
@@ -153,7 +139,7 @@
(^template [<pm> <getter> <prep>]
(^ (<pm> idx))
- (////;wrap (|> idx <prep> .int _.i32 (<getter> ..peek-cursor) push-cursor!)))
+ (////@wrap (|> idx <prep> .int _.i32 (<getter> ..peek-cursor) push-cursor!)))
([/////synthesis.member/left //runtime.product//left (<|)]
[/////synthesis.member/right //runtime.product//right inc])
@@ -163,7 +149,7 @@
thenP))
(do ////.monad
[then! (pattern-matching' generate thenP)]
- (////;wrap ($_ _.then
+ (////@wrap ($_ _.then
(_.define (..register register) ..peek-and-pop-cursor)
then!)))
@@ -171,10 +157,10 @@
#/////synthesis.Pop
#/////synthesis.Pop
nextP))
- (.let [[extra-pops nextP'] (count-pops nextP)]
+ (.let [[extra-pops nextP'] (case.count-pops nextP)]
(do ////.monad
[next! (pattern-matching' generate nextP')]
- (////;wrap ($_ _.then
+ (////@wrap ($_ _.then
(multi-pop-cursor! (n/+ 2 extra-pops))
next!))))
@@ -204,7 +190,7 @@
(wrap ($_ _.then
(_.do-while _.false
pattern-matching!)
- (_.throw (_.string "Invalid expression for pattern-matching."))))))
+ (_.throw (_.string case.pattern-matching-error))))))
(def: #export (case generate [valueS pathP])
(-> Phase [Synthesis Path] (Operation Computation))
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/js/extension/common.lux b/stdlib/source/lux/tool/compiler/phase/generation/js/extension/common.lux
index dfd0e4aee..2e661dc29 100644
--- a/stdlib/source/lux/tool/compiler/phase/generation/js/extension/common.lux
+++ b/stdlib/source/lux/tool/compiler/phase/generation/js/extension/common.lux
@@ -1,77 +1,29 @@
(.module:
[lux #*
[control
- ["." monad (#+ do)]
- ["ex" exception (#+ exception:)]]
+ ["." monad (#+ do)]]
[data
- ["e" error]
["." product]
- [number (#+ hex)]
[collection
- ["." list ("#;." functor)]
["." dictionary]]]
- ["." macro (#+ with-gensyms)
- ["." code]
- ["s" syntax (#+ syntax:)]]
[host (#+ import:)
- ["_" js (#+ Expression Computation)]]]
+ ["_" js (#+ Expression)]]]
["." /// #_
["#." runtime (#+ Operation Phase Handler Bundle)]
["#." primitive]
- ["#//" ///
- ["#." extension
- ["." bundle]]
- ["#/" // #_
- [synthesis (#+ Synthesis)]]]])
-
-(syntax: (Vector {size s.nat} elemT)
- (wrap (list (` [(~+ (list.repeat size elemT))]))))
-
-(type: #export Nullary (-> (Vector 0 Expression) Computation))
-(type: #export Unary (-> (Vector 1 Expression) Computation))
-(type: #export Binary (-> (Vector 2 Expression) Computation))
-(type: #export Trinary (-> (Vector 3 Expression) Computation))
-(type: #export Variadic (-> (List Expression) Computation))
-
-(syntax: (arity: {name s.local-identifier} {arity s.nat})
- (with-gensyms [g!_ g!extension g!name g!phase g!inputs]
- (do @
- [g!input+ (monad.seq @ (list.repeat arity (macro.gensym "input")))]
- (wrap (list (` (def: #export ((~ (code.local-identifier name)) (~ g!extension))
- (-> (-> (..Vector (~ (code.nat arity)) Expression) Computation)
- Handler)
- (function ((~ g!_) (~ g!name) (~ g!phase) (~ g!inputs))
- (case (~ g!inputs)
- (^ (list (~+ g!input+)))
- (do /////.monad
- [(~+ (|> g!input+
- (list;map (function (_ g!input)
- (list g!input (` ((~ g!phase) (~ g!input))))))
- list.concat))]
- ((~' wrap) ((~ g!extension) [(~+ g!input+)])))
-
- (~' _)
- (/////.throw /////extension.incorrect-arity [(~ g!name) 1 (list.size (~ g!inputs))]))))))))))
-
-(arity: nullary 0)
-(arity: unary 1)
-(arity: binary 2)
-(arity: trinary 3)
-
-(def: #export (variadic extension)
- (-> Variadic Handler)
- (function (_ extension-name)
- (function (_ phase inputsS)
- (do /////.monad
- [inputsI (monad.map @ phase inputsS)]
- (wrap (extension inputsI))))))
+ [//
+ [extension (#+ Nullary Unary Binary Trinary
+ nullary unary binary trinary)]
+ [//
+ [extension
+ ["." bundle]]]]])
## [Procedures]
## [[Bits]]
(do-template [<name> <op>]
- [(def: (<name> [paramJS subjectJS])
- Binary
- (<op> subjectJS (///runtime.i64//to-number paramJS)))]
+ [(def: (<name> [paramG subjectG])
+ (Binary Expression)
+ (<op> subjectG (///runtime.i64//to-number paramG)))]
[i64//left-shift ///runtime.i64//left-shift]
[i64//arithmetic-right-shift ///runtime.i64//arithmetic-right-shift]
@@ -85,7 +37,7 @@
(do-template [<name> <const>]
[(def: (<name> _)
- Nullary
+ (Nullary Expression)
(///primitive.f64 <const>))]
[frac//smallest (java/lang/Double::MIN_VALUE)]
@@ -94,7 +46,7 @@
)
(def: frac//decode
- Unary
+ (Unary Expression)
(|>> list
(_.apply/* (_.var "parseFloat"))
_.return
@@ -102,34 +54,34 @@
///runtime.lux//try))
(def: int//char
- Unary
+ (Unary Expression)
(|>> ///runtime.i64//to-number
(list)
(_.apply/* (_.var "String.fromCharCode"))))
## [[Text]]
-(def: (text//concat [subjectJS paramJS])
- Binary
- (|> subjectJS (_.do "concat" (list paramJS))))
+(def: (text//concat [subjectG paramG])
+ (Binary Expression)
+ (|> subjectG (_.do "concat" (list paramG))))
(do-template [<name> <runtime>]
- [(def: (<name> [subjectJS paramJS extraJS])
- Trinary
- (<runtime> subjectJS paramJS extraJS))]
+ [(def: (<name> [subjectG paramG extraG])
+ (Trinary Expression)
+ (<runtime> subjectG paramG extraG))]
[text//clip ///runtime.text//clip]
[text//index ///runtime.text//index]
)
## [[IO]]
-(def: (io//log messageJS)
- Unary
+(def: (io//log messageG)
+ (Unary Expression)
($_ _.,
- (///runtime.io//log messageJS)
+ (///runtime.io//log messageG)
///runtime.unit))
-(def: (io//exit codeJS)
- Unary
+(def: (io//exit codeG)
+ (Unary Expression)
(let [@@process (_.var "process")
@@window (_.var "window")
@@location (_.var "location")]
@@ -137,12 +89,12 @@
($_ _.and
(_.not (_.= _.undefined (_.type-of @@process)))
(_.the "exit" @@process)
- (_.do "exit" (list (///runtime.i64//to-number codeJS)) @@process))
+ (_.do "exit" (list (///runtime.i64//to-number codeG)) @@process))
(_.do "close" (list) @@window)
(_.do "reload" (list) @@location))))
(def: (io//current-time _)
- Nullary
+ (Nullary Expression)
(|> (_.new (_.var "Date") (list))
(_.do "getTime" (list))
///runtime.i64//from-number))
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/js/extension/host.lux b/stdlib/source/lux/tool/compiler/phase/generation/js/extension/host.lux
index f623242a0..aed6c4711 100644
--- a/stdlib/source/lux/tool/compiler/phase/generation/js/extension/host.lux
+++ b/stdlib/source/lux/tool/compiler/phase/generation/js/extension/host.lux
@@ -7,19 +7,20 @@
[collection
["." dictionary]]]
[host
- ["_" js]]]
- ["." // #_
- ["#." common (#+ Nullary Binary Trinary Variadic)]
+ ["_" js (#+ Expression)]]]
+ ["." /// #_
+ ["#." runtime (#+ Handler Bundle)]
["#/" // #_
- ["#." runtime (#+ Handler Bundle)]
- ["#//" ///
+ ["#." extension (#+ Nullary Unary Binary Trinary Variadic
+ nullary unary binary trinary variadic)]
+ ["#/" //
["#." extension
["." bundle]]
["#/" // #_
["#." synthesis]]]]])
(do-template [<name> <js>]
- [(def: (<name> _) Nullary <js>)]
+ [(def: (<name> _) (Nullary Expression) <js>)]
[js//null _.null]
[js//undefined _.undefined]
@@ -50,10 +51,10 @@
(def: js
Bundle
(|> bundle.empty
- (bundle.install "null" (//common.nullary js//null))
- (bundle.install "undefined" (//common.nullary js//undefined))
- (bundle.install "object" (//common.nullary js//object))
- (bundle.install "array" (//common.variadic _.array))
+ (bundle.install "null" (nullary js//null))
+ (bundle.install "undefined" (nullary js//undefined))
+ (bundle.install "object" (nullary js//object))
+ (bundle.install "array" (variadic _.array))
(bundle.install "global" js//global)
(bundle.install "call" js//call)))
@@ -85,7 +86,7 @@
(/////.throw /////extension.incorrect-syntax name)))
(def: (object//set [fieldJS valueJS objectJS])
- Trinary
+ (Trinary Expression)
(///runtime.js//set objectJS fieldJS valueJS))
(def: object
@@ -94,23 +95,23 @@
(|> bundle.empty
(bundle.install "new" object//new)
(bundle.install "call" object//call)
- (bundle.install "read" (//common.binary (product.uncurry ///runtime.js//get)))
- (bundle.install "write" (//common.trinary object//set))
- (bundle.install "delete" (//common.binary (product.uncurry ///runtime.js//delete)))
+ (bundle.install "read" (binary (product.uncurry ///runtime.js//get)))
+ (bundle.install "write" (trinary object//set))
+ (bundle.install "delete" (binary (product.uncurry ///runtime.js//delete)))
)))
(def: (array//write [indexJS valueJS arrayJS])
- Trinary
+ (Trinary Expression)
(///runtime.array//write indexJS valueJS arrayJS))
(def: array
Bundle
(<| (bundle.prefix "array")
(|> bundle.empty
- (bundle.install "read" (//common.binary (product.uncurry ///runtime.array//read)))
- (bundle.install "write" (//common.trinary array//write))
- (bundle.install "delete" (//common.binary (product.uncurry ///runtime.array//delete)))
- (bundle.install "length" (//common.unary (_.the "length")))
+ (bundle.install "read" (binary (product.uncurry ///runtime.array//read)))
+ (bundle.install "write" (trinary array//write))
+ (bundle.install "delete" (binary (product.uncurry ///runtime.array//delete)))
+ (bundle.install "length" (unary (_.the "length")))
)))
(def: #export bundle
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/js/function.lux b/stdlib/source/lux/tool/compiler/phase/generation/js/function.lux
index a99546957..10a53986f 100644
--- a/stdlib/source/lux/tool/compiler/phase/generation/js/function.lux
+++ b/stdlib/source/lux/tool/compiler/phase/generation/js/function.lux
@@ -8,7 +8,7 @@
[text
format]
[collection
- ["." list ("#;." functor fold)]]]
+ ["." list ("#@." functor fold)]]]
[host
["_" js (#+ Expression Computation Var)]]]
["." // #_
@@ -17,7 +17,7 @@
["#." case]
["#/" //
["#." reference]
- ["#/" // ("#;." monad)
+ ["#/" // ("#@." monad)
["." // #_
[reference (#+ Register Variable)]
[analysis (#+ Variant Tuple Environment Arity Abstraction Application Analysis)]
@@ -35,14 +35,14 @@
(def: (with-closure inits function-definition)
(-> (List Expression) Computation (Operation Computation))
- (////;wrap
+ (////@wrap
(case inits
#.Nil
function-definition
_
(let [closure (_.closure (|> (list.enumerate inits)
- (list;map (|>> product.left ..capture)))
+ (list@map (|>> product.left ..capture)))
(_.return function-definition))]
(_.apply/* closure inits)))))
@@ -69,7 +69,7 @@
apply-poly (.function (_ args func)
(|> func (_.do "apply" (list _.null args))))
initialize-self! (_.define (//case.register 0) @self)
- initialize! (list;fold (.function (_ post pre!)
+ initialize! (list@fold (.function (_ post pre!)
($_ _.then
pre!
(_.define (..input post) (_.at (_.i32 (.int post)) @@arguments))))
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/js/runtime.lux b/stdlib/source/lux/tool/compiler/phase/generation/js/runtime.lux
index cb65b8b85..b5ef432f6 100644
--- a/stdlib/source/lux/tool/compiler/phase/generation/js/runtime.lux
+++ b/stdlib/source/lux/tool/compiler/phase/generation/js/runtime.lux
@@ -89,16 +89,13 @@
(def: runtime-name
(-> Text Var)
(|>> /////name.normalize
- (format prefix "$")
+ (format ..prefix "$")
_.var))
(def: (feature name definition)
(-> Var (-> Var Expression) Statement)
(_.define name (definition name)))
-(syntax: (code-name {definition-name s.local-identifier})
- (wrap (list (code.local-identifier (format "@" definition-name)))))
-
(syntax: #export (with-vars {vars (s.tuple (p.some s.local-identifier))}
body)
(wrap (list (` (let [(~+ (|> vars
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/python.lux b/stdlib/source/lux/tool/compiler/phase/generation/python.lux
new file mode 100644
index 000000000..29c95ff43
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/phase/generation/python.lux
@@ -0,0 +1,60 @@
+(.module:
+ [lux #*
+ [control
+ [monad (#+ do)]]]
+ [/
+ [runtime (#+ Phase)]
+ ["." primitive]
+ ["." structure]
+ ["." reference ("#@." system)]
+ ["." function]
+ ["." case]
+ ["." loop]
+ ["." ///
+ ["." extension]
+ [//
+ ["." synthesis]]]])
+
+(def: #export (generate 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)
+
+ (^ (synthesis.branch/if if))
+ (case.if generate if)
+
+ (^ (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)))
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/python/case.lux b/stdlib/source/lux/tool/compiler/phase/generation/python/case.lux
new file mode 100644
index 000000000..82a96836d
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/phase/generation/python/case.lux
@@ -0,0 +1,218 @@
+(.module:
+ [lux (#- case let if)
+ [control
+ [monad (#+ do)]
+ ["ex" exception (#+ exception:)]]
+ [data
+ ["." text
+ format]
+ [collection
+ ["." list ("#@." functor fold)]
+ ["." set]]]
+ [host
+ ["_" python (#+ Expression SVar Statement)]]]
+ ["." // #_
+ ["#." runtime (#+ Operation Phase)]
+ ["#." reference]
+ ["#." primitive]
+ ["#/" //
+ ["#." reference]
+ ["#/" // ("#@." monad)
+ [synthesis
+ ["." case]]
+ ["#/" // #_
+ ["." reference (#+ Register)]
+ ["#." synthesis (#+ Synthesis Path)]]]]])
+
+(def: #export register
+ (///reference.local _.var))
+
+(def: #export capture
+ (///reference.foreign _.var))
+
+(def: #export (let generate [valueS register bodyS])
+ (-> Phase [Synthesis Register Synthesis]
+ (Operation (Expression Any)))
+ (do ////.monad
+ [valueO (generate valueS)
+ bodyO (generate bodyS)]
+ ## TODO: Find some way to do 'let' without paying the price of the closure.
+ (wrap (_.apply/* (_.lambda (list (..register register))
+ bodyO)
+ (list valueO)))))
+
+(def: #export (record-get generate valueS pathP)
+ (-> Phase Synthesis (List [Nat Bit])
+ (Operation (Expression Any)))
+ (do ////.monad
+ [valueO (generate valueS)]
+ (wrap (list@fold (function (_ [idx tail?] source)
+ (.let [method (.if tail?
+ //runtime.product//right
+ //runtime.product//left)]
+ (method source (_.int (.int idx)))))
+ valueO
+ pathP))))
+
+(def: #export (if generate [testS thenS elseS])
+ (-> Phase [Synthesis Synthesis Synthesis]
+ (Operation (Expression Any)))
+ (do ////.monad
+ [testO (generate testS)
+ thenO (generate thenS)
+ elseO (generate elseS)]
+ (wrap (_.? testO thenO elseO))))
+
+(def: @savepoint (_.var "lux_pm_cursor_savepoint"))
+(def: @cursor (_.var "lux_pm_cursor"))
+(def: @temp (_.var "lux_pm_temp"))
+
+(def: (push-cursor! value)
+ (-> (Expression Any) (Statement Any))
+ (_.statement (|> @cursor (_.do "append" (list value)))))
+
+(def: peek-and-pop-cursor
+ (Expression Any)
+ (|> @cursor (_.do "pop" (list))))
+
+(def: pop-cursor!
+ (Statement Any)
+ (_.statement ..peek-and-pop-cursor))
+
+(def: peek-cursor
+ (Expression Any)
+ (_.nth (_.int -1) @cursor))
+
+(def: save-cursor!
+ (Statement Any)
+ (.let [cursor (_.slice-from (_.int +0) @cursor)]
+ (_.statement (|> @savepoint (_.do "append" (list cursor))))))
+
+(def: restore-cursor!
+ (Statement Any)
+ (_.set (list @cursor) (|> @savepoint (_.do "pop" (list)))))
+
+(def: fail-pm! _.break)
+
+(exception: #export unrecognized-path)
+
+(def: (multi-pop-cursor! pops)
+ (-> Nat (Statement Any))
+ (_.delete (_.slice-from (_.int (i/* -1 (.int pops))) @cursor)))
+
+(def: (pattern-matching' generate pathP)
+ (-> Phase Path (Operation (Statement Any)))
+ (.case pathP
+ (^ (/////synthesis.path/then bodyS))
+ (do ////.monad
+ [body! (generate bodyS)]
+ (wrap (_.return body!)))
+
+ #/////synthesis.Pop
+ (////@wrap pop-cursor!)
+
+ (#/////synthesis.Bind register)
+ (////@wrap (_.set (list (..register register)) ..peek-cursor))
+
+ (^template [<tag> <format>]
+ (^ (<tag> value))
+ (////@wrap (_.when (|> value <format> (_.= ..peek-cursor) _.not)
+ fail-pm!)))
+ ([/////synthesis.path/bit //primitive.bit]
+ [/////synthesis.path/i64 //primitive.i64]
+ [/////synthesis.path/f64 //primitive.f64]
+ [/////synthesis.path/text //primitive.text])
+
+ (^template [<pm> <flag> <prep>]
+ (^ (<pm> idx))
+ (////@wrap ($_ _.then
+ (_.set (list @temp) (|> idx <prep> .int _.int (//runtime.sum//get ..peek-cursor <flag>)))
+ (_.if (_.= _.none @temp)
+ fail-pm!
+ (push-cursor! @temp)))))
+ ([/////synthesis.side/left _.none (<|)]
+ [/////synthesis.side/right (_.string "") inc])
+
+ (^template [<pm> <getter> <prep>]
+ (^ (<pm> idx))
+ (////@wrap (|> idx <prep> .int _.int (<getter> ..peek-cursor) push-cursor!)))
+ ([/////synthesis.member/left //runtime.product//left (<|)]
+ [/////synthesis.member/right //runtime.product//right inc])
+
+ (^ ($_ /////synthesis.path/seq
+ (#/////synthesis.Bind register)
+ #/////synthesis.Pop
+ thenP))
+ (do ////.monad
+ [then! (pattern-matching' generate thenP)]
+ (////@wrap ($_ _.then
+ (_.set (list (..register register)) ..peek-and-pop-cursor)
+ then!)))
+
+ (^ ($_ /////synthesis.path/seq
+ #/////synthesis.Pop
+ #/////synthesis.Pop
+ nextP))
+ (.let [[extra-pops nextP'] (case.count-pops nextP)]
+ (do ////.monad
+ [next! (pattern-matching' generate nextP')]
+ (////@wrap ($_ _.then
+ (multi-pop-cursor! (n/+ 2 extra-pops))
+ next!))))
+
+ (^template [<tag> <computation>]
+ (^ (<tag> leftP rightP))
+ (do ////.monad
+ [left! (pattern-matching' generate leftP)
+ right! (pattern-matching' generate rightP)]
+ (wrap <computation>)))
+ ([/////synthesis.path/seq (_.then left! right!)]
+ [/////synthesis.path/alt ($_ _.then
+ (_.while (_.bool true)
+ ($_ _.then
+ ..save-cursor!
+ left!))
+ ($_ _.then
+ ..restore-cursor!
+ right!))])
+
+ _
+ (////.throw unrecognized-path [])))
+
+(def: (pattern-matching generate pathP)
+ (-> Phase Path (Operation (Statement Any)))
+ (do ////.monad
+ [pattern-matching! (pattern-matching' generate pathP)]
+ (wrap ($_ _.then
+ (_.while (_.bool true)
+ pattern-matching!)
+ (_.raise (_.Exception/1 (_.string case.pattern-matching-error)))))))
+
+(def: (gensym prefix)
+ (-> Text (Operation SVar))
+ (:: ////.monad map (|>> %n (format prefix) _.var) ///.next))
+
+(def: #export (case generate [valueS pathP])
+ (-> Phase [Synthesis Path] (Operation (Expression Any)))
+ (do ////.monad
+ [initG (generate valueS)
+ pattern-matching! (pattern-matching generate pathP)
+ @case (..gensym "case")
+ @init (..gensym "init")
+ #let [@dependencies+ (|> (case.storage pathP)
+ (get@ #case.dependencies)
+ set.to-list
+ (list@map (function (_ variable)
+ (.case variable
+ (#reference.Local register)
+ (..register register)
+
+ (#reference.Foreign register)
+ (..capture register)))))]
+ _ (///.save! ["" (_.code @case)]
+ (_.def @case (list& @init @dependencies+)
+ ($_ _.then
+ (_.set (list @cursor) (_.list (list @init)))
+ (_.set (list @savepoint) (_.list (list)))
+ pattern-matching!)))]
+ (wrap (_.apply/* @case (list& initG @dependencies+)))))
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/python/extension.lux b/stdlib/source/lux/tool/compiler/phase/generation/python/extension.lux
new file mode 100644
index 000000000..a40b4953f
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/phase/generation/python/extension.lux
@@ -0,0 +1,15 @@
+(.module:
+ [lux #*
+ [data
+ [collection
+ ["." dictionary]]]]
+ [//
+ [runtime (#+ Bundle)]]
+ [/
+ ["." common]
+ ["." host]])
+
+(def: #export bundle
+ Bundle
+ (|> common.bundle
+ (dictionary.merge host.bundle)))
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/python/extension/common.lux b/stdlib/source/lux/tool/compiler/phase/generation/python/extension/common.lux
new file mode 100644
index 000000000..48fd005fb
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/phase/generation/python/extension/common.lux
@@ -0,0 +1,130 @@
+(.module:
+ [lux #*
+ ["." function]
+ [control
+ ["." monad (#+ do)]]
+ [data
+ ["." product]
+ [collection
+ ["." dictionary]]]
+ [host (#+ import:)
+ ["_" python (#+ Expression)]]]
+ ["." /// #_
+ ["#." runtime (#+ Operation Phase Handler Bundle)]
+ ["#." primitive]
+ [//
+ [extension (#+ Nullary Unary Binary Trinary
+ nullary unary binary trinary)]
+ [//
+ [extension
+ ["." bundle]]]]])
+
+(def: lux-procs
+ Bundle
+ (|> bundle.empty
+ (bundle.install "is" (binary (product.uncurry _.is)))
+ (bundle.install "try" (unary ///runtime.lux//try))))
+
+(def: i64-procs
+ Bundle
+ (<| (bundle.prefix "i64")
+ (|> bundle.empty
+ (bundle.install "and" (binary (product.uncurry _.bit-and)))
+ (bundle.install "or" (binary (product.uncurry _.bit-or)))
+ (bundle.install "xor" (binary (product.uncurry _.bit-xor)))
+ (bundle.install "left-shift" (binary (|>> (product.uncurry _.bit-shl) ///runtime.i64//64)))
+ (bundle.install "logical-right-shift" (binary (product.uncurry (function.flip ///runtime.i64//logic-right-shift))))
+ (bundle.install "arithmetic-right-shift" (binary (product.uncurry (function.flip _.bit-shr))))
+ (bundle.install "=" (binary (product.uncurry _.=)))
+ (bundle.install "+" (binary (product.uncurry _.+)))
+ (bundle.install "-" (binary (product.uncurry (function.flip _.-))))
+ )))
+
+(import: #long java/lang/Double
+ (#static MIN_VALUE Double)
+ (#static MAX_VALUE Double))
+
+(do-template [<name> <const>]
+ [(def: (<name> _)
+ (Nullary (Expression Any))
+ (_.float <const>))]
+
+ [frac//smallest (java/lang/Double::MIN_VALUE)]
+ [frac//min (f/* -1.0 (java/lang/Double::MAX_VALUE))]
+ [frac//max (java/lang/Double::MAX_VALUE)]
+ )
+
+(def: int-procs
+ Bundle
+ (<| (bundle.prefix "int")
+ (|> bundle.empty
+ (bundle.install "<" (binary (product.uncurry (function.flip _.<))))
+ (bundle.install "*" (binary (product.uncurry _.*)))
+ (bundle.install "/" (binary (product.uncurry (function.flip _./))))
+ (bundle.install "%" (binary (product.uncurry (function.flip _.%))))
+ (bundle.install "frac" (unary _.float/1))
+ (bundle.install "char" (unary _.chr/1)))))
+
+(def: frac-procs
+ Bundle
+ (<| (bundle.prefix "frac")
+ (|> bundle.empty
+ (bundle.install "+" (binary (product.uncurry _.+)))
+ (bundle.install "-" (binary (product.uncurry (function.flip _.-))))
+ (bundle.install "*" (binary (product.uncurry _.*)))
+ (bundle.install "/" (binary (product.uncurry (function.flip _./))))
+ (bundle.install "%" (binary (product.uncurry (function.flip _.%))))
+ (bundle.install "=" (binary (product.uncurry _.=)))
+ (bundle.install "<" (binary (product.uncurry (function.flip _.<))))
+ (bundle.install "smallest" (nullary frac//smallest))
+ (bundle.install "min" (nullary frac//min))
+ (bundle.install "max" (nullary frac//max))
+ (bundle.install "int" (unary _.int/1))
+ (bundle.install "encode" (unary _.repr/1))
+ (bundle.install "decode" (unary ///runtime.frac//decode)))))
+
+(def: (text//char [subjectO paramO])
+ (Binary (Expression Any))
+ (///runtime.text//char subjectO paramO))
+
+(def: (text//clip [subjectO paramO extraO])
+ (Trinary (Expression Any))
+ (///runtime.text//clip subjectO paramO extraO))
+
+(def: (text//index [textO partO startO])
+ (Trinary (Expression Any))
+ (///runtime.text//index textO partO startO))
+
+(def: text-procs
+ Bundle
+ (<| (bundle.prefix "text")
+ (|> bundle.empty
+ (bundle.install "=" (binary (product.uncurry _.=)))
+ (bundle.install "<" (binary (product.uncurry (function.flip _.<))))
+ (bundle.install "concat" (binary (product.uncurry (function.flip _.+))))
+ (bundle.install "index" (trinary text//index))
+ (bundle.install "size" (unary _.len/1))
+ (bundle.install "char" (binary (product.uncurry ///runtime.text//char)))
+ (bundle.install "clip" (trinary text//clip))
+ )))
+
+(def: io-procs
+ Bundle
+ (<| (bundle.prefix "io")
+ (|> bundle.empty
+ (bundle.install "log" (unary ///runtime.io//log!))
+ (bundle.install "error" (unary ///runtime.io//throw!))
+ (bundle.install "exit" (unary ///runtime.io//exit!))
+ (bundle.install "current-time" (nullary (function (_ _)
+ (///runtime.io//current-time! ///runtime.unit)))))))
+
+(def: #export bundle
+ Bundle
+ (<| (bundle.prefix "lux")
+ (|> lux-procs
+ (dictionary.merge i64-procs)
+ (dictionary.merge int-procs)
+ (dictionary.merge frac-procs)
+ (dictionary.merge text-procs)
+ (dictionary.merge io-procs)
+ )))
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/python/extension/host.lux b/stdlib/source/lux/tool/compiler/phase/generation/python/extension/host.lux
new file mode 100644
index 000000000..92887899b
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/phase/generation/python/extension/host.lux
@@ -0,0 +1,25 @@
+(.module:
+ [lux #*
+ [control
+ ["." monad (#+ do)]]
+ [data
+ ["." product]
+ [collection
+ ["." dictionary]]]
+ [host
+ ["_" python (#+ Expression)]]]
+ ["." /// #_
+ ["#." runtime (#+ Handler Bundle)]
+ ["#/" // #_
+ ["#." extension (#+ Nullary Unary Binary Trinary Variadic
+ nullary unary binary trinary variadic)]
+ ["#/" //
+ ["#." extension
+ ["." bundle]]
+ ["#/" // #_
+ ["#." synthesis]]]]])
+
+(def: #export bundle
+ Bundle
+ (<| (bundle.prefix "python")
+ bundle.empty))
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/python/function.lux b/stdlib/source/lux/tool/compiler/phase/generation/python/function.lux
new file mode 100644
index 000000000..c92f6dd37
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/phase/generation/python/function.lux
@@ -0,0 +1,107 @@
+(.module:
+ [lux (#- function)
+ [control
+ ["." monad (#+ do)]
+ pipe]
+ [data
+ ["." product]
+ [text
+ format]
+ [collection
+ ["." list ("#@." functor fold)]]]
+ [host
+ ["_" python (#+ Expression Statement)]]]
+ ["." // #_
+ [runtime (#+ Operation Phase)]
+ ["#." reference]
+ ["#." case]
+ ["#/" //
+ ["#." reference]
+ ["#/" //
+ ["." // #_
+ [reference (#+ Register Variable)]
+ [analysis (#+ Variant Tuple Environment Arity Abstraction Application Analysis)]
+ [synthesis (#+ Synthesis)]]]]])
+
+(def: #export (apply generate [functionS argsS+])
+ (-> Phase (Application Synthesis) (Operation (Expression Any)))
+ (do ////.monad
+ [functionO (generate functionS)
+ argsO+ (monad.map @ generate argsS+)]
+ (wrap (_.apply/* functionO argsO+))))
+
+(def: #export capture
+ (///reference.foreign _.var))
+
+(def: (with-closure function-name inits function-definition)
+ (-> Text (List (Expression Any)) (Statement Any) (Operation (Expression Any)))
+ (case inits
+ #.Nil
+ (do ////.monad
+ [_ (///.save! ["" function-name]
+ function-definition)]
+ (wrap (_.apply/* (_.var function-name) inits)))
+
+ _
+ (do ////.monad
+ [@closure (:: @ map (|>> %n (format "closure") _.var) ///.next)
+ _ (///.save! ["" (_.code @closure)]
+ (_.def @closure
+ (|> (list.enumerate inits)
+ (list@map (|>> product.left ..capture)))
+ ($_ _.then
+ function-definition
+ (_.return (_.var function-name)))))]
+ (wrap (_.apply/* @closure inits)))))
+
+(def: @curried (_.var "curried"))
+
+(def: input
+ (|>> inc //case.register))
+
+(def: #export (function generate [environment arity bodyS])
+ (-> Phase (Abstraction Synthesis) (Operation (Expression Any)))
+ (do ////.monad
+ [[function-name bodyO] (///.with-context
+ (do @
+ [function-name ///.context]
+ (///.with-anchor (_.var function-name)
+ (generate bodyS))))
+ closureO+ (: (Operation (List (Expression Any)))
+ (monad.map @ (:: //reference.system variable) environment))
+ #let [arityO (|> arity .int _.int)
+ @num-args (_.var "num_args")
+ @self (_.var function-name)
+ apply-poly (.function (_ args func)
+ (_.apply-poly (list) args func))
+ initialize-self! (_.set (list (//case.register 0)) @self)
+ initialize! (list@fold (.function (_ post pre!)
+ ($_ _.then
+ pre!
+ (_.set (list (..input post)) (_.nth (|> post .int _.int) @curried))))
+ initialize-self!
+ (list.indices arity))]]
+ (with-closure function-name closureO+
+ (_.def @self (list)
+ ($_ _.then
+ (_.set (list @num-args) (_.len/1 @curried))
+ (_.cond (list [(|> @num-args (_.= arityO))
+ ($_ _.then
+ initialize!
+ (_.return bodyO))]
+ [(|> @num-args (_.> arityO))
+ (let [arity-inputs (_.slice (_.int +0) arityO @curried)
+ extra-inputs (_.slice arityO @num-args @curried)]
+ (_.return (|> @self
+ (apply-poly arity-inputs)
+ (apply-poly extra-inputs))))])
+ ## (|> @num-args (_.< arityO))
+ (let [@next (_.var "next")
+ @missing (_.var "missing")]
+ ($_ _.then
+ (_.def @next (list (_.poly @missing))
+ (_.return (|> @self (apply-poly (|> @curried (_.+ @missing))))))
+ (_.return @next)
+ )))
+ )))
+ ))
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/python/loop.lux b/stdlib/source/lux/tool/compiler/phase/generation/python/loop.lux
new file mode 100644
index 000000000..7666319bf
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/phase/generation/python/loop.lux
@@ -0,0 +1,40 @@
+(.module:
+ [lux (#- Scope)
+ [control
+ ["." monad (#+ do)]]
+ [data
+ ["." product]
+ [text
+ format]
+ [collection
+ ["." list ("#@." functor)]]]
+ [host
+ ["_" python (#+ Expression)]]]
+ ["." // #_
+ [runtime (#+ Operation Phase)]
+ ["#." case]
+ ["#/" //
+ ["#/" //
+ [//
+ [synthesis (#+ Scope Synthesis)]]]]])
+
+(def: #export (scope generate [start initsS+ bodyS])
+ (-> Phase (Scope Synthesis) (Operation (Expression Any)))
+ (do ////.monad
+ [@loop (:: @ map (|>> %n (format "loop") _.var) ///.next)
+ initsO+ (monad.map @ generate initsS+)
+ bodyO (///.with-anchor @loop
+ (generate bodyS))
+ _ (///.save! ["" (_.code @loop)]
+ (_.def @loop (|> initsS+
+ list.enumerate
+ (list@map (|>> product.left (n/+ start) //case.register)))
+ (_.return bodyO)))]
+ (wrap (_.apply/* @loop initsO+))))
+
+(def: #export (recur generate argsS+)
+ (-> Phase (List Synthesis) (Operation (Expression Any)))
+ (do ////.monad
+ [@scope ///.anchor
+ argsO+ (monad.map @ generate argsS+)]
+ (wrap (_.apply/* @scope argsO+))))
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/python/primitive.lux b/stdlib/source/lux/tool/compiler/phase/generation/python/primitive.lux
new file mode 100644
index 000000000..1ddd3950e
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/phase/generation/python/primitive.lux
@@ -0,0 +1,27 @@
+(.module:
+ [lux (#- i64)
+ [control
+ [pipe (#+ cond> new>)]]
+ [data
+ [number
+ ["." frac]]]
+ [host
+ ["_" python (#+ Expression)]]]
+ ["." // #_
+ ["#." runtime]])
+
+(def: #export bit
+ (-> Bit (Expression Any))
+ _.bool)
+
+(def: #export i64
+ (-> (I64 Any) (Expression Any))
+ (|>> .int _.int))
+
+(def: #export f64
+ (-> Frac (Expression Any))
+ _.float)
+
+(def: #export text
+ (-> Text (Expression Any))
+ _.string)
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/python/reference.lux b/stdlib/source/lux/tool/compiler/phase/generation/python/reference.lux
new file mode 100644
index 000000000..acc09c784
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/phase/generation/python/reference.lux
@@ -0,0 +1,11 @@
+(.module:
+ [lux #*
+ [host
+ ["_" python (#+ Expression)]]]
+ [//
+ [//
+ ["." reference]]])
+
+(def: #export system
+ (reference.system (: (-> Text (Expression Any)) _.var)
+ (: (-> Text (Expression Any)) _.var)))
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/python/runtime.lux b/stdlib/source/lux/tool/compiler/phase/generation/python/runtime.lux
new file mode 100644
index 000000000..fd847af16
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/phase/generation/python/runtime.lux
@@ -0,0 +1,392 @@
+(.module:
+ [lux (#- inc)
+ ["." function]
+ [control
+ [monad (#+ do)]
+ ["p" parser]]
+ [data
+ [number (#+ hex)
+ ["." i64]]
+ ["." text
+ format]
+ [collection
+ ["." list ("#@." functor)]]]
+ ["." macro
+ ["." code]
+ ["s" syntax (#+ syntax:)]]
+ [host
+ ["_" python (#+ Expression SVar Computation Literal Statement)]]]
+ ["." ///
+ ["//." //
+ [//
+ ["/////." name]
+ ["." synthesis]]]]
+ )
+
+(do-template [<name> <base>]
+ [(type: #export <name>
+ (<base> SVar (Expression Any) (Statement Any)))]
+
+ [Operation ///.Operation]
+ [Phase ///.Phase]
+ [Handler ///.Handler]
+ [Bundle ///.Bundle]
+ )
+
+(def: #export variant-tag-field "_lux_tag")
+(def: #export variant-flag-field "_lux_flag")
+(def: #export variant-value-field "_lux_value")
+
+(def: prefix Text "LuxRuntime")
+
+(def: #export unit (_.string synthesis.unit))
+
+(def: (flag value)
+ (-> Bit (Computation Any))
+ (if value
+ (_.string "")
+ _.none))
+
+(def: (variant' tag last? value)
+ (-> (Expression Any) (Expression Any) (Expression Any) (Computation Any))
+ (_.dict (list [(_.string ..variant-tag-field) tag]
+ [(_.string ..variant-flag-field) last?]
+ [(_.string ..variant-value-field) value])))
+
+(def: #export (variant tag last? value)
+ (-> Nat Bit (Expression Any) (Computation Any))
+ (variant' (_.int (.int tag))
+ (flag last?)
+ value))
+
+(def: #export none
+ (Computation Any)
+ (..variant 0 #0 unit))
+
+(def: #export some
+ (-> (Expression Any) (Computation Any))
+ (..variant 1 #1))
+
+(def: #export left
+ (-> (Expression Any) (Computation Any))
+ (..variant 0 #0))
+
+(def: #export right
+ (-> (Expression Any) (Computation Any))
+ (..variant 1 #1))
+
+(def: runtime-name
+ (-> Text SVar)
+ (|>> /////name.normalize
+ (format ..prefix "$")
+ _.var))
+
+(def: (feature name definition)
+ (-> SVar (-> SVar (Statement Any)) (Statement Any))
+ (_.def name (list) (definition name)))
+
+(syntax: #export (with-vars {vars (s.tuple (p.some s.local-identifier))}
+ body)
+ (wrap (list (` (let [(~+ (|> vars
+ (list@map (function (_ var)
+ (list (code.local-identifier var)
+ (` (_.var (~ (code.text (/////name.normalize var))))))))
+ list.concat))]
+ (~ body))))))
+
+(syntax: (runtime: {declaration (p.or s.local-identifier
+ (s.form (p.and s.local-identifier
+ (p.some s.local-identifier))))}
+ code)
+ (case declaration
+ (#.Left name)
+ (macro.with-gensyms [g!_]
+ (let [nameC (code.local-identifier name)
+ code-nameC (code.local-identifier (format "@" name))
+ runtime-nameC (` (runtime-name (~ (code.text name))))]
+ (wrap (list (` (def: #export (~ nameC) SVar (~ runtime-nameC)))
+ (` (def: (~ code-nameC)
+ (Statement Any)
+ (..feature (~ runtime-nameC)
+ (function ((~ g!_) (~ nameC))
+ (~ code)))))))))
+
+ (#.Right [name inputs])
+ (macro.with-gensyms [g!_]
+ (let [nameC (code.local-identifier name)
+ code-nameC (code.local-identifier (format "@" name))
+ runtime-nameC (` (runtime-name (~ (code.text name))))
+ inputsC (list@map code.local-identifier inputs)
+ inputs-typesC (list@map (function.constant (` (_.Expression Any)))
+ inputs)]
+ (wrap (list (` (def: #export ((~ nameC) (~+ inputsC))
+ (-> (~+ inputs-typesC) (Computation Any))
+ (_.apply/* (~ runtime-nameC) (list (~+ inputsC)))))
+ (` (def: (~ code-nameC)
+ (Statement Any)
+ (..feature (~ runtime-nameC)
+ (function ((~ g!_) (~ g!_))
+ (..with-vars [(~+ inputsC)]
+ (_.def (~ g!_) (list (~+ inputsC))
+ (~ code)))))))))))))
+
+(runtime: (lux//try op)
+ (with-vars [error value]
+ (_.try ($_ _.then
+ (_.set (list value) (_.apply/* op (list unit)))
+ (_.return (right value)))
+ (list [(list (_.var "Exception")) error
+ (_.return (left (_.str/1 error)))]))))
+
+(runtime: (lux//program-args program-args)
+ (with-vars [inputs value]
+ ($_ _.then
+ (_.set (list inputs) none)
+ (<| (_.for-in value program-args)
+ (_.set (list inputs)
+ (some (_.tuple (list value inputs)))))
+ (_.return inputs))))
+
+(def: runtime//lux
+ (Statement Any)
+ ($_ _.then
+ @lux//try
+ @lux//program-args))
+
+(runtime: (io//log! message)
+ ($_ _.then
+ (_.print message)
+ (_.return ..unit)))
+
+(runtime: (io//throw! message)
+ ($_ _.then
+ (_.raise (_.Exception/1 message))
+ (_.return ..unit)))
+
+(runtime: (io//exit! code)
+ ($_ _.then
+ (_.import "sys")
+ (_.statement (|> (_.var "sys") (_.do "exit" (list code))))
+ (_.return ..unit)))
+
+(runtime: (io//current-time! _)
+ ($_ _.then
+ (_.import "time")
+ (_.return (|> (_.var "time")
+ (_.do "time" (list))
+ (_.* (_.int +1,000))
+ _.int/1))))
+
+(def: runtime//io
+ (Statement Any)
+ ($_ _.then
+ @io//log!
+ @io//throw!
+ @io//exit!
+ @io//current-time!))
+
+(runtime: (product//left product index)
+ (with-vars [index-min-length]
+ ($_ _.then
+ (_.set (list index-min-length) (_.+ (_.int +1) index))
+ (_.if (_.> index-min-length (_.len/1 product))
+ ## No need for recursion
+ (_.return (_.nth index product))
+ ## Needs recursion
+ (_.return (product//left (_.nth (_.- (_.int +1)
+ (_.len/1 product))
+ product)
+ (_.- (_.len/1 product)
+ index-min-length)))))))
+
+(runtime: (product//right product index)
+ (with-vars [index-min-length]
+ ($_ _.then
+ (_.set (list index-min-length) (_.+ (_.int +1) index))
+ (_.cond (list [(_.= index-min-length (_.len/1 product))
+ ## Last element.
+ (_.return (_.nth index product))]
+ [(_.< index-min-length (_.len/1 product))
+ ## Needs recursion
+ (_.return (product//right (_.nth (_.- (_.int +1)
+ (_.len/1 product))
+ product)
+ (_.- (_.len/1 product)
+ index-min-length)))])
+ ## Must slice
+ (_.return (_.slice-from index product))))))
+
+(runtime: (sum//get sum wantedTag wantsLast)
+ (let [no-match! (_.return _.none)
+ sum-tag (_.nth (_.string ..variant-tag-field) sum)
+ sum-flag (_.nth (_.string ..variant-flag-field) sum)
+ sum-value (_.nth (_.string ..variant-value-field) sum)
+ is-last? (_.= (_.string "") sum-flag)
+ test-recursion! (_.if is-last?
+ ## Must recurse.
+ (_.return (sum//get sum-value (_.- sum-tag wantedTag) wantsLast))
+ no-match!)]
+ (_.cond (list [(_.= sum-tag wantedTag)
+ (_.if (_.= wantsLast sum-flag)
+ (_.return sum-value)
+ test-recursion!)]
+
+ [(_.> sum-tag wantedTag)
+ test-recursion!]
+
+ [(_.and (_.< sum-tag wantedTag)
+ (_.= (_.string "") wantsLast))
+ (_.return (variant' (_.- wantedTag sum-tag) sum-flag sum-value))])
+
+ no-match!)))
+
+(def: runtime//adt
+ (Statement Any)
+ ($_ _.then
+ @product//left
+ @product//right
+ @sum//get))
+
+(def: full-64-bits
+ Literal
+ (_.manual "0xFFFFFFFFFFFFFFFF"))
+
+(runtime: (i64//64 input)
+ (with-vars [capped]
+ (_.cond (list [(|> input (_.> full-64-bits))
+ (_.return (|> input (_.bit-and full-64-bits) i64//64))]
+ [(|> input (_.> (: Literal (_.manual "0x7FFFFFFFFFFFFFFF"))))
+ ($_ _.then
+ (_.set (list capped)
+ (_.int/1 (|> (: Literal (_.manual "0x10000000000000000"))
+ (_.- input))))
+ (_.if (|> capped (_.<= (: Literal (_.manual "9223372036854775807L"))))
+ (_.return (|> capped (_.* (_.int -1))))
+ (_.return (: Literal (_.manual "-9223372036854775808L")))))])
+ (_.return input))))
+
+(runtime: (i64//logic-right-shift param subject)
+ (let [mask (|> (_.int +1)
+ (_.bit-shl (_.- param (_.int +64)))
+ (_.- (_.int +1)))]
+ (_.return (|> subject
+ (_.bit-shr param)
+ (_.bit-and mask)))))
+
+(def: runtime//i64
+ (Statement Any)
+ ($_ _.then
+ @i64//64
+ @i64//logic-right-shift))
+
+(runtime: (frac//decode input)
+ (with-vars [ex]
+ (_.try
+ (_.return (..some (_.float/1 input)))
+ (list [(list (_.var "Exception")) ex
+ (_.return ..none)]))))
+
+(def: runtime//frac
+ (Statement Any)
+ ($_ _.then
+ @frac//decode))
+
+(runtime: (text//index subject param start)
+ (with-vars [idx]
+ ($_ _.then
+ (_.set (list idx) (|> subject (_.do "find" (list param start))))
+ (_.if (_.= (_.int -1) idx)
+ (_.return ..none)
+ (_.return (..some idx))))))
+
+(def: inc (|>> (_.+ (_.int +1))))
+
+(do-template [<name> <top-cmp>]
+ [(def: (<name> top value)
+ (-> (Expression Any) (Expression Any) (Computation Any))
+ (_.and (|> value (_.>= (_.int +0)))
+ (|> value (<top-cmp> top))))]
+
+ [within? _.<]
+ [up-to? _.<=]
+ )
+
+(runtime: (text//clip @text @from @to)
+ (with-vars [length]
+ ($_ _.then
+ (_.set (list length) (_.len/1 @text))
+ (_.if ($_ _.and
+ (|> @to (within? length))
+ (|> @from (up-to? @to)))
+ (_.return (..some (|> @text (_.slice @from (inc @to)))))
+ (_.return ..none)))))
+
+(runtime: (text//char text idx)
+ (_.if (|> idx (within? (_.len/1 text)))
+ (_.return (..some (_.ord/1 (|> text (_.slice idx (inc idx))))))
+ (_.return ..none)))
+
+(def: runtime//text
+ (Statement Any)
+ ($_ _.then
+ @text//index
+ @text//clip
+ @text//char))
+
+(def: (check-index-out-of-bounds array idx body!)
+ (-> (Expression Any) (Expression Any) (Statement Any) (Statement Any))
+ (_.if (|> idx (_.<= (_.len/1 array)))
+ body!
+ (_.raise (_.Exception/1 (_.string "Array index out of bounds!")))))
+
+(runtime: (array//get array idx)
+ (with-vars [temp]
+ (<| (check-index-out-of-bounds array idx)
+ ($_ _.then
+ (_.set (list temp) (_.nth idx array))
+ (_.if (_.= _.none temp)
+ (_.return ..none)
+ (_.return (..some temp)))))))
+
+(runtime: (array//put array idx value)
+ (<| (check-index-out-of-bounds array idx)
+ ($_ _.then
+ (_.set (list (_.nth idx array)) value)
+ (_.return array))))
+
+(def: runtime//array
+ (Statement Any)
+ ($_ _.then
+ @array//get
+ @array//put))
+
+(runtime: (box//write value box)
+ ($_ _.then
+ (_.set (list (_.nth (_.int +0) box)) value)
+ (_.return ..unit)))
+
+(def: runtime//box
+ (Statement Any)
+ @box//write)
+
+(def: runtime
+ (Statement Any)
+ ($_ _.then
+ runtime//lux
+ runtime//adt
+ runtime//i64
+ runtime//frac
+ runtime//text
+ runtime//array
+ runtime//box
+ runtime//io
+ ))
+
+(def: #export artifact ..prefix)
+
+(def: #export generate
+ (Operation Any)
+ (///.with-buffer
+ (do ////.monad
+ [_ (///.save! ["" ..prefix] ..runtime)]
+ (///.save-buffer! ..artifact))))
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/python/structure.lux b/stdlib/source/lux/tool/compiler/phase/generation/python/structure.lux
new file mode 100644
index 000000000..1415251df
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/phase/generation/python/structure.lux
@@ -0,0 +1,36 @@
+(.module:
+ [lux #*
+ [control
+ ["." monad (#+ do)]]
+ [host
+ ["_" python (#+ Expression)]]]
+ ["." // #_
+ ["#." runtime (#+ Operation Phase)]
+ ["#." primitive]
+ ["#//" ///
+ ["#/" // #_
+ [analysis (#+ Variant Tuple)]
+ ["#." synthesis (#+ Synthesis)]]]])
+
+(def: #export (tuple generate elemsS+)
+ (-> Phase (Tuple Synthesis) (Operation (Expression Any)))
+ (case elemsS+
+ #.Nil
+ (:: ////.monad wrap (//primitive.text /////synthesis.unit))
+
+ (#.Cons singletonS #.Nil)
+ (generate singletonS)
+
+ _
+ (do ////.monad
+ [elemsT+ (monad.map @ generate elemsS+)]
+ (wrap (_.tuple elemsT+)))))
+
+(def: #export (variant generate [lefts right? valueS])
+ (-> Phase (Variant Synthesis) (Operation (Expression Any)))
+ (:: ////.monad map
+ (//runtime.variant (if right?
+ (inc lefts)
+ lefts)
+ right?)
+ (generate valueS)))
diff --git a/stdlib/source/lux/tool/compiler/phase/synthesis/case.lux b/stdlib/source/lux/tool/compiler/phase/synthesis/case.lux
index 8dd7c342e..841846351 100644
--- a/stdlib/source/lux/tool/compiler/phase/synthesis/case.lux
+++ b/stdlib/source/lux/tool/compiler/phase/synthesis/case.lux
@@ -6,16 +6,17 @@
["." monad (#+ do)]]
[data
["." product]
- ["." bit ("#;." equivalence)]
- ["." text ("#;." equivalence)
+ ["." bit ("#@." equivalence)]
+ ["." text ("#@." equivalence)
format]
[number
- ["." frac ("#;." equivalence)]]
+ ["." frac ("#@." equivalence)]]
[collection
- ["." list ("#;." fold monoid)]]]]
- ["." /// ("#;." monad)
+ ["." list ("#@." functor fold monoid)]
+ ["." set (#+ Set)]]]]
+ ["." /// ("#@." monad)
["#/" //
- ["#." reference]
+ ["#." reference (#+ Variable)]
["#." analysis (#+ Pattern Match Analysis)]
["/" synthesis (#+ Path Synthesis Operation Phase)]]])
@@ -33,7 +34,7 @@
(^template [<from> <to>]
(<from> value)
- (///;map (|>> (#/.Seq (#/.Test (|> value <to>))))
+ (///@map (|>> (#/.Seq (#/.Test (|> value <to>))))
thenC))
([#////analysis.Bit #/.Bit]
[#////analysis.Nat (<| #/.I64 .i64)]
@@ -48,23 +49,23 @@
thenC)
(#////analysis.Complex (#////analysis.Variant [lefts right? value-pattern]))
- (<| (///;map (|>> (#/.Seq (#/.Access (#/.Side (if right?
+ (<| (///@map (|>> (#/.Seq (#/.Access (#/.Side (if right?
(#.Right lefts)
(#.Left lefts)))))))
(path' value-pattern end?)
- (when> [(new> (not end?) [])] [(///;map ..clean-up)])
+ (when> [(new> (not end?) [])] [(///@map ..clean-up)])
thenC)
(#////analysis.Complex (#////analysis.Tuple tuple))
(let [tuple::last (dec (list.size tuple))]
- (list;fold (function (_ [tuple::lefts tuple::member] nextC)
+ (list@fold (function (_ [tuple::lefts tuple::member] nextC)
(let [right? (n/= tuple::last tuple::lefts)
end?' (and end? right?)]
- (<| (///;map (|>> (#/.Seq (#/.Access (#/.Member (if right?
+ (<| (///@map (|>> (#/.Seq (#/.Access (#/.Member (if right?
(#.Right (dec tuple::lefts))
(#.Left tuple::lefts)))))))
(path' tuple::member end?')
- (when> [(new> (not end?') [])] [(///;map ..clean-up)])
+ (when> [(new> (not end?') [])] [(///@map ..clean-up)])
nextC)))
thenC
(list.reverse (list.enumerate tuple))))
@@ -72,7 +73,7 @@
(def: #export (path synthesize pattern bodyA)
(-> Phase Pattern Analysis (Operation Path))
- (path' pattern true (///;map (|>> #/.Then) (synthesize bodyA))))
+ (path' pattern true (///@map (|>> #/.Then) (synthesize bodyA))))
(def: #export (weave leftP rightP)
(-> Path Path Path)
@@ -96,10 +97,10 @@
(if (<eq> leftV rightV)
rightP
<default>))
- ([#/.Bit bit;=]
+ ([#/.Bit bit@=]
[#/.I64 "lux i64 ="]
- [#/.F64 frac;=]
- [#/.Text text;=])
+ [#/.F64 frac@=]
+ [#/.Text text@=])
(^template [<access> <side>]
[(#/.Access (<access> (<side> leftL)))
@@ -157,14 +158,101 @@
list.reverse
(case> (#.Cons [lastP lastA] prevsPA)
[[lastP lastA] prevsPA]
-
+
_
(undefined)))]
(do @
[lastSP (path synthesize^ lastP lastA)
prevsSP+ (monad.map @ (product.uncurry (path synthesize^)) prevsPA)]
- (wrap (/.branch/case [inputS (list;fold weave lastSP prevsSP+)])))))]
+ (wrap (/.branch/case [inputS (list@fold weave lastSP prevsSP+)])))))]
(case [headB tailB+]
<let>
<if>
<case>))))
+
+(def: #export (count-pops path)
+ (-> Path [Nat Path])
+ (case path
+ (^ (/.path/seq #/.Pop path'))
+ (let [[pops post-pops] (count-pops path')]
+ [(inc pops) post-pops])
+
+ _
+ [0 path]))
+
+(def: #export pattern-matching-error
+ "Invalid expression for pattern-matching.")
+
+(type: #export Storage
+ {#bindings (Set Variable)
+ #dependencies (Set Variable)})
+
+(def: empty
+ Storage
+ {#bindings (set.new ////reference.hash)
+ #dependencies (set.new ////reference.hash)})
+
+## TODO: Use this to declare all local variables at the beginning of
+## script functions.
+## That way, it should be possible to do cheap "let" expressions,
+## since the variable will exist before hand so no closure will need
+## to be created for it.
+## Apply this trick to JS, Python et al.
+(def: #export (storage path)
+ (-> Path Storage)
+ (loop for-path
+ [path path
+ path-storage ..empty]
+ (case path
+ (^ (/.path/bind register))
+ (update@ #bindings (set.add (#////reference.Local register))
+ path-storage)
+
+ (^or (^ (/.path/seq left right))
+ (^ (/.path/alt left right)))
+ (list@fold for-path path-storage (list left right))
+
+ (^ (/.path/then bodyS))
+ (loop for-synthesis
+ [bodyS bodyS
+ synthesis-storage path-storage]
+ (case bodyS
+ (^ (/.variant [lefts right? valueS]))
+ (for-synthesis valueS synthesis-storage)
+
+ (^ (/.tuple members))
+ (list@fold for-synthesis synthesis-storage members)
+
+ (#/.Reference (#////reference.Variable var))
+ (if (set.member? (get@ #bindings synthesis-storage) var)
+ synthesis-storage
+ (update@ #dependencies (set.add var) synthesis-storage))
+
+ (^ (/.function/apply [functionS argsS]))
+ (list@fold for-synthesis synthesis-storage (#.Cons functionS argsS))
+
+ (^ (/.function/abstraction [environment arity bodyS]))
+ (list@fold (function (_ variable storage)
+ (for-synthesis (#/.Reference (#////reference.Variable variable))
+ storage))
+ synthesis-storage
+ environment)
+
+ (^ (/.branch/let [inputS register exprS]))
+ (list@fold for-synthesis
+ (update@ #bindings (set.add (#////reference.Local register))
+ synthesis-storage)
+ (list inputS exprS))
+
+ (^ (/.branch/case [inputS pathS]))
+ (|> synthesis-storage (for-synthesis inputS) (for-path pathS))
+
+ (#/.Extension [extension argsS])
+ (list@fold for-synthesis synthesis-storage argsS)
+
+ _
+ synthesis-storage))
+
+ _
+ path-storage
+ )))
diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux
index d0dc4f257..30abe1b37 100644
--- a/stdlib/source/test/lux.lux
+++ b/stdlib/source/test/lux.lux
@@ -40,14 +40,17 @@
[markdown (#+)]]]
[host
[js (#+)]
+ [python (#+)]
[scheme (#+)]]
[tool
[compiler
[phase
[generation
- [scheme (#+)
- <host-modules>]
[js (#+)
+ <host-modules>]
+ [python (#+)
+ <host-modules>]
+ [scheme (#+)
<host-modules>]]]]]
## [control
## ["._" contract]