aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux.lux25
-rw-r--r--stdlib/source/lux/control/concurrency/atom.lux9
-rw-r--r--stdlib/source/lux/data/binary.lux50
-rw-r--r--stdlib/source/lux/data/collection/array.lux50
-rw-r--r--stdlib/source/lux/data/text.lux6
-rw-r--r--stdlib/source/lux/data/text/buffer.lux31
-rw-r--r--stdlib/source/lux/data/text/encoding.lux20
-rw-r--r--stdlib/source/lux/data/text/unicode/set.lux27
-rw-r--r--stdlib/source/lux/debug.lux49
-rw-r--r--stdlib/source/lux/host.lua.lux298
-rw-r--r--stdlib/source/lux/math.lux32
-rw-r--r--stdlib/source/lux/math/number/frac.lux14
-rw-r--r--stdlib/source/lux/math/number/int.lux4
-rw-r--r--stdlib/source/lux/math/number/rev.lux17
-rw-r--r--stdlib/source/lux/program.lux3
-rw-r--r--stdlib/source/lux/target/lua.lux88
-rw-r--r--stdlib/source/lux/target/python.lux4
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/js.lux5
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/lua.lux217
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js/host.lux9
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/lua.lux4
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/lua/common.lux49
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/lua/host.lux197
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/js.lux7
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/case.lux29
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/function.lux26
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/loop.lux17
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux7
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua.lux72
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/case.lux83
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/function.lux113
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/loop.lux76
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/runtime.lux66
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux4
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/syntax.lux2
-rw-r--r--stdlib/source/lux/world/file.lux282
-rw-r--r--stdlib/source/lux/world/program.lux54
-rw-r--r--stdlib/source/spec/compositor/generation/common.lux8
38 files changed, 1672 insertions, 382 deletions
diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux
index de071c35a..c18603b4b 100644
--- a/stdlib/source/lux.lux
+++ b/stdlib/source/lux.lux
@@ -3270,7 +3270,11 @@
(#Some idx)
(list& ("lux text clip" 0 idx input)
(text\split_all_with splitter
- ("lux text clip" ("lux i64 +" 1 idx) ("lux text size" input) input)))))
+ (let [after_offset ("lux i64 +" 1 idx)
+ after_length ("lux i64 -"
+ after_offset
+ ("lux text size" input))]
+ ("lux text clip" after_offset after_length input))))))
(def: (nth idx xs)
(All [a]
@@ -3760,7 +3764,7 @@
(def: (split! at x)
(-> Nat Text [Text Text])
[("lux text clip" 0 at x)
- ("lux text clip" at ("lux text size" x) x)])
+ ("lux text clip" at ("lux i64 -" at ("lux text size" x)) x)])
(def: (split_with token sample)
(-> Text Text (Maybe [Text Text]))
@@ -3770,14 +3774,17 @@
[_ post] (split! ("lux text size" token) post')]]
(wrap [pre post])))
-(def: (replace_all pattern value template)
+(def: (replace_all pattern replacement template)
(-> Text Text Text Text)
- (case (..split_with pattern template)
- (#.Some [pre post])
- ($_ "lux text concat" pre value (replace_all pattern value post))
+ ((: (-> Text Text Text)
+ (function (recur left right)
+ (case (..split_with pattern right)
+ (#.Some [pre post])
+ (recur ($_ "lux text concat" left pre replacement) post)
- #.None
- template))
+ #.None
+ ("lux text concat" left right))))
+ "" template))
(def: contextual_reference "#")
(def: self_reference ".")
@@ -3837,7 +3844,7 @@
list\reverse
(interpose ..module_separator)
(text\join_with ""))
- clean ("lux text clip" relatives ("lux text size" module) module)
+ clean ("lux text clip" relatives ("lux i64 -" relatives ("lux text size" module)) module)
output (case ("lux text size" clean)
0 prefix
_ ($_ text\compose prefix ..module_separator clean))]
diff --git a/stdlib/source/lux/control/concurrency/atom.lux b/stdlib/source/lux/control/concurrency/atom.lux
index 5f3719ba8..3b57678fc 100644
--- a/stdlib/source/lux/control/concurrency/atom.lux
+++ b/stdlib/source/lux/control/concurrency/atom.lux
@@ -24,13 +24,16 @@
(as_is)))
(with_expansions [<new> (for {@.js "js array new"
- @.python "python array new"}
+ @.python "python array new"
+ @.lua "lua array new"}
(as_is))
<write> (for {@.js "js array write"
- @.python "python array write"}
+ @.python "python array write"
+ @.lua "lua array write"}
(as_is))
<read> (for {@.js "js array read"
- @.python "python array read"}
+ @.python "python array read"
+ @.lua "lua array read"}
(as_is))]
(abstract: #export (Atom a)
(with_expansions [<jvm> (java/util/concurrent/atomic/AtomicReference a)]
diff --git a/stdlib/source/lux/data/binary.lux b/stdlib/source/lux/data/binary.lux
index ccf4f54b4..1fa94f565 100644
--- a/stdlib/source/lux/data/binary.lux
+++ b/stdlib/source/lux/data/binary.lux
@@ -81,19 +81,28 @@
@.python
(type: #export Binary
- (primitive "bytearray"))}))
+ (primitive "bytearray"))}
+
+ ## Default
+ (type: #export Binary
+ (array.Array (I64 Any)))))
(template: (!size binary)
(for {@.old (host.array_length binary)
@.jvm (host.array_length binary)
@.js
- (f.nat (Uint8Array::length binary))
+ (|> binary
+ Uint8Array::length
+ f.nat)
@.python
(|> binary
(:coerce (array.Array (I64 Any)))
- "python array length")}))
+ "python array length")}
+
+ ## Default
+ (array.size binary)))
(template: (!read idx binary)
(for {@.old (..i64 (host.array_read idx binary))
@@ -110,24 +119,30 @@
@.python
(|> binary
(:coerce (array.Array .I64))
- ("python array read" idx))}))
+ ("python array read" idx))}
+
+ ## Default
+ (|> binary
+ (array.read idx)
+ (maybe.default (: (I64 Any) 0))
+ (:coerce I64))))
+
+(template: (!!write <byte_type> <post> <write> idx value binary)
+ (|> binary
+ (: ..Binary)
+ (:coerce (array.Array <byte_type>))
+ (<write> idx (|> value .nat (n.% (hex "100")) <post>))
+ (:coerce ..Binary)))
(template: (!write idx value binary)
(for {@.old (host.array_write idx (..byte value) binary)
@.jvm (host.array_write idx (..byte value) binary)
- @.js
- (|> binary
- (: ..Binary)
- (:coerce (array.Array .Frac))
- ("js array write" idx (n.frac (n.% (hex "100") (.nat value))))
- (:coerce ..Binary))
+ @.js (!!write .Frac n.frac "js array write" idx value binary)
+ @.python (!!write (I64 Any) (:coerce (I64 Any)) "python array write" idx value binary)}
- @.python
- (|> binary
- (:coerce (array.Array (I64 Any)))
- ("python array write" idx (:coerce (I64 Any) (n.% (hex "100") (.nat value))))
- (:coerce ..Binary))}))
+ ## Default
+ (array.write! idx (|> value .nat (n.% (hex "100"))) binary)))
(def: #export size
(-> Binary Nat)
@@ -143,7 +158,10 @@
@.python
(|>> ("python apply" (:coerce host.Function ("python constant" "bytearray")))
- (:coerce Binary))}))
+ (:coerce Binary))}
+
+ ## Default
+ array.new))
(def: #export (fold f init binary)
(All [a] (-> (-> I64 a a) a Binary a))
diff --git a/stdlib/source/lux/data/collection/array.lux b/stdlib/source/lux/data/collection/array.lux
index e407f4877..0bc661941 100644
--- a/stdlib/source/lux/data/collection/array.lux
+++ b/stdlib/source/lux/data/collection/array.lux
@@ -45,11 +45,9 @@
(: <array_type>)
:assume)
- @.js
- ("js array new" size)
-
- @.python
- ("python array new" size)}))
+ @.js ("js array new" size)
+ @.python ("python array new" size)
+ @.lua ("lua array new" size)}))
(def: #export (size array)
(All [a] (-> (Array a) Nat))
@@ -65,11 +63,15 @@
(: <index_type>)
(:coerce Nat))
- @.js
- ("js array length" array)
+ @.js ("js array length" array)
+ @.python ("python array length" array)
+ @.lua ("lua array length" array)}))
- @.python
- ("python array length" array)}))
+ (template: (!read <read> <null?>)
+ (let [output (<read> index array)]
+ (if (<null?> output)
+ #.None
+ (#.Some output))))
(def: #export (read index array)
(All [a]
@@ -89,17 +91,9 @@
#.None
(#.Some (:assume value))))
- @.js
- (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)))})
+ @.js (!read "js array read" "js object undefined?")
+ @.python (!read "python array read" "python object none?")
+ @.lua (!read "lua array read" "lua object nil?")})
#.None))
(def: #export (write! index value array)
@@ -114,11 +108,9 @@
("jvm array write object" (!int index) (:coerce <elem_type> value))
:assume)
- @.js
- ("js array write" index value array)
-
- @.python
- ("python array write" index value array)}))
+ @.js ("js array write" index value array)
+ @.python ("python array write" index value array)
+ @.lua ("lua array write" index value array)}))
(def: #export (delete! index array)
(All [a]
@@ -130,11 +122,9 @@
@.jvm
(write! index (:assume (: <elem_type> ("jvm object null"))) array)
- @.js
- ("js array delete" index array)
-
- @.python
- ("python array delete" index array)})
+ @.js ("js array delete" index array)
+ @.python ("python array delete" index array)
+ @.lua ("lua array delete" index array)})
array))
)
diff --git a/stdlib/source/lux/data/text.lux b/stdlib/source/lux/data/text.lux
index 0b07b3ae1..18d51a25f 100644
--- a/stdlib/source/lux/data/text.lux
+++ b/stdlib/source/lux/data/text.lux
@@ -2,7 +2,7 @@
[lux #*
["@" target]
[abstract
- hash
+ [hash (#+ Hash)]
[monoid (#+ Monoid)]
[equivalence (#+ Equivalence)]
[order (#+ Order)]
@@ -125,14 +125,14 @@
(-> Nat Nat Text (Maybe Text))
(if (and (n.<= to from)
(n.<= ("lux text size" input) to))
- (#.Some ("lux text clip" from to input))
+ (#.Some ("lux text clip" from (n.- from to) input))
#.None))
(def: #export (clip' from input)
(-> Nat Text (Maybe Text))
(let [size ("lux text size" input)]
(if (n.<= size from)
- (#.Some ("lux text clip" from size input))
+ (#.Some ("lux text clip" from (n.- from size) input))
#.None)))
(def: #export (split at x)
diff --git a/stdlib/source/lux/data/text/buffer.lux b/stdlib/source/lux/data/text/buffer.lux
index e4ebba1c9..5d29532a5 100644
--- a/stdlib/source/lux/data/text/buffer.lux
+++ b/stdlib/source/lux/data/text/buffer.lux
@@ -9,6 +9,7 @@
[text
["%" format (#+ format)]]
[collection
+ ["." array]
["." row (#+ Row) ("#\." fold)]]]
[math
[number
@@ -33,12 +34,18 @@
(new [int])
(toString [] java/lang/String)]))]
(`` (for {@.old (as_is <jvm>)
- @.jvm (as_is <jvm>)}
+ @.jvm (as_is <jvm>)
+ @.lua (as_is (import: table
+ ##v https://www.lua.org/manual/5.3/manual.html#pdf-table.concat
+ (#static concat [(Array Text) Text] Text)
+ ## https://www.lua.org/manual/5.3/manual.html#pdf-table.insert
+ (#static insert [(Array Text) Text] Nothing)))}
(as_is))))
(`` (abstract: #export Buffer
(for {@.old [Nat (-> java/lang/StringBuilder java/lang/StringBuilder)]
- @.jvm [Nat (-> java/lang/StringBuilder java/lang/StringBuilder)]}
+ @.jvm [Nat (-> java/lang/StringBuilder java/lang/StringBuilder)]
+ @.lua [Nat (-> (array.Array Text) (array.Array Text))]}
## default
(Row Text))
@@ -48,7 +55,8 @@
Buffer
(:abstraction (with_expansions [<jvm> [0 function.identity]]
(for {@.old <jvm>
- @.jvm <jvm>}
+ @.jvm <jvm>
+ @.lua function.identity}
## default
row.empty))))
@@ -63,7 +71,15 @@
(:abstraction [(n.+ (//.size chunk) capacity)
(|>> transform (append! chunk))]))]
(for {@.old <jvm>
- @.jvm <jvm>}
+ @.jvm <jvm>
+ @.lua (let [[capacity transform] (:representation buffer)
+ append! (: (-> Text (array.Array Text) (array.Array Text))
+ (function (_ chunk array)
+ (exec
+ (table::insert [array chunk])
+ array)))]
+ (:abstraction [(n.+ (//.size chunk) capacity)
+ (|>> transform (append! chunk))]))}
## default
(|> buffer :representation (row.add chunk) :abstraction))))
@@ -71,7 +87,8 @@
(-> Buffer Nat)
(with_expansions [<jvm> (|>> :representation product.left)]
(for {@.old <jvm>
- @.jvm <jvm>}
+ @.jvm <jvm>
+ @.lua <jvm>}
## default
(|>> :representation
(row\fold (function (_ chunk total)
@@ -85,7 +102,9 @@
transform
java/lang/StringBuilder::toString))]
(for {@.old <jvm>
- @.jvm <jvm>}
+ @.jvm <jvm>
+ @.lua (let [[capacity transform] (:representation buffer)]
+ (table::concat [(transform (array.new 0)) ""]))}
## default
(row\fold (function (_ chunk total)
(format total chunk))
diff --git a/stdlib/source/lux/data/text/encoding.lux b/stdlib/source/lux/data/text/encoding.lux
index 2050cbc8c..55afc77ed 100644
--- a/stdlib/source/lux/data/text/encoding.lux
+++ b/stdlib/source/lux/data/text/encoding.lux
@@ -7,7 +7,7 @@
[control
["." try (#+ Try)]]
[data
- [binary (#+ Binary)]]
+ ["." binary (#+ Binary)]]
[type
abstract]])
@@ -195,7 +195,7 @@
(decode [Uint8Array] host.String)))}
(as_is)))
-(def: (to_utf8 value)
+(def: (utf8\encode value)
(-> Text Binary)
(for {@.old
(java/lang/String::getBytes (..name ..utf_8)
@@ -224,9 +224,12 @@
)
@.python
- (:coerce Binary ("python apply" (:assume ("python constant" "bytearray")) value "utf-8"))}))
+ (:coerce Binary ("python apply" (:assume ("python constant" "bytearray")) value "utf-8"))}
-(def: (from_utf8 value)
+ ## Default
+ ("lua utf8 encode" value)))
+
+(def: (utf8\decode value)
(-> Binary (Try Text))
(with_expansions [<jvm> (#try.Success (java/lang/String::new value (..name ..utf_8)))]
(for {@.old <jvm>
@@ -249,10 +252,13 @@
#try.Success))
@.python
- (host.try (:coerce Text ("python object do" "decode" (:assume value) "utf-8")))})))
+ (host.try (:coerce Text ("python object do" "decode" (:assume value) "utf-8")))}
+
+ ## Default
+ (#try.Success ("lua utf8 decode" value)))))
(structure: #export utf8
(Codec Binary Text)
- (def: encode ..to_utf8)
- (def: decode ..from_utf8))
+ (def: encode ..utf8\encode)
+ (def: decode ..utf8\decode))
diff --git a/stdlib/source/lux/data/text/unicode/set.lux b/stdlib/source/lux/data/text/unicode/set.lux
index bf0b55cd7..d773ba8e4 100644
--- a/stdlib/source/lux/data/text/unicode/set.lux
+++ b/stdlib/source/lux/data/text/unicode/set.lux
@@ -43,7 +43,7 @@
(-> [Block (List Block)] Set)
(list\fold ..compose (..singleton head) (list\map ..singleton tail)))
- (def: #export character
+ (def: character/0
Set
(..set [//block.basic_latin
(list //block.latin_1_supplement
@@ -74,9 +74,12 @@
//block.lao
//block.tibetan
//block.myanmar
- //block.georgian
- //block.hangul_jamo
- //block.ethiopic
+ //block.georgian)]))
+
+ (def: character/1
+ Set
+ (..set [//block.hangul_jamo
+ (list //block.ethiopic
//block.cherokee
//block.unified_canadian_aboriginal_syllabics
//block.ogham
@@ -105,10 +108,12 @@
//block.control_pictures
//block.optical_character_recognition
//block.enclosed_alphanumerics
- //block.box_drawing
+ //block.box_drawing)]))
- //block.block_elements
- //block.geometric_shapes
+ (def: character/2
+ Set
+ (..set [//block.block_elements
+ (list //block.geometric_shapes
//block.miscellaneous_symbols
//block.dingbats
//block.miscellaneous_mathematical_symbols_a
@@ -139,6 +144,14 @@
//block.hangul_syllables
)]))
+ (def: #export character
+ Set
+ ($_ ..compose
+ ..character/0
+ ..character/1
+ ..character/2
+ ))
+
(def: #export non_character
Set
(..set [//block.high_surrogates
diff --git a/stdlib/source/lux/debug.lux b/stdlib/source/lux/debug.lux
index cd354ec84..8006c83dd 100644
--- a/stdlib/source/lux/debug.lux
+++ b/stdlib/source/lux/debug.lux
@@ -6,13 +6,13 @@
[abstract
[monad (#+ do)]]
[control
+ [pipe (#+ case> new>)]
["." function]
["." try (#+ Try)]
["." exception (#+ exception:)]
["<>" parser
["<.>" type (#+ Parser)]
- ["<.>" code]]
- pipe]
+ ["<.>" code]]]
[data
["." text
["%" format (#+ format)]]
@@ -72,7 +72,14 @@
(primitive "python_type"))
(import: (type [.Any] PyType))
- (import: (str [.Any] host.String)))}))
+ (import: (str [.Any] host.String)))
+
+ @.lua
+ (as_is (import: (type [.Any] host.String))
+ (import: (tostring [.Any] host.String))
+
+ (import: math
+ (#static type [.Any] #? host.String)))}))
(def: Inspector (-> Any Text))
@@ -190,6 +197,39 @@
_
(..str value))
+
+ @.lua
+ (case (..type value)
+ (^template [<type_of> <then>]
+ [<type_of>
+ (`` (|> value (~~ (template.splice <then>))))])
+ (["boolean" [(:coerce .Bit) %.bit]]
+ ["string" [(:coerce .Text) %.text]]
+ ["nil" [(new> "nil" [])]])
+
+ "number"
+ (case (math::type [value])
+ (#.Some "integer") (|> value (:coerce .Int) %.int)
+ (#.Some "float") (|> value (:coerce .Frac) %.frac)
+
+ _
+ (..tostring value))
+
+ "table"
+ (let [variant_tag ("lua object get" "_lux_tag" value)
+ variant_flag ("lua object get" "_lux_flag" value)
+ variant_value ("lua object get" "_lux_value" value)]
+ (if (not (or ("lua object nil?" variant_tag)
+ ("lua object nil?" variant_flag)
+ ("lua object nil?" variant_value)))
+ (|> (format (|> variant_tag (:coerce .Int) %.int)
+ " " (%.bit (not ("lua object nil?" variant_flag)))
+ " " (inspect variant_value))
+ (text.enclose ["(" ")"]))
+ (inspect_tuple inspect value)))
+
+ _
+ (..tostring value))
})))
(exception: #export (cannot_represent_value {type Type})
@@ -336,8 +376,7 @@
(~ (code.identifier definition))))))))
(def: #export (log! message)
- {#.doc (doc "Logs message to standard output."
- "Useful for debugging.")}
+ {#.doc "Logs message to standard output."}
(-> Text Any)
("lux io log" message))
diff --git a/stdlib/source/lux/host.lua.lux b/stdlib/source/lux/host.lua.lux
new file mode 100644
index 000000000..ed81d97b1
--- /dev/null
+++ b/stdlib/source/lux/host.lua.lux
@@ -0,0 +1,298 @@
+(.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>)))]
+
+ [Nil]
+ [Function]
+ [Table]
+ )
+
+(template [<name> <type>]
+ [(type: #export <name>
+ <type>)]
+
+ [Boolean Bit]
+ [Integer Int]
+ [Float Frac]
+ [String Text]
+ )
+
+(type: Nilable
+ [Bit Code])
+
+(def: nilable
+ (Parser Nilable)
+ (let [token (' #?)]
+ (<| (<>.and (<>.parses? (<c>.this! token)))
+ (<>.after (<>.not (<c>.this! token)))
+ <c>.any)))
+
+(type: Field
+ [Bit Text Nilable])
+
+(def: static!
+ (Parser Any)
+ (<c>.this! (' #static)))
+
+(def: field
+ (Parser Field)
+ (<c>.form ($_ <>.and
+ (<>.parses? ..static!)
+ <c>.local_identifier
+ ..nilable)))
+
+(type: Common_Method
+ {#name Text
+ #alias (Maybe Text)
+ #inputs (List Nilable)
+ #io? Bit
+ #try? Bit
+ #output Nilable})
+
+(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 ..nilable))
+ (<>.parses? (<c>.this! (' #io)))
+ (<>.parses? (<c>.this! (' #try)))
+ ..nilable))
+
+(def: static_method
+ (<>.after ..static! ..common_method))
+
+(def: method
+ (Parser Method)
+ (<c>.form (<>.or ..static_method
+ ..common_method)))
+
+(type: Member
+ (#Field Field)
+ (#Method Method))
+
+(def: member
+ (Parser Member)
+ ($_ <>.or
+ ..field
+ ..method
+ ))
+
+(def: input_variables
+ (-> (List Nilable) (List [Bit Code]))
+ (|>> list.enumeration
+ (list\map (function (_ [idx [nilable? type]])
+ [nilable? (|> idx %.nat code.local_identifier)]))))
+
+(def: (nilable_type [nilable? type])
+ (-> Nilable Code)
+ (if nilable?
+ (` (.Maybe (~ type)))
+ type))
+
+(def: (with_nil g!temp [nilable? input])
+ (-> Code [Bit Code] Code)
+ (if nilable?
+ (` (case (~ input)
+ (#.Some (~ g!temp))
+ (~ g!temp)
+
+ #.Nil
+ ("lua object nil")))
+ input))
+
+(def: (without_nil g!temp [nilable? outputT] output)
+ (-> Code Nilable Code Code)
+ (if nilable?
+ (` (let [(~ g!temp) (~ output)]
+ (if ("lua object nil?" (~ g!temp))
+ #.None
+ (#.Some (~ g!temp)))))
+ (` (let [(~ g!temp) (~ output)]
+ (if (not ("lua object nil?" (~ g!temp)))
+ (~ g!temp)
+ (.error! "Nil is an invalid value!"))))))
+
+(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 Nilable) Bit Bit Nilable Code)
+ (let [g!inputs (input_variables inputsT)]
+ (` (def: ((~ g!method)
+ [(~+ (list\map product.right g!inputs))])
+ (-> [(~+ (list\map nilable_type inputsT))]
+ (~ (|> (nilable_type outputT)
+ (try_type try?)
+ (io_type io?))))
+ (:assume
+ (~ (<| (with_io io?)
+ (with_try try?)
+ (without_nil g!temp outputT)
+ (` ("lua apply"
+ (:coerce ..Function (~ source))
+ (~+ (list\map (with_nil 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)
+ (` ("lua object get" (~ (code.text sub))
+ (:coerce (..Object .Any) (~ super)))))
+ (` ("lua import" (~ (code.text head))))
+ tail)
+
+ #.Nil
+ (` ("lua import" (~ (code.text class)))))]
+ (wrap (list& (` (type: (~ g!type)
+ (..Object (primitive (~ (code.text real_class))))))
+ (list\map (function (_ member)
+ (case member
+ (#Field [static? field fieldT])
+ (if static?
+ (` ((~! syntax:) ((~ (qualify field)))
+ (\ (~! meta.monad) (~' wrap)
+ (list (` (.:coerce (~ (nilable_type fieldT))
+ ("lua object get" (~ (code.text field))
+ (:coerce (..Object .Any) (~ imported)))))))))
+ (` (def: ((~ (qualify field))
+ (~ g!object))
+ (-> (~ g!type)
+ (~ (nilable_type fieldT)))
+ (:assume
+ (~ (without_nil g!temp fieldT (` ("lua object get" (~ (code.text field))
+ (:coerce (..Object .Any) (~ g!object))))))))))
+
+ (#Method method)
+ (case method
+ (#Static [method alias inputsT io? try? outputT])
+ (..make_function (qualify (maybe.default method alias))
+ g!temp
+ (` ("lua object get" (~ (code.text method))
+ (:coerce (..Object .Any) (~ 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 nilable_type inputsT))]
+ (~ g!type)
+ (~ (|> (nilable_type outputT)
+ (try_type try?)
+ (io_type io?))))
+ (:assume
+ (~ (<| (with_io io?)
+ (with_try try?)
+ (without_nil g!temp outputT)
+ (` ("lua object do"
+ (~ (code.text method))
+ (~ g!object)
+ (~+ (list\map (with_nil 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
+ (` ("lua constant" (~ (code.text name))))
+ inputsT
+ io?
+ try?
+ outputT)))
+ )))
+
+(template: #export (closure <inputs> <output>)
+ (.:coerce ..Function
+ (`` ("lua function"
+ (~~ (template.count <inputs>))
+ (.function (_ [<inputs>])
+ <output>)))))
diff --git a/stdlib/source/lux/math.lux b/stdlib/source/lux/math.lux
index 44650ed57..1c4247ad2 100644
--- a/stdlib/source/lux/math.lux
+++ b/stdlib/source/lux/math.lux
@@ -143,6 +143,38 @@
(def: #export root/3
(-> Frac Frac)
+ (..pow ("lux f64 /" +3.0 +1.0))))
+
+ @.lua
+ (as_is (template [<name> <method>]
+ [(def: #export <name>
+ (-> Frac Frac)
+ (|>> ("lua apply" ("lua constant" <method>))
+ (:coerce Frac)))]
+
+ [cos "math.cos"]
+ [sin "math.sin"]
+ [tan "math.tan"]
+
+ [acos "math.acos"]
+ [asin "math.asin"]
+ [atan "math.atan"]
+
+ [exp "math.exp"]
+ [log "math.log"]
+
+ [ceil "math.ceil"]
+ [floor "math.floor"]
+
+ [root/2 "math.sqrt"]
+ )
+
+ (def: #export (pow param subject)
+ (-> Frac Frac Frac)
+ ("lua power" param subject))
+
+ (def: #export root/3
+ (-> Frac Frac)
(..pow ("lux f64 /" +3.0 +1.0))))})
(def: #export (round input)
diff --git a/stdlib/source/lux/math/number/frac.lux b/stdlib/source/lux/math/number/frac.lux
index ccc6bd544..5ca3dff83 100644
--- a/stdlib/source/lux/math/number/frac.lux
+++ b/stdlib/source/lux/math/number/frac.lux
@@ -365,8 +365,10 @@
(^template [<factor> <patterns>]
[<patterns>
(do try.monad
- [exponent (|> representation
- ("lux text clip" (//nat.+ 2 split_index) ("lux text size" representation))
+ [#let [after_offset (//nat.+ 2 split_index)
+ after_length (//nat.- after_offset ("lux text size" representation))]
+ exponent (|> representation
+ ("lux text clip" after_offset after_length)
(\ codec decode))]
(wrap [("lux text clip" 0 split_index representation)
(//int.* <factor> (.int exponent))]))])
@@ -405,15 +407,17 @@
[whole decimal] (case ("lux text index" 0 "." mantissa)
(#.Some split_index)
(do !
- [decimal (|> mantissa
- ("lux text clip" (inc split_index) ("lux text size" mantissa))
+ [#let [after_offset (inc split_index)
+ after_length (//nat.- after_offset ("lux text size" mantissa))]
+ decimal (|> mantissa
+ ("lux text clip" after_offset after_length)
(\ <nat> decode))]
(wrap [("lux text clip" 0 split_index mantissa)
decimal]))
#.None
(#try.Failure ("lux text concat" <error> representation)))
- #let [whole ("lux text clip" 1 ("lux text size" whole) whole)]
+ #let [whole ("lux text clip" 1 (dec ("lux text size" whole)) whole)]
mantissa (\ <nat> decode (case decimal
0 whole
_ ("lux text concat" whole (\ <nat> encode decimal))))
diff --git a/stdlib/source/lux/math/number/int.lux b/stdlib/source/lux/math/number/int.lux
index e43c5eb89..b121fc216 100644
--- a/stdlib/source/lux/math/number/int.lux
+++ b/stdlib/source/lux/math/number/int.lux
@@ -226,13 +226,13 @@
(case ("lux text clip" 0 1 repr)
(^ (static ..+sign))
(|> repr
- ("lux text clip" 1 input_size)
+ ("lux text clip" 1 (dec input_size))
(\ <codec> decode)
(\ try.functor map .int))
(^ (static ..-sign))
(|> repr
- ("lux text clip" 1 input_size)
+ ("lux text clip" 1 (dec input_size))
(\ <codec> decode)
(\ try.functor map (|>> dec .int ..negate dec)))
diff --git a/stdlib/source/lux/math/number/rev.lux b/stdlib/source/lux/math/number/rev.lux
index 2e7975f1d..78d80767b 100644
--- a/stdlib/source/lux/math/number/rev.lux
+++ b/stdlib/source/lux/math/number/rev.lux
@@ -228,7 +228,7 @@
(def: (de_prefix input)
(-> Text Text)
- ("lux text clip" 1 ("lux text size" input) input))
+ ("lux text clip" 1 (dec ("lux text size" input)) input))
(template [<struct> <codec> <char_bit_size> <error>]
[(with_expansions [<error_output> (as_is (#try.Failure ("lux text concat" <error> repr)))]
@@ -242,12 +242,13 @@
0 0
_ 1))
raw_size ("lux text size" raw_output)
- zero_padding (loop [zeroes_left (//nat.- raw_size max_num_chars)
- output ""]
- (if (//nat.= 0 zeroes_left)
- output
- (recur (dec zeroes_left)
- ("lux text concat" "0" output))))]
+ zero_padding (: Text
+ (loop [zeroes_left (: Nat (//nat.- raw_size max_num_chars))
+ output (: Text "")]
+ (if (//nat.= 0 zeroes_left)
+ output
+ (recur (dec zeroes_left)
+ ("lux text concat" "0" output)))))]
(|> raw_output
("lux text concat" zero_padding)
("lux text concat" "."))))
@@ -366,7 +367,7 @@
(loop [idx 0
output (digits::new [])]
(if (//nat.< length idx)
- (case ("lux text index" 0 ("lux text clip" idx (inc idx) input) "0123456789")
+ (case ("lux text index" 0 ("lux text clip" idx 1 input) "0123456789")
#.None
#.None
diff --git a/stdlib/source/lux/program.lux b/stdlib/source/lux/program.lux
index 36f513e84..0723a7b4e 100644
--- a/stdlib/source/lux/program.lux
+++ b/stdlib/source/lux/program.lux
@@ -57,8 +57,7 @@
@.jvm (list)
@.js (list)
@.python (list)}
- (list g!_
- (` ((~! thread.run!) [])))))]
+ (list g!_ (` (~! thread.run!)))))]
((~' wrap) (~ g!output))))]
(wrap (list (` ("lux def program"
(~ (case args
diff --git a/stdlib/source/lux/target/lua.lux b/stdlib/source/lux/target/lua.lux
index c1bceb634..ef646cddc 100644
--- a/stdlib/source/lux/target/lua.lux
+++ b/stdlib/source/lux/target/lua.lux
@@ -1,19 +1,25 @@
(.module:
- [lux (#- Location Code int if cond function or and not let)
+ [lux (#- Location Code int if cond function or and not let ^)
[abstract
[equivalence (#+ Equivalence)]
- [hash (#+ Hash)]]
+ [hash (#+ Hash)]
+ ["." enum]]
[control
- [pipe (#+ case> cond> new>)]]
+ [pipe (#+ case> cond> new>)]
+ [parser
+ ["<.>" code]]]
[data
["." text
["%" format (#+ format)]]
[collection
["." list ("#\." functor fold)]]]
[macro
- ["." template]]
+ [syntax (#+ syntax:)]
+ ["." template]
+ ["." code]]
[math
[number
+ ["n" nat]
["i" int]
["f" frac]]]
[type
@@ -69,6 +75,7 @@
[Literal [Computation' Expression' Code]]
[Var [Location' Computation' Expression' Code]]
[Access [Location' Computation' Expression' Code]]
+ [Label [Code]]
)
(def: #export nil
@@ -99,7 +106,7 @@
[(new> "(0.0/0.0)" [])]
## else
- [%.frac])
+ [%.frac (text.replace_all "+" "")])
:abstraction))
(def: sanitize
@@ -123,6 +130,12 @@
(-> Text Literal)
(|>> ..sanitize (text.enclose' text.double_quote) :abstraction))
+ (def: #export multi
+ (-> (List Expression) Literal)
+ (|>> (list\map ..code)
+ (text.join_with ..input_separator)
+ :abstraction))
+
(def: #export array
(-> (List Expression) Literal)
(|>> (list\map ..code)
@@ -161,8 +174,8 @@
(format (:representation func))
:abstraction))
- (def: #export (do method table args)
- (-> Text Expression (List Expression) Computation)
+ (def: #export (do method args table)
+ (-> Text (List Expression) Expression Computation)
(|> args
(list\map ..code)
(text.join_with ..input_separator)
@@ -187,6 +200,7 @@
["+" +]
["-" -]
["*" *]
+ ["^" ^]
["/" /]
["//" //]
["%" %]
@@ -206,9 +220,14 @@
(-> Expression Expression)
(:abstraction (format "(not " (:representation subject) ")")))
- (def: #export var
- (-> Text Var)
- (|>> :abstraction))
+ (template [<name> <type>]
+ [(def: #export <name>
+ (-> Text <type>)
+ (|>> :abstraction))]
+
+ [var Var]
+ [label Label]
+ )
(def: #export statement
(-> Expression Statement)
@@ -236,9 +255,7 @@
(def: #export (let vars value)
(-> (List Var) Expression Statement)
- ($_ ..then
- (local vars)
- (set vars value)))
+ (:abstraction (format "local " (..locations vars) " = " (:representation value) ..statement_suffix)))
(def: #export (local/1 var value)
(-> Var Expression Statement)
@@ -319,6 +336,14 @@
(|> "break"
(text.suffix ..statement_suffix)
:abstraction))
+
+ (def: #export (set_label label)
+ (-> Label Statement)
+ (:abstraction (format "::" (:representation label) "::")))
+
+ (def: #export (go_to label)
+ (-> Label Statement)
+ (:abstraction (format "goto " (:representation label))))
)
(def: #export (cond clauses else!)
@@ -327,3 +352,40 @@
(..if test then! next!))
else!
(list.reverse clauses)))
+
+(syntax: (arity_inputs {arity <code>.nat})
+ (wrap (case arity
+ 0 (.list)
+ _ (|> (dec arity)
+ (enum.range n.enum 0)
+ (list\map (|>> %.nat code.local_identifier))))))
+
+(syntax: (arity_types {arity <code>.nat})
+ (wrap (list.repeat arity (` ..Expression))))
+
+(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 <types> Computation)
+ (..apply/* (.list <inputs>) function))
+
+ (template [<function>]
+ [(`` (def: #export (~~ (template.identifier [<function> "/" <arity>]))
+ (<apply> (..var <function>))))]
+
+ <definitions>))]
+
+ [1
+ [["error"]
+ ["print"]
+ ["require"]]]
+
+ [2
+ []]
+
+ [3
+ []]
+ )
diff --git a/stdlib/source/lux/target/python.lux b/stdlib/source/lux/target/python.lux
index e38694d08..f8c7157a3 100644
--- a/stdlib/source/lux/target/python.lux
+++ b/stdlib/source/lux/target/python.lux
@@ -14,9 +14,9 @@
[collection
["." list ("#\." functor fold)]]]
[macro
+ [syntax (#+ syntax:)]
["." template]
- ["." code]
- [syntax (#+ syntax:)]]
+ ["." code]]
[math
[number
["n" nat]
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/js.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/js.lux
index b15f22be5..860badea3 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/js.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/js.lux
@@ -207,10 +207,11 @@
Bundle
(<| (bundle.prefix "js")
(|> bundle.empty
+ (dictionary.merge bundle::array)
+ (dictionary.merge bundle::object)
+
(bundle.install "constant" js::constant)
(bundle.install "apply" js::apply)
(bundle.install "type-of" js::type_of)
(bundle.install "function" js::function)
- (dictionary.merge bundle::array)
- (dictionary.merge bundle::object)
)))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/lua.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/lua.lux
index b431dc39b..596000060 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/lua.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/lua.lux
@@ -27,8 +27,225 @@
[///
["." phase]]]]]])
+(def: Nil
+ (for {@.lua
+ host.Nil}
+ Any))
+
+(def: Object
+ (for {@.lua (type (host.Object Any))}
+ Any))
+
+(def: Function
+ (for {@.lua host.Function}
+ Any))
+
+(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: 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 "nil" (/.nullary ..Nil))
+ (bundle.install "nil?" (/.unary Any Bit))
+ )))
+
+(template [<name> <fromT> <toT>]
+ [(def: <name>
+ Handler
+ (custom
+ [<c>.any
+ (function (_ extension phase archive inputC)
+ (do {! phase.monad}
+ [inputA (analysis/type.with_type (type <fromT>)
+ (phase archive inputC))
+ _ (analysis/type.infer (type <toT>))]
+ (wrap (#analysis.Extension extension (list inputA)))))]))]
+
+ [utf8::encode Text (array.Array (I64 Any))]
+ [utf8::decode (array.Array (I64 Any)) Text]
+ )
+
+(def: bundle::utf8
+ Bundle
+ (<| (bundle.prefix "utf8")
+ (|> bundle.empty
+ (bundle.install "encode" utf8::encode)
+ (bundle.install "decode" utf8::decode)
+ )))
+
+(def: lua::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: lua::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: lua::power
+ Handler
+ (custom
+ [($_ <>.and <c>.any <c>.any)
+ (function (_ extension phase archive [powerC baseC])
+ (do {! phase.monad}
+ [powerA (analysis/type.with_type Frac
+ (phase archive powerC))
+ baseA (analysis/type.with_type Frac
+ (phase archive baseC))
+ _ (analysis/type.infer Frac)]
+ (wrap (#analysis.Extension extension (list powerA baseA)))))]))
+
+(def: lua::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::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: #export bundle
Bundle
(<| (bundle.prefix "lua")
(|> bundle.empty
+ (dictionary.merge bundle::array)
+ (dictionary.merge bundle::object)
+ (dictionary.merge bundle::utf8)
+
+ (bundle.install "constant" lua::constant)
+ (bundle.install "apply" lua::apply)
+ (bundle.install "power" lua::power)
+ (bundle.install "import" lua::import)
+ (bundle.install "function" python::function)
)))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js/host.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js/host.lux
index c81705f24..45fb3e5d2 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js/host.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js/host.lux
@@ -114,9 +114,7 @@
(custom
[<s>.text
(function (_ extension phase archive name)
- (do ////////phase.monad
- []
- (wrap (_.var name))))]))
+ (\ ////////phase.monad wrap (_.var name)))]))
(def: js::apply
(custom
@@ -151,10 +149,11 @@
Bundle
(<| (/.prefix "js")
(|> /.empty
+ (dictionary.merge ..array)
+ (dictionary.merge ..object)
+
(/.install "constant" js::constant)
(/.install "apply" js::apply)
(/.install "type-of" (unary _.type_of))
(/.install "function" js::function)
- (dictionary.merge ..array)
- (dictionary.merge ..object)
)))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/lua.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/lua.lux
index b64cf2427..ab0d0d555 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/lua.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/lua.lux
@@ -5,6 +5,7 @@
["." dictionary]]]]
["." / #_
["#." common]
+ ["#." host]
[////
[generation
[lua
@@ -12,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/lua/common.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/lua/common.lux
index 7d7ce2fbf..e619e76f8 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/lua/common.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/lua/common.lux
@@ -3,24 +3,49 @@
[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
- ["_" lua (#+ Expression Literal)]]]
- [////
+ ["_" lua (#+ Expression)]]]
+ ["." //// #_
["/" bundle]
- [//
+ ["/#" // #_
+ ["." extension]
[generation
[extension (#+ Nullary Unary Binary Trinary
nullary unary binary trinary)]
["//" lua #_
- ["#." 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]))))
(template: (!unary function)
(|>> list _.apply/* (|> (_.var function))))
@@ -70,9 +95,9 @@
(/.install "encode" (unary (!unary "tostring")))
(/.install "decode" (unary ..f64//decode)))))
-(def: (text//char [subjectO paramO])
+(def: (text//char [paramO subjectO])
(Binary Expression)
- (//runtime.text//char subjectO paramO))
+ (//runtime.text//char (_.+ (_.int +1) paramO) subjectO))
(def: (text//clip [paramO extraO subjectO])
(Trinary Expression)
@@ -80,7 +105,7 @@
(def: (text//index [startO partO textO])
(Trinary Expression)
- (//runtime.text//index textO partO startO))
+ (//runtime.text//index textO partO (_.+ (_.int +1) startO)))
(def: text_procs
Bundle
@@ -89,10 +114,10 @@
(/.install "=" (binary (product.uncurry _.=)))
(/.install "<" (binary (product.uncurry _.<)))
(/.install "concat" (binary (product.uncurry (function.flip _.concat))))
- (/.install "index" (trinary text//index))
+ (/.install "index" (trinary ..text//index))
(/.install "size" (unary (|>> list _.apply/* (|> (_.var "string.len")))))
- (/.install "char" (binary (product.uncurry //runtime.text//char)))
- (/.install "clip" (trinary text//clip))
+ (/.install "char" (binary ..text//char))
+ (/.install "clip" (trinary ..text//clip))
)))
(def: (io//log! messageO)
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/lua/host.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/lua/host.lux
new file mode 100644
index 000000000..03600ab57
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/lua/host.lux
@@ -0,0 +1,197 @@
+(.module:
+ [lux #*
+ [abstract
+ ["." monad (#+ do)]]
+ [control
+ ["." function]
+ ["<>" parser
+ ["<s>" synthesis (#+ Parser)]]]
+ [data
+ [collection
+ ["." dictionary]
+ ["." list]]
+ [text
+ ["%" format (#+ format)]]]
+ [target
+ ["_" lua (#+ Var Expression)]]]
+ ["." // #_
+ ["#." common (#+ custom)]
+ ["//#" /// #_
+ ["/" bundle]
+ ["/#" // #_
+ ["." extension]
+ [generation
+ [extension (#+ Nullary Unary Binary Trinary
+ nullary unary binary trinary)]
+ ["//" lua #_
+ ["#." runtime (#+ Operation Phase Handler Bundle
+ with_vars)]]]
+ ["/#" // #_
+ ["." generation]
+ ["//#" /// #_
+ ["#." phase]]]]]])
+
+(def: array::new
+ (Unary Expression)
+ (|>> ["n"] list _.table))
+
+(def: array::length
+ (Unary Expression)
+ (_.the "n"))
+
+(def: (array::read [indexG arrayG])
+ (Binary Expression)
+ (_.nth (_.+ (_.int +1) indexG) arrayG))
+
+(def: (array::write [indexG valueG arrayG])
+ (Trinary Expression)
+ (//runtime.array//write indexG valueG arrayG))
+
+(def: (array::delete [indexG arrayG])
+ (Binary Expression)
+ (//runtime.array//write indexG _.nil arrayG))
+
+(def: array
+ Bundle
+ (<| (/.prefix "array")
+ (|> /.empty
+ (/.install "new" (unary array::new))
+ (/.install "length" (unary array::length))
+ (/.install "read" (binary array::read))
+ (/.install "write" (trinary array::write))
+ (/.install "delete" (binary array::delete))
+ )))
+
+(def: object::get
+ Handler
+ (custom
+ [($_ <>.and <s>.text <s>.any)
+ (function (_ extension phase archive [fieldS objectS])
+ (do ////////phase.monad
+ [objectG (phase archive objectS)]
+ (wrap (_.the fieldS objectG))))]))
+
+(def: object::do
+ Handler
+ (custom
+ [($_ <>.and <s>.text <s>.any (<>.some <s>.any))
+ (function (_ extension phase archive [methodS objectS inputsS])
+ (do {! ////////phase.monad}
+ [objectG (phase archive objectS)
+ inputsG (monad.map ! (phase archive) inputsS)]
+ (wrap (_.do methodS inputsG objectG))))]))
+
+(template [<!> <?> <unit>]
+ [(def: <!> (Nullary Expression) (function.constant <unit>))
+ (def: <?> (Unary Expression) (_.= <unit>))]
+
+ [object::nil object::nil? _.nil]
+ )
+
+(def: object
+ Bundle
+ (<| (/.prefix "object")
+ (|> /.empty
+ (/.install "get" object::get)
+ (/.install "do" object::do)
+ (/.install "nil" (nullary object::nil))
+ (/.install "nil?" (unary object::nil?))
+ )))
+
+(def: $input
+ (_.var "input"))
+
+(def: utf8::encode
+ (custom
+ [<s>.any
+ (function (_ extension phase archive inputS)
+ (do {! ////////phase.monad}
+ [inputG (phase archive inputS)]
+ (wrap (_.apply/1 (<| (_.closure (list $input))
+ (_.return (|> (_.var "string.byte")
+ (_.apply/* (list $input (_.int +1) (_.length $input)))
+ (_.apply/1 (_.var "table.pack")))))
+ inputG))))]))
+
+(def: utf8::decode
+ (custom
+ [<s>.any
+ (function (_ extension phase archive inputS)
+ (do {! ////////phase.monad}
+ [inputG (phase archive inputS)]
+ (wrap (|> inputG
+ (_.apply/1 (_.var "table.unpack"))
+ (_.apply/1 (_.var "string.char"))))))]))
+
+(def: utf8
+ Bundle
+ (<| (/.prefix "utf8")
+ (|> /.empty
+ (/.install "encode" utf8::encode)
+ (/.install "decode" utf8::decode)
+ )))
+
+(def: lua::constant
+ (custom
+ [<s>.text
+ (function (_ extension phase archive name)
+ (\ ////////phase.monad wrap (_.var name)))]))
+
+(def: lua::apply
+ (custom
+ [($_ <>.and <s>.any (<>.some <s>.any))
+ (function (_ extension phase archive [abstractionS inputsS])
+ (do {! ////////phase.monad}
+ [abstractionG (phase archive abstractionS)
+ inputsG (monad.map ! (phase archive) inputsS)]
+ (wrap (_.apply/* inputsG abstractionG))))]))
+
+(def: lua::power
+ (custom
+ [($_ <>.and <s>.any <s>.any)
+ (function (_ extension phase archive [powerS baseS])
+ (do {! ////////phase.monad}
+ [powerG (phase archive powerS)
+ baseG (phase archive baseS)]
+ (wrap (_.^ powerG baseG))))]))
+
+(def: lua::import
+ (custom
+ [<s>.text
+ (function (_ extension phase archive module)
+ (\ ////////phase.monad wrap
+ (_.require/1 (_.string module))))]))
+
+(def: lua::function
+ (custom
+ [($_ <>.and <s>.i64 <s>.any)
+ (function (_ extension phase archive [arity abstractionS])
+ (do {! ////////phase.monad}
+ [abstractionG (phase archive abstractionS)
+ #let [variable (: (-> Text (Operation Var))
+ (|>> generation.gensym
+ (\ ! map _.var)))]
+ g!inputs (monad.map ! (function (_ _)
+ (variable "input"))
+ (list.repeat (.nat arity) []))]
+ (wrap (<| (_.closure g!inputs)
+ _.statement
+ (case (.nat arity)
+ 0 (_.apply/1 abstractionG //runtime.unit)
+ 1 (_.apply/* g!inputs abstractionG)
+ _ (_.apply/1 abstractionG (_.array g!inputs)))))))]))
+
+(def: #export bundle
+ Bundle
+ (<| (/.prefix "lua")
+ (|> /.empty
+ (dictionary.merge ..array)
+ (dictionary.merge ..object)
+ (dictionary.merge ..utf8)
+
+ (/.install "constant" lua::constant)
+ (/.install "apply" lua::apply)
+ (/.install "power" lua::power)
+ (/.install "import" lua::import)
+ (/.install "function" lua::function)
+ )))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js.lux
index 03913b84b..ab89ff708 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js.lux
@@ -26,8 +26,6 @@
[reference (#+)
[variable (#+)]]]]]]])
-(exception: #export cannot-recur-as-an-expression)
-
(def: (statement expression archive synthesis)
Phase!
(case synthesis
@@ -64,6 +62,8 @@
(//////phase\map _.return (/function.function statement expression archive abstraction))
))
+(exception: #export cannot-recur-as-an-expression)
+
(def: (expression archive synthesis)
Phase
(case synthesis
@@ -109,8 +109,7 @@
(/function.apply expression archive application)
(#synthesis.Extension extension)
- (///extension.apply archive expression extension)
- ))
+ (///extension.apply archive expression extension)))
(def: #export generate
Phase
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/case.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/case.lux
index 1bcd569c7..50e3ba008 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/case.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/case.lux
@@ -34,11 +34,11 @@
(-> Register Var)
(|>> (///reference.local //reference.system) :assume))
-(def: #export (let generate archive [valueS register bodyS])
+(def: #export (let expression archive [valueS register bodyS])
(Generator [Synthesis Register Synthesis])
(do ///////phase.monad
- [valueO (generate archive valueS)
- bodyO (generate archive bodyS)]
+ [valueO (expression archive valueS)
+ bodyO (expression archive bodyS)]
## TODO: Find some way to do 'let' without paying the price of the closure.
(wrap (_.apply/* (_.closure (list (..register register))
(_.return bodyO))
@@ -49,15 +49,16 @@
(do ///////phase.monad
[valueO (expression archive valueS)
bodyO (statement expression archive bodyS)]
- (wrap (_.then (_.define (..register register) valueO)
- bodyO))))
+ (wrap ($_ _.then
+ (_.define (..register register) valueO)
+ bodyO))))
-(def: #export (if generate archive [testS thenS elseS])
+(def: #export (if expression archive [testS thenS elseS])
(Generator [Synthesis Synthesis Synthesis])
(do ///////phase.monad
- [testO (generate archive testS)
- thenO (generate archive thenS)
- elseO (generate archive elseS)]
+ [testO (expression archive testS)
+ thenO (expression archive thenS)
+ elseO (expression archive elseS)]
(wrap (_.? testO thenO elseO))))
(def: #export (if! statement expression archive [testS thenS elseS])
@@ -70,10 +71,10 @@
thenO
elseO))))
-(def: #export (get generate archive [pathP valueS])
+(def: #export (get expression archive [pathP valueS])
(Generator [(List Member) Synthesis])
(do ///////phase.monad
- [valueO (generate archive valueS)]
+ [valueO (expression archive valueS)]
(wrap (list\fold (function (_ side source)
(.let [method (.case side
(^template [<side> <accessor>]
@@ -223,6 +224,9 @@
#.None
(.case pathP
+ (#/////synthesis.Then bodyS)
+ (statement expression archive bodyS)
+
#/////synthesis.Pop
(///////phase\wrap pop_cursor!)
@@ -269,9 +273,6 @@
([#/////synthesis.F64_Fork //primitive.f64]
[#/////synthesis.Text_Fork //primitive.text])
- (#/////synthesis.Then bodyS)
- (statement expression archive bodyS)
-
(^template [<complex> <choice>]
[(^ (<complex> idx))
(///////phase\wrap (<choice> false idx))])
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/function.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/function.lux
index 89fd86bb6..4d403e22e 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/function.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/function.lux
@@ -26,28 +26,30 @@
[reference
[variable (#+ Register Variable)]]]]]])
-(def: #export (apply generate archive [functionS argsS+])
+(def: #export (apply expression archive [functionS argsS+])
(Generator (Application Synthesis))
(do {! ///////phase.monad}
- [functionO (generate archive functionS)
- argsO+ (monad.map ! (generate archive) argsS+)]
+ [functionO (expression archive functionS)
+ argsO+ (monad.map ! (expression archive) argsS+)]
(wrap (_.apply/* functionO argsO+))))
-(def: (with_closure @self inits function_body)
+(def: capture
+ (-> Register Var)
+ (|>> (///reference.foreign //reference.system) :assume))
+
+(def: (with_closure @self inits body!)
(-> Var (List Expression) Statement [Statement Expression])
(case inits
#.Nil
- [(_.function! @self (list) function_body)
+ [(_.function! @self (list) body!)
@self]
_
- (let [capture (: (-> Register Var)
- (|>> (///reference.foreign //reference.system) :assume))]
- [(_.function! @self
- (|> (list.enumeration inits)
- (list\map (|>> product.left capture)))
- (_.return (_.function @self (list) function_body)))
- (_.apply/* @self inits)])))
+ [(_.function! @self
+ (|> (list.enumeration inits)
+ (list\map (|>> product.left ..capture)))
+ (_.return (_.function @self (list) body!)))
+ (_.apply/* @self inits)]))
(def: @curried
(_.var "curried"))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/loop.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/loop.lux
index bbeaca725..135cfeb74 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/loop.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/loop.lux
@@ -69,20 +69,11 @@
## true loop
_
(do {! ///////phase.monad}
- [@scope (\ ! map ..@scope /////generation.next)
- initsO+ (monad.map ! (expression archive) initsS+)
- body! (/////generation.with_anchor [start @scope]
- (statement expression archive bodyS))
- #let [closure (_.closure
- (|> initsS+
- list.enumeration
- (list\map (|>> product.left (n.+ start) //case.register)))
- (_.with_label (_.label @scope)
- (_.do_while (_.boolean true)
- body!)))]]
- (wrap (_.apply/* closure initsO+)))))
+ [loop! (scope! statement expression archive [start initsS+ bodyS])]
+ (wrap (_.apply/* (_.closure (list) loop!) (list))))))
-(def: @temp (_.var "lux_recur_values"))
+(def: @temp
+ (_.var "lux_recur_values"))
(def: #export (recur! statement expression archive argsS+)
(Generator! (List Synthesis))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux
index f62b04c4e..53213d3f1 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux
@@ -682,9 +682,10 @@
..none
(..some (i64//from_number idx)))))))
-(runtime: (text//clip start end text)
- (_.return (|> text (_.do "substring" (list (_.the ..i64_low_field start)
- (_.the ..i64_low_field end))))))
+(runtime: (text//clip offset length text)
+ (_.return (|> text (_.do "substring" (list (_.the ..i64_low_field offset)
+ (_.+ (_.the ..i64_low_field offset)
+ (_.the ..i64_low_field length)))))))
(runtime: (text//char idx text)
(with_vars [result]
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua.lux
index 2e3369915..7f16a8d5f 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua.lux
@@ -1,7 +1,11 @@
(.module:
[lux #*
[abstract
- [monad (#+ do)]]]
+ [monad (#+ do)]]
+ [control
+ ["." exception (#+ exception:)]]
+ [target
+ ["_" lua]]]
["." / #_
[runtime (#+ Phase Phase!)]
["#." primitive]
@@ -22,7 +26,45 @@
[reference (#+)
[variable (#+)]]]]]]])
-(def: #export (generate archive synthesis)
+(def: (statement expression archive synthesis)
+ Phase!
+ (case synthesis
+ (^template [<tag>]
+ [(^ (<tag> value))
+ (//////phase\map _.return (expression archive synthesis))])
+ ([synthesis.bit]
+ [synthesis.i64]
+ [synthesis.f64]
+ [synthesis.text]
+ [synthesis.variant]
+ [synthesis.tuple]
+ [#synthesis.Reference]
+ [synthesis.branch/get]
+ [synthesis.function/apply]
+ [#synthesis.Extension])
+
+ (^ (synthesis.branch/case case))
+ (/case.case! statement expression archive case)
+
+ (^ (synthesis.branch/let let))
+ (/case.let! statement expression archive let)
+
+ (^ (synthesis.branch/if if))
+ (/case.if! statement expression archive if)
+
+ (^ (synthesis.loop/scope scope))
+ (/loop.scope! statement expression archive scope)
+
+ (^ (synthesis.loop/recur updates))
+ (/loop.recur! statement expression archive updates)
+
+ (^ (synthesis.function/abstraction abstraction))
+ (//////phase\map _.return (/function.function statement expression archive abstraction))
+ ))
+
+(exception: #export cannot-recur-as-an-expression)
+
+(def: (expression archive synthesis)
Phase
(case synthesis
(^template [<tag> <generator>]
@@ -34,37 +76,41 @@
[synthesis.text /primitive.text])
(^ (synthesis.variant variantS))
- (/structure.variant generate archive variantS)
+ (/structure.variant expression archive variantS)
(^ (synthesis.tuple members))
- (/structure.tuple generate archive members)
+ (/structure.tuple expression archive members)
(#synthesis.Reference value)
(//reference.reference /reference.system archive value)
(^ (synthesis.branch/case case))
- (/case.case generate archive case)
+ (/case.case ..statement expression archive case)
(^ (synthesis.branch/let let))
- (/case.let generate archive let)
+ (/case.let expression archive let)
(^ (synthesis.branch/if if))
- (/case.if generate archive if)
+ (/case.if expression archive if)
(^ (synthesis.branch/get get))
- (/case.get generate archive get)
+ (/case.get expression archive get)
(^ (synthesis.loop/scope scope))
- (/loop.scope generate archive scope)
+ (/loop.scope ..statement expression archive scope)
(^ (synthesis.loop/recur updates))
- (/loop.recur generate archive updates)
+ (//////phase.throw ..cannot-recur-as-an-expression [])
(^ (synthesis.function/abstraction abstraction))
- (/function.function generate archive abstraction)
+ (/function.function ..statement expression archive abstraction)
(^ (synthesis.function/apply application))
- (/function.apply generate archive application)
+ (/function.apply expression archive application)
(#synthesis.Extension extension)
- (///extension.apply archive generate extension)))
+ (///extension.apply archive expression extension)))
+
+(def: #export generate
+ Phase
+ ..expression)
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/case.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/case.lux
index 3c56c2dfa..818575720 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/case.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/case.lux
@@ -37,21 +37,30 @@
(-> Register Var)
(|>> (///reference.foreign //reference.system) :assume))
-(def: #export (let generate archive [valueS register bodyS])
+(def: #export (let expression archive [valueS register bodyS])
(Generator [Synthesis Register Synthesis])
(do ///////phase.monad
- [valueO (generate archive valueS)
- bodyO (generate archive bodyS)]
+ [valueO (expression archive valueS)
+ bodyO (expression archive bodyS)]
## TODO: Find some way to do 'let' without paying the price of the closure.
(wrap (|> bodyO
_.return
(_.closure (list (..register register)))
(_.apply/* (list valueO))))))
-(def: #export (get generate archive [pathP valueS])
+(def: #export (let! statement expression archive [valueS register bodyS])
+ (Generator! [Synthesis Register Synthesis])
+ (do ///////phase.monad
+ [valueO (expression archive valueS)
+ bodyO (statement expression archive bodyS)]
+ (wrap ($_ _.then
+ (_.local/1 (..register register) valueO)
+ bodyO))))
+
+(def: #export (get expression archive [pathP valueS])
(Generator [(List Member) Synthesis])
(do ///////phase.monad
- [valueO (generate archive valueS)]
+ [valueO (expression archive valueS)]
(wrap (list\fold (function (_ side source)
(.let [method (.case side
(^template [<side> <accessor>]
@@ -63,18 +72,28 @@
valueO
(list.reverse pathP)))))
-(def: #export (if generate archive [testS thenS elseS])
+(def: #export (if expression archive [testS thenS elseS])
(Generator [Synthesis Synthesis Synthesis])
(do ///////phase.monad
- [testO (generate archive testS)
- thenO (generate archive thenS)
- elseO (generate archive elseS)]
+ [testO (expression archive testS)
+ thenO (expression archive thenS)
+ elseO (expression archive elseS)]
(wrap (|> (_.if testO
(_.return thenO)
(_.return elseO))
(_.closure (list))
(_.apply/* (list))))))
+(def: #export (if! statement expression archive [testS thenS elseS])
+ (Generator! [Synthesis Synthesis Synthesis])
+ (do ///////phase.monad
+ [testO (expression archive testS)
+ thenO (statement expression archive thenS)
+ elseO (statement expression archive elseS)]
+ (wrap (_.if testO
+ thenO
+ elseO))))
+
(def: @savepoint (_.var "lux_pm_savepoint"))
(def: @cursor (_.var "lux_pm_cursor"))
(def: @temp (_.var "lux_pm_temp"))
@@ -134,12 +153,12 @@
..restore!
post!)))
-(def: (pattern_matching' generate archive)
- (-> Phase Archive Path (Operation Statement))
+(def: (pattern_matching' statement expression archive)
+ (-> Phase! Phase Archive Path (Operation Statement))
(function (recur pathP)
(.case pathP
(#/////synthesis.Then bodyS)
- (///////phase\map _.return (generate archive bodyS))
+ (statement expression archive bodyS)
#/////synthesis.Pop
(///////phase\wrap ..pop!)
@@ -213,10 +232,10 @@
([/////synthesis.path/seq _.then]
[/////synthesis.path/alt ..alternation]))))
-(def: (pattern_matching generate archive pathP)
- (-> Phase Archive Path (Operation Statement))
+(def: (pattern_matching statement expression archive pathP)
+ (-> Phase! Phase Archive Path (Operation Statement))
(do ///////phase.monad
- [pattern_matching! (pattern_matching' generate archive pathP)]
+ [pattern_matching! (pattern_matching' statement expression archive pathP)]
(wrap ($_ _.then
(_.while (_.bool true)
pattern_matching!)
@@ -235,21 +254,21 @@
(#///////variable.Foreign register)
(..capture register))))))
-(def: #export (case generate archive [valueS pathP])
- (Generator [Synthesis Path])
+(def: #export (case! statement expression archive [valueS pathP])
+ (Generator! [Synthesis Path])
(do ///////phase.monad
- [initG (generate archive valueS)
- [[case_module case_artifact] pattern_matching!] (/////generation.with_new_context archive
- (pattern_matching generate archive pathP))
- #let [@case (_.var (///reference.artifact [case_module case_artifact]))
- @dependencies+ (..dependencies (/////synthesis.path/seq (/////synthesis.path/then valueS)
- pathP))
- directive (_.function @case @dependencies+
- ($_ _.then
- (_.local (list @temp))
- (_.local/1 @cursor (_.array (list initG)))
- (_.local/1 @savepoint (_.array (list)))
- pattern_matching!))]
- _ (/////generation.execute! directive)
- _ (/////generation.save! (%.nat case_artifact) directive)]
- (wrap (_.apply/* @dependencies+ @case))))
+ [stack_init (expression archive valueS)
+ pattern_matching! (pattern_matching statement expression archive pathP)]
+ (wrap ($_ _.then
+ (_.local (list @temp))
+ (_.local/1 @cursor (_.array (list stack_init)))
+ (_.local/1 @savepoint (_.array (list)))
+ pattern_matching!))))
+
+(def: #export (case statement expression archive [valueS pathP])
+ (-> Phase! (Generator [Synthesis Path]))
+ (|> [valueS pathP]
+ (..case! statement expression archive)
+ (\ ///////phase.monad map
+ (|>> (_.closure (list))
+ (_.apply/* (list))))))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/function.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/function.lux
index c7fe7f51c..3aa3a9ca7 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/function.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/function.lux
@@ -11,7 +11,7 @@
[collection
["." list ("#\." functor fold)]]]
[target
- ["_" lua (#+ Var Expression Statement)]]]
+ ["_" lua (#+ Var Expression Label Statement)]]]
["." // #_
["#." runtime (#+ Operation Phase Phase! Generator)]
["#." reference]
@@ -28,58 +28,55 @@
[reference
[variable (#+ Register Variable)]]]]]])
-(def: #export (apply generate archive [functionS argsS+])
+(def: #export (apply expression archive [functionS argsS+])
(Generator (Application Synthesis))
(do {! ///////phase.monad}
- [functionO (generate archive functionS)
- argsO+ (monad.map ! (generate archive) argsS+)]
+ [functionO (expression archive functionS)
+ argsO+ (monad.map ! (expression archive) argsS+)]
(wrap (_.apply/* argsO+ functionO))))
-(def: #export capture
+(def: capture
(-> Register Var)
(|>> (///reference.foreign //reference.system) :assume))
-(def: (with_closure function_name inits @function @args @body)
- (-> Text (List Expression) Var (List Var) Statement (Operation Expression))
+(def: (with_closure inits @self @args body!)
+ (-> (List Expression) Var (List Var) Statement [Statement Expression])
(case inits
#.Nil
- (do ///////phase.monad
- [#let [function_definition (_.function @function @args @body)]
- _ (/////generation.execute! function_definition)
- _ (/////generation.save! function_name function_definition)]
- (wrap (_.var function_name)))
+ [(_.function @self @args body!)
+ @self]
_
- (do {! ///////phase.monad}
- [#let [@closure (_.var (format function_name "_closure"))
- directive (_.function @closure
- (|> (list.enumeration inits)
- (list\map (|>> product.left ..capture)))
- ($_ _.then
- (_.local_function @function @args @body)
- (_.return (_.var function_name))))]
- _ (/////generation.execute! directive)
- _ (/////generation.save! (_.code @closure) directive)]
- (wrap (_.apply/* inits @closure)))))
+ (let [@inits (|> (list.enumeration inits)
+ (list\map (|>> product.left ..capture)))]
+ [(_.function @self @inits
+ ($_ _.then
+ (_.local_function @self @args body!)
+ (_.return @self)))
+ (_.apply/* inits @self)])))
(def: input
(|>> inc //case.register))
-(def: #export (function generate archive [environment arity bodyS])
- (Generator (Abstraction Synthesis))
+(def: (@scope function_name)
+ (-> Context Label)
+ (_.label (format (///reference.artifact function_name) "_scope")))
+
+(def: #export (function statement expression archive [environment arity bodyS])
+ (-> Phase! (Generator (Abstraction Synthesis)))
(do {! ///////phase.monad}
- [[function_name bodyO] (/////generation.with_new_context archive
+ [[function_name body!] (/////generation.with_new_context archive
(do !
- [function_name (\ ! map ///reference.artifact
- (/////generation.context archive))]
- (/////generation.with_anchor (_.var function_name)
- (generate archive bodyS))))
- closureO+ (monad.map ! (generate archive) environment)
- #let [function_name (///reference.artifact function_name)
- @curried (_.var "curried")
+ [@scope (\ ! map ..@scope
+ (/////generation.context archive))]
+ (/////generation.with_anchor [1 @scope]
+ (statement expression archive bodyS))))
+ closureO+ (monad.map ! (expression archive) environment)
+ #let [@curried (_.var "curried")
arityO (|> arity .int _.int)
@num_args (_.var "num_args")
- @self (_.var function_name)
+ @scope (..@scope function_name)
+ @self (_.var (///reference.artifact function_name))
initialize_self! (_.local/1 (//case.register 0) @self)
initialize! (list\fold (.function (_ post pre!)
($_ _.then
@@ -89,26 +86,28 @@
(list.indices arity))
pack (|>> (list) _.array)
unpack (|>> (list) _.apply/* (|> (_.var "table.unpack")))
- @var_args (_.var "...")]]
- (with_closure function_name closureO+
- @self (list @var_args)
- ($_ _.then
- (_.local/1 @curried (pack @var_args))
- (_.local/1 @num_args (_.length @curried))
- (_.cond (list [(|> @num_args (_.= (_.int +0)))
- (_.return @self)]
- [(|> @num_args (_.= arityO))
- ($_ _.then
- initialize!
- (_.return bodyO))]
- [(|> @num_args (_.> arityO))
- (let [arity_inputs (//runtime.array//sub (_.int +0) arityO @curried)
- extra_inputs (//runtime.array//sub arityO @num_args @curried)]
- (_.return (|> @self
- (_.apply/* (list (unpack arity_inputs)))
- (_.apply/* (list (unpack extra_inputs))))))])
- ## (|> @num_args (_.< arityO))
- (_.return (_.closure (list @var_args)
- (_.return (|> @self (_.apply/* (list (unpack (//runtime.array//concat @curried (pack @var_args))))))))))
- ))
- ))
+ @var_args (_.var "...")]
+ #let [[definition instantiation] (with_closure closureO+ @self (list @var_args)
+ ($_ _.then
+ (_.local/1 @curried (pack @var_args))
+ (_.local/1 @num_args (_.length @curried))
+ (_.cond (list [(|> @num_args (_.= (_.int +0)))
+ (_.return @self)]
+ [(|> @num_args (_.= arityO))
+ ($_ _.then
+ initialize!
+ (_.set_label @scope)
+ body!)]
+ [(|> @num_args (_.> arityO))
+ (let [arity_inputs (//runtime.array//sub (_.int +0) arityO @curried)
+ extra_inputs (//runtime.array//sub arityO @num_args @curried)]
+ (_.return (|> @self
+ (_.apply/* (list (unpack arity_inputs)))
+ (_.apply/* (list (unpack extra_inputs))))))])
+ ## (|> @num_args (_.< arityO))
+ (_.return (_.closure (list @var_args)
+ (_.return (|> @self (_.apply/* (list (unpack (//runtime.array//concat @curried (pack @var_args))))))))))
+ ))]
+ _ (/////generation.execute! definition)
+ _ (/////generation.save! (%.nat (product.right function_name)) definition)]
+ (wrap instantiation)))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/loop.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/loop.lux
index b1b8a47cb..7fc7ebbfd 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/loop.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/loop.lux
@@ -13,7 +13,7 @@
[number
["n" nat]]]
[target
- ["_" lua (#+ Var Expression Statement)]]]
+ ["_" lua (#+ Var Expression Label Statement)]]]
["." // #_
[runtime (#+ Operation Phase Phase! Generator Generator!)]
["#." case]
@@ -27,29 +27,53 @@
[reference
[variable (#+ Register)]]]]]])
-(def: loop_name
- (-> Nat Var)
- (|>> %.nat (format "loop") _.var))
+(def: @scope
+ (-> Nat Label)
+ (|>> %.nat (format "scope") _.label))
-(def: #export (scope generate archive [start initsS+ bodyS])
- (Generator (Scope Synthesis))
+(def: (setup initial? offset bindings body)
+ (-> Bit Register (List Expression) Statement Statement)
+ (let [variables (|> bindings
+ list.enumeration
+ (list\map (|>> product.left (n.+ offset) //case.register)))]
+ ($_ _.then
+ (if initial?
+ (_.let variables (_.multi bindings))
+ (_.set variables (_.multi bindings)))
+ body)))
+
+(def: #export (scope! statement expression archive [start initsS+ bodyS])
+ (Generator! (Scope Synthesis))
+ (case initsS+
+ ## function/false/non-independent loop
+ #.Nil
+ (statement expression archive bodyS)
+
+ ## true loop
+ _
+ (do {! ///////phase.monad}
+ [@scope (\ ! map ..@scope /////generation.next)
+ initsO+ (monad.map ! (expression archive) initsS+)
+ body! (/////generation.with_anchor [start @scope]
+ (statement expression archive bodyS))]
+ (wrap (..setup true start initsO+
+ ($_ _.then
+ (_.set_label @scope)
+ body!))))))
+
+(def: #export (scope statement expression archive [start initsS+ bodyS])
+ (-> Phase! (Generator (Scope Synthesis)))
(case initsS+
## function/false/non-independent loop
#.Nil
- (generate archive bodyS)
+ (expression archive bodyS)
## true loop
_
(do {! ///////phase.monad}
- [@loop (\ ! map ..loop_name /////generation.next)
- initsO+ (monad.map ! (generate archive) initsS+)
- [loop_name bodyO] (/////generation.with_new_context archive
- (do !
- [@loop (\ ! map (|>> ///reference.artifact _.var)
- (/////generation.context archive))]
- (/////generation.with_anchor @loop
- (generate archive bodyS))))
- #let [@loop (_.var (///reference.artifact loop_name))
+ [[[artifact_module artifact_id] scope!] (/////generation.with_new_context archive
+ (scope! statement expression archive [start initsS+ bodyS]))
+ #let [@loop (_.var (///reference.artifact [artifact_module artifact_id]))
locals (|> initsS+
list.enumeration
(list\map (|>> product.left (n.+ start) //case.register)))
@@ -61,25 +85,25 @@
set.to_list)
#.Nil
[(_.function @loop locals
- (_.return bodyO))
+ scope!)
@loop]
foreigns
- (let [@context (_.var (format (///reference.artifact loop_name) "_context"))]
+ (let [@context (_.var (format (_.code @loop) "_context"))]
[(_.function @context foreigns
($_ _.then
(<| (_.local_function @loop locals)
- (_.return bodyO))
+ scope!)
(_.return @loop)
))
(_.apply/* foreigns @context)])))]
_ (/////generation.execute! directive)
- _ (/////generation.save! (_.code @loop) directive)]
- (wrap (_.apply/* initsO+ instantiation)))))
+ _ (/////generation.save! (%.nat artifact_id) directive)]
+ (wrap instantiation))))
-(def: #export (recur generate archive argsS+)
- (Generator (List Synthesis))
+(def: #export (recur! statement expression archive argsS+)
+ (Generator! (List Synthesis))
(do {! ///////phase.monad}
- [@scope /////generation.anchor
- argsO+ (monad.map ! (generate archive) argsS+)]
- (wrap (_.apply/* argsO+ @scope))))
+ [[offset @scope] /////generation.anchor
+ argsO+ (monad.map ! (expression archive) argsS+)]
+ (wrap (..setup false offset argsO+ (_.go_to @scope)))))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/runtime.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/runtime.lux
index d7b0f1cd3..46911bcc4 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/runtime.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/runtime.lux
@@ -22,7 +22,7 @@
[number (#+ hex)
["." i64]]]
[target
- ["_" lua (#+ Expression Location Var Computation Literal Statement)]]]
+ ["_" lua (#+ Expression Location Var Computation Literal Label Statement)]]]
["." /// #_
["#." reference]
["//#" /// #_
@@ -38,7 +38,7 @@
(template [<name> <base>]
[(type: #export <name>
- (<base> Var Expression Statement))]
+ (<base> [Register Label] Expression Statement))]
[Operation /////generation.Operation]
[Phase /////generation.Phase]
@@ -295,22 +295,23 @@
(runtime: (text//index subject param start)
(with_vars [idx]
($_ _.then
- (_.let (list idx) (_.apply/* (list subject param start (_.bool #1))
- (_.var "string.find")))
+ (_.local/1 idx (_.apply/* (list subject param start (_.bool #1))
+ (_.var "string.find")))
(_.if (_.= _.nil idx)
(_.return ..none)
- (_.return (..some idx))))))
+ (_.return (..some (_.- (_.int +1) idx)))))))
-(runtime: (text//clip text from to)
- (_.return (_.apply/* (list text from to) (_.var "string.sub"))))
+(runtime: (text//clip text offset length)
+ (_.return (_.apply/* (list text (_.+ (_.int +1) offset) (_.+ offset length))
+ (_.var "string.sub"))))
(runtime: (text//char idx text)
(with_vars [char]
($_ _.then
- (_.let (list char) (_.apply/* (list text idx) (_.var "string.byte")))
+ (_.local/1 char (_.apply/* (list text idx)
+ (_.var "string.byte")))
(_.if (_.= _.nil char)
- (_.statement (_.apply/* (list (_.string "[Lux Error] Cannot get char from text."))
- (_.var "error")))
+ (_.statement (_.error/1 (_.string "[Lux Error] Cannot get char from text.")))
(_.return char)))))
(def: runtime//text
@@ -321,24 +322,7 @@
@text//char
))
-(runtime: (array//new size)
- (with_vars [output idx]
- ($_ _.then
- (_.let (list output) (_.array (list)))
- (_.for_step idx (_.int +1) size (_.int +1)
- (_.statement (_.apply/* (list output ..unit) (_.var "table.insert"))))
- (_.return output))))
-
-(runtime: (array//get array idx)
- (with_vars [temp]
- ($_ _.then
- (_.let (list temp) (..nth idx array))
- (_.if (_.or (_.= _.nil temp)
- (_.= ..unit temp))
- (_.return ..none)
- (_.return (..some temp))))))
-
-(runtime: (array//put array idx value)
+(runtime: (array//write idx value array)
($_ _.then
(_.set (list (..nth idx array)) value)
(_.return array)))
@@ -346,31 +330,17 @@
(def: runtime//array
Statement
($_ _.then
- @array//new
- @array//get
- @array//put
- ))
-
-(runtime: (box//write value box)
- ($_ _.then
- (_.set (list (_.nth (_.int +1) box)) value)
- (_.return ..unit)))
-
-(def: runtime//box
- Statement
- ($_ _.then
- @box//write
+ @array//write
))
(def: runtime
Statement
($_ _.then
- runtime//adt
- runtime//lux
- runtime//i64
- runtime//text
- runtime//array
- runtime//box
+ ..runtime//adt
+ ..runtime//lux
+ ..runtime//i64
+ ..runtime//text
+ ..runtime//array
))
(def: #export artifact ..prefix)
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 132ec3c98..a2e18808a 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
@@ -378,8 +378,8 @@
(_.and (|> value (_.>= (_.int +0)))
(|> value (_.< top))))
-(runtime: (text//clip @from @to @text)
- (_.return (|> @text (_.slice @from @to))))
+(runtime: (text//clip @offset @length @text)
+ (_.return (|> @text (_.slice @offset (_.+ @offset @length)))))
(runtime: (text//char idx text)
(_.if (|> idx (within? (_.len/1 text)))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/syntax.lux b/stdlib/source/lux/tool/compiler/language/lux/syntax.lux
index 8362c7054..488738c00 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/syntax.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/syntax.lux
@@ -79,7 +79,7 @@
)
(template: (!clip from to text)
- ("lux text clip" from to text))
+ ("lux text clip" from (n.- from to) text))
(template [<name> <extension>]
[(template: (<name> reference subject)
diff --git a/stdlib/source/lux/world/file.lux b/stdlib/source/lux/world/file.lux
index b24f6fda4..63298038f 100644
--- a/stdlib/source/lux/world/file.lux
+++ b/stdlib/source/lux/world/file.lux
@@ -216,12 +216,16 @@
[not_a_directory]
)
-(with_expansions [<for_jvm> (as_is (exception: #export (cannot_move {target Path} {source Path})
- (exception.report
- ["Source" source]
- ["Target" target]))
-
- (exception: #export (cannot_modify {instant Instant} {file Path})
+(with_expansions [<extra> (as_is (exception: #export (cannot_move {target Path} {source Path})
+ (exception.report
+ ["Source" source]
+ ["Target" target])))]
+ (for {@.old (as_is <extra>)
+ @.jvm (as_is <extra>)
+ @.lua (as_is <extra>)}
+ (as_is)))
+
+(with_expansions [<for_jvm> (as_is (exception: #export (cannot_modify {instant Instant} {file Path})
(exception.report
["Instant" (%.instant instant)]
["Path" file]))
@@ -723,7 +727,7 @@
_ (PyFile::close [] file)]
(wrap [])))))]
- [over_write "wb"]
+ [over_write "w+b"]
[append "ab"]
))
@@ -874,6 +878,270 @@
(os/path::sep))
))
)
+
+ @.lua
+ (as_is (host.import: LuaFile
+ (read [host.String] #io host.String)
+ (write [host.String] #io #? LuaFile)
+ (flush [] #io host.Boolean)
+ (close [] #io host.Boolean))
+
+ (host.import: io
+ (#static open [host.String host.String] #io #? LuaFile))
+
+ (host.import: package
+ (#static config host.String))
+
+ (host.import: os
+ (#static rename [host.String host.String] #io #? host.Boolean)
+ (#static remove [host.String] #io #? host.Boolean)
+ (#static execute [host.String] #io #? host.Boolean))
+
+ (def: default_separator
+ Text
+ (|> (package::config)
+ (text.split_all_with text.new_line)
+ list.head
+ (maybe.default "/")))
+
+ (template [<name>]
+ [(exception: #export (<name> {file Path})
+ (exception.report
+ ["Path" file]))]
+
+ [cannot_open_file]
+ [cannot_close_file]
+ [cannot_write_to_file]
+ [file_already_exists]
+ )
+
+ (exception: #export (invalid_operation {signature Name} {operation Text})
+ (exception.report
+ ["Platform" @.lua]
+ ["Signature" (%.name signature)]
+ ["Operation" (%.text operation)]))
+
+ (`` (structure: (file path)
+ (-> Path (File IO))
+
+ (~~ (template [<name> <mode>]
+ [(def: <name>
+ (..can_modify
+ (function (<name> data)
+ (do {! io.monad}
+ [?file (io::open [path <mode>])]
+ (case ?file
+ (#.Some file)
+ (do !
+ [?wrote (LuaFile::write [("lua utf8 decode" data)] file)]
+ (case ?wrote
+ (#.Some _)
+ (do !
+ [flushed? (LuaFile::flush [] file)
+ closed? (LuaFile::close [] file)]
+ (wrap (cond (not flushed?)
+ (exception.throw ..cannot_write_to_file [path])
+
+ (not closed?)
+ (exception.throw ..cannot_close_file [path])
+
+ ## else
+ (#try.Success []))))
+
+ #.None
+ (wrap (exception.throw ..cannot_write_to_file [path]))))
+
+ #.None
+ (wrap (exception.throw ..cannot_open_file [path])))))))]
+
+ [over_write "w+b"]
+ [append "ab"]
+ ))
+
+ (def: content
+ (..can_query
+ (function (_ _)
+ (do {! io.monad}
+ [?file (io::open [path "rb"])]
+ (case ?file
+ (#.Some file)
+ (do !
+ [data (LuaFile::read ["a"] file)
+ closed? (LuaFile::close [] file)]
+ (wrap (if closed?
+ (#try.Success ("lua utf8 encode" data))
+ (exception.throw ..cannot_close_file [path]))))
+
+ #.None
+ (wrap (exception.throw ..cannot_read_all_data [path])))))))
+
+ (def: name
+ (..can_see
+ (function (_ _)
+ (|> path
+ (text.split_all_with ..default_separator)
+ list.reverse
+ list.head
+ (maybe.default path)))))
+
+ (def: path
+ (..can_see
+ (function (_ _)
+ path)))
+
+ (~~ (template [<capability> <name>]
+ [(def: <name>
+ (<capability>
+ (function (_ _)
+ (let [[_ short] (name_of <name>)]
+ (\ io.monad wrap (exception.throw ..invalid_operation [(name_of ..File) short]))))))]
+
+ [..can_query size]
+ [..can_query last_modified]
+ [..can_query can_execute?]
+
+ [..can_modify modify]
+ ))
+
+ (def: move
+ (..can_open
+ (function (move destination)
+ (do io.monad
+ [?verdict (os::rename [path destination])]
+ (wrap (if (case ?verdict
+ (#.Some verdict)
+ verdict
+
+ #.None
+ false)
+ (#try.Success (file destination))
+ (exception.throw ..cannot_move [destination path])))))))
+
+ (def: delete
+ (..can_delete
+ (function (delete _)
+ (do io.monad
+ [?verdict (os::remove [path])]
+ (wrap (if (case ?verdict
+ (#.Some verdict)
+ verdict
+
+ #.None
+ false)
+ (#try.Success [])
+ (exception.throw ..cannot_delete_file path)))))))
+ ))
+
+ (`` (structure: (directory path)
+ (-> Path (Directory IO))
+
+ (def: scope
+ (..can_see
+ (function (_ _)
+ path)))
+
+ (~~ (template [<name>]
+ [(def: <name>
+ (..can_query
+ (function (_ _)
+ (let [[_ short] (name_of <name>)]
+ (\ io.monad wrap (exception.throw ..invalid_operation [(name_of ..File) short]))))))]
+
+ [files]
+ [directories]
+ ))
+
+ (def: discard
+ (..can_delete
+ (function (discard _)
+ (do io.monad
+ [?verdict (os::remove [path])]
+ (wrap (if (case ?verdict
+ (#.Some verdict)
+ verdict
+
+ #.None
+ false)
+ (#try.Success [])
+ (exception.throw ..cannot_discard_directory path)))))))
+ ))
+
+ (def: (default_file path)
+ (-> Path (IO (Try (File IO))))
+ (do {! io.monad}
+ [?file (io::open [path "r"])]
+ (case ?file
+ (#try.Success file)
+ (do !
+ [closed? (LuaFile::close [] file)]
+ (wrap (if closed?
+ (#try.Success (..file path))
+ (exception.throw ..cannot_close_file [path]))))
+
+ (#try.Failure _)
+ (wrap (exception.throw ..cannot_find_file [path])))))
+
+ (def: (default_create_file path)
+ (-> Path (IO (Try (File IO))))
+ (do {! io.monad}
+ [?file (..default_file path)]
+ (case ?file
+ (#try.Failure _)
+ (do {! io.monad}
+ [?file (io::open [path "w+b"])]
+ (case ?file
+ (#.Some file)
+ (do !
+ [closed? (LuaFile::close [] file)]
+ (wrap (if closed?
+ (#try.Success (..file path))
+ (exception.throw ..cannot_close_file [path]))))
+
+ #.None
+ (wrap (exception.throw ..cannot_create_file [path]))))
+
+ (#try.Success file)
+ (wrap (exception.throw ..file_already_exists [path])))))
+
+ (`` (structure: #export default
+ (System IO)
+
+ (def: file (..can_open ..default_file))
+ (def: create_file (..can_open ..default_create_file))
+
+ (def: directory
+ (let [dummy "lux_lua_dummy_file"]
+ (..can_open
+ (function (directory path)
+ (do {! io.monad}
+ [?file (..default_create_file (format path ..default_separator dummy))]
+ (case ?file
+ (#try.Success file)
+ (do (try.with !)
+ [_ (!.use (\ file delete) [])]
+ (wrap (..directory path)))
+
+ (#try.Failure error)
+ (wrap (if (exception.match? ..file_already_exists error)
+ (#try.Success (..directory path))
+ (exception.throw ..cannot_find_directory [path])))))))))
+
+ (def: create_directory
+ (..can_open
+ (function (create_directory path)
+ (do io.monad
+ [?verdict (os::execute [(format "mkdir " path)])]
+ (wrap (case ?verdict
+ (#.Some verdict)
+ (#try.Success (..directory path))
+
+ #.None
+ (exception.throw ..cannot_create_directory [path])))))))
+
+ (def: separator
+ ..default_separator)
+ ))
+ )
}))
(template [<get> <signature> <create> <find> <exception>]
diff --git a/stdlib/source/lux/world/program.lux b/stdlib/source/lux/world/program.lux
index ca301e2ce..1d6b099ad 100644
--- a/stdlib/source/lux/world/program.lux
+++ b/stdlib/source/lux/world/program.lux
@@ -7,6 +7,7 @@
[control
["." function]
["." io (#+ IO)]
+ ["." try]
[concurrency
["." atom]
["." promise (#+ Promise)]]
@@ -178,7 +179,36 @@
(#static get [host.String] #io host.String))
(import: sys
- (#static exit [host.Integer] #io Nothing)))}
+ (#static exit [host.Integer] #io Nothing)))
+ @.lua (as_is (host.import: LuaFile
+ (read [host.String] #io #? host.String)
+ (close [] #io host.Boolean))
+
+ (host.import: io
+ (#static popen [host.String] #io #try #? LuaFile))
+
+ (import: os
+ (#static getenv [host.String] #io #? host.String)
+ (#static exit [host.Integer] #io Nothing))
+
+ (def: (run_command default command)
+ (-> Text Text (IO Text))
+ (do {! io.monad}
+ [outcome (io::popen [command])]
+ (case outcome
+ (#try.Success outcome)
+ (case outcome
+ (#.Some file)
+ (do !
+ [?output (LuaFile::read ["*l"] file)
+ _ (LuaFile::close [] file)]
+ (wrap (maybe.default default ?output)))
+
+ #.None
+ (wrap default))
+
+ (#try.Failure _)
+ (wrap default)))))}
(as_is)))
(structure: #export default
@@ -224,12 +254,13 @@
(:coerce NodeJs_OS)
(NodeJs_OS::homedir []))
<default>)
- @.python (os/path::expanduser ["~"])}
+ @.python (os/path::expanduser ["~"])
+ @.lua (..run_command "~" "echo ~")}
## TODO: Replace dummy implementation.
<default>)))
(def: (directory _)
- (with_expansions [<default> (io.io ".")
+ (with_expansions [<default> "."
<jvm> (io.io (maybe.default "" (java/lang/System::getProperty "user.dir")))]
(for {@.old <jvm>
@.jvm <jvm>
@@ -239,11 +270,17 @@
(NodeJs_Process::cwd [] process)
#.None
- <default>)
- <default>)
- @.python (os::getcwd [])}
+ (io.io <default>))
+ (io.io <default>))
+ @.python (os::getcwd [])
+ @.lua (do io.monad
+ [#let [default <default>]
+ on_windows (..run_command default "cd")]
+ (if (is? default on_windows)
+ (..run_command default "pwd")
+ (wrap on_windows)))}
## TODO: Replace dummy implementation.
- <default>)))
+ (io.io <default>))))
(def: (exit code)
(with_expansions [<jvm> (do io.monad
@@ -259,4 +296,5 @@
## else
(..default_exit! code))
- @.python (sys::exit code)}))))
+ @.python (sys::exit code)
+ @.lua (os::exit [code])}))))
diff --git a/stdlib/source/spec/compositor/generation/common.lux b/stdlib/source/spec/compositor/generation/common.lux
index a963cd7f6..baa32674a 100644
--- a/stdlib/source/spec/compositor/generation/common.lux
+++ b/stdlib/source/spec/compositor/generation/common.lux
@@ -251,11 +251,11 @@
_
false))))
(let [test-clip (: (-> (I64 Any) (I64 Any) Text Bit)
- (function (_ from to expected)
+ (function (_ offset length expected)
(|> (#synthesis.Extension "lux text clip"
(list concatenatedS
- (synthesis.i64 from)
- (synthesis.i64 to)))
+ (synthesis.i64 offset)
+ (synthesis.i64 length)))
(run (..sanitize "lux text clip"))
(case> (^multi (#try.Success valueV)
[(:coerce (Maybe Text) valueV) (#.Some valueV)])
@@ -265,7 +265,7 @@
false))))]
(_.test "Can clip text to extract sub-text."
(and (test-clip 0 sample-size sample-lower)
- (test-clip sample-size (n.* 2 sample-size) sample-upper))))
+ (test-clip sample-size sample-size sample-upper))))
(_.test "Can extract individual characters from text."
(|> (#synthesis.Extension "lux text char"
(list sample-lowerS