aboutsummaryrefslogtreecommitdiff
path: root/stdlib
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib')
-rw-r--r--stdlib/source/lux/control/concurrency/atom.lux99
-rw-r--r--stdlib/source/lux/control/concurrency/thread.lux36
-rw-r--r--stdlib/source/lux/data/binary.lux115
-rw-r--r--stdlib/source/lux/data/collection/array.lux26
-rw-r--r--stdlib/source/lux/data/text.lux4
-rw-r--r--stdlib/source/lux/data/text/encoding.lux53
-rw-r--r--stdlib/source/lux/debug.lux59
-rw-r--r--stdlib/source/lux/host.py.lux315
-rw-r--r--stdlib/source/lux/math.lux54
-rw-r--r--stdlib/source/lux/math/number/frac.lux63
-rw-r--r--stdlib/source/lux/math/number/i64.lux69
-rw-r--r--stdlib/source/lux/math/number/nat.lux8
-rw-r--r--stdlib/source/lux/meta.lux5
-rw-r--r--stdlib/source/lux/program.lux12
-rw-r--r--stdlib/source/lux/target/python.lux16
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/generation.lux8
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/python.lux224
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/python.lux9
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/python/common.lux100
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/python/host.lux163
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/python.lux1
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/case.lux17
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/function.lux38
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/loop.lux72
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/primitive.lux8
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux134
-rw-r--r--stdlib/source/lux/type/check.lux6
-rw-r--r--stdlib/source/lux/world/file.lux231
-rw-r--r--stdlib/source/lux/world/program.lux35
-rw-r--r--stdlib/source/program/aedifex/artifact/snapshot.lux72
-rw-r--r--stdlib/source/program/aedifex/artifact/snapshot/stamp.lux19
-rw-r--r--stdlib/source/test/aedifex/artifact/snapshot.lux48
-rw-r--r--stdlib/source/test/aedifex/artifact/snapshot/stamp.lux4
-rw-r--r--stdlib/source/test/lux/meta.lux129
-rw-r--r--stdlib/source/test/lux/type/dynamic.lux54
35 files changed, 1884 insertions, 422 deletions
diff --git a/stdlib/source/lux/control/concurrency/atom.lux b/stdlib/source/lux/control/concurrency/atom.lux
index 3b690ea7d..b82a24cca 100644
--- a/stdlib/source/lux/control/concurrency/atom.lux
+++ b/stdlib/source/lux/control/concurrency/atom.lux
@@ -20,63 +20,52 @@
(compareAndSet [a a] boolean)]))]
(for {@.old <jvm>
@.jvm <jvm>}
-
(as_is)))
-(abstract: #export (Atom a)
- (for {@.old
- (java/util/concurrent/atomic/AtomicReference a)
-
- @.jvm
- (java/util/concurrent/atomic/AtomicReference a)
-
- @.js
- (array.Array a)
- })
-
- {#.doc "Atomic references that are safe to mutate concurrently."}
-
- (def: #export (atom value)
- (All [a] (-> a (Atom a)))
- (:abstraction (for {@.old
- (java/util/concurrent/atomic/AtomicReference::new value)
-
- @.jvm
- (java/util/concurrent/atomic/AtomicReference::new value)
-
- @.js
- ("js array write" 0 value ("js array new" 1))
- })))
-
- (def: #export (read atom)
- (All [a] (-> (Atom a) (IO a)))
- (io (for {@.old
- (java/util/concurrent/atomic/AtomicReference::get (:representation atom))
-
- @.jvm
- (java/util/concurrent/atomic/AtomicReference::get (:representation atom))
-
- @.js
- ("js array read" 0 (:representation atom))
- })))
-
- (def: #export (compare_and_swap current new atom)
- {#.doc (doc "Only mutates an atom if you can present its current value."
- "That guarantees that atom was not updated since you last read from it.")}
- (All [a] (-> a a (Atom a) (IO Bit)))
- (io (for {@.old
- (java/util/concurrent/atomic/AtomicReference::compareAndSet current new (:representation atom))
-
- @.jvm
- (java/util/concurrent/atomic/AtomicReference::compareAndSet current new (:representation atom))
-
- @.js
- (let [old ("js array read" 0 (:representation atom))]
- (if (is? old current)
- (exec ("js array write" 0 new (:representation atom))
- true)
- false))})))
- )
+(with_expansions [<new> (for {@.js "js array new"
+ @.python "python array new"}
+ (as_is))
+ <write> (for {@.js "js array write"
+ @.python "python array write"}
+ (as_is))
+ <read> (for {@.js "js array read"
+ @.python "python array read"}
+ (as_is))]
+ (abstract: #export (Atom a)
+ (with_expansions [<jvm> (java/util/concurrent/atomic/AtomicReference a)]
+ (for {@.old <jvm>
+ @.jvm <jvm>}
+ (array.Array a)))
+
+ {#.doc "Atomic references that are safe to mutate concurrently."}
+
+ (def: #export (atom value)
+ (All [a] (-> a (Atom a)))
+ (:abstraction (with_expansions [<jvm> (java/util/concurrent/atomic/AtomicReference::new value)]
+ (for {@.old <jvm>
+ @.jvm <jvm>}
+ (<write> 0 value (<new> 1))))))
+
+ (def: #export (read atom)
+ (All [a] (-> (Atom a) (IO a)))
+ (io (with_expansions [<jvm> (java/util/concurrent/atomic/AtomicReference::get (:representation atom))]
+ (for {@.old <jvm>
+ @.jvm <jvm>}
+ (<read> 0 (:representation atom))))))
+
+ (def: #export (compare_and_swap current new atom)
+ {#.doc (doc "Only mutates an atom if you can present its current value."
+ "That guarantees that atom was not updated since you last read from it.")}
+ (All [a] (-> a a (Atom a) (IO Bit)))
+ (io (with_expansions [<jvm> (java/util/concurrent/atomic/AtomicReference::compareAndSet current new (:representation atom))]
+ (for {@.old <jvm>
+ @.jvm <jvm>}
+ (let [old (<read> 0 (:representation atom))]
+ (if (is? old current)
+ (exec (<write> 0 new (:representation atom))
+ true)
+ false))))))
+ ))
(def: #export (update f atom)
{#.doc (doc "Updates an atom by applying a function to its current value."
diff --git a/stdlib/source/lux/control/concurrency/thread.lux b/stdlib/source/lux/control/concurrency/thread.lux
index d1ab65886..9c77fc85f 100644
--- a/stdlib/source/lux/control/concurrency/thread.lux
+++ b/stdlib/source/lux/control/concurrency/thread.lux
@@ -12,7 +12,8 @@
["." list]]]
[math
[number
- ["n" nat]]]]
+ ["n" nat]
+ ["f" frac]]]]
[//
["." atom (#+ Atom)]])
@@ -43,7 +44,12 @@
@.jvm (as_is <jvm>)
@.js
- (as_is (host.import: (setTimeout [host.Function host.Number] #io Any)))}
+ (as_is (host.import: (setTimeout [host.Function host.Number] #io Any)))
+
+ @.python
+ (host.import: threading/Timer
+ (new [host.Float host.Function])
+ (start [] #io Any))}
## Default
(type: Thread
@@ -59,7 +65,6 @@
.nat)]
(for {@.old <jvm>
@.jvm <jvm>}
-
## Default
1)))
@@ -68,9 +73,8 @@
(java/util/concurrent/ScheduledThreadPoolExecutor::new (.int ..parallelism))))]
(for {@.old <jvm>
@.jvm <jvm>
-
- @.js
- (as_is)}
+ @.js (as_is)
+ @.python (as_is)}
## Default
(def: runner
@@ -101,7 +105,13 @@
@.js
(..setTimeout [(host.closure [] (io.run action))
- (n.frac milli_seconds)])}
+ (n.frac milli_seconds)])
+
+ @.python
+ (|> (host.lambda [] (io.run action))
+ [(|> milli_seconds n.frac (f./ +1,000.0))]
+ threading/Timer::new
+ (threading/Timer::start []))}
## Default
(do io.monad
@@ -111,14 +121,10 @@
..runner)]
(wrap []))))
-(for {@.old
- (as_is)
-
- @.jvm
- (as_is)
-
- @.js
- (as_is)}
+(for {@.old (as_is)
+ @.jvm (as_is)
+ @.js (as_is)
+ @.python (as_is)}
## Default
(as_is (exception: #export cannot_continue_running_threads)
diff --git a/stdlib/source/lux/data/binary.lux b/stdlib/source/lux/data/binary.lux
index cc4273079..eb8405fc5 100644
--- a/stdlib/source/lux/data/binary.lux
+++ b/stdlib/source/lux/data/binary.lux
@@ -37,39 +37,39 @@
[inverted_slice]
)
-(with_expansions [<for_jvm> (as_is (type: #export Binary (host.type [byte]))
-
- (host.import: java/lang/Object)
-
- (host.import: java/lang/System
- ["#::."
- (#static arraycopy [java/lang/Object int java/lang/Object int int] #try void)])
-
- (host.import: java/util/Arrays
- ["#::."
- (#static copyOfRange [[byte] int int] [byte])
- (#static equals [[byte] [byte]] boolean)])
-
- (def: byte_mask
- I64
- (|> i64.bits_per_byte i64.mask .i64))
-
- (def: i64
- (-> (primitive "java.lang.Byte") I64)
- (|>> host.byte_to_long (:coerce I64) (i64.and ..byte_mask)))
-
- (def: byte
- (-> (I64 Any) (primitive "java.lang.Byte"))
- (for {@.old
- (|>> .int host.long_to_byte)
-
- @.jvm
- (|>> .int (:coerce (primitive "java.lang.Long")) host.long_to_byte)})))]
+(with_expansions [<jvm> (as_is (type: #export Binary (host.type [byte]))
+
+ (host.import: java/lang/Object)
+
+ (host.import: java/lang/System
+ ["#::."
+ (#static arraycopy [java/lang/Object int java/lang/Object int int] #try void)])
+
+ (host.import: java/util/Arrays
+ ["#::."
+ (#static copyOfRange [[byte] int int] [byte])
+ (#static equals [[byte] [byte]] boolean)])
+
+ (def: byte_mask
+ I64
+ (|> i64.bits_per_byte i64.mask .i64))
+
+ (def: i64
+ (-> (primitive "java.lang.Byte") I64)
+ (|>> host.byte_to_long (:coerce I64) (i64.and ..byte_mask)))
+
+ (def: byte
+ (-> (I64 Any) (primitive "java.lang.Byte"))
+ (for {@.old
+ (|>> .int host.long_to_byte)
+
+ @.jvm
+ (|>> .int (:coerce (primitive "java.lang.Long")) host.long_to_byte)})))]
(for {@.old
- (as_is <for_jvm>)
+ (as_is <jvm>)
@.jvm
- (as_is <for_jvm>)
+ (as_is <jvm>)
@.js
(as_is (host.import: ArrayBuffer
@@ -80,7 +80,11 @@
(length host.Number))
(type: #export Binary
- Uint8Array))}))
+ Uint8Array))
+
+ @.python
+ (type: #export Binary
+ (primitive "bytearray"))}))
(template: (!size binary)
(for {@.old
@@ -90,7 +94,12 @@
(host.array_length binary)
@.js
- (f.nat (Uint8Array::length binary))}))
+ (f.nat (Uint8Array::length binary))
+
+ @.python
+ (|> binary
+ (:coerce (array.Array (I64 Any)))
+ "python array length")}))
(template: (!read idx binary)
(for {@.old
@@ -105,7 +114,12 @@
(:coerce (array.Array .Frac))
("js array read" idx)
f.nat
- .i64)}))
+ .i64)
+
+ @.python
+ (|> binary
+ (:coerce (array.Array .I64))
+ ("python array read" idx))}))
(template: (!write idx value binary)
(for {@.old
@@ -119,6 +133,12 @@
(: ..Binary)
(:coerce (array.Array .Frac))
("js array write" idx (n.frac (.nat value)))
+ (:coerce ..Binary))
+
+ @.python
+ (|> binary
+ (:coerce (array.Array (I64 Any)))
+ ("python array write" idx (:coerce (I64 Any) value))
(:coerce ..Binary))}))
(def: #export size
@@ -134,7 +154,11 @@
(|>> (host.array byte))
@.js
- (|>> n.frac [] ArrayBuffer::new Uint8Array::new)}))
+ (|>> n.frac [] ArrayBuffer::new Uint8Array::new)
+
+ @.python
+ (|>> ("python apply" ("python constant" "bytearray"))
+ (:coerce Binary))}))
(def: #export (fold f init binary)
(All [a] (-> (-> I64 a a) a Binary a))
@@ -245,11 +269,8 @@
(recur (inc idx)))
true)))))))
-(for {@.old
- (as_is)
-
- @.jvm
- (as_is)}
+(for {@.old (as_is)
+ @.jvm (as_is)}
## Default
(exception: #export (cannot_copy_bytes {bytes Nat}
@@ -262,14 +283,14 @@
(def: #export (copy bytes source_offset source target_offset target)
(-> Nat Nat Binary Nat Binary (Try Binary))
- (with_expansions [<for_jvm> (as_is (do try.monad
- [_ (java/lang/System::arraycopy source (.int source_offset) target (.int target_offset) (.int bytes))]
- (wrap target)))]
+ (with_expansions [<jvm> (as_is (do try.monad
+ [_ (java/lang/System::arraycopy source (.int source_offset) target (.int target_offset) (.int bytes))]
+ (wrap target)))]
(for {@.old
- <for_jvm>
+ <jvm>
@.jvm
- <for_jvm>}
+ <jvm>}
## Default
(let [source_input (n.- source_offset (!size source))
@@ -290,12 +311,12 @@
(if (n.<= to from)
(if (and (n.< size from)
(n.< size to))
- (with_expansions [<for_jvm> (as_is (#try.Success (java/util/Arrays::copyOfRange binary (.int from) (.int (inc to)))))]
+ (with_expansions [<jvm> (as_is (#try.Success (java/util/Arrays::copyOfRange binary (.int from) (.int (inc to)))))]
(for {@.old
- <for_jvm>
+ <jvm>
@.jvm
- <for_jvm>}
+ <jvm>}
## Default
(let [how_many (n.- from to)]
diff --git a/stdlib/source/lux/data/collection/array.lux b/stdlib/source/lux/data/collection/array.lux
index 470640bcf..e407f4877 100644
--- a/stdlib/source/lux/data/collection/array.lux
+++ b/stdlib/source/lux/data/collection/array.lux
@@ -46,7 +46,10 @@
:assume)
@.js
- ("js array new" size)}))
+ ("js array new" size)
+
+ @.python
+ ("python array new" size)}))
(def: #export (size array)
(All [a] (-> (Array a) Nat))
@@ -63,7 +66,10 @@
(:coerce Nat))
@.js
- ("js array length" array)}))
+ ("js array length" array)
+
+ @.python
+ ("python array length" array)}))
(def: #export (read index array)
(All [a]
@@ -87,6 +93,12 @@
(let [output ("js array read" index array)]
(if ("js object undefined?" output)
#.None
+ (#.Some output)))
+
+ @.python
+ (let [output ("python array read" index array)]
+ (if ("python object none?" output)
+ #.None
(#.Some output)))})
#.None))
@@ -103,7 +115,10 @@
:assume)
@.js
- ("js array write" index value array)}))
+ ("js array write" index value array)
+
+ @.python
+ ("python array write" index value array)}))
(def: #export (delete! index array)
(All [a]
@@ -116,7 +131,10 @@
(write! index (:assume (: <elem_type> ("jvm object null"))) array)
@.js
- ("js array delete" index array)})
+ ("js array delete" index array)
+
+ @.python
+ ("python array delete" index array)})
array))
)
diff --git a/stdlib/source/lux/data/text.lux b/stdlib/source/lux/data/text.lux
index cc30732d2..031d76a07 100644
--- a/stdlib/source/lux/data/text.lux
+++ b/stdlib/source/lux/data/text.lux
@@ -14,8 +14,8 @@
["." list ("#\." fold)]]]
[math
[number
- ["." i64]
- ["n" nat]]]])
+ ["n" nat]
+ ["." i64]]]])
(type: #export Char
Nat)
diff --git a/stdlib/source/lux/data/text/encoding.lux b/stdlib/source/lux/data/text/encoding.lux
index df1714484..2050cbc8c 100644
--- a/stdlib/source/lux/data/text/encoding.lux
+++ b/stdlib/source/lux/data/text/encoding.lux
@@ -173,11 +173,8 @@
["#::."
(new [[byte] java/lang/String])
(getBytes [java/lang/String] [byte])]))]
- (for {@.old
- (as_is <jvm>)
-
- @.jvm
- (as_is <jvm>)
+ (for {@.old (as_is <jvm>)
+ @.jvm (as_is <jvm>)
@.js
(as_is (host.import: Uint8Array)
@@ -195,12 +192,14 @@
(host.import: TextDecoder
(new [host.String])
- (decode [Uint8Array] host.String)))}))
+ (decode [Uint8Array] host.String)))}
+ (as_is)))
(def: (to_utf8 value)
(-> Text Binary)
(for {@.old
(java/lang/String::getBytes (..name ..utf_8)
+ ## TODO: Remove coercion below.
## The coercion below may seem
## gratuitous, but removing it
## causes a grave compilation problem.
@@ -222,31 +221,35 @@
## On the browser
(|> (TextEncoder::new [(..name ..utf_8)])
(TextEncoder::encode [value]))
- )}))
+ )
+
+ @.python
+ (:coerce Binary ("python apply" (:assume ("python constant" "bytearray")) value "utf-8"))}))
(def: (from_utf8 value)
(-> Binary (Try Text))
- (for {@.old
- (#try.Success (java/lang/String::new value (..name ..utf_8)))
+ (with_expansions [<jvm> (#try.Success (java/lang/String::new value (..name ..utf_8)))]
+ (for {@.old <jvm>
+ @.jvm <jvm>
- @.jvm
- (#try.Success (java/lang/String::new value (..name ..utf_8)))
+ @.js
+ (cond host.on_nashorn?
+ (|> ("js object new" ("js constant" "java.lang.String") [value "utf8"])
+ (:coerce Text)
+ #try.Success)
- @.js
- (cond host.on_nashorn?
- (|> ("js object new" ("js constant" "java.lang.String") [value "utf8"])
- (:coerce Text)
- #try.Success)
+ host.on_node_js?
+ (|> (Buffer::from|decode [value])
+ (Buffer::toString ["utf8"])
+ #try.Success)
+
+ ## On the browser
+ (|> (TextDecoder::new [(..name ..utf_8)])
+ (TextDecoder::decode [value])
+ #try.Success))
- host.on_node_js?
- (|> (Buffer::from|decode [value])
- (Buffer::toString ["utf8"])
- #try.Success)
-
- ## On the browser
- (|> (TextDecoder::new [(..name ..utf_8)])
- (TextDecoder::decode [value])
- #try.Success))}))
+ @.python
+ (host.try (:coerce Text ("python object do" "decode" (:assume value) "utf-8")))})))
(structure: #export utf8
(Codec Binary Text)
diff --git a/stdlib/source/lux/debug.lux b/stdlib/source/lux/debug.lux
index b60d62c11..cd354ec84 100644
--- a/stdlib/source/lux/debug.lux
+++ b/stdlib/source/lux/debug.lux
@@ -1,5 +1,5 @@
(.module:
- [lux #*
+ [lux (#- type)
["@" target]
["." type]
["." host (#+ import:)]
@@ -58,17 +58,21 @@
(intValue [] int)
(longValue [] long)
(doubleValue [] double)]))]
- (for {@.old
- (as_is <jvm>)
-
- @.jvm
- (as_is <jvm>)
+ (for {@.old (as_is <jvm>)
+ @.jvm (as_is <jvm>)
@.js
(as_is (import: JSON
(#static stringify [.Any] host.String))
(import: Array
- (#static isArray [.Any] host.Boolean)))}))
+ (#static isArray [.Any] host.Boolean)))
+
+ @.python
+ (as_is (type: PyType
+ (primitive "python_type"))
+
+ (import: (type [.Any] PyType))
+ (import: (str [.Any] host.String)))}))
(def: Inspector (-> Any Text))
@@ -117,11 +121,8 @@
(inspect_tuple inspect value)))
#.None)
(java/lang/Object::toString object))))]
- (for {@.old
- <jvm>
-
- @.jvm
- <jvm>
+ (for {@.old <jvm>
+ @.jvm <jvm>
@.js
(case (host.type_of value)
@@ -156,7 +157,39 @@
(JSON::stringify value)))
_
- (undefined))
+ (JSON::stringify value))
+
+ @.python
+ (case (..str (..type value))
+ (^template [<type_of> <then>]
+ [<type_of>
+ (`` (|> value (~~ (template.splice <then>))))])
+ (["<type 'bool'>" [(:coerce .Bit) %.bit]]
+ ["<type 'int'>" [(:coerce .Int) %.int]]
+ ["<type 'float'>" [(:coerce .Frac) %.frac]]
+ ["<type 'str'>" [(:coerce .Text) %.text]]
+ ["<type 'unicode'>" [(:coerce .Text) %.text]])
+
+ "<type 'list'>"
+ (inspect_tuple inspect value)
+
+ "<type 'tuple'>"
+ (let [variant (:coerce (array.Array Any) value)]
+ (case (array.size variant)
+ 3 (let [variant_tag ("python array read" 0 variant)
+ variant_flag ("python array read" 1 variant)
+ variant_value ("python array read" 2 variant)]
+ (if (or ("python object none?" variant_tag)
+ ("python object none?" variant_value))
+ (..str value)
+ (|> (format (|> variant_tag (:coerce .Int) %.int)
+ " " (|> variant_flag "python object none?" not %.bit)
+ " " (inspect variant_value))
+ (text.enclose ["(" ")"]))))
+ _ (..str value)))
+
+ _
+ (..str value))
})))
(exception: #export (cannot_represent_value {type Type})
diff --git a/stdlib/source/lux/host.py.lux b/stdlib/source/lux/host.py.lux
new file mode 100644
index 000000000..ed3497df8
--- /dev/null
+++ b/stdlib/source/lux/host.py.lux
@@ -0,0 +1,315 @@
+(.module:
+ [lux #*
+ ["." meta]
+ ["@" target]
+ [abstract
+ [monad (#+ do)]]
+ [control
+ ["." io]
+ ["<>" parser
+ ["<c>" code (#+ Parser)]]]
+ [data
+ ["." product]
+ ["." maybe]
+ ["." text
+ ["%" format (#+ format)]]
+ [collection
+ ["." list ("#\." functor fold)]]]
+ [type
+ abstract]
+ [macro (#+ with_gensyms)
+ [syntax (#+ syntax:)]
+ ["." code]
+ ["." template]]])
+
+(abstract: #export (Object brand) Any)
+
+(template [<name>]
+ [(with_expansions [<brand> (template.identifier [<name> "'"])]
+ (abstract: #export <brand> Any)
+ (type: #export <name>
+ (..Object <brand>)))]
+
+ [None]
+ [Function]
+ )
+
+(template [<name> <type>]
+ [(type: #export <name>
+ <type>)]
+
+ [Boolean Bit]
+ [Integer Int]
+ [Float Frac]
+ [String Text]
+ )
+
+(type: Noneable
+ [Bit Code])
+
+(def: noneable
+ (Parser Noneable)
+ (let [token (' #?)]
+ (<| (<>.and (<>.parses? (<c>.this! token)))
+ (<>.after (<>.not (<c>.this! token)))
+ <c>.any)))
+
+(type: Constructor
+ (List Noneable))
+
+(def: constructor
+ (Parser Constructor)
+ (<c>.form (<>.after (<c>.this! (' new))
+ (<c>.tuple (<>.some ..noneable)))))
+
+(type: Field
+ [Bit Text Noneable])
+
+(def: static!
+ (Parser Any)
+ (<c>.this! (' #static)))
+
+(def: field
+ (Parser Field)
+ (<c>.form ($_ <>.and
+ (<>.parses? ..static!)
+ <c>.local_identifier
+ ..noneable)))
+
+(type: Common_Method
+ {#name Text
+ #alias (Maybe Text)
+ #inputs (List Noneable)
+ #io? Bit
+ #try? Bit
+ #output Noneable})
+
+(type: Static_Method Common_Method)
+(type: Virtual_Method Common_Method)
+
+(type: Method
+ (#Static Static_Method)
+ (#Virtual Virtual_Method))
+
+(def: common_method
+ (Parser Common_Method)
+ ($_ <>.and
+ <c>.local_identifier
+ (<>.maybe (<>.after (<c>.this! (' #as)) <c>.local_identifier))
+ (<c>.tuple (<>.some ..noneable))
+ (<>.parses? (<c>.this! (' #io)))
+ (<>.parses? (<c>.this! (' #try)))
+ ..noneable))
+
+(def: static_method
+ (<>.after ..static! ..common_method))
+
+(def: method
+ (Parser Method)
+ (<c>.form (<>.or ..static_method
+ ..common_method)))
+
+(type: Member
+ (#Constructor Constructor)
+ (#Field Field)
+ (#Method Method))
+
+(def: member
+ (Parser Member)
+ ($_ <>.or
+ ..constructor
+ ..field
+ ..method
+ ))
+
+(def: input_variables
+ (-> (List Noneable) (List [Bit Code]))
+ (|>> list.enumeration
+ (list\map (function (_ [idx [noneable? type]])
+ [noneable? (|> idx %.nat code.local_identifier)]))))
+
+(def: (noneable_type [noneable? type])
+ (-> Noneable Code)
+ (if noneable?
+ (` (.Maybe (~ type)))
+ type))
+
+(def: (with_none g!temp [noneable? input])
+ (-> Code [Bit Code] Code)
+ (if noneable?
+ (` (case (~ input)
+ (#.Some (~ g!temp))
+ (~ g!temp)
+
+ #.None
+ ("python object none")))
+ input))
+
+(def: (without_none g!temp [noneable? outputT] output)
+ (-> Code Noneable Code Code)
+ (if noneable?
+ (` (let [(~ g!temp) (~ output)]
+ (if ("python object none?" (~ g!temp))
+ #.None
+ (#.Some (~ g!temp)))))
+ output))
+
+(type: Import
+ (#Class [Text (List Member)])
+ (#Function Static_Method))
+
+(def: import
+ ($_ <>.or
+ ($_ <>.and
+ <c>.local_identifier
+ (<>.some member))
+ (<c>.form ..common_method)
+ ))
+
+(syntax: #export (try expression)
+ {#.doc (doc (case (try (risky_computation input))
+ (#.Right success)
+ (do_something success)
+
+ (#.Left error)
+ (recover_from_failure error)))}
+ (wrap (list (` ("lux try" ((~! io.io) (~ expression)))))))
+
+(def: (with_io with? without)
+ (-> Bit Code Code)
+ (if with?
+ (` (io.io (~ without)))
+ without))
+
+(def: (io_type io? rawT)
+ (-> Bit Code Code)
+ (if io?
+ (` (io.IO (~ rawT)))
+ rawT))
+
+(def: (with_try with? without_try)
+ (-> Bit Code Code)
+ (if with?
+ (` (..try (~ without_try)))
+ without_try))
+
+(def: (try_type try? rawT)
+ (-> Bit Code Code)
+ (if try?
+ (` (.Either .Text (~ rawT)))
+ rawT))
+
+(def: (make_function g!method g!temp source inputsT io? try? outputT)
+ (-> Code Code Code (List Noneable) Bit Bit Noneable Code)
+ (let [g!inputs (input_variables inputsT)]
+ (` (def: ((~ g!method)
+ [(~+ (list\map product.right g!inputs))])
+ (-> [(~+ (list\map noneable_type inputsT))]
+ (~ (|> (noneable_type outputT)
+ (try_type try?)
+ (io_type io?))))
+ (:assume
+ (~ (<| (with_io io?)
+ (with_try try?)
+ (without_none g!temp outputT)
+ (` ("python apply"
+ (~ source)
+ (~+ (list\map (with_none g!temp) g!inputs)))))))))))
+
+(syntax: #export (import: {import ..import})
+ (with_gensyms [g!temp]
+ (case import
+ (#Class [class members])
+ (with_gensyms [g!object]
+ (let [qualify (: (-> Text Code)
+ (|>> (format class "::") code.local_identifier))
+ g!type (code.local_identifier class)
+ real_class (text.replace_all "/" "." class)
+ imported (case (text.split_all_with "/" class)
+ (#.Cons head tail)
+ (list\fold (function (_ sub super)
+ (` ("python object get" (~ (code.text sub)) (~ super))))
+ (` ("python import" (~ (code.text head))))
+ tail)
+
+ #.Nil
+ (` ("python import" (~ (code.text class)))))]
+ (wrap (list& (` (type: (~ g!type)
+ (..Object (primitive (~ (code.text real_class))))))
+ (list\map (function (_ member)
+ (case member
+ (#Constructor inputsT)
+ (let [g!inputs (input_variables inputsT)]
+ (` (def: ((~ (qualify "new"))
+ [(~+ (list\map product.right g!inputs))])
+ (-> [(~+ (list\map noneable_type inputsT))]
+ (~ g!type))
+ (:assume
+ ("python apply"
+ (:coerce ..Function (~ imported))
+ [(~+ (list\map (with_none g!temp) g!inputs))])))))
+
+ (#Field [static? field fieldT])
+ (if static?
+ (` ((~! syntax:) ((~ (qualify field)))
+ (\ (~! meta.monad) (~' wrap)
+ (list (` (.:coerce (~ (noneable_type fieldT))
+ ("python object get" (~ (code.text field)) (~ imported))))))))
+ (` (def: ((~ (qualify field))
+ (~ g!object))
+ (-> (~ g!type)
+ (~ (noneable_type fieldT)))
+ (:assume
+ (~ (without_none g!temp fieldT (` ("python object get" (~ (code.text field)) (~ g!object)))))))))
+
+ (#Method method)
+ (case method
+ (#Static [method alias inputsT io? try? outputT])
+ (..make_function (qualify (maybe.default method alias))
+ g!temp
+ (` ("python object get" (~ (code.text method)) (~ imported)))
+ inputsT
+ io?
+ try?
+ outputT)
+
+ (#Virtual [method alias inputsT io? try? outputT])
+ (let [g!inputs (input_variables inputsT)]
+ (` (def: ((~ (qualify (maybe.default method alias)))
+ [(~+ (list\map product.right g!inputs))]
+ (~ g!object))
+ (-> [(~+ (list\map noneable_type inputsT))]
+ (~ g!type)
+ (~ (|> (noneable_type outputT)
+ (try_type try?)
+ (io_type io?))))
+ (:assume
+ (~ (<| (with_io io?)
+ (with_try try?)
+ (without_none g!temp outputT)
+ (` ("python object do"
+ (~ (code.text method))
+ (~ g!object)
+ [(~+ (list\map (with_none g!temp) g!inputs))])))))))))))
+ members)))))
+
+ (#Function [name alias inputsT io? try? outputT])
+ (wrap (list (..make_function (code.local_identifier (maybe.default name alias))
+ g!temp
+ (` ("python constant" (~ (code.text name))))
+ inputsT
+ io?
+ try?
+ outputT)))
+ )))
+
+(def: #export none
+ (<| (:coerce None)
+ ("python object none")))
+
+(template: #export (lambda <inputs> <output>)
+ (.:coerce ..Function
+ (`` ("python function"
+ (~~ (template.count <inputs>))
+ (.function (_ [<inputs>])
+ <output>)))))
diff --git a/stdlib/source/lux/math.lux b/stdlib/source/lux/math.lux
index 6c52b62fd..44650ed57 100644
--- a/stdlib/source/lux/math.lux
+++ b/stdlib/source/lux/math.lux
@@ -41,8 +41,17 @@
("jvm invokestatic:java.lang.Math:pow:double,double" subject param)))
@.jvm
- (as_is (template: (!double value) (|> value (:coerce (primitive "java.lang.Double")) "jvm object cast"))
- (template: (!frac value) (|> value "jvm object cast" (: (primitive "java.lang.Double")) (:coerce Frac)))
+ (as_is (template: (!double value)
+ (|> value
+ (:coerce (primitive "java.lang.Double"))
+ "jvm object cast"))
+
+ (template: (!frac value)
+ (|> value
+ "jvm object cast"
+ (: (primitive "java.lang.Double"))
+ (:coerce Frac)))
+
(template [<name> <method>]
[(def: #export <name>
(-> Frac Frac)
@@ -68,6 +77,7 @@
[root/2 "sqrt"]
[root/3 "cbrt"]
)
+
(def: #export (pow param subject)
(-> Frac Frac Frac)
(|> ("jvm member invoke static" [] "java.lang.Math" "pow" []
@@ -78,7 +88,8 @@
(as_is (template [<name> <method>]
[(def: #export <name>
(-> Frac Frac)
- (|>> ("js apply" ("js constant" <method>)) (:coerce Frac)))]
+ (|>> ("js apply" ("js constant" <method>))
+ (:coerce Frac)))]
[cos "Math.cos"]
[sin "Math.sin"]
@@ -97,9 +108,42 @@
[root/2 "Math.sqrt"]
[root/3 "Math.cbrt"]
)
+
(def: #export (pow param subject)
(-> Frac Frac Frac)
- (:coerce Frac ("js apply" ("js constant" "Math.pow") subject param))))})
+ (:coerce Frac ("js apply" ("js constant" "Math.pow") subject param))))
+
+ @.python
+ (as_is (template [<name> <method>]
+ [(def: #export <name>
+ (-> Frac Frac)
+ (|>> ("python object do" <method> ("python import" "math"))
+ (:coerce Frac)))]
+
+ [cos "cos"]
+ [sin "sin"]
+ [tan "tan"]
+
+ [acos "acos"]
+ [asin "asin"]
+ [atan "atan"]
+
+ [exp "exp"]
+ [log "log"]
+
+ [ceil "ceil"]
+ [floor "floor"]
+
+ [root/2 "sqrt"]
+ )
+
+ (def: #export (pow param subject)
+ (-> Frac Frac Frac)
+ (:coerce Frac ("python object do" "pow" ("python import" "math") subject param)))
+
+ (def: #export root/3
+ (-> Frac Frac)
+ (..pow ("lux f64 /" +3.0 +1.0))))})
(def: #export (round input)
(-> Frac Frac)
@@ -117,7 +161,7 @@
(def: #export (atan2 param subject)
(-> Frac Frac Frac)
(cond ("lux f64 <" param +0.0)
- (atan ("lux f64 /" param subject))
+ (..atan ("lux f64 /" param subject))
("lux f64 <" +0.0 param)
(if (or ("lux f64 <" subject +0.0)
diff --git a/stdlib/source/lux/math/number/frac.lux b/stdlib/source/lux/math/number/frac.lux
index 09c80cd05..599c5cbbb 100644
--- a/stdlib/source/lux/math/number/frac.lux
+++ b/stdlib/source/lux/math/number/frac.lux
@@ -1,5 +1,6 @@
(.module:
[lux (#- nat int rev)
+ ["@" target]
[abstract
[hash (#+ Hash)]
[monoid (#+ Monoid)]
@@ -12,13 +13,13 @@
["." try (#+ Try)]]
[data
["." maybe]
- ["." text]]
- ["." math]]
+ ["." text]]]
["." // #_
["#." i64]
["#." nat]
["#." int]
- ["#." rev]])
+ ["#." rev]
+ ["/#" //]])
(def: #export (= reference sample)
{#.doc "Frac(tion) equivalence."}
@@ -144,13 +145,13 @@
(def: #export smallest
Frac
- (math.pow (//int.frac (//int.- (.int ..mantissa_size) ..min_exponent))
- +2.0))
+ (///.pow (//int.frac (//int.- (.int ..mantissa_size) ..min_exponent))
+ +2.0))
(def: #export biggest
Frac
- (let [f2^-52 (math.pow (//nat.frac (//nat.- ..mantissa_size 0)) +2.0)
- f2^+1023 (math.pow ..max_exponent +2.0)]
+ (let [f2^-52 (///.pow (//nat.frac (//nat.- ..mantissa_size 0)) +2.0)
+ f2^+1023 (///.pow ..max_exponent +2.0)]
(|> +2.0
(..- f2^-52)
(..* f2^+1023))))
@@ -168,16 +169,32 @@
[maximum ..max (..* -1.0 ..biggest)]
)
-(template [<name> <numerator> <doc>]
- [(def: #export <name>
- {#.doc <doc>}
- Frac
- (../ +0.0 <numerator>))]
-
- [not_a_number +0.0 "Not a number."]
- [positive_infinity +1.0 "Positive infinity."]
- [negative_infinity -1.0 "Negative infinity."]
- )
+(for {@.python
+ (template [<name> <constant> <doc>]
+ [(def: #export <name>
+ {#.doc <doc>}
+ (|> <constant>
+ ("python apply" (:assume ("python constant" "float")))
+ (:coerce Frac)))]
+
+ [not_a_number "NaN" "Not a number."]
+ [positive_infinity "inf" "Positive infinity."]
+ )}
+
+ (template [<name> <numerator> <doc>]
+ [(def: #export <name>
+ {#.doc <doc>}
+ Frac
+ (../ +0.0 <numerator>))]
+
+ [not_a_number +0.0 "Not a number."]
+ [positive_infinity +1.0 "Positive infinity."]
+ ))
+
+(def: #export negative_infinity
+ {#.doc "Negative infinity."}
+ Frac
+ (..* -1.0 ..positive_infinity))
(def: #export (not_a_number? number)
{#.doc "Tests whether a frac is actually not-a-number."}
@@ -213,8 +230,8 @@
(def: log/2
(-> Frac Frac)
- (|>> math.log
- (../ (math.log +2.0))))
+ (|>> ///.log
+ (../ (///.log +2.0))))
(def: double_bias Nat 1023)
@@ -263,7 +280,7 @@
input (..abs input)
exponent (|> input
..log/2
- math.floor
+ ///.floor
(..min ..max_exponent))
min_gap (..- (//int.frac ..min_exponent) exponent)
power (|> (//nat.frac ..mantissa_size)
@@ -271,9 +288,9 @@
(..- exponent))
max_gap (..- ..max_exponent power)
mantissa (|> input
- (..* (math.pow (..min ..max_exponent power) +2.0))
+ (..* (///.pow (..min ..max_exponent power) +2.0))
(..* (if (..> +0.0 max_gap)
- (math.pow max_gap +2.0)
+ (///.pow max_gap +2.0)
+1.0)))
exponent_bits (|> (if (..< +0.0 min_gap)
(|> (..int exponent)
@@ -334,7 +351,7 @@
(//int.- (.int ..mantissa_size)))]
[(//i64.set ..mantissa_size M)
(|> E (//nat.- ..double_bias) (//nat.- ..mantissa_size) .int)])
- exponent (math.pow (//int.frac power) +2.0)]
+ exponent (///.pow (//int.frac power) +2.0)]
(|> (//nat.frac mantissa)
(..* exponent)
(..* sign)))))
diff --git a/stdlib/source/lux/math/number/i64.lux b/stdlib/source/lux/math/number/i64.lux
index b25015bf9..d04a9c13a 100644
--- a/stdlib/source/lux/math/number/i64.lux
+++ b/stdlib/source/lux/math/number/i64.lux
@@ -107,16 +107,14 @@
(-> Nat (I64 Any) Bit)
(.not (..set? idx input)))
-(template [<name> <main> <comp>]
+(template [<name> <forward> <backward>]
[(def: #export (<name> distance input)
(All [s] (-> Nat (I64 s) (I64 s)))
- (let [backwards_distance (n.- (n.% width distance) width)]
- (|> input
- (<comp> backwards_distance)
- (..or (<main> distance input)))))]
+ (..or (<forward> distance input)
+ (<backward> (n.- (n.% ..width distance) ..width) input)))]
- [rotate_left left_shift logic_right_shift]
- [rotate_right logic_right_shift left_shift]
+ [rotate_left ..left_shift ..logic_right_shift]
+ [rotate_right ..logic_right_shift ..left_shift]
)
(def: #export (region size offset)
@@ -147,31 +145,42 @@
[conjunction ..true ..and]
)
-(template [<swap> <size> <pattern>]
- [(def: <swap>
- (All [a] (-> (I64 a) (I64 a)))
- (let [high (try.assume (\ n.binary decode <pattern>))
- low (..rotate_right <size> high)]
- (function (_ value)
- (..or (..logic_right_shift <size> (..and high value))
- (..left_shift <size> (..and low value))))))]
-
- [swap/32 32 "1111111111111111111111111111111100000000000000000000000000000000"]
- [swap/16 16 "1111111111111111000000000000000011111111111111110000000000000000"]
- [swap/08 08 "1111111100000000111111110000000011111111000000001111111100000000"]
- [swap/04 04 "1111000011110000111100001111000011110000111100001111000011110000"]
- [swap/02 02 "1100110011001100110011001100110011001100110011001100110011001100"]
- [swap/01 01 "1010101010101010101010101010101010101010101010101010101010101010"]
- )
-
(def: #export reverse
(All [a] (-> (I64 a) (I64 a)))
- (|>> ..swap/32
- ..swap/16
- ..swap/08
- ..swap/04
- ..swap/02
- ..swap/01))
+ (let [swapper (: (-> Nat (All [a] (-> (I64 a) (I64 a))))
+ (function (_ power)
+ (let [size (..left_shift power 1)
+ repetitions (: (-> Nat Text Text)
+ (function (_ times char)
+ (loop [iterations 1
+ output char]
+ (if (n.< times iterations)
+ (recur (inc iterations)
+ ("lux text concat" char output))
+ output))))
+ pattern (repetitions (n./ (n.+ size size) ..width)
+ ("lux text concat"
+ (repetitions size "1")
+ (repetitions size "0")))
+
+ high (try.assume (\ n.binary decode pattern))
+ low (..rotate_right size high)]
+ (function (_ value)
+ (..or (..logic_right_shift size (..and high value))
+ (..left_shift size (..and low value)))))))
+
+ swap/01 (swapper 0)
+ swap/02 (swapper 1)
+ swap/04 (swapper 2)
+ swap/08 (swapper 3)
+ swap/16 (swapper 4)
+ swap/32 (swapper 5)]
+ (|>> swap/32
+ swap/16
+ swap/08
+ swap/04
+ swap/02
+ swap/01)))
(signature: #export (Sub size)
(: (Equivalence (I64 size))
diff --git a/stdlib/source/lux/math/number/nat.lux b/stdlib/source/lux/math/number/nat.lux
index 267846c89..5d1f7a101 100644
--- a/stdlib/source/lux/math/number/nat.lux
+++ b/stdlib/source/lux/math/number/nat.lux
@@ -108,11 +108,11 @@
(def: #export (/% parameter subject)
{#.doc "Nat(ural) [division remainder]."}
(-> Nat Nat [Nat Nat])
- (let [div (../ parameter subject)
+ (let [quotient (../ parameter subject)
flat ("lux i64 *"
("lux coerce" Int parameter)
- ("lux coerce" Int div))]
- [div ("lux i64 -" flat subject)]))
+ ("lux coerce" Int quotient))]
+ [quotient ("lux i64 -" flat subject)]))
(def: #export (% parameter subject)
{#.doc "Nat(ural) remainder."}
@@ -177,7 +177,7 @@
(Interval Nat)
(def: &enum ..enum)
- (def: top (.nat -1))
+ (def: top (dec 0))
(def: bottom 0))
(template [<name> <compose> <identity>]
diff --git a/stdlib/source/lux/meta.lux b/stdlib/source/lux/meta.lux
index 36a2294a2..454d33498 100644
--- a/stdlib/source/lux/meta.lux
+++ b/stdlib/source/lux/meta.lux
@@ -303,8 +303,9 @@
(get@ #.definitions)
(list.all (function (_ [def_name global])
(case global
- (#.Definition _)
- (if (text\= normal_short def_name)
+ (#.Definition [exported? _ _ _])
+ (if (and exported?
+ (text\= normal_short def_name))
(#.Some (name\encode [module_name def_name]))
#.None)
diff --git a/stdlib/source/lux/program.lux b/stdlib/source/lux/program.lux
index 55e9ec9b0..36f513e84 100644
--- a/stdlib/source/lux/program.lux
+++ b/stdlib/source/lux/program.lux
@@ -53,14 +53,10 @@
(let [initialization+event_loop
(` ((~! do) (~! io.monad)
[(~ g!output) (~ body)
- (~+ (for {@.old
- (list)
-
- @.jvm
- (list)
-
- @.js
- (list)}
+ (~+ (for {@.old (list)
+ @.jvm (list)
+ @.js (list)
+ @.python (list)}
(list g!_
(` ((~! thread.run!) [])))))]
((~' wrap) (~ g!output))))]
diff --git a/stdlib/source/lux/target/python.lux b/stdlib/source/lux/target/python.lux
index 6edba8f89..7510eac7d 100644
--- a/stdlib/source/lux/target/python.lux
+++ b/stdlib/source/lux/target/python.lux
@@ -1,5 +1,5 @@
(.module:
- [lux (#- Location Code not or and list if cond int comment)
+ [lux (#- Location Code not or and list if cond int comment exec)
[abstract
[equivalence (#+ Equivalence)]
[hash (#+ Hash)]
@@ -159,6 +159,13 @@
(text.enclose [text.double_quote text.double_quote])
:abstraction))
+ (def: #export unicode
+ (-> Text Literal)
+ (|>> ..string
+ :representation
+ (format "u")
+ :abstraction))
+
(def: (composite_literal left_delimiter right_delimiter entry_serializer)
(All [a]
(-> Text Text (-> a Text)
@@ -272,6 +279,7 @@
[- "-"]
[* "*"]
[/ "/"]
+ [// "//"]
[% "%"]
[** "**"]
[bit_or "|"]
@@ -354,6 +362,12 @@
(-> (Expression Any) (Statement Any))
(|>> :transmutation))
+ (def: #export (exec code then)
+ (-> (Expression Any) (Statement Any) (Statement Any))
+ (:abstraction
+ (format "exec" (..expression (:representation code)) text.new_line
+ (:representation then))))
+
(def: #export pass
(Statement Any)
(:abstraction "pass"))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/generation.lux b/stdlib/source/lux/tool/compiler/language/lux/generation.lux
index fb63247be..dbc56bc0d 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/generation.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/generation.lux
@@ -29,8 +29,11 @@
["." descriptor (#+ Module)]
["." artifact]]]]])
-(type: #export Context [archive.ID artifact.ID])
-(type: #export (Buffer directive) (Row [Text directive]))
+(type: #export Context
+ [archive.ID artifact.ID])
+
+(type: #export (Buffer directive)
+ (Row [Text directive]))
(exception: #export (cannot_interpret {error Text})
(exception.report
@@ -224,6 +227,7 @@
[?buffer (extension.read (get@ #buffer))]
(case ?buffer
(#.Some buffer)
+ ## TODO: Optimize by no longer checking for overwrites...
(if (row.any? (|>> product.left (text\= name)) buffer)
(phase.throw ..cannot_overwrite_output [name])
(extension.update (set@ #buffer (#.Some (row.add [name code] buffer)))))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/python.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/python.lux
new file mode 100644
index 000000000..5c10bbc0f
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/python.lux
@@ -0,0 +1,224 @@
+(.module:
+ [lux #*
+ ["." host]
+ [abstract
+ ["." monad (#+ do)]]
+ [control
+ ["<>" parser
+ ["<c>" code (#+ Parser)]]]
+ [data
+ [collection
+ ["." array (#+ Array)]
+ ["." dictionary]
+ ["." list]]]
+ ["." type
+ ["." check]]
+ ["@" target
+ ["_" python]]]
+ [//
+ ["/" lux (#+ custom)]
+ [//
+ ["." bundle]
+ [//
+ ["." analysis #_
+ ["#/." type]]
+ [//
+ ["." analysis (#+ Analysis Operation Phase Handler Bundle)]
+ [///
+ ["." phase]]]]]])
+
+(def: array::new
+ Handler
+ (custom
+ [<c>.any
+ (function (_ extension phase archive lengthC)
+ (do phase.monad
+ [lengthA (analysis/type.with_type Nat
+ (phase archive lengthC))
+ [var_id varT] (analysis/type.with_env check.var)
+ _ (analysis/type.infer (type (Array varT)))]
+ (wrap (#analysis.Extension extension (list lengthA)))))]))
+
+(def: array::length
+ Handler
+ (custom
+ [<c>.any
+ (function (_ extension phase archive arrayC)
+ (do phase.monad
+ [[var_id varT] (analysis/type.with_env check.var)
+ arrayA (analysis/type.with_type (type (Array varT))
+ (phase archive arrayC))
+ _ (analysis/type.infer Nat)]
+ (wrap (#analysis.Extension extension (list arrayA)))))]))
+
+(def: array::read
+ Handler
+ (custom
+ [(<>.and <c>.any <c>.any)
+ (function (_ extension phase archive [indexC arrayC])
+ (do phase.monad
+ [indexA (analysis/type.with_type Nat
+ (phase archive indexC))
+ [var_id varT] (analysis/type.with_env check.var)
+ arrayA (analysis/type.with_type (type (Array varT))
+ (phase archive arrayC))
+ _ (analysis/type.infer varT)]
+ (wrap (#analysis.Extension extension (list indexA arrayA)))))]))
+
+(def: array::write
+ Handler
+ (custom
+ [($_ <>.and <c>.any <c>.any <c>.any)
+ (function (_ extension phase archive [indexC valueC arrayC])
+ (do phase.monad
+ [indexA (analysis/type.with_type Nat
+ (phase archive indexC))
+ [var_id varT] (analysis/type.with_env check.var)
+ valueA (analysis/type.with_type varT
+ (phase archive valueC))
+ arrayA (analysis/type.with_type (type (Array varT))
+ (phase archive arrayC))
+ _ (analysis/type.infer (type (Array varT)))]
+ (wrap (#analysis.Extension extension (list indexA valueA arrayA)))))]))
+
+(def: array::delete
+ Handler
+ (custom
+ [($_ <>.and <c>.any <c>.any)
+ (function (_ extension phase archive [indexC arrayC])
+ (do phase.monad
+ [indexA (analysis/type.with_type Nat
+ (phase archive indexC))
+ [var_id varT] (analysis/type.with_env check.var)
+ arrayA (analysis/type.with_type (type (Array varT))
+ (phase archive arrayC))
+ _ (analysis/type.infer (type (Array varT)))]
+ (wrap (#analysis.Extension extension (list indexA arrayA)))))]))
+
+(def: bundle::array
+ Bundle
+ (<| (bundle.prefix "array")
+ (|> bundle.empty
+ (bundle.install "new" array::new)
+ (bundle.install "length" array::length)
+ (bundle.install "read" array::read)
+ (bundle.install "write" array::write)
+ (bundle.install "delete" array::delete)
+ )))
+
+(def: None
+ (for {@.python
+ host.None}
+ Any))
+
+(def: Object
+ (for {@.python (type (host.Object Any))}
+ Any))
+
+(def: Function
+ (for {@.python host.Function}
+ Any))
+
+(def: object::get
+ Handler
+ (custom
+ [($_ <>.and <c>.text <c>.any)
+ (function (_ extension phase archive [fieldC objectC])
+ (do phase.monad
+ [objectA (analysis/type.with_type ..Object
+ (phase archive objectC))
+ _ (analysis/type.infer .Any)]
+ (wrap (#analysis.Extension extension (list (analysis.text fieldC)
+ objectA)))))]))
+
+(def: object::do
+ Handler
+ (custom
+ [($_ <>.and <c>.text <c>.any (<>.some <c>.any))
+ (function (_ extension phase archive [methodC objectC inputsC])
+ (do {! phase.monad}
+ [objectA (analysis/type.with_type ..Object
+ (phase archive objectC))
+ inputsA (monad.map ! (|>> (phase archive) (analysis/type.with_type Any)) inputsC)
+ _ (analysis/type.infer .Any)]
+ (wrap (#analysis.Extension extension (list& (analysis.text methodC)
+ objectA
+ inputsA)))))]))
+
+(def: bundle::object
+ Bundle
+ (<| (bundle.prefix "object")
+ (|> bundle.empty
+ (bundle.install "get" object::get)
+ (bundle.install "do" object::do)
+ (bundle.install "none" (/.nullary ..None))
+ (bundle.install "none?" (/.unary Any Bit))
+ )))
+
+(def: python::constant
+ Handler
+ (custom
+ [<c>.text
+ (function (_ extension phase archive name)
+ (do phase.monad
+ [_ (analysis/type.infer Any)]
+ (wrap (#analysis.Extension extension (list (analysis.text name))))))]))
+
+(def: python::import
+ Handler
+ (custom
+ [<c>.text
+ (function (_ extension phase archive name)
+ (do phase.monad
+ [_ (analysis/type.infer ..Object)]
+ (wrap (#analysis.Extension extension (list (analysis.text name))))))]))
+
+(def: python::apply
+ Handler
+ (custom
+ [($_ <>.and <c>.any (<>.some <c>.any))
+ (function (_ extension phase archive [abstractionC inputsC])
+ (do {! phase.monad}
+ [abstractionA (analysis/type.with_type ..Function
+ (phase archive abstractionC))
+ inputsA (monad.map ! (|>> (phase archive) (analysis/type.with_type Any)) inputsC)
+ _ (analysis/type.infer Any)]
+ (wrap (#analysis.Extension extension (list& abstractionA inputsA)))))]))
+
+(def: python::function
+ Handler
+ (custom
+ [($_ <>.and <c>.nat <c>.any)
+ (function (_ extension phase archive [arity abstractionC])
+ (do phase.monad
+ [#let [inputT (type.tuple (list.repeat arity Any))]
+ abstractionA (analysis/type.with_type (-> inputT Any)
+ (phase archive abstractionC))
+ _ (analysis/type.infer ..Function)]
+ (wrap (#analysis.Extension extension (list (analysis.nat arity)
+ abstractionA)))))]))
+
+(def: python::exec
+ Handler
+ (custom
+ [<c>.any
+ (function (_ extension phase archive codeC)
+ (do phase.monad
+ [codeA (analysis/type.with_type Text
+ (phase archive codeC))
+ _ (analysis/type.infer .Any)]
+ (wrap (#analysis.Extension extension (list codeA)))))]))
+
+(def: #export bundle
+ Bundle
+ (<| (bundle.prefix "python")
+ (|> bundle.empty
+ (dictionary.merge bundle::array)
+ (dictionary.merge bundle::object)
+
+ (bundle.install "constant" python::constant)
+ (bundle.install "import" python::import)
+ (bundle.install "apply" python::apply)
+ (bundle.install "function" python::function)
+ (bundle.install "exec" python::exec)
+ )))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/python.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/python.lux
index 6c09e4123..5639551c6 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/python.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/python.lux
@@ -1,7 +1,11 @@
(.module:
- [lux #*]
+ [lux #*
+ [data
+ [collection
+ ["." dictionary]]]]
["." / #_
["#." common]
+ ["#." host]
[////
[generation
[python
@@ -9,4 +13,5 @@
(def: #export bundle
Bundle
- /common.bundle)
+ (dictionary.merge /common.bundle
+ /host.bundle))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/python/common.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/python/common.lux
index b1da3c425..9657fcb66 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/python/common.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/python/common.lux
@@ -3,48 +3,114 @@
[abstract
["." monad (#+ do)]]
[control
- ["." function]]
+ ["." function]
+ ["." try]
+ ["<>" parser
+ ["<s>" synthesis (#+ Parser)]]]
[data
["." product]
+ [text
+ ["%" format (#+ format)]]
[collection
- ["." dictionary]]]
+ ["." dictionary]
+ ["." list ("#\." functor fold)]]]
[math
[number
["f" frac]]]
[target
["_" python (#+ Expression)]]]
- [////
+ ["." //// #_
["/" bundle]
- [//
+ ["/#" // #_
+ ["." extension]
[generation
[extension (#+ Nullary Unary Binary Trinary
nullary unary binary trinary)]
["//" python #_
- ["#." runtime (#+ Operation Phase Handler Bundle)]]]]])
+ ["#." runtime (#+ Operation Phase Handler Bundle Generator)]]]
+ [//
+ [synthesis (#+ %synthesis)]
+ ["." generation]
+ [///
+ ["#" phase]]]]])
+
+(def: #export (custom [parser handler])
+ (All [s]
+ (-> [(Parser s)
+ (-> Text (Generator s))]
+ Handler))
+ (function (_ extension_name phase archive input)
+ (case (<s>.run parser input)
+ (#try.Success input')
+ (handler extension_name phase archive input')
+
+ (#try.Failure error)
+ (/////.throw extension.invalid_syntax [extension_name %synthesis input]))))
+
+## TODO: Get rid of this ASAP
+(def: lux::syntax_char_case!
+ (..custom [($_ <>.and
+ <s>.any
+ <s>.any
+ (<>.some (<s>.tuple ($_ <>.and
+ (<s>.tuple (<>.many <s>.i64))
+ <s>.any))))
+ (function (_ extension_name phase archive [input else conditionals])
+ (do {! /////.monad}
+ [inputG (phase archive input)
+ elseG (phase archive else)
+ @input (\ ! map _.var (generation.gensym "input"))
+ conditionalsG (: (Operation (List [(Expression Any)
+ (Expression Any)]))
+ (monad.map ! (function (_ [chars branch])
+ (do !
+ [branchG (phase archive branch)]
+ (wrap [(|> chars
+ (list\map (|>> .int _.int (_.= @input)))
+ (list\fold (function (_ clause total)
+ (if (is? _.none total)
+ clause
+ (_.or clause total)))
+ _.none))
+ branchG])))
+ conditionals))
+ #let [closure (_.lambda (list @input)
+ (list\fold (function (_ [test then] else)
+ (_.? test then else))
+ elseG
+ conditionalsG))]]
+ (wrap (_.apply/* closure (list inputG)))))]))
(def: lux_procs
Bundle
(|> /.empty
+ (/.install "syntax char case!" lux::syntax_char_case!)
(/.install "is" (binary (product.uncurry _.is)))
(/.install "try" (unary //runtime.lux//try))))
+(def: (capped operation parameter subject)
+ (-> (-> (Expression Any) (Expression Any) (Expression Any))
+ (-> (Expression Any) (Expression Any) (Expression Any)))
+ (//runtime.i64//64 (operation 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 (function.compose //runtime.i64//64 (product.uncurry _.bit_shl))))
+ (/.install "and" (binary (product.uncurry //runtime.i64//and)))
+ (/.install "or" (binary (product.uncurry //runtime.i64//or)))
+ (/.install "xor" (binary (product.uncurry //runtime.i64//xor)))
+ (/.install "left-shift" (binary (product.uncurry //runtime.i64//left_shift)))
(/.install "logical-right-shift" (binary (product.uncurry //runtime.i64//logic_right_shift)))
(/.install "arithmetic-right-shift" (binary (product.uncurry _.bit_shr)))
+
(/.install "<" (binary (product.uncurry _.<)))
(/.install "=" (binary (product.uncurry _.=)))
- (/.install "+" (binary (product.uncurry _.+)))
- (/.install "-" (binary (product.uncurry _.-)))
- (/.install "*" (binary (product.uncurry _.*)))
- (/.install "/" (binary (product.uncurry _./)))
- (/.install "%" (binary (product.uncurry _.%)))
+ (/.install "+" (binary (product.uncurry (..capped _.+))))
+ (/.install "-" (binary (product.uncurry (..capped _.-))))
+ (/.install "*" (binary (product.uncurry (..capped _.*))))
+ (/.install "/" (binary (product.uncurry _.//)))
+ (/.install "%" (binary (product.uncurry //runtime.i64//remainder)))
(/.install "f64" (unary _.float/1))
(/.install "char" (unary _.chr/1))
)))
@@ -66,11 +132,11 @@
(def: (text//clip [paramO extraO subjectO])
(Trinary (Expression Any))
- (//runtime.text//clip subjectO paramO extraO))
+ (//runtime.text//clip paramO extraO subjectO))
(def: (text//index [startO partO textO])
(Trinary (Expression Any))
- (//runtime.text//index textO partO startO))
+ (//runtime.text//index startO partO textO))
(def: text_procs
Bundle
@@ -78,7 +144,7 @@
(|> /.empty
(/.install "=" (binary (product.uncurry _.=)))
(/.install "<" (binary (product.uncurry _.<)))
- (/.install "concat" (binary (product.uncurry _.+)))
+ (/.install "concat" (binary (product.uncurry (function.flip _.+))))
(/.install "index" (trinary text//index))
(/.install "size" (unary _.len/1))
(/.install "char" (binary (product.uncurry //runtime.text//char)))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/python/host.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/python/host.lux
new file mode 100644
index 000000000..fcf35aa99
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/python/host.lux
@@ -0,0 +1,163 @@
+(.module:
+ [lux #*
+ [abstract
+ ["." monad (#+ do)]]
+ [control
+ ["." function]
+ ["<>" parser
+ ["<s>" synthesis (#+ Parser)]]]
+ [data
+ [collection
+ ["." dictionary]
+ ["." list]]]
+ [target
+ ["_" python (#+ Expression SVar)]]]
+ ["." // #_
+ ["#." common (#+ custom)]
+ ["//#" /// #_
+ ["/" bundle]
+ ["/#" // #_
+ ["." extension]
+ [generation
+ [extension (#+ Nullary Unary Binary Trinary
+ nullary unary binary trinary)]
+ ["//" python #_
+ ["#." runtime (#+ Operation Phase Handler Bundle
+ with_vars)]]]
+ ["/#" // #_
+ ["." generation]
+ ["//#" /// #_
+ ["#." phase]]]]]])
+
+(def: (array::new size)
+ (Unary (Expression Any))
+ (|> (list _.none)
+ _.list
+ (_.* size)))
+
+(def: array::length
+ (Unary (Expression Any))
+ (|>> _.len/1 //runtime.i64//64))
+
+(def: (array::read [indexG arrayG])
+ (Binary (Expression Any))
+ (_.nth indexG arrayG))
+
+(def: (array::write [indexG valueG arrayG])
+ (Trinary (Expression Any))
+ (//runtime.array//write indexG valueG arrayG))
+
+(def: (array::delete [indexG arrayG])
+ (Binary (Expression Any))
+ (//runtime.array//write indexG _.none arrayG))
+
+(def: array
+ Bundle
+ (<| (/.prefix "array")
+ (|> /.empty
+ (/.install "new" (unary array::new))
+ (/.install "length" (unary array::length))
+ (/.install "read" (binary array::read))
+ (/.install "write" (trinary array::write))
+ (/.install "delete" (binary array::delete))
+ )))
+
+(def: object::get
+ Handler
+ (custom
+ [($_ <>.and <s>.text <s>.any)
+ (function (_ extension phase archive [fieldS objectS])
+ (do ////////phase.monad
+ [objectG (phase archive objectS)]
+ (wrap (_.the fieldS objectG))))]))
+
+(def: object::do
+ Handler
+ (custom
+ [($_ <>.and <s>.text <s>.any (<>.some <s>.any))
+ (function (_ extension phase archive [methodS objectS inputsS])
+ (do {! ////////phase.monad}
+ [objectG (phase archive objectS)
+ inputsG (monad.map ! (phase archive) inputsS)]
+ (wrap (_.do methodS inputsG objectG))))]))
+
+(template [<!> <?> <unit>]
+ [(def: <!> (Nullary (Expression Any)) (function.constant <unit>))
+ (def: <?> (Unary (Expression Any)) (_.= <unit>))]
+
+ [object::none object::none? _.none]
+ )
+
+(def: object
+ Bundle
+ (<| (/.prefix "object")
+ (|> /.empty
+ (/.install "get" object::get)
+ (/.install "do" object::do)
+ (/.install "none" (nullary object::none))
+ (/.install "none?" (unary object::none?))
+ )))
+
+(def: python::constant
+ (custom
+ [<s>.text
+ (function (_ extension phase archive name)
+ (do ////////phase.monad
+ []
+ (wrap (_.var name))))]))
+
+(def: python::import
+ (custom
+ [<s>.text
+ (function (_ extension phase archive module)
+ (do ////////phase.monad
+ []
+ (wrap (_.apply/* (_.var "__import__") (list (_.string module))))))]))
+
+(def: python::apply
+ (custom
+ [($_ <>.and <s>.any (<>.some <s>.any))
+ (function (_ extension phase archive [abstractionS inputsS])
+ (do {! ////////phase.monad}
+ [abstractionG (phase archive abstractionS)
+ inputsG (monad.map ! (phase archive) inputsS)]
+ (wrap (_.apply/* abstractionG inputsG))))]))
+
+(def: python::function
+ (custom
+ [($_ <>.and <s>.i64 <s>.any)
+ (function (_ extension phase archive [arity abstractionS])
+ (do {! ////////phase.monad}
+ [abstractionG (phase archive abstractionS)
+ #let [variable (: (-> Text (Operation SVar))
+ (|>> generation.gensym
+ (\ ! map _.var)))]
+ g!inputs (monad.map ! (function (_ _) (variable "input"))
+ (list.repeat (.nat arity) []))]
+ (wrap (_.lambda g!inputs
+ (case (.nat arity)
+ 0 (_.apply/1 abstractionG //runtime.unit)
+ 1 (_.apply/* abstractionG g!inputs)
+ _ (_.apply/1 abstractionG (_.list g!inputs)))))))]))
+
+(def: python::exec
+ (custom
+ [<s>.any
+ (function (_ extension phase archive codeS)
+ (do {! ////////phase.monad}
+ [codeG (phase archive codeS)]
+ (wrap (//runtime.lux//exec codeG))))]))
+
+(def: #export bundle
+ Bundle
+ (<| (/.prefix "python")
+ (|> /.empty
+ (dictionary.merge ..array)
+ (dictionary.merge ..object)
+
+ (/.install "constant" python::constant)
+ (/.install "import" python::import)
+ (/.install "apply" python::apply)
+ (/.install "function" python::function)
+ (/.install "exec" python::exec)
+ )))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python.lux
index 9ab6f4056..4d6000fbc 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python.lux
@@ -19,6 +19,7 @@
["/#" // #_
["#." extension]
["/#" // #_
+ [analysis (#+)]
["#." synthesis]
["//#" /// #_
["#." phase ("#\." monad)]
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/case.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/case.lux
index e3be48bc6..ddaf1fe5b 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/case.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/case.lux
@@ -267,10 +267,6 @@
pattern_matching!)
(_.raise (_.Exception/1 (_.string case.pattern_matching_error)))))))
-(def: #export (gensym prefix)
- (-> Text (Operation SVar))
- (///////phase\map (|>> %.nat (format prefix) _.var) /////generation.next))
-
(def: #export dependencies
(-> Path (List SVar))
(|>> case.storage
@@ -284,6 +280,10 @@
(#///////variable.Foreign register)
(..capture register))))))
+(def: #export (gensym prefix)
+ (-> Text (Operation SVar))
+ (///////phase\map (|>> %.nat (format prefix) _.var) /////generation.next))
+
(def: #export (case! statement expression archive [valueS pathP])
(Generator! [Synthesis Path])
(do ///////phase.monad
@@ -298,12 +298,13 @@
(def: #export (case statement expression archive [valueS pathP])
(-> Phase! (Generator [Synthesis Path]))
(do ///////phase.monad
- [pattern_matching! (case! statement expression archive [valueS pathP])
- @case (..gensym "case")
- #let [@dependencies+ (..dependencies (/////synthesis.path/seq (/////synthesis.path/then valueS)
+ [[[case_module case_artifact] pattern_matching!] (/////generation.with_new_context archive
+ (case! statement expression archive [valueS pathP]))
+ #let [@case (_.var (///reference.artifact [case_module case_artifact]))
+ @dependencies+ (..dependencies (/////synthesis.path/seq (/////synthesis.path/then valueS)
pathP))
directive (_.def @case @dependencies+
pattern_matching!)]
_ (/////generation.execute! directive)
- _ (/////generation.save! (_.code @case) directive)]
+ _ (/////generation.save! (%.nat case_artifact) directive)]
(wrap (_.apply/* @case @dependencies+))))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/function.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/function.lux
index 23619eafc..8ef3446f5 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/function.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/function.lux
@@ -25,7 +25,10 @@
[arity (#+ Arity)]
["#." phase]
[reference
- [variable (#+ Register Variable)]]]]]])
+ [variable (#+ Register Variable)]]
+ [meta
+ [archive (#+ Archive)
+ ["." artifact]]]]]]])
(def: #export (apply expression archive [functionS argsS+])
(Generator (Application Synthesis))
@@ -38,27 +41,26 @@
(-> Register SVar)
(|>> (///reference.foreign //reference.system) :assume))
-(def: (with_closure function_name inits function_definition)
- (-> Text (List (Expression Any)) (Statement Any) (Operation (Expression Any)))
+(def: (with_closure function_id @function inits function_definition)
+ (-> artifact.ID SVar (List (Expression Any)) (Statement Any) (Operation (Expression Any)))
(case inits
#.Nil
(do ///////phase.monad
[_ (/////generation.execute! function_definition)
- _ (/////generation.save! function_name function_definition)]
- (wrap (_.apply/* (_.var function_name) inits)))
+ _ (/////generation.save! (%.nat function_id) function_definition)]
+ (wrap @function))
_
(do {! ///////phase.monad}
- [@closure (\ ! map _.var (/////generation.gensym "closure"))
- #let [directive (_.def @closure
+ [#let [directive (_.def @function
(|> (list.enumeration inits)
(list\map (|>> product.left ..capture)))
($_ _.then
function_definition
- (_.return (_.var function_name))))]
+ (_.return @function)))]
_ (/////generation.execute! directive)
- _ (/////generation.save! (_.code @closure) directive)]
- (wrap (_.apply/* @closure inits)))))
+ _ (/////generation.save! (%.nat function_id) directive)]
+ (wrap (_.apply/* @function inits)))))
(def: input
(|>> inc //case.register))
@@ -68,18 +70,14 @@
(do {! ///////phase.monad}
[@expected_exception (//case.gensym "expected_exception")
@actual_exception (//case.gensym "actual_exception")
- [function_name body!] (/////generation.with_new_context archive
- (do !
- [function_name (\ ! map ///reference.artifact
- (/////generation.context archive))]
- (/////generation.with_anchor [1 @expected_exception]
- (statement expression archive bodyS))))
+ [[function_module function_artifact] body!] (/////generation.with_new_context archive
+ (/////generation.with_anchor [1 @expected_exception]
+ (statement expression archive bodyS)))
environment (monad.map ! (expression archive) environment)
- #let [function_name (///reference.artifact function_name)
- @curried (_.var "curried")
+ #let [@curried (_.var "curried")
arityO (|> arity .int _.int)
@num_args (_.var "num_args")
- @self (_.var function_name)
+ @self (_.var (///reference.artifact [function_module function_artifact]))
apply_poly (.function (_ args func)
(_.apply_poly (list) args func))
initialize_self! (_.set (list (//case.register 0)) @self)
@@ -89,7 +87,7 @@
(_.set (list (..input post)) (_.nth (|> post .int _.int) @curried))))
initialize_self!
(list.indices arity))]]
- (with_closure function_name environment
+ (with_closure function_artifact @self environment
(_.def @self (list (_.poly @curried))
($_ _.then
(_.set (list @num_args) (_.len/1 @curried))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/loop.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/loop.lux
index 563e8ee61..c330d1f45 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/loop.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/loop.lux
@@ -17,20 +17,18 @@
["." // #_
[runtime (#+ Operation Phase Generator Phase! Generator!)]
["#." case]
- ["//#" /// #_
- [synthesis
- ["." case]]
+ ["/#" // #_
+ ["#." reference]
["/#" // #_
- ["." synthesis (#+ Scope Synthesis)]
- ["#." generation]
- ["//#" /// #_
- ["#." phase]
- [reference
- ["#." variable (#+ Register)]]]]]])
-
-(def: loop_name
- (-> Nat SVar)
- (|>> %.nat (format "loop") _.var))
+ [synthesis
+ ["." case]]
+ ["/#" // #_
+ ["." synthesis (#+ Scope Synthesis)]
+ ["#." generation]
+ ["//#" /// #_
+ ["#." phase]
+ [reference
+ ["#." variable (#+ Register)]]]]]]])
(def: (setup offset bindings body)
(-> Register (List (Expression Any)) (Statement Any) (Statement Any))
@@ -84,39 +82,39 @@
## true loop
_
(do {! ///////phase.monad}
- [@loop (\ ! map ..loop_name /////generation.next)
- @expected_exception (//case.gensym "expected_exception")
+ [@expected_exception (//case.gensym "expected_exception")
@actual_exception (//case.gensym "actual_exception")
initsO+ (monad.map ! (expression archive) initsS+)
- body! (/////generation.with_anchor [start @expected_exception]
- (statement expression archive bodyS))
- #let [locals (|> initsS+
+ [[loop_module loop_artifact] body!] (/////generation.with_new_context archive
+ (/////generation.with_anchor [start @expected_exception]
+ (statement expression archive bodyS)))
+ #let [@loop (_.var (///reference.artifact [loop_module loop_artifact]))
+ locals (|> initsS+
list.enumeration
(list\map (|>> product.left (n.+ start) //case.register)))
actual_loop (<| (_.def @loop locals)
(set_scope @expected_exception @actual_exception)
body!)
- [directive instantiation] (case (|> (synthesis.path/then bodyS)
- //case.dependencies
- (set.from_list _.hash)
- (set.difference (set.from_list _.hash locals))
- set.to_list)
- #.Nil
- [actual_loop
- (_.apply/* @loop initsO+)]
+ [directive instantiation] (: [(Statement Any) (Expression Any)]
+ (case (|> (synthesis.path/then bodyS)
+ //case.dependencies
+ (set.from_list _.hash)
+ (set.difference (set.from_list _.hash locals))
+ set.to_list)
+ #.Nil
+ [actual_loop
+ @loop]
- foreigns
- [(_.def @loop foreigns
- ($_ _.then
- actual_loop
- (_.return @loop)
- ))
- (_.apply/* (_.apply/* @loop
- foreigns)
- initsO+)])]
+ foreigns
+ [(_.def @loop foreigns
+ ($_ _.then
+ actual_loop
+ (_.return @loop)
+ ))
+ (_.apply/* @loop foreigns)]))]
_ (/////generation.execute! directive)
- _ (/////generation.save! (_.code @loop) directive)]
- (wrap instantiation))))
+ _ (/////generation.save! (%.nat loop_artifact) directive)]
+ (wrap (_.apply/* instantiation initsO+)))))
(def: #export (recur! statement expression archive argsS+)
(Generator! (List Synthesis))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/primitive.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/primitive.lux
index 5ecb466b3..270560266 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/primitive.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/primitive.lux
@@ -1,7 +1,9 @@
(.module:
[lux (#- i64)
[target
- ["_" python (#+ Expression)]]])
+ ["_" python (#+ Expression)]]]
+ ["." // #_
+ ["#." runtime]])
(template [<type> <name> <implementation>]
[(def: #export <name>
@@ -9,7 +11,7 @@
<implementation>)]
[Bit bit _.bool]
- [(I64 Any) i64 (|>> .int _.long)]
+ [(I64 Any) i64 (|>> .int _.int //runtime.i64//64)]
[Frac f64 _.float]
- [Text text _.string]
+ [Text text _.unicode]
)
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux
index fc2e95789..ef213fb2c 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux
@@ -21,7 +21,7 @@
[math
[number (#+ hex)
["." i64]]]
- [target
+ ["@" target
["_" python (#+ Expression SVar Computation Literal Statement)]]]
["." /// #_
["#." reference]
@@ -61,12 +61,12 @@
(def: #export
unit
- (_.string /////synthesis.unit))
+ (_.unicode /////synthesis.unit))
(def: (flag value)
(-> Bit Literal)
(if value
- (_.string "")
+ (_.unicode "")
_.none))
(def: (variant' tag last? value)
@@ -132,8 +132,8 @@
(` (def: (~ code_nameC)
(Statement Any)
(..feature (~ runtime_nameC)
- (function ((~ g!_) (~ nameC))
- (~ code)))))))))
+ (function ((~ g!_) (~ g!_))
+ (_.set (list (~ g!_)) (~ code))))))))))
(#.Right [name inputs])
(macro.with_gensyms [g!_]
@@ -165,17 +165,22 @@
(runtime: (lux//program_args program_args)
(with_vars [inputs value]
($_ _.then
- (_.set (list inputs) none)
+ (_.set (list inputs) ..none)
(<| (_.for_in value program_args)
(_.set (list inputs)
- (some (_.tuple (list value inputs)))))
+ (..some (_.tuple (list value inputs)))))
(_.return inputs))))
+(runtime: (lux//exec code)
+ (<| (_.exec code)
+ (_.return ..unit)))
+
(def: runtime//lux
(Statement Any)
($_ _.then
@lux//try
@lux//program_args
+ @lux//exec
))
(runtime: (io//log! message)
@@ -184,9 +189,7 @@
(_.return ..unit)))
(runtime: (io//throw! message)
- ($_ _.then
- (_.raise (_.Exception/1 message))
- (_.return ..unit)))
+ (_.raise (_.Exception/1 message)))
(runtime: (io//current_time! _)
($_ _.then
@@ -240,7 +243,7 @@
sum_tag (_.nth (_.int +0) sum)
sum_flag (_.nth (_.int +1) sum)
sum_value (_.nth (_.int +2) sum)
- is_last? (_.= (_.string "") sum_flag)
+ is_last? (_.= (_.unicode "") sum_flag)
test_recursion! (_.if is_last?
## Must recurse.
(_.return (sum//get sum_value wantsLast (_.- sum_tag wantedTag)))
@@ -254,7 +257,7 @@
test_recursion!]
[(_.and (_.< sum_tag wantedTag)
- (_.= (_.string "") wantsLast))
+ (_.= (_.unicode "") wantsLast))
(_.return (variant' (_.- wantedTag sum_tag) sum_flag sum_value))])
no_match!)))
@@ -267,37 +270,71 @@
@sum//get
))
-(def: full_64_bits
- Literal
- (_.manual "0xFFFFFFFFFFFFFFFF"))
+(runtime: i64//top
+ (|> (_.int +1)
+ (_.bit_shl (_.int +63))
+ (_.- (_.int +1))))
+
+(runtime: i64//bottom
+ (_.- (|> (_.int +1)
+ (_.bit_shl (_.int +63)))
+ (_.int +0)))
(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))))
+ (_.return (<| (_.? (|> input (_.< ..i64//bottom))
+ (|> input (_.- ..i64//bottom) (_.+ (_.int +1)) (_.+ i64//top) i64//64))
+ (_.? (|> input (_.> ..i64//top))
+ (|> input (_.- ..i64//top) (_.- (_.int +1)) (_.+ ..i64//bottom) i64//64))
+ (for {@.python input}
+ ## This +- is only necessary to guaranteed that values within the limits are always longs in Python 2
+ (|> input (_.+ i64//top) (_.- ..i64//top))))))
+
+(runtime: i64//nat_top
+ (|> (_.int +1)
+ (_.bit_shl (_.int +64))
+ (_.- (_.int +1))))
+
+(def: as_nat
+ (_.% (_.manual "0x10000000000000000")))
+
+(runtime: (i64//left_shift param subject)
+ (_.return (|> subject
+ ..as_nat
+ (_.bit_shl param)
+ ..as_nat
+ ..i64//64)))
(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)))))
+ (_.return (|> subject
+ ..as_nat
+ (_.bit_shr param))))
+
+(runtime: (i64//remainder param subject)
+ (_.return (_.- (|> subject (_.// param) (_.* param))
+ subject)))
+
+(template [<runtime> <python>]
+ [(runtime: (<runtime> left right)
+ (_.return (..i64//64 (<python> (..as_nat left) (..as_nat right)))))]
+
+ [i64//and _.bit_and]
+ [i64//or _.bit_or]
+ [i64//xor _.bit_xor]
+ )
(def: runtime//i64
(Statement Any)
($_ _.then
+ @i64//top
+ @i64//bottom
@i64//64
+ @i64//left_shift
@i64//logic_right_shift
+ @i64//nat_top
+ @i64//and
+ @i64//or
+ @i64//xor
+ @i64//remainder
))
(runtime: (f64//decode input)
@@ -313,28 +350,29 @@
@f64//decode
))
-(runtime: (text//index subject param start)
+(runtime: (text//index start param subject)
(with_vars [idx]
($_ _.then
(_.set (list idx) (|> subject (_.do "find" (list param start))))
- (_.if (_.= (_.int -1) idx)
- (_.return ..none)
- (_.return (..some idx))))))
+ (_.return (_.? (_.= (_.int -1) idx)
+ ..none
+ (..some (..i64//64 idx)))))))
-(def: inc (|>> (_.+ (_.int +1))))
+(def: inc
+ (|>> (_.+ (_.int +1))))
(def: (within? top value)
(-> (Expression Any) (Expression Any) (Computation Any))
(_.and (|> value (_.>= (_.int +0)))
(|> value (_.< top))))
-(runtime: (text//clip @text @from @to)
- (_.return (|> @text (_.slice @from (inc @to)))))
+(runtime: (text//clip @from @to @text)
+ (_.return (|> @text (_.slice @from @to))))
(runtime: (text//char idx text)
(_.if (|> idx (within? (_.len/1 text)))
- (_.return (..some (_.ord/1 (|> text (_.slice idx (inc idx))))))
- (_.return ..none)))
+ (_.return (|> text (_.slice idx (..inc idx)) _.ord/1 ..i64//64))
+ (_.raise (_.Exception/1 (_.unicode "[Lux Error] Cannot get char from text.")))))
(def: runtime//text
(Statement Any)
@@ -344,6 +382,17 @@
@text//char
))
+(runtime: (array//write idx value array)
+ ($_ _.then
+ (_.set (list (_.nth idx array)) value)
+ (_.return array)))
+
+(def: runtime//array
+ (Statement Any)
+ ($_ _.then
+ @array//write
+ ))
+
(def: runtime
(Statement Any)
($_ _.then
@@ -353,6 +402,7 @@
runtime//f64
runtime//text
runtime//io
+ runtime//array
))
(def: #export artifact
diff --git a/stdlib/source/lux/type/check.lux b/stdlib/source/lux/type/check.lux
index e87b1802a..8f79817c0 100644
--- a/stdlib/source/lux/type/check.lux
+++ b/stdlib/source/lux/type/check.lux
@@ -49,9 +49,11 @@
["Expected" (//.format expected)]
["Actual" (//.format actual)]))
-(type: #export Var Nat)
+(type: #export Var
+ Nat)
-(type: #export Assumption [Type Type])
+(type: #export Assumption
+ [Type Type])
(type: #export (Check a)
(-> Type_Context (Try [Type_Context a])))
diff --git a/stdlib/source/lux/world/file.lux b/stdlib/source/lux/world/file.lux
index 8882270f8..e8ebb7aac 100644
--- a/stdlib/source/lux/world/file.lux
+++ b/stdlib/source/lux/world/file.lux
@@ -1,6 +1,6 @@
(.module:
[lux #*
- ["." host (#+ import:)]
+ ["." host]
["@" target]
[abstract
["." monad (#+ Monad do)]]
@@ -226,9 +226,9 @@
["Instant" (%.instant instant)]
["Path" file]))
- (import: java/lang/String)
+ (host.import: java/lang/String)
- (`` (import: java/io/File
+ (`` (host.import: java/io/File
["#::."
(new [java/lang/String])
(~~ (template [<name>]
@@ -258,24 +258,24 @@
_
(wrap (exception.throw exception [path])))))
- (import: java/lang/AutoCloseable
+ (host.import: java/lang/AutoCloseable
["#::."
(close [] #io #try void)])
- (import: java/io/OutputStream
+ (host.import: java/io/OutputStream
["#::."
(write [[byte]] #io #try void)
(flush [] #io #try void)])
- (import: java/io/FileOutputStream
+ (host.import: java/io/FileOutputStream
["#::."
(new [java/io/File boolean] #io #try)])
- (import: java/io/InputStream
+ (host.import: java/io/InputStream
["#::."
(read [[byte]] #io #try int)])
- (import: java/io/FileInputStream
+ (host.import: java/io/FileInputStream
["#::."
(new [java/io/File] #io #try)])
@@ -435,31 +435,28 @@
(def: separator (java/io/File::separator))
)))]
- (for {@.old
- (as_is <for_jvm>)
-
- @.jvm
- (as_is <for_jvm>)
+ (for {@.old (as_is <for_jvm>)
+ @.jvm (as_is <for_jvm>)
@.js
- (as_is (import: Buffer
+ (as_is (host.import: Buffer
(#static from [Binary] ..Buffer))
- (import: FileDescriptor)
+ (host.import: FileDescriptor)
- (import: Stats
+ (host.import: Stats
(size host.Number)
(mtimeMs host.Number)
(isFile [] #io #try host.Boolean)
(isDirectory [] #io #try host.Boolean))
- (import: FsConstants
+ (host.import: FsConstants
(F_OK host.Number)
(R_OK host.Number)
(W_OK host.Number)
(X_OK host.Number))
- (import: Fs
+ (host.import: Fs
(constants FsConstants)
(readFileSync [host.String] #io #try Binary)
(appendFileSync [host.String Buffer] #io #try Any)
@@ -473,7 +470,7 @@
(mkdirSync [host.String] #io #try Any)
(rmdirSync [host.String] #io #try Any))
- (import: JsPath
+ (host.import: JsPath
(sep host.String)
(basename [host.String] host.String))
@@ -678,6 +675,202 @@
"/"))
))
)
+
+ @.python
+ (as_is (type: (Tuple/2 left right)
+ (primitive "python_tuple[2]" [left right]))
+
+ (host.import: (open [host.String host.String] #io #try Any))
+ (host.import: (tuple [[host.Integer host.Integer]] (Tuple/2 host.Integer host.Integer)))
+
+ (host.import: os
+ (#static F_OK host.Integer)
+ (#static R_OK host.Integer)
+ (#static W_OK host.Integer)
+ (#static X_OK host.Integer)
+
+ (#static mkdir [host.String] #io #try Any)
+ (#static access [host.String host.Integer] #io #try host.Boolean)
+ (#static remove [host.String] #io #try Any)
+ (#static rmdir [host.String] #io #try Any)
+ (#static rename [host.String host.String] #io #try Any)
+ (#static utime [host.String (Tuple/2 host.Integer host.Integer)] #io #try Any)
+ (#static listdir [host.String] #io #try (Array host.String)))
+
+ (host.import: os/path
+ (#static isfile [] #io #try host.Boolean)
+ (#static isdir [] #io #try host.Boolean)
+ (#static sep host.String)
+ (#static basename [host.String] host.String)
+ (#static getsize [host.String] #io #try host.Integer)
+ (#static getmtime [host.String] #io #try host.Float))
+
+ (`` (structure: (file path)
+ (-> Path (File IO))
+
+ (~~ (template [<name> <mode>]
+ [(def: <name>
+ (..can_modify
+ (function (<name> data)
+ (do (try.with io.monad)
+ [file (..open [path <mode>])]
+ (io.io (do try.monad
+ [_ (host.try ("python object do" "write" (:assume file) data))]
+ (host.try ("python object do" "close" (:assume file)))))))))]
+
+ [over_write "wb"]
+ [append "ab"]
+ ))
+
+ (def: content
+ (..can_query
+ (function (_ _)
+ (do (try.with io.monad)
+ [file (..open [path "rb"])]
+ (io.io (do try.monad
+ [data (:coerce (Try Binary)
+ (host.try ("python object do" "read" (:assume file))))
+ _ (host.try ("python object do" "close" (:assume file)))]
+ (wrap data)))))))
+
+ (def: name
+ (..can_see
+ (function (_ _)
+ (os/path::basename [path]))))
+
+ (def: path
+ (..can_see
+ (function (_ _)
+ path)))
+
+ (def: size
+ (..can_query
+ (function (_ _)
+ (do (try.with io.monad)
+ [size (os/path::getsize [path])]
+ (wrap (.nat size))))))
+
+ (def: last_modified
+ (..can_query
+ (function (_ _)
+ (do (try.with io.monad)
+ [seconds_since_epoch (os/path::getmtime [path])]
+ (wrap (|> seconds_since_epoch
+ f.int
+ (i.* +1,000)
+ duration.from_millis
+ instant.absolute))))))
+
+ (def: can_execute?
+ (..can_query
+ (function (can_execute? _)
+ (os::access [path (os::X_OK)]))))
+
+ (def: move
+ (..can_open
+ (function (move destination)
+ (do (try.with io.monad)
+ [_ (os::rename [path destination])]
+ (wrap (file destination))))))
+
+ (def: modify
+ (..can_modify
+ (function (modify time_stamp)
+ (let [when (|> time_stamp instant.relative duration.to_millis (i./ +1,000))]
+ (os::utime [path (..tuple [when when])])))))
+
+ (def: delete
+ (..can_delete
+ (function (delete _)
+ (os::remove [path]))))
+ ))
+
+ (`` (structure: (directory path)
+ (-> Path (Directory IO))
+
+ (def: scope
+ (..can_see
+ (function (_ _)
+ path)))
+
+ (~~ (template [<name> <method> <capability>]
+ [(def: <name>
+ (..can_query
+ (function (<name> _)
+ (do {! (try.with io.monad)}
+ [subs (os::listdir [path])
+ subs (monad.map ! (function (_ sub)
+ (do !
+ [verdict (<method> [sub])]
+ (wrap [verdict sub])))
+ (array.to_list subs))]
+ (wrap (|> subs
+ (list.filter product.left)
+ (list\map (|>> product.right <capability>))))))))]
+
+ [files os/path::isfile ..file]
+ [directories os/path::isdir directory]
+ ))
+
+ (def: discard
+ (..can_delete
+ (function (discard _)
+ (os::rmdir [path]))))
+ ))
+
+ (`` (structure: #export default
+ (System IO)
+
+ (~~ (template [<name> <method> <capability> <exception>]
+ [(with_expansions [<failure> (exception.throw <exception> [path])]
+ (def: <name>
+ (..can_open
+ (function (<name> path)
+ (do io.monad
+ [?verdict (<method> [path])]
+ (wrap (case ?verdict
+ (#try.Success verdict)
+ (if verdict
+ (#try.Success (<capability> path))
+ <failure>)
+
+ (#try.Failure _)
+ <failure>)))))))]
+
+ [file os/path::isfile ..file ..cannot_find_file]
+ [directory os/path::isdir ..directory ..cannot_find_directory]
+ ))
+
+ (def: create_file
+ (..can_open
+ (function (create_file path)
+ (do io.monad
+ [outcome (..open [path "x"])]
+ (wrap (case outcome
+ (#try.Success _)
+ (do try.monad
+ [_ (host.try ("python object do" "close" (:assume outcome)))]
+ (wrap (..file path)))
+
+ (#try.Failure error)
+ (exception.throw ..cannot_create_file [path])))))))
+
+ (def: create_directory
+ (..can_open
+ (function (create_directory path)
+ (do io.monad
+ [outcome (os::mkdir [path])]
+ (wrap (case outcome
+ (#try.Success _)
+ (#try.Success (..directory path))
+
+ (#try.Failure error)
+ (exception.throw ..cannot_create_directory [path])))))))
+
+ (def: separator
+ (os/path::sep))
+ ))
+ )
}))
(template [<get> <signature> <create> <find> <exception>]
diff --git a/stdlib/source/lux/world/program.lux b/stdlib/source/lux/world/program.lux
index 92a5793bd..ca301e2ce 100644
--- a/stdlib/source/lux/world/program.lux
+++ b/stdlib/source/lux/world/program.lux
@@ -3,7 +3,7 @@
["@" target]
["." host (#+ import:)]
[abstract
- [monad (#+ do)]]
+ ["." monad (#+ do)]]
[control
["." function]
["." io (#+ IO)]
@@ -166,7 +166,19 @@
(import: NodeJs_OS
(homedir [] #io Path))
- (import: (require [host.String] Any)))}
+ (import: (require [host.String] Any)))
+ @.python (as_is (import: os
+ (#static getcwd [] #io host.String))
+
+ (import: os/path
+ (#static expanduser [host.String] #io host.String))
+
+ (import: os/environ
+ (#static keys [] #io (Array host.String))
+ (#static get [host.String] #io host.String))
+
+ (import: sys
+ (#static exit [host.Integer] #io Nothing)))}
(as_is)))
(structure: #export default
@@ -190,7 +202,15 @@
#.None
(undefined))
- environment.empty))}
+ environment.empty))
+ @.python (do {! io.monad}
+ [keys (os/environ::keys [])]
+ (monad.fold ! (function (_ variable environment)
+ (do !
+ [value (os/environ::get [variable])]
+ (wrap (dictionary.put variable value environment))))
+ environment.empty
+ (array.to_list keys)))}
## TODO: Replace dummy implementation.
(io.io environment.empty))))
@@ -203,7 +223,8 @@
(|> (..require "os")
(:coerce NodeJs_OS)
(NodeJs_OS::homedir []))
- <default>)}
+ <default>)
+ @.python (os/path::expanduser ["~"])}
## TODO: Replace dummy implementation.
<default>)))
@@ -219,7 +240,8 @@
#.None
<default>)
- <default>)}
+ <default>)
+ @.python (os::getcwd [])}
## TODO: Replace dummy implementation.
<default>)))
@@ -236,4 +258,5 @@
(..exit_browser! code)
## else
- (..default_exit! code))}))))
+ (..default_exit! code))
+ @.python (sys::exit code)}))))
diff --git a/stdlib/source/program/aedifex/artifact/snapshot.lux b/stdlib/source/program/aedifex/artifact/snapshot.lux
new file mode 100644
index 000000000..0488d76dd
--- /dev/null
+++ b/stdlib/source/program/aedifex/artifact/snapshot.lux
@@ -0,0 +1,72 @@
+(.module:
+ [lux (#- Name Type)
+ [abstract
+ [equivalence (#+ Equivalence)]
+ [monad (#+ do)]]
+ [control
+ ["<>" parser
+ ["<.>" xml (#+ Parser)]
+ ["<.>" text]]]
+ [data
+ ["." sum]
+ [format
+ ["." xml (#+ XML)]]]]
+ ["." / #_
+ ["#." stamp (#+ Stamp)]])
+
+(type: #export Snapshot
+ #Local
+ (#Remote Stamp))
+
+(structure: any_equivalence
+ (Equivalence Any)
+
+ (def: (= _ _)
+ true))
+
+(def: #export equivalence
+ (Equivalence Snapshot)
+ ($_ sum.equivalence
+ ..any_equivalence
+ /stamp.equivalence
+ ))
+
+(template [<definition> <tag>]
+ [(def: <definition> xml.Tag ["" <tag>])]
+
+ [<local_copy> "localCopy"]
+ [<snapshot> "snapshot"]
+ )
+
+(def: local_copy_value
+ "true")
+
+(def: local_copy_format
+ XML
+ (#xml.Node <local_copy>
+ xml.attributes
+ (list (#xml.Text ..local_copy_value))))
+
+(def: local_copy_parser
+ (Parser Any)
+ (do <>.monad
+ [_ (<xml>.node ..<local_copy>)]
+ (<xml>.children (<text>.embed (<text>.this ..local_copy_value)
+ <xml>.text))))
+
+(def: #export (format snapshot)
+ (-> Snapshot XML)
+ (<| (#xml.Node ..<snapshot> xml.attributes)
+ (case snapshot
+ #Local
+ (list ..local_copy_format)
+
+ (#Remote stamp)
+ (/stamp.format stamp))))
+
+(def: #export parser
+ (Parser Snapshot)
+ (do <>.monad
+ [_ (<xml>.node <snapshot>)]
+ (<xml>.children (<>.or ..local_copy_parser
+ /stamp.parser))))
diff --git a/stdlib/source/program/aedifex/artifact/snapshot/stamp.lux b/stdlib/source/program/aedifex/artifact/snapshot/stamp.lux
index c1efcc8ee..ca59b11a6 100644
--- a/stdlib/source/program/aedifex/artifact/snapshot/stamp.lux
+++ b/stdlib/source/program/aedifex/artifact/snapshot/stamp.lux
@@ -1,11 +1,16 @@
(.module:
[lux #*
[abstract
- [equivalence (#+ Equivalence)]]
+ [equivalence (#+ Equivalence)]
+ [monad (#+ do)]]
+ [control
+ ["<>" parser
+ ["<.>" xml (#+ Parser)]
+ ["<.>" text]]]
[data
["." product]
[format
- [xml (#+ XML)]]]]
+ ["." xml (#+ XML)]]]]
["." // #_
["#." time (#+ Time)]
["#." build (#+ Build)]])
@@ -21,22 +26,22 @@
//build.equivalence
))
+(def: <timestamp>
+ xml.Tag
+ ["" "timestamp"])
+
(def: time_format
(-> Time XML)
(|>> //time.format
#xml.Text
list
- (#xml.Node ..tag xml.attributes)))
+ (#xml.Node ..<timestamp> xml.attributes)))
(def: #export (format (^slots [#time #build]))
(-> Stamp (List XML))
(list (..time_format time)
(//build.format build)))
-(def: <timestamp>
- xml.Tag
- ["" "timestamp"])
-
## (exception: #export (mismatch {expected Instant} {actual Instant})
## (exception.report
## ["Expected" (%.instant expected)]
diff --git a/stdlib/source/test/aedifex/artifact/snapshot.lux b/stdlib/source/test/aedifex/artifact/snapshot.lux
new file mode 100644
index 000000000..1bdb9ca2d
--- /dev/null
+++ b/stdlib/source/test/aedifex/artifact/snapshot.lux
@@ -0,0 +1,48 @@
+(.module:
+ [lux #*
+ ["_" test (#+ Test)]
+ [abstract
+ [monad (#+ do)]
+ {[0 #spec]
+ [/
+ ["$." equivalence]]}]
+ [control
+ ["." try ("#\." functor)]
+ [parser
+ ["<.>" xml]]]
+ [math
+ ["." random (#+ Random) ("#\." monad)]]]
+ ["$." / #_
+ ["#." build]
+ ["#." time]
+ ["#." stamp]]
+ {#program
+ ["." /]})
+
+(def: #export random
+ (Random /.Snapshot)
+ (random.or (random\wrap [])
+ $/stamp.random))
+
+(def: #export test
+ Test
+ (<| (_.covering /._)
+ (_.for [/.Snapshot]
+ ($_ _.and
+ (_.for [/.equivalence]
+ ($equivalence.spec /.equivalence ..random))
+
+ (do random.monad
+ [expected ..random]
+ (_.cover [/.format /.parser]
+ (|> expected
+ /.format
+ list
+ (<xml>.run /.parser)
+ (try\map (\ /.equivalence = expected))
+ (try.default false))))
+
+ $/build.test
+ $/time.test
+ $/stamp.test
+ ))))
diff --git a/stdlib/source/test/aedifex/artifact/snapshot/stamp.lux b/stdlib/source/test/aedifex/artifact/snapshot/stamp.lux
index aab722cad..a36e5af9d 100644
--- a/stdlib/source/test/aedifex/artifact/snapshot/stamp.lux
+++ b/stdlib/source/test/aedifex/artifact/snapshot/stamp.lux
@@ -41,8 +41,8 @@
(_.cover [/.format /.parser]
(|> expected
/.format
- (<xml>.run' /.parser)
- (try\map (\ instant.equivalence = expected))
+ (<xml>.run /.parser)
+ (try\map (\ /.equivalence = expected))
(try.default false)))
))
)))
diff --git a/stdlib/source/test/lux/meta.lux b/stdlib/source/test/lux/meta.lux
index ec76184cd..c3d984854 100644
--- a/stdlib/source/test/lux/meta.lux
+++ b/stdlib/source/test/lux/meta.lux
@@ -3,6 +3,7 @@
["_" test (#+ Test)]
["." type ("#\." equivalence)]
[abstract
+ [equivalence (#+ Equivalence)]
[monad (#+ do)]
{[0 #spec]
[/
@@ -742,6 +743,133 @@
correct_type!)))))))))
)))
+(def: locals_related
+ Test
+ (do {! random.monad}
+ [current_module (random.ascii/upper 1)
+ [name_0 name_1 name_2 name_3 name_4] (|> (random.ascii/upper 1)
+ (random.set text.hash 5)
+ (\ ! map set.to_list)
+ (random.one (function (_ values)
+ (case values
+ (^ (list name_0 name_1 name_2 name_3 name_4))
+ (#.Some [name_0 name_1 name_2 name_3 name_4])
+
+ _
+ #.None))))
+ #let [type_0 (#.Primitive name_0 (list))
+ type_1 (#.Primitive name_1 (list))
+ type_2 (#.Primitive name_2 (list))
+ type_3 (#.Primitive name_3 (list))
+ type_4 (#.Primitive name_4 (list))
+
+ globals (: (List [Text .Global])
+ (list [name_4
+ (#.Definition [false type_4 (' {}) []])]))
+
+ scopes (list {#.name (list)
+ #.inner 0
+ #.locals {#.counter 1
+ #.mappings (list [name_3 [type_3 3]])}
+ #.captured {#.counter 0
+ #.mappings (list)}}
+ {#.name (list)
+ #.inner 0
+ #.locals {#.counter 2
+ #.mappings (list [name_1 [type_1 1]]
+ [name_2 [type_2 2]])}
+ #.captured {#.counter 0
+ #.mappings (list)}}
+ {#.name (list)
+ #.inner 0
+ #.locals {#.counter 1
+ #.mappings (list [name_0 [type_0 0]])}
+ #.captured {#.counter 0
+ #.mappings (list)}})]
+ #let [expected_lux
+ (: Lux
+ {#.info {#.target ""
+ #.version ""
+ #.mode #.Build}
+ #.source [location.dummy 0 ""]
+ #.location location.dummy
+ #.current_module (#.Some current_module)
+ #.modules (list [current_module
+ {#.module_hash 0
+ #.module_aliases (list)
+ #.definitions globals
+ #.imports (list)
+ #.tags (list)
+ #.types (list)
+ #.module_annotations #.None
+ #.module_state #.Active}])
+ #.scopes scopes
+ #.type_context {#.ex_counter 0
+ #.var_counter 0
+ #.var_bindings (list)}
+ #.expected #.None
+ #.seed 0
+ #.scope_type_vars (list)
+ #.extensions []
+ #.host []})]]
+ ($_ _.and
+ (_.cover [/.locals]
+ (let [equivalence (: (Equivalence (List (List [Text Type])))
+ (list.equivalence
+ (list.equivalence
+ (product.equivalence
+ text.equivalence
+ type.equivalence))))]
+ (|> /.locals
+ (/.run expected_lux)
+ (try\map (\ equivalence = (list (list [name_3 type_3])
+ (list [name_1 type_1]
+ [name_2 type_2]))))
+ (try.default false))))
+ (_.cover [/.find_var_type]
+ (and (|> (/.find_var_type name_0)
+ (/.run expected_lux)
+ (try\map (\ type.equivalence = type_0))
+ (try.default false))
+ (|> (/.find_var_type name_1)
+ (/.run expected_lux)
+ (try\map (\ type.equivalence = type_1))
+ (try.default false))
+ (|> (/.find_var_type name_2)
+ (/.run expected_lux)
+ (try\map (\ type.equivalence = type_2))
+ (try.default false))
+ (|> (/.find_var_type name_3)
+ (/.run expected_lux)
+ (try\map (\ type.equivalence = type_3))
+ (try.default false))))
+ (_.cover [/.find_type]
+ (and (|> (/.find_type ["" name_0])
+ (/.run expected_lux)
+ (try\map (\ type.equivalence = type_0))
+ (try.default false))
+ (|> (/.find_type ["" name_1])
+ (/.run expected_lux)
+ (try\map (\ type.equivalence = type_1))
+ (try.default false))
+ (|> (/.find_type ["" name_2])
+ (/.run expected_lux)
+ (try\map (\ type.equivalence = type_2))
+ (try.default false))
+ (|> (/.find_type ["" name_3])
+ (/.run expected_lux)
+ (try\map (\ type.equivalence = type_3))
+ (try.default false))
+ (|> (/.find_type [current_module name_4])
+ (/.run expected_lux)
+ (try\map (\ type.equivalence = type_4))
+ (try.default false))
+ (|> (/.find_type ["" name_4])
+ (/.run expected_lux)
+ (try\map (\ type.equivalence = type_4))
+ (try.default false))))
+ )))
+
(def: injection
(Injection Meta)
(\ /.monad wrap))
@@ -824,6 +952,7 @@
..definition_related
..search_related
..tags_related
+ ..locals_related
))
/annotation.test
diff --git a/stdlib/source/test/lux/type/dynamic.lux b/stdlib/source/test/lux/type/dynamic.lux
index fadc98ca7..533b7fad0 100644
--- a/stdlib/source/test/lux/type/dynamic.lux
+++ b/stdlib/source/test/lux/type/dynamic.lux
@@ -1,35 +1,47 @@
(.module:
[lux #*
- ["%" data/text/format (#+ format)]
- [abstract/monad (#+ do)]
["_" test (#+ Test)]
+ [abstract
+ [monad (#+ do)]]
[control
- ["." try]]
+ ["." try]
+ ["." exception]]
+ [data
+ ["." text ("#\." equivalence)
+ ["%" format (#+ format)]]]
[math
["." random (#+ Random)]
[number
["n" nat]]]]
{1
- ["." / (#+ Dynamic :dynamic :check)]})
+ ["." /]})
(def: #export test
Test
- (<| (_.context (%.name (name_of /._)))
+ (<| (_.covering /._)
+ (_.for [/.Dynamic])
(do random.monad
- [expected random.nat
- #let [value (:dynamic expected)]]
+ [expected random.nat]
($_ _.and
- (_.test "Can check dynamic values."
- (case (:check Nat value)
- (#try.Success actual)
- (n.= expected actual)
-
- (#try.Failure _)
- false))
- (_.test "Cannot confuse types."
- (case (:check Text value)
- (#try.Success actual)
- false
-
- (#try.Failure _)
- true))))))
+ (_.cover [/.:dynamic /.:check]
+ (case (/.:check Nat (/.:dynamic expected))
+ (#try.Success actual)
+ (n.= expected actual)
+
+ (#try.Failure _)
+ false))
+ (_.cover [/.wrong_type]
+ (case (/.:check Text (/.:dynamic expected))
+ (#try.Success actual)
+ false
+
+ (#try.Failure error)
+ (exception.match? /.wrong_type error)))
+ (_.cover [/.print]
+ (case (/.print (/.:dynamic expected))
+ (#try.Success actual)
+ (text\= (%.nat expected) actual)
+
+ (#try.Failure _)
+ false))
+ ))))