aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEduardo Julian2022-02-11 19:57:00 -0400
committerEduardo Julian2022-02-11 19:57:00 -0400
commit105ab334201646be6b594d3d1215297e3b629a10 (patch)
treed1f972d5fe676f8b93f4efa8fb0a8ce602878903
parent469b171e5793422a4dbd27f4f2fab8a261c9ccf9 (diff)
Fixed directive extensions for Lux/Python.
-rw-r--r--lux-python/source/program.lux406
-rw-r--r--stdlib/source/library/lux.lux103
-rw-r--r--stdlib/source/library/lux/abstract/enum.lux21
-rw-r--r--stdlib/source/library/lux/control/lazy.lux41
-rw-r--r--stdlib/source/library/lux/data/collection/array.lux11
-rw-r--r--stdlib/source/library/lux/data/collection/dictionary/ordered.lux6
-rw-r--r--stdlib/source/library/lux/data/collection/list.lux5
-rw-r--r--stdlib/source/library/lux/data/collection/sequence.lux13
-rw-r--r--stdlib/source/library/lux/data/collection/tree/finger.lux8
-rw-r--r--stdlib/source/library/lux/ffi.jvm.lux6
-rw-r--r--stdlib/source/library/lux/math/random.lux2
-rw-r--r--stdlib/source/library/lux/target/python.lux2
-rw-r--r--stdlib/source/library/lux/tool/compiler/default/platform.lux2
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/analysis.lux3
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/analysis/inference.lux80
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/analysis/type.lux93
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/complex.lux2
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux6
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux2
-rw-r--r--stdlib/source/library/lux/tool/compiler/meta/archive.lux4
-rw-r--r--stdlib/source/library/lux/tool/compiler/meta/export.lux15
-rw-r--r--stdlib/source/library/lux/tool/compiler/meta/import.lux (renamed from stdlib/source/program/compositor/import.lux)4
-rw-r--r--stdlib/source/library/lux/tool/compiler/meta/io/archive.lux2
-rw-r--r--stdlib/source/library/lux/tool/compiler/meta/io/context.lux4
-rw-r--r--stdlib/source/library/lux/type/check.lux95
-rw-r--r--stdlib/source/library/lux/world/program.lux13
-rw-r--r--stdlib/source/program/compositor.lux6
-rw-r--r--stdlib/source/specification/lux/abstract/apply.lux78
-rw-r--r--stdlib/source/test/lux/control/concatenative.lux15
-rw-r--r--stdlib/source/test/lux/control/concurrency/frp.lux58
-rw-r--r--stdlib/source/test/lux/control/maybe.lux3
-rw-r--r--stdlib/source/test/lux/extension.lux4
-rw-r--r--stdlib/source/test/lux/tool.lux4
-rw-r--r--stdlib/source/test/lux/tool/compiler/language/lux/analysis/inference.lux40
-rw-r--r--stdlib/source/test/lux/tool/compiler/language/lux/analysis/type.lux28
-rw-r--r--stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/function.lux113
-rw-r--r--stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/reference.lux4
-rw-r--r--stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/simple.lux24
-rw-r--r--stdlib/source/test/lux/tool/compiler/meta/export.lux10
-rw-r--r--stdlib/source/test/lux/tool/compiler/meta/import.lux158
-rw-r--r--stdlib/source/test/lux/type/check.lux4
41 files changed, 937 insertions, 561 deletions
diff --git a/lux-python/source/program.lux b/lux-python/source/program.lux
index 8fb761f0f..1ae02bb2e 100644
--- a/lux-python/source/program.lux
+++ b/lux-python/source/program.lux
@@ -1,75 +1,82 @@
(.using
- [library
- [lux "*"
- [program {"+" program:}]
- ["[0]" ffi {"+" import:}]
- [abstract
- [monad {"+" do}]]
- [control
- [pipe {"+" new>}]
- ["[0]" maybe]
- ["[0]" try {"+" Try}]
- ["[0]" exception {"+" exception:}]
- ["[0]" io {"+" IO io}]
- ["[0]" function]
- [concurrency
- ["[0]" async {"+" Async}]]]
- [data
- ["[0]" text ("[1]#[0]" hash)
- ["%" format {"+" format}]
- [encoding
- ["[0]" utf8]]]
- [collection
- ["[0]" array {"+" Array}]
- ["[0]" list]]]
- [macro
- ["[0]" template]]
- [math
- [number
- ["n" nat]
- ["[0]" i64]]]
- ["[0]" world "_"
- ["[0]" file]
- ["[1]/[0]" program]]
- ["@" target
- ["_" python]]
- [tool
- [compiler
- ["[0]" phase {"+" Operation Phase}]
- [reference
- [variable {"+" Register}]]
- [language
- [lux
- [program {"+" Program}]
- [generation {"+" Context Host}]
- ["[0]" synthesis]
- [analysis
- [macro {"+" Expander}]]
- [phase
- ["[0]" extension {"+" Extender Handler}
- ["[1]/[0]" bundle]
- ["[0]" analysis "_"
- ["[1]" python]]
- ["[0]" generation "_"
- ["[1]" python]]]
- [generation
- ["[0]" reference]
- ["[0]" python
- ["[0]" runtime]]]]]]
- [default
- ["[0]" platform {"+" Platform}]]
- [meta
- [archive {"+" Archive}]
- ["[0]" packager "_"
- ["[1]" script]]]]]]]
- [program
- ["/" compositor
- ["/[0]" cli]
- ["/[0]" static]]])
+ [library
+ [lux "*"
+ [program {"+" program:}]
+ ["[0]" ffi {"+" import:}]
+ ["[0]" debug]
+ ["[0]" static]
+ [abstract
+ ["[0]" monad {"+" do}]]
+ [control
+ [pipe {"+" new>}]
+ ["[0]" maybe]
+ ["[0]" try {"+" Try} ("[1]#[0]" monad)]
+ ["[0]" exception {"+" exception:}]
+ ["[0]" io {"+" IO io}]
+ ["[0]" function]
+ [concurrency
+ ["[0]" async {"+" Async}]]]
+ [data
+ ["[0]" text ("[1]#[0]" hash)
+ ["%" format {"+" format}]
+ [encoding
+ ["[0]" utf8]]]
+ [collection
+ ["[0]" array {"+" Array}]
+ ["[0]" list ("[1]#[0]" functor)]]]
+ ["[0]" macro
+ ["[0]" template]
+ ["[0]" code]]
+ [math
+ [number
+ ["n" nat]
+ ["[0]" i64]]]
+ ["[0]" world "_"
+ ["[0]" file]
+ ["[1]/[0]" program]]
+ ["@" target
+ ["_" python]]
+ [tool
+ [compiler
+ ["[0]" phase {"+" Operation Phase} ("[1]#[0]" monad)]
+ [reference
+ [variable {"+" Register}]]
+ [language
+ [lux
+ [program {"+" Program}]
+ [generation {"+" Host}]
+ ["[0]" synthesis]
+ [analysis
+ [macro {"+" Expander}]]
+ [phase
+ ["[0]" extension {"+" Extender Handler}
+ ["[1]/[0]" bundle]
+ ["[0]" analysis "_"
+ ["[1]" python]]
+ ["[0]" generation "_"
+ ["[1]" python]]]
+ [generation
+ ["[0]" reference]
+ ["[0]" python
+ ["[0]" runtime]]]]]]
+ [default
+ ["[0]" platform {"+" Platform}]]
+ [meta
+ ["[0]" cli]
+ [archive {"+" Archive}
+ ["[0]" unit]]
+ ["[0]" packager "_"
+ ["[1]" script]]]]]]]
+ [program
+ ["/" compositor
+ ["/[0]" static]]])
(with_expansions [<jvm> (as_is (import: java/lang/String)
- (import: (java/lang/Class a))
+ (import: (java/lang/Class a)
+ ["[1]::[0]"
+ ("static" forName [java/lang/String] (java/lang/Class java/lang/Object))
+ (getName [] java/lang/String)])
(import: java/lang/Object
["[1]::[0]"
@@ -78,12 +85,21 @@
(getClass [] (java/lang/Class java/lang/Object))])
(import: org/python/core/PyNone)
- (import: org/python/core/PyBoolean)
(import: org/python/core/PyInteger)
- (import: org/python/core/PyLong)
- (import: org/python/core/PyFloat)
(import: org/python/core/PyTuple)
(import: org/python/core/PyList)
+
+ (import: org/python/core/PyBoolean
+ ["[1]::[0]"
+ (new [boolean])])
+
+ (import: org/python/core/PyLong
+ ["[1]::[0]"
+ (new [long])])
+
+ (import: org/python/core/PyFloat
+ ["[1]::[0]"
+ (new [double])])
(import: org/python/core/PyString
["[1]::[0]"
@@ -173,6 +189,13 @@
_
(exception.except ..unknown_kind_of_object [(:as java/lang/Object host_object)])))
+ (ffi.interface: LuxValue
+ (value [] java/lang/Object))
+
+ (import: LuxValue
+ ["[1]::[0]"
+ (value [] java/lang/Object)])
+
(def: (read host_object)
Translator
(`` (<| (~~ (template [<class> <processing>]
@@ -182,6 +205,7 @@
_)]
+ [LuxValue [LuxValue::value]]
[org/python/core/PyNone [(new> [] [])]]
[org/python/core/PyBoolean [org/python/core/PyObject::__nonzero__]]
... [org/python/core/PyInteger [(ffi.:as org/python/core/PyObject) org/python/core/PyObject::asInt]]
@@ -209,28 +233,112 @@
... (exception.except ..unknown_kind_of_object [(:as java/lang/Object host_object)])
{try.#Success host_object})))
- (exception: (cannot_apply_a_non_function [object java/lang/Object])
- (exception.report
- ["Non-function" (java/lang/Object::toString object)]))
+ (def: (function/? arity)
+ (-> Nat Code)
+ (` (.-> (~+ (list.repeated arity (` .Any))) .Any)))
- (def: (ensure_macro macro)
- (-> Macro (Maybe org/python/core/PyFunction))
- (ffi.check org/python/core/PyFunction (:as java/lang/Object macro)))
+ (def: (inputs/? arity)
+ (-> Nat (List Text))
+ (|> (list.indices arity)
+ (list#each (|>> %.nat (format "input/")))))
+
+ (def: (pseudo_function to_host it)
+ (-> (-> Any org/python/core/PyObject) Any org/python/core/PyObject)
+ (<| (:as org/python/core/PyObject)
+ (ffi.object [] org/python/core/PyObject [LuxValue]
+ []
+ ... Methods
+ (LuxValue [] (value self []) java/lang/Object (:as java/lang/Object it))
+
+ (org/python/core/PyObject
+ [] (__call__ self [inputs [org/python/core/PyObject]
+ keywords [java/lang/String]])
+ org/python/core/PyObject
+ (try.trusted
+ (do [! try.monad]
+ [inputs (monad.each ! ..read (array.list {.#None} inputs))]
+ (in (loop [it it
+ inputs inputs]
+ (`` (`` (case inputs
+ (^ (list))
+ (:as org/python/core/PyObject self)
+
+ (~~ (template [<arity>]
+ [(^ (list (~~ (static.literals code.local_symbol (inputs/? <arity>)))))
+ (to_host ((:as (~~ (static.literal function.identity (function/? <arity>))) it)
+ (~~ (static.literals code.local_symbol (inputs/? <arity>)))))]
+
+ [1]
+ [2]
+ [3]
+ [4]
+ [5]
+ [6]
+ [7]
+ [8]))
+
+ (^ (list& (~~ (static.literals code.local_symbol (inputs/? 8)))
+ input/+))
+ (again ((:as (~~ (static.literal function.identity (function/? 8))) it)
+ (~~ (static.literals code.local_symbol (inputs/? 8))))
+ input/+))))))))))))
(def: object_class
(java/lang/Class java/lang/Object)
(java/lang/Object::getClass (java/lang/Object::new)))
- (def: to_host
+ (import: library/lux/Function)
+
+ (def: (to_host|array to_host it)
+ (-> (-> Any org/python/core/PyObject) Any org/python/core/PyObject)
+ (:as org/python/core/PyObject
+ (ffi.object [] org/python/core/PyArray [LuxValue]
+ [(java/lang/Class java/lang/Object) ..object_class
+ java/lang/Object (:as java/lang/Object it)]
+ ... Methods
+ (LuxValue [] (value self []) java/lang/Object (:as java/lang/Object it))
+
+ (org/python/core/PyArray
+ [] (pyget self [index' int])
+ org/python/core/PyObject
+ (case (|> it
+ (:as (Array Any))
+ (array.read! (|> index' ffi.int_to_long (:as Nat))))
+ {.#None}
+ (::super! [index'])
+
+ {.#Some it}
+ (<| (case (ffi.check [java/lang/Object] (:as java/lang/Object it))
+ {.#Some it}
+ (to_host it)
+
+ {.#None})
+ (case (ffi.check library/lux/Function (:as java/lang/Object it))
+ {.#Some it}
+ (pseudo_function to_host it)
+
+ {.#None})
+ (::super! [index']))))
+ )))
+
+ (def: (to_host it)
(-> Any org/python/core/PyObject)
- (|>> (:as java/lang/Object)
- (org/python/core/PyArray::new ..object_class)
- (:as org/python/core/PyObject)))
-
- (def: ensure_function
- (-> Any (Maybe org/python/core/PyFunction))
- (|>> (:as java/lang/Object)
- (ffi.check org/python/core/PyFunction)))
+ (`` (<| (~~ (template [<jvm> <python>]
+ [(case (ffi.check <jvm> (:as java/lang/Object it))
+ {.#Some it}
+ (:as org/python/core/PyObject
+ (<python> [(:expected it)]))
+
+ {.#None})]
+
+ [java/lang/Boolean org/python/core/PyBoolean::new]
+ [java/lang/Long org/python/core/PyLong::new]
+ [java/lang/Double org/python/core/PyFloat::new]
+ [java/lang/String org/python/core/PyString::new]
+ [library/lux/Function (pseudo_function to_host)]
+ [[java/lang/Object] (to_host|array to_host)]
+ ))
+ (:as org/python/core/PyObject it))))
)]
(for [@.old (as_is <jvm>)
@.jvm (as_is <jvm>)
@@ -238,17 +346,27 @@
(with_expansions [<jvm> (as_is (def: (call_macro inputs lux macro)
(-> (List Code) Lux org/python/core/PyFunction (Try (Try [Lux (List Code)])))
- (:expected
- (do try.monad
- [expansion (org/python/core/PyFunction::__call__ (|> (ffi.array org/python/core/PyObject 2)
- (ffi.write! 0 (..to_host inputs))
- (ffi.write! 1 (..to_host lux)))
- macro)]
- (..read expansion))))
+ (|> macro
+ (org/python/core/PyFunction::__call__ (|> (ffi.array org/python/core/PyObject 2)
+ (ffi.write! 0 (..to_host inputs))
+ (ffi.write! 1 (..to_host lux))))
+ (try#each ..read)
+ try#conjoint
+ :expected))
+
+ (def: python_function!
+ (-> Any (Maybe org/python/core/PyFunction))
+ (|>> (:as java/lang/Object)
+ (ffi.check org/python/core/PyFunction)))
+
+ (exception: (cannot_apply_a_non_function [object java/lang/Object])
+ (exception.report
+ ["Object" (java/lang/Object::toString object)]
+ ["Class" (java/lang/Class::getName (java/lang/Object::getClass object))]))
(def: (expander macro inputs lux)
Expander
- (case (ensure_macro macro)
+ (case (python_function! macro)
{.#Some macro}
(case (..call_macro inputs lux macro)
{try.#Success output}
@@ -273,7 +391,7 @@
(with_expansions [<jvm> (def: host
(IO (Host (_.Expression Any) (_.Statement Any)))
(io (let [interpreter (org/python/util/PythonInterpreter::new)
- evaluate! (: (-> Context (_.Expression Any) (Try Any))
+ evaluate! (: (-> unit.ID (_.Expression Any) (Try Any))
(function (evaluate! context input)
(do try.monad
[output (org/python/util/PythonInterpreter::eval (_.code input) interpreter)]
@@ -326,13 +444,13 @@
(IO (Host (_.Expression Any) (_.Statement Any)))
(io (: (Host (_.Expression Any) (_.Statement Any))
(let [globals (..dict [])
- evaluate! (: (-> Context (_.Expression Any) (Try Any))
+ evaluate! (: (-> unit.ID (_.Expression Any) (Try Any))
(function (evaluate! context input)
(..eval [(_.code input) globals])))
execute! (: (-> (_.Statement Any) (Try Any))
(function (execute! input)
(ffi.try ("python exec" (_.code input) globals))))
- define! (: (-> Context (_.Expression Any) (Try [Text Any (_.Statement Any)]))
+ define! (: (-> unit.ID (_.Expression Any) (Try [Text Any (_.Statement Any)]))
(function (define! context input)
(let [global (reference.artifact context)
@global (_.var global)]
@@ -357,84 +475,7 @@
[_ (execute! content)]
(evaluate! context (_.var (reference.artifact context)))))))))))]))
-(with_expansions [<jvm> (as_is (exception: .public (invaid_phase_application [partial_application (List Any)
- arity Nat])
- (exception.report
- ["Partial Application" (%.nat (list.size partial_application))]
- ["Arity" (%.nat arity)]))
-
- (def: (host_phase partial_application phase)
- (All (_ s i o)
- (-> (List Any) (Phase [extension.Bundle s] i o)
- org/python/core/PyObject))
- (<| (:as org/python/core/PyObject)
- (ffi.object [] org/python/core/PyObject []
- []
- ... Methods
- (org/python/core/PyObject
- [] (__call__ self [inputs [org/python/core/PyObject]
- keywords [java/lang/String]])
- org/python/core/PyObject
- (try.trusted
- (case (array.list {.#None} inputs)
- (^ (list))
- (# try.monad in (host_phase (list) phase))
-
- (^ (list input/0))
- (do try.monad
- [input/0 (..read input/0)]
- (case partial_application
- (^ (list partial/0 partial/1))
- (in (..to_host ((:as (-> Any Any Any Any) phase)
- partial/0
- partial/1
- input/0)))
-
- (^ (list partial/0))
- (in (host_phase (list partial/0 input/0) phase))
-
- (^ (list))
- (in (host_phase (list input/0) phase))
-
- _
- (exception.except ..invaid_phase_application [partial_application (array.size inputs)])))
-
- (^ (list input/0 input/1))
- (do try.monad
- [input/0 (..read input/0)
- input/1 (..read input/1)]
- (case partial_application
- (^ (list partial/0))
- (in (..to_host ((:as (-> Any Any Any Any) phase)
- partial/0
- input/0
- input/1)))
-
- (^ (list))
- (in (host_phase (list input/0 input/1) phase))
-
- _
- (exception.except ..invaid_phase_application [partial_application (array.size inputs)])))
-
- (^ (list input/0 input/1 input/2))
- (do try.monad
- [input/0 (..read input/0)
- input/1 (..read input/1)
- input/2 (..read input/2)]
- (case partial_application
- (^ (list))
- (in (..to_host ((:as (-> Any Any Any Any) phase)
- input/0
- input/1
- input/2)))
-
- _
- (exception.except ..invaid_phase_application [partial_application (array.size inputs)])))
-
- _
- (exception.except ..invaid_phase_application [partial_application (array.size inputs)])))))))
-
- (def: (extender phase_wrapper)
+(with_expansions [<jvm> (as_is (def: (extender phase_wrapper)
(-> phase.Wrapper Extender)
... TODO: Stop relying on coercions ASAP.
(<| (:as Extender)
@@ -449,7 +490,7 @@
try.trusted
(:as Try)
(do try.monad
- [handler (try.of_maybe (..ensure_function handler))
+ [handler (try.of_maybe (..python_function! handler))
output (org/python/core/PyFunction::__call__ (|> (ffi.array org/python/core/PyObject 5)
(ffi.write! 0 (:as org/python/core/PyObject (org/python/core/PyString::new name)))
(ffi.write! 1 (:as org/python/core/PyObject (phase_wrapper phase)))
@@ -468,10 +509,9 @@
(def: (phase_wrapper archive)
(-> Archive (runtime.Operation phase.Wrapper))
- (do phase.monad
- []
- (in (:as phase.Wrapper
- (..host_phase (list))))))
+ (|> (..pseudo_function ..to_host)
+ (:as phase.Wrapper)
+ phase#in))
(def: platform
(IO (Platform Register (_.Expression Any) (_.Statement Any)))
@@ -514,13 +554,13 @@
(; (_.apply/* @program (list)))
))))
-(program: [service /cli.service]
+(program: [service cli.service]
(let [extension ".py"]
(exec
(do async.monad
[_ (/.compiler [/static.#host @.python
/static.#host_module_extension extension
- /static.#target (/cli.target service)
+ /static.#target (cli.target service)
/static.#artifact_extension extension]
..expander
analysis.bundle
@@ -537,7 +577,7 @@
_.code
_.then
..scope)
- (format (/cli.target service)
+ (format (cli.target service)
(# file.default separator)
"program"
extension)])]
diff --git a/stdlib/source/library/lux.lux b/stdlib/source/library/lux.lux
index 7ddfa427f..75575ebe4 100644
--- a/stdlib/source/library/lux.lux
+++ b/stdlib/source/library/lux.lux
@@ -3718,13 +3718,6 @@
cases)]
output))
-(def: (on_either f x1 x2)
- (All (_ a b)
- (-> (-> a (Maybe b)) a a (Maybe b)))
- (case (f x1)
- {#None} (f x2)
- {#Some y} {#Some y}))
-
(def: (in_env name state)
(-> Text Lux (Maybe Type))
(case state
@@ -3738,14 +3731,13 @@
[..#name _
..#inner _
..#locals [..#counter _ ..#mappings locals]
- ..#captured [..#counter _ ..#mappings closure]]
- (on_either (list#one (: (-> [Text [Type Any]] (Maybe Type))
- (function (_ [bname [type _]])
- (if (text#= name bname)
- {#Some type}
- {#None}))))
- (: (List [Text [Type Any]]) locals)
- (: (List [Text [Type Any]]) closure)))))
+ ..#captured _]
+ (list#one (: (-> [Text [Type Any]] (Maybe Type))
+ (function (_ [bname [type _]])
+ (if (text#= name bname)
+ {#Some type}
+ {#None})))
+ locals))))
scopes)))
(def: (definition_type name state)
@@ -3839,24 +3831,25 @@
[.let [[module name] full_name]
current_module current_module_name]
(function (_ compiler)
- (let [temp (if (text#= "" module)
- (case (in_env name compiler)
- {#Some struct_type}
- {#Right [compiler struct_type]}
+ (let [temp (: (Either Text [Lux Type])
+ (if (text#= "" module)
+ (case (in_env name compiler)
+ {#Some struct_type}
+ {#Right [compiler struct_type]}
- _
- (case (definition_type [current_module name] compiler)
- {#Some struct_type}
- {#Right [compiler struct_type]}
+ _
+ (case (definition_type [current_module name] compiler)
+ {#Some struct_type}
+ {#Right [compiler struct_type]}
- _
- {#Left ($_ text#composite "Unknown var: " (symbol#encoded full_name))}))
- (case (definition_type full_name compiler)
- {#Some struct_type}
- {#Right [compiler struct_type]}
+ _
+ {#Left ($_ text#composite "Unknown var: " (symbol#encoded full_name))}))
+ (case (definition_type full_name compiler)
+ {#Some struct_type}
+ {#Right [compiler struct_type]}
- _
- {#Left ($_ text#composite "Unknown var: " (symbol#encoded full_name))}))]
+ _
+ {#Left ($_ text#composite "Unknown var: " (symbol#encoded full_name))})))]
(case temp
{#Right [compiler {#Var type_id}]}
(let [[..#info _ ..#source _ ..#current_module _ ..#modules _
@@ -4708,30 +4701,6 @@
_
(failure (..wrong_syntax_error [..prelude_module "symbol"]))))
-(def: (scope_type_vars state)
- (Meta (List Nat))
- (case state
- [..#info info ..#source source ..#current_module _ ..#modules modules
- ..#scopes scopes ..#type_context types ..#host host
- ..#seed seed ..#expected expected ..#location location ..#extensions extensions
- ..#scope_type_vars scope_type_vars ..#eval _eval]
- {#Right [state scope_type_vars]}))
-
-(macro: .public (:parameter tokens)
- (case tokens
- (^ (list [_ {#Nat idx}]))
- (do meta_monad
- [stvs ..scope_type_vars]
- (case (..item idx (list#reversed stvs))
- {#Some var_id}
- (in (list (` {.#Ex (~ (nat$ var_id))})))
-
- {#None}
- (failure (text#composite "Indexed-type does not exist: " (nat#encoded idx)))))
-
- _
- (failure (..wrong_syntax_error (symbol ..$)))))
-
(def: .public (same? reference sample)
(All (_ a)
(-> a a Bit))
@@ -4927,6 +4896,32 @@
_
(failure (..wrong_syntax_error (symbol ..for))))))
+... TODO: Delete "scope_type_vars" (including the #scope_type_vars Lux state) and ":parameter" ASAP.
+(for ["{old}" (as_is (def: (scope_type_vars state)
+ (Meta (List Nat))
+ (case state
+ [..#info info ..#source source ..#current_module _ ..#modules modules
+ ..#scopes scopes ..#type_context types ..#host host
+ ..#seed seed ..#expected expected ..#location location ..#extensions extensions
+ ..#scope_type_vars scope_type_vars ..#eval _eval]
+ {#Right [state scope_type_vars]}))
+
+ (macro: .public (:parameter tokens)
+ (case tokens
+ (^ (list [_ {#Nat idx}]))
+ (do meta_monad
+ [stvs ..scope_type_vars]
+ (case (..item idx (list#reversed stvs))
+ {#Some var_id}
+ (in (list (` {.#Ex (~ (nat$ var_id))})))
+
+ {#None}
+ (failure (text#composite "Indexed-type does not exist: " (nat#encoded idx)))))
+
+ _
+ (failure (..wrong_syntax_error (symbol ..$))))))]
+ (as_is))
+
(macro: .public (using _imports)
(do meta_monad
[current_module ..current_module_name
diff --git a/stdlib/source/library/lux/abstract/enum.lux b/stdlib/source/library/lux/abstract/enum.lux
index 45026abc1..f136fc92d 100644
--- a/stdlib/source/library/lux/abstract/enum.lux
+++ b/stdlib/source/library/lux/abstract/enum.lux
@@ -1,8 +1,8 @@
(.using
- [library
- [lux "*"]]
- [//
- ["[0]" order {"+" Order}]])
+ [library
+ [lux "*"]]
+ [//
+ ["[0]" order {"+" Order}]])
(type: .public (Enum e)
(Interface
@@ -12,14 +12,15 @@
(def: .public (range enum from to)
(All (_ a) (-> (Enum a) a a (List a)))
- (let [(^open "[0]") enum]
+ (let [(^open "/#[0]") enum]
(loop [end to
- output {.#End}]
- (cond (< end from)
- (again (pred end) {.#Item end output})
+ output (`` (: (List (~~ (:of from)))
+ {.#End}))]
+ (cond (/#< end from)
+ (again (/#pred end) {.#Item end output})
- (< from end)
- (again (succ end) {.#Item end output})
+ (/#< from end)
+ (again (/#succ end) {.#Item end output})
... (= end from)
{.#Item end output}))))
diff --git a/stdlib/source/library/lux/control/lazy.lux b/stdlib/source/library/lux/control/lazy.lux
index 9e59da7dc..8d3c877d8 100644
--- a/stdlib/source/library/lux/control/lazy.lux
+++ b/stdlib/source/library/lux/control/lazy.lux
@@ -1,28 +1,33 @@
(.using
- [library
- [lux "*"
- [abstract
- [functor {"+" Functor}]
- [apply {"+" Apply}]
- [monad {"+" Monad do}]
- [equivalence {"+" Equivalence}]]
- [control
- ["[0]" io]
- [parser
- ["<[0]>" code]]
- [concurrency
- ["[0]" atom]]]
- [macro {"+" with_symbols}
- [syntax {"+" syntax:}]]
- [type
- abstract]]])
+ [library
+ [lux "*"
+ [abstract
+ [functor {"+" Functor}]
+ [apply {"+" Apply}]
+ [monad {"+" Monad do}]
+ [equivalence {"+" Equivalence}]]
+ [control
+ ["[0]" io]
+ [parser
+ ["<[0]>" code]]
+ [concurrency
+ ["[0]" atom]]]
+ [macro {"+" with_symbols}
+ [syntax {"+" syntax:}]]
+ [type {"+" :sharing}
+ abstract]]])
(abstract: .public (Lazy a)
(-> [] a)
(def: (lazy' generator)
(All (_ a) (-> (-> [] a) (Lazy a)))
- (let [cache (atom.atom {.#None})]
+ (let [cache (atom.atom (:sharing [a]
+ (-> [] a)
+ generator
+
+ (Maybe a)
+ {.#None}))]
(:abstraction (function (_ _)
(case (io.run! (atom.read! cache))
{.#Some value}
diff --git a/stdlib/source/library/lux/data/collection/array.lux b/stdlib/source/library/lux/data/collection/array.lux
index ea16cddfc..437c80bfa 100644
--- a/stdlib/source/library/lux/data/collection/array.lux
+++ b/stdlib/source/library/lux/data/collection/array.lux
@@ -275,10 +275,10 @@
Nat
(-- 0))
-(def: (list|-default array)
- (All (_ a) (-> (Array a) (List a)))
+(def: (list|-default array empty)
+ (All (_ a) (-> (Array a) (List a) (List a)))
(loop [idx (-- (size array))
- output {.#End}]
+ output empty]
(case idx
(^ (static ..underflow))
output
@@ -295,7 +295,8 @@
(def: (list|+default default array)
(All (_ a) (-> a (Array a) (List a)))
(loop [idx (-- (size array))
- output {.#End}]
+ output (`` (: (List (~~ (:of default)))
+ {.#End}))]
(case idx
(^ (static ..underflow))
output
@@ -312,7 +313,7 @@
(list|+default default array)
{.#None}
- (list|-default array)))
+ (list|-default array {.#End})))
(implementation: .public (equivalence (^open ",#[0]"))
(All (_ a) (-> (Equivalence a) (Equivalence (Array a))))
diff --git a/stdlib/source/library/lux/data/collection/dictionary/ordered.lux b/stdlib/source/library/lux/data/collection/dictionary/ordered.lux
index 083ad161c..7437962f6 100644
--- a/stdlib/source/library/lux/data/collection/dictionary/ordered.lux
+++ b/stdlib/source/library/lux/data/collection/dictionary/ordered.lux
@@ -475,9 +475,6 @@
(let [(^open "_#[0]") (value@ #&order dict)
[?root found?] (loop [?root (value@ #root dict)]
(case ?root
- {.#None}
- [{.#None} #0]
-
{.#Some root}
(let [root_key (value@ #key root)
root_val (value@ #value root)]
@@ -514,6 +511,9 @@
#0])
)))
))
+
+ {.#None}
+ [{.#None} #0]
))]
(case ?root
{.#None}
diff --git a/stdlib/source/library/lux/data/collection/list.lux b/stdlib/source/library/lux/data/collection/list.lux
index 28f4d3db7..e5130f985 100644
--- a/stdlib/source/library/lux/data/collection/list.lux
+++ b/stdlib/source/library/lux/data/collection/list.lux
@@ -382,7 +382,10 @@
(if (< x x')
[{.#Item x' pre} post]
[pre {.#Item x' post}]))
- [(list) (list)]
+ (`` [(: (~~ (:of xs))
+ (list))
+ (: (~~ (:of xs))
+ (list))])
xs')]
($_ composite (sorted < pre) (list x) (sorted < post)))))
diff --git a/stdlib/source/library/lux/data/collection/sequence.lux b/stdlib/source/library/lux/data/collection/sequence.lux
index 07ebeba76..746654c57 100644
--- a/stdlib/source/library/lux/data/collection/sequence.lux
+++ b/stdlib/source/library/lux/data/collection/sequence.lux
@@ -224,10 +224,8 @@
... If so, a brand-new root must be established, that is
... 1-level taller.
(|> sequence
- (with@ #root (|> (for [@.old
- (: (Hierarchy (:parameter 0))
- (empty_hierarchy []))]
- (empty_hierarchy []))
+ (with@ #root (|> (`` (: (Hierarchy (~~ (:of val)))
+ (empty_hierarchy [])))
(array.write! 0 {#Hierarchy (value@ #root sequence)})
(array.write! 1 (..path (value@ #level sequence) (value@ #tail sequence)))))
(revised@ #level level_up))
@@ -293,10 +291,9 @@
{try.#Success (if (n.< (tail_off sequence_size) idx)
(revised@ #root (hierarchy#has (value@ #level sequence) idx val)
sequence)
- (revised@ #tail (for [@.old
- (: (-> (Base (:parameter 0)) (Base (:parameter 0)))
- (|>> array.clone (array.write! (branch_idx idx) val)))]
- (|>> array.clone (array.write! (branch_idx idx) val)))
+ (revised@ #tail (`` (: (-> (Base (~~ (:of val)))
+ (Base (~~ (:of val))))
+ (|>> array.clone (array.write! (branch_idx idx) val))))
sequence))}
(exception.except ..index_out_of_bounds [sequence idx]))))
diff --git a/stdlib/source/library/lux/data/collection/tree/finger.lux b/stdlib/source/library/lux/data/collection/tree/finger.lux
index 270623c6e..7c8a244b1 100644
--- a/stdlib/source/library/lux/data/collection/tree/finger.lux
+++ b/stdlib/source/library/lux/data/collection/tree/finger.lux
@@ -15,8 +15,8 @@
(Record
[#monoid (Monoid t)
#tag t
- #root (Or v
- [(Tree @ t v) (Tree @ t v)])])
+ #root (Either v
+ [(Tree @ t v) (Tree @ t v)])])
(type: .public (Builder @ t)
(Interface
@@ -45,13 +45,13 @@
(:abstraction
[#monoid monoid
#tag tag
- #root {0 #0 value}]))
+ #root {.#Left value}]))
(def: (branch left right)
(:abstraction
[#monoid monoid
#tag (# monoid composite (..tag left) (..tag right))
- #root {0 #1 [left right]}])))
+ #root {.#Right [left right]}])))
(def: .public (value tree)
(All (_ @ t v) (-> (Tree @ t v) v))
diff --git a/stdlib/source/library/lux/ffi.jvm.lux b/stdlib/source/library/lux/ffi.jvm.lux
index 59d2b2374..46ffa8021 100644
--- a/stdlib/source/library/lux/ffi.jvm.lux
+++ b/stdlib/source/library/lux/ffi.jvm.lux
@@ -1258,9 +1258,9 @@
(syntax: .public (??? [expr <code>.any])
(with_symbols [g!temp]
(in (list (` (let [(~ g!temp) (~ expr)]
- (if ("jvm object null?" (~ g!temp))
- {.#None}
- {.#Some (~ g!temp)})))))))
+ (if (not ("jvm object null?" (~ g!temp)))
+ {.#Some (~ g!temp)}
+ {.#None})))))))
(syntax: .public (!!! [expr <code>.any])
(with_symbols [g!value]
diff --git a/stdlib/source/library/lux/math/random.lux b/stdlib/source/library/lux/math/random.lux
index 469a17226..1b3a9426a 100644
--- a/stdlib/source/library/lux/math/random.lux
+++ b/stdlib/source/library/lux/math/random.lux
@@ -352,7 +352,7 @@
(let [magic 6364136223846793005]
(function (_ _)
[(|> seed .nat (n.* magic) ("lux i64 +" increase) [increase] pcg_32)
- (let [rot (|> seed .i64 (i64.right_shifted 59))]
+ (let [rot (|> seed .nat (i64.right_shifted 59))]
(|> seed
(i64.right_shifted 18)
(i64.xor seed)
diff --git a/stdlib/source/library/lux/target/python.lux b/stdlib/source/library/lux/target/python.lux
index 87864e062..dc1b5e935 100644
--- a/stdlib/source/library/lux/target/python.lux
+++ b/stdlib/source/library/lux/target/python.lux
@@ -450,7 +450,7 @@
(def: .public (comment commentary on)
(All (_ brand) (-> Text (Code brand) (Code brand)))
- (:abstraction (format "# " (..safe commentary) \n+
+ (:abstraction (format "# " (text.replaced text.\n "\n" commentary) \n+
(:representation on))))
)
diff --git a/stdlib/source/library/lux/tool/compiler/default/platform.lux b/stdlib/source/library/lux/tool/compiler/default/platform.lux
index ef79450e9..f13ffecd2 100644
--- a/stdlib/source/library/lux/tool/compiler/default/platform.lux
+++ b/stdlib/source/library/lux/tool/compiler/default/platform.lux
@@ -51,6 +51,7 @@
[phase
["[0]" extension {"+" Extender}]]]]
[meta
+ [import {"+" Import}]
[cli {"+" Compilation Library}
["[0]" compiler {"+" Compiler}]]
["[0]" archive {"+" Output Archive}
@@ -64,7 +65,6 @@
["ioW" archive]]]]]
[program
[compositor
- [import {"+" Import}]
["[0]" static {"+" Static}]]])
(with_expansions [<type_vars> (as_is anchor expression directive)
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/analysis.lux b/stdlib/source/library/lux/tool/compiler/language/lux/analysis.lux
index 2d231f1cc..65b191979 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/analysis.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/analysis.lux
@@ -159,7 +159,8 @@
(def: .public (reification analysis)
(-> Analysis (Reification Analysis))
(loop [abstraction analysis
- inputs (list)]
+ inputs (: (List Analysis)
+ (list))]
(.case abstraction
{#Apply input next}
(again next {.#Item input inputs})
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/analysis/inference.lux b/stdlib/source/library/lux/tool/compiler/language/lux/analysis/inference.lux
index 1b693629a..6ca7137d2 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/analysis/inference.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/analysis/inference.lux
@@ -3,7 +3,7 @@
[lux "*"
["[0]" meta]
[abstract
- [monad {"+" do}]]
+ ["[0]" monad {"+" do}]]
[control
[pipe {"+" case>}]
["[0]" maybe]
@@ -53,25 +53,6 @@
[invalid_type_application]
)
-(def: prefix
- (format (%.symbol (symbol ..type)) "#"))
-
-(def: .public (existential? type)
- (-> Type Bit)
- (case type
- {.#Primitive actual {.#End}}
- (text.starts_with? ..prefix actual)
-
- _
- false))
-
-(def: existential
- (Operation Type)
- (do phase.monad
- [module (extension.lifted meta.current_module_name)
- [id _] (/type.check check.existential)]
- (in {.#Primitive (format ..prefix module "#" (%.nat id)) (list)})))
-
(def: .public (quantified @var @parameter :it:)
(-> check.Var Nat Type Type)
(case :it:
@@ -111,33 +92,34 @@
... tagged variants).
... But, so long as the type being used for the inference can be treated
... as a function type, this method of inference should work.
-(def: .public (general archive analyse inferT args)
- (-> Archive Phase Type (List Code) (Operation [Type (List Analysis)]))
+(def: (general' vars archive analyse inferT args)
+ (-> (List check.Var) Archive Phase Type (List Code) (Operation [Type_Context (List check.Var) Type (List Analysis)]))
(case args
{.#End}
(do phase.monad
- [_ (/type.inference inferT)]
- (in [inferT (list)]))
+ [just_before (/type.check check.context)
+ _ (/type.inference inferT)]
+ (in [just_before vars inferT (list)]))
{.#Item argC args'}
(case inferT
{.#Named name unnamedT}
- (general archive analyse unnamedT args)
+ (general' vars archive analyse unnamedT args)
{.#UnivQ _}
(do phase.monad
[[@var :var:] (/type.check check.var)]
- (general archive analyse (maybe.trusted (type.applied (list :var:) inferT)) args))
+ (general' (list& @var vars) archive analyse (maybe.trusted (type.applied (list :var:) inferT)) args))
{.#ExQ _}
(do phase.monad
- [:ex: ..existential]
- (general archive analyse (maybe.trusted (type.applied (list :ex:) inferT)) args))
+ [:ex: /type.existential]
+ (general' vars archive analyse (maybe.trusted (type.applied (list :ex:) inferT)) args))
{.#Apply inputT transT}
(case (type.applied (list inputT) transT)
{.#Some outputT}
- (general archive analyse outputT args)
+ (general' vars archive analyse outputT args)
{.#None}
(/.except ..invalid_type_application [inferT]))
@@ -151,18 +133,18 @@
... things together more easily.
{.#Function inputT outputT}
(do phase.monad
- [[outputT' args'A] (general archive analyse outputT args')
+ [[just_before vars outputT' args'A] (general' vars archive analyse outputT args')
argA (<| (/.with_exception ..cannot_infer_argument [inputT argC])
(/type.expecting inputT)
(analyse archive argC))]
- (in [outputT' (list& argA args'A)]))
+ (in [just_before vars outputT' (list& argA args'A)]))
{.#Var infer_id}
(do phase.monad
[?inferT' (/type.check (check.peek infer_id))]
(case ?inferT'
{.#Some inferT'}
- (general archive analyse inferT' args)
+ (general' vars archive analyse inferT' args)
_
(/.except ..cannot_infer [inferT args])))
@@ -171,6 +153,40 @@
(/.except ..cannot_infer [inferT args]))
))
+(def: .public (general archive analyse inferT args)
+ (-> Archive Phase Type (List Code) (Operation [Type (List Analysis)]))
+ (do [! phase.monad]
+ [[just_before vars :inference: terms] (general' (list) archive analyse inferT args)]
+ (in [:inference: terms])
+ ... (case vars
+ ... (^ (list))
+ ... (in [:inference: terms])
+
+ ... _
+ ... (do !
+ ... [:inference: (/type.check
+ ... (do [! check.monad]
+ ... [quantifications (monad.mix ! (function (_ @var level)
+ ... (do !
+ ... [:var: (check.try (check.identity vars @var))]
+ ... (case :var:
+ ... {try.#Success _}
+ ... (in level)
+
+ ... {try.#Failure _}
+ ... (do !
+ ... [.let [:var: (|> level (n.* 2) ++ {.#Parameter})]
+ ... _ (check.bind :var: @var)]
+ ... (in (++ level))))))
+ ... 0
+ ... vars)
+ ... :inference:' (# ! each (type.univ_q quantifications) (check.clean vars :inference:))
+ ... _ (check.with just_before)]
+ ... (in :inference:')))
+ ... _ (/type.inference :inference:)]
+ ... (in [:inference: terms])))
+ ))
+
(def: (with_recursion @self recursion)
(-> Nat Type Type Type)
(function (again it)
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/analysis/type.lux b/stdlib/source/library/lux/tool/compiler/language/lux/analysis/type.lux
index c066115ec..bd2c04844 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/analysis/type.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/analysis/type.lux
@@ -3,10 +3,18 @@
[lux "*"
["[0]" meta]
[abstract
- [monad {"+" do}]]
+ ["[0]" monad {"+" do}]]
[control
["[0]" function]
["[0]" try]]
+ [data
+ ["[0]" text
+ ["%" format {"+" format}]]
+ [collection
+ ["[0]" list]]]
+ [math
+ [number
+ ["n" nat]]]
[type
["[0]" check {"+" Check}]]]]
["/" // {"+" Operation}
@@ -16,11 +24,6 @@
[///
["[0]" phase]]]])
-(def: .public (expecting expected)
- (All (_ a) (-> Type (Operation a) (Operation a)))
- (extension.localized (value@ .#expected) (with@ .#expected)
- (function.constant {.#Some expected})))
-
(def: .public (check action)
(All (_ a) (-> (Check a) (Operation a)))
(function (_ (^@ stateE [bundle state]))
@@ -32,6 +35,34 @@
{try.#Failure error}
((/.failure error) stateE))))
+(def: prefix
+ (format (%.symbol (symbol ..type)) "#"))
+
+(def: .public (existential? type)
+ (-> Type Bit)
+ (case type
+ {.#Primitive actual {.#End}}
+ (text.starts_with? ..prefix actual)
+
+ _
+ false))
+
+(def: (existential' module id)
+ (-> Text Nat Type)
+ {.#Primitive (format ..prefix module "#" (%.nat id)) (list)})
+
+(def: .public existential
+ (Operation Type)
+ (do phase.monad
+ [module (extension.lifted meta.current_module_name)
+ [id _] (..check check.existential)]
+ (in (..existential' module id))))
+
+(def: .public (expecting expected)
+ (All (_ a) (-> Type (Operation a) (Operation a)))
+ (extension.localized (value@ .#expected) (with@ .#expected)
+ (function.constant {.#Some expected})))
+
(def: .public fresh
(All (_ a) (-> (Operation a) (Operation a)))
(extension.localized (value@ .#type_context) (with@ .#type_context)
@@ -40,8 +71,44 @@
(def: .public (inference actualT)
(-> Type (Operation Any))
(do phase.monad
- [expectedT (extension.lifted meta.expected_type)]
- (..check (check.check expectedT actualT))))
+ [module (extension.lifted meta.current_module_name)
+ expectedT (extension.lifted meta.expected_type)]
+ (..check (check.check expectedT actualT)
+ ... (do [! check.monad]
+ ... [pre check.context
+ ... it (check.check expectedT actualT)
+ ... post check.context
+ ... .let [pre#var_counter (value@ .#var_counter pre)]]
+ ... (if (n.< (value@ .#var_counter post)
+ ... pre#var_counter)
+ ... (do !
+ ... [.let [new! (: (-> [Nat (Maybe Type)] (Maybe Nat))
+ ... (function (_ [id _])
+ ... (if (n.< id pre#var_counter)
+ ... {.#Some id}
+ ... {.#None})))
+ ... new_vars (|> post
+ ... (value@ .#var_bindings)
+ ... (list.all new!))]
+ ... _ (monad.each ! (function (_ @new)
+ ... (do !
+ ... [:new: (check.try (check.identity new_vars @new))]
+ ... (case :new:
+ ... {try.#Success :new:}
+ ... (in :new:)
+
+ ... {try.#Failure error}
+ ... (do !
+ ... [[id _] check.existential
+ ... .let [:new: (..existential' module id)]
+ ... _ (check.bind :new: @new)]
+ ... (in :new:)))))
+ ... new_vars)
+ ... expectedT' (check.clean new_vars expectedT)
+ ... _ (check.with pre)]
+ ... (check.check expectedT' actualT))
+ ... (in it)))
+ )))
(def: .public (with_var it)
(All (_ a) (-> (-> [check.Var Type] (Operation a))
@@ -50,7 +117,8 @@
[var (..check check.var)
.let [[@it :it:] var]
it (it var)
- _ (..check (check.forget! @it))]
+ ... _ (..check (check.forget! @it))
+ ]
(in it)))
(def: .public (inferring action)
@@ -58,5 +126,10 @@
(do phase.monad
[[@it :it:] (..check check.var)
it (..expecting :it: action)
- :it: (..check (check.clean :it:))]
+ :it: (..check (check.clean (list) :it:))
+ ... :it: (..check (do check.monad
+ ... [:it: (check.identity (list) @it)
+ ... _ (check.forget! @it)]
+ ... (in :it:)))
+ ]
(in [:it: it])))
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/complex.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/complex.lux
index 726860314..cce7b1f00 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/complex.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/complex.lux
@@ -105,7 +105,7 @@
(function (again valueC)
(do [! ///.monad]
[expectedT (///extension.lifted meta.expected_type)
- expectedT' (/type.check (check.clean expectedT))]
+ expectedT' (/type.check (check.clean (list) expectedT))]
(/.with_exception ..cannot_analyse_variant [expectedT' lefts right? valueC]
(case expectedT
{.#Sum _}
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux
index a7d889777..2338824c4 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux
@@ -461,7 +461,7 @@
[var_id varT] (typeA.check check.var)
arrayA (<| (typeA.expecting (.type (array.Array varT)))
(analyse archive arrayC))
- varT (typeA.check (check.clean varT))
+ varT (typeA.check (check.clean (list) varT))
arrayJT (jvm_array_type (.type (array.Array varT)))]
(in {/////analysis.#Extension extension_name (list (/////analysis.text (..signature arrayJT))
arrayA)}))
@@ -667,7 +667,7 @@
_ (typeA.inference varT)
arrayA (<| (typeA.expecting (.type (array.Array varT)))
(analyse archive arrayC))
- varT (typeA.check (check.clean varT))
+ varT (typeA.check (check.clean (list) varT))
arrayJT (jvm_array_type (.type (array.Array varT)))
idxA (<| (typeA.expecting ..int)
(analyse archive idxC))]
@@ -710,7 +710,7 @@
_ (typeA.inference (.type (array.Array varT)))
arrayA (<| (typeA.expecting (.type (array.Array varT)))
(analyse archive arrayC))
- varT (typeA.check (check.clean varT))
+ varT (typeA.check (check.clean (list) varT))
arrayJT (jvm_array_type (.type (array.Array varT)))
idxA (<| (typeA.expecting ..int)
(analyse archive idxC))
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux
index 04006e52f..e159172b2 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux
@@ -146,7 +146,7 @@
(do !
[[code//type codeA] (typeA.inferring
(analyse archive codeC))
- code//type (typeA.check (check.clean code//type))]
+ code//type (typeA.check (check.clean (list) code//type))]
(in [code//type codeA]))
{.#Some expected}
diff --git a/stdlib/source/library/lux/tool/compiler/meta/archive.lux b/stdlib/source/library/lux/tool/compiler/meta/archive.lux
index d8347d9fd..4ec08ed90 100644
--- a/stdlib/source/library/lux/tool/compiler/meta/archive.lux
+++ b/stdlib/source/library/lux/tool/compiler/meta/archive.lux
@@ -108,7 +108,7 @@
{try.#Success [/#next
(|> archive
:representation
- (revised@ #resolver (dictionary.has module [/#next {.#None}]))
+ (revised@ #resolver (dictionary.has module [/#next (: (Maybe (Entry Any)) {.#None})]))
(revised@ #next ++)
:abstraction)]})))
@@ -261,7 +261,7 @@
(in (:abstraction
[#next next
#resolver (list#mix (function (_ [module id] archive)
- (dictionary.has module [id {.#None}] archive))
+ (dictionary.has module [id (: (Maybe (Entry Any)) {.#None})] archive))
(value@ #resolver (:representation ..empty))
reservations)]))))
)
diff --git a/stdlib/source/library/lux/tool/compiler/meta/export.lux b/stdlib/source/library/lux/tool/compiler/meta/export.lux
index 79c5a2a44..9b21de75b 100644
--- a/stdlib/source/library/lux/tool/compiler/meta/export.lux
+++ b/stdlib/source/library/lux/tool/compiler/meta/export.lux
@@ -30,7 +30,13 @@
(def: .public file
"library.tar")
-(def: commons
+(def: .public mode
+ ($_ tar.and
+ tar.read_by_owner tar.write_by_owner
+ tar.read_by_group tar.write_by_group
+ tar.read_by_other))
+
+(def: .public ownership
tar.Ownership
(let [commons (: tar.Owner
[tar.#name tar.anonymous
@@ -51,11 +57,8 @@
tar.path)]
(try#each (|>> [path
(instant.of_millis +0)
- ($_ tar.and
- tar.read_by_owner tar.write_by_owner
- tar.read_by_group tar.write_by_group
- tar.read_by_other)
- ..commons]
+ ..mode
+ ..ownership]
{tar.#Normal})
(tar.content source_code)))))
(try#each sequence.of_list)))
diff --git a/stdlib/source/program/compositor/import.lux b/stdlib/source/library/lux/tool/compiler/meta/import.lux
index 7f21f20ec..d3a356c43 100644
--- a/stdlib/source/program/compositor/import.lux
+++ b/stdlib/source/library/lux/tool/compiler/meta/import.lux
@@ -7,13 +7,13 @@
["[0]" try {"+" Try}]
["[0]" exception {"+" exception:}]
[concurrency
- ["[0]" async {"+" Async} ("[1]#[0]" monad)]]
+ ["[0]" async {"+" Async}]]
["<>" parser
["<[0]>" binary]]]
[data
[binary {"+" Binary}]
["[0]" text
- ["%" format {"+" format}]]
+ ["%" format]]
[collection
["[0]" dictionary {"+" Dictionary}]
["[0]" sequence]]
diff --git a/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux b/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux
index 63cae0681..b9b99208f 100644
--- a/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux
+++ b/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux
@@ -30,11 +30,11 @@
["[0]" file]]]]
[program
[compositor
- [import {"+" Import}]
["[0]" static {"+" Static}]]]
["[0]" // {"+" Context}
["[1][0]" context]
["/[1]" //
+ [import {"+" Import}]
["[0]" archive {"+" Output Archive}
["[0]" registry {"+" Registry}]
["[0]" unit]
diff --git a/stdlib/source/library/lux/tool/compiler/meta/io/context.lux b/stdlib/source/library/lux/tool/compiler/meta/io/context.lux
index 2f99ddce1..d576571eb 100644
--- a/stdlib/source/library/lux/tool/compiler/meta/io/context.lux
+++ b/stdlib/source/library/lux/tool/compiler/meta/io/context.lux
@@ -22,11 +22,9 @@
["[0]" list]]]
[world
["[0]" file]]]]
- [program
- [compositor
- [import {"+" Import}]]]
["[0]" // {"+" Context Code}
["/[1]" // "_"
+ [import {"+" Import}]
["/[1]" // {"+" Input}]
[archive
[module
diff --git a/stdlib/source/library/lux/type/check.lux b/stdlib/source/library/lux/type/check.lux
index 31ec9da05..984456187 100644
--- a/stdlib/source/library/lux/type/check.lux
+++ b/stdlib/source/library/lux/type/check.lux
@@ -299,10 +299,7 @@
_
(except ..invalid_type_application [funcT argT]))))
-(type: Ring
- (Set Var))
-
-(def: (ring' start)
+(def: .public (ring' start)
(-> Var (Check (List Var)))
(function (_ context)
(loop [current start
@@ -326,7 +323,7 @@
... TODO: Optimize this by not using sets anymore.
(def: ring
- (-> Var (Check Ring))
+ (-> Var (Check (Set Var)))
(|>> ..ring'
(check#each (set.of_list n.hash))))
@@ -336,15 +333,7 @@
(set.member? it @1))
(..ring @0)))
-(exception: (invalid_alias [var Var
- expected (List Var)
- actual (List Var)])
- (exception.report
- ["Var" (n#encoded var)]
- ["Expected" (exception.listing n#encoded expected)]
- ["Actual" (exception.listing n#encoded actual)]))
-
-(exception: (cannot_identify [var Var])
+(exception: .public (cannot_identify [var Var])
(exception.report
["Var" (n#encoded var)]))
@@ -358,18 +347,18 @@
{.#None}
(do !
- [existing_aliases (..ring @)
- _ (if (list.every? (set.member? existing_aliases) aliases)
- (in [])
- (..except ..invalid_alias [@ aliases (set.list existing_aliases)]))
- .let [forbidden_aliases (set.of_list n.hash (list& @ aliases))
- allowed_aliases (set.difference forbidden_aliases existing_aliases)]]
- (case (set.list allowed_aliases)
- {.#Item identity _}
- (in {.#Var identity})
-
- {.#None}
- (..except ..cannot_identify [@]))))))
+ [existing_aliases (..ring @)]
+ (if (n.< 2 (set.size existing_aliases))
+ (..except ..cannot_identify [@])
+ (do !
+ [.let [forbidden_aliases (set.of_list n.hash (list& @ aliases))
+ allowed_aliases (set.difference forbidden_aliases existing_aliases)]]
+ (case (set.list allowed_aliases)
+ {.#Item identity _}
+ (in {.#Var identity})
+
+ {.#None}
+ (..except ..cannot_identify [@]))))))))
(def: (erase! @)
(-> Var (Check Any))
@@ -639,7 +628,7 @@
_
..silent_failure!)))
-(def: (with exception parameter check)
+(def: (with_exception exception parameter check)
(All (_ e a) (-> (Exception e) e (Check a) (Check a)))
(|>> check
(exception.with exception parameter)))
@@ -652,7 +641,7 @@
@.php false]
(same? expected actual))
(check#in assumptions)
- (with ..type_check_failed [expected actual]
+ (with_exception ..type_check_failed [expected actual]
(case [expected actual]
[{.#Var idE} {.#Var idA}]
(check_vars check' assumptions idE idA)
@@ -774,12 +763,17 @@
(function (_ context)
{try.#Success [context context]}))
-(def: .public (clean inputT)
- (-> Type (Check Type))
+(def: .public (with context)
+ (-> Type_Context (Check Any))
+ (function (_ _)
+ {try.#Success [context []]}))
+
+(def: .public (clean aliases inputT)
+ (-> (List Var) Type (Check Type))
(case inputT
{.#Primitive name paramsT+}
(|> paramsT+
- (monad.each ..monad clean)
+ (monad.each ..monad (clean aliases))
(check#each (|>> {.#Primitive name})))
(^or {.#Parameter _} {.#Ex _} {.#Named _})
@@ -788,26 +782,43 @@
(^template [<tag>]
[{<tag> leftT rightT}
(do ..monad
- [leftT' (clean leftT)]
- (|> (clean rightT)
+ [leftT' (clean aliases leftT)]
+ (|> (clean aliases rightT)
(check#each (|>> {<tag> leftT'}))))])
([.#Sum] [.#Product] [.#Function] [.#Apply])
{.#Var @}
- (do ..monad
- [?actualT (peek @)]
- (case ?actualT
- {.#Some actualT}
- (clean actualT)
+ (case aliases
+ (^ (list))
+ (do ..monad
+ [?actualT (peek @)]
+ (case ?actualT
+ {.#Some actualT}
+ (clean aliases actualT)
- _
- (in inputT)))
+ _
+ (in inputT)))
+
+ _
+ (do ..monad
+ [:it: (..try (..identity aliases @))]
+ (case :it:
+ {try.#Success :it:}
+ (case :it:
+ {.#Var _}
+ (in inputT)
+
+ _
+ (clean aliases :it:))
+
+ failure
+ (in inputT))))
(^template [<tag>]
[{<tag> envT+ unquantifiedT}
(do [! ..monad]
- [envT+' (monad.each ! clean envT+)
- unquantifiedT' (clean unquantifiedT)]
+ [envT+' (monad.each ! (clean aliases) envT+)
+ unquantifiedT' (clean aliases unquantifiedT)]
(in {<tag> envT+' unquantifiedT'}))])
([.#UnivQ] [.#ExQ])
))
diff --git a/stdlib/source/library/lux/world/program.lux b/stdlib/source/library/lux/world/program.lux
index 950f19206..5fdc9cc21 100644
--- a/stdlib/source/library/lux/world/program.lux
+++ b/stdlib/source/library/lux/world/program.lux
@@ -306,10 +306,11 @@
(Program IO)
(def: (available_variables _)
- (with_expansions [<jvm> (io.io (|> (java/lang/System::getenv)
- java/util/Map::keySet
- java/util/Set::iterator
- ..jvm##consume))]
+ (with_expansions [<jvm> (|> (java/lang/System::getenv)
+ java/util/Map::keySet
+ java/util/Set::iterator
+ ..jvm##consume
+ io.io)]
(for [@.old <jvm>
@.jvm <jvm>
@.js (io.io (if ffi.on_node_js?
@@ -325,9 +326,7 @@
@.python (# io.monad each (array.list {.#None}) (os/environ::keys []))
... Lua offers no way to get all the environment variables available.
@.lua (io.io (list))
- @.ruby (|> (RubyEnv::keys [])
- (array.list {.#None})
- io.io)
+ @.ruby (io.io (array.list {.#None} (RubyEnv::keys [])))
... @.php (do io.monad
... [environment (..getenv/0 [])]
... (in (|> environment
diff --git a/stdlib/source/program/compositor.lux b/stdlib/source/program/compositor.lux
index 55da4161b..4e0599859 100644
--- a/stdlib/source/program/compositor.lux
+++ b/stdlib/source/program/compositor.lux
@@ -42,6 +42,7 @@
[meta
[packager {"+" Packager}]
["[0]" cli {"+" Service}]
+ ["[0]" import]
["[0]" export]
[archive {"+" Archive}
["[0]" unit]
@@ -52,8 +53,7 @@
... ["[0]" interpreter]
]]]
["[0]" / "_"
- ["[1][0]" static {"+" Static}]
- ["[1][0]" import]])
+ ["[1][0]" static {"+" Static}]])
(def: (or_crash! failure_description action)
(All (_ a)
@@ -153,7 +153,7 @@
..timed
(do (try.with async.monad)
[.let [[compilation_host_dependencies compilation_libraries compilation_compilers compilation_sources compilation_target compilation_module] compilation]
- import (/import.import (value@ platform.#&file_system platform) compilation_libraries)
+ import (import.import (value@ platform.#&file_system platform) compilation_libraries)
[state archive phase_wrapper] (:sharing [<parameters>]
(Platform <parameters>)
platform
diff --git a/stdlib/source/specification/lux/abstract/apply.lux b/stdlib/source/specification/lux/abstract/apply.lux
index 867a7b76f..3d01a1217 100644
--- a/stdlib/source/specification/lux/abstract/apply.lux
+++ b/stdlib/source/specification/lux/abstract/apply.lux
@@ -1,65 +1,69 @@
(.using
- [library
- [lux "*"
- ["_" test {"+" Test}]
- [abstract
- [monad {"+" do}]]
- [control
- ["[0]" function]]
- [math
- ["[0]" random]
- [number
- ["n" nat]]]]]
- [\\library
- ["[0]" / {"+" Apply}]]
- [//
- [functor {"+" Injection Comparison}]])
+ [library
+ [lux "*"
+ ["_" test {"+" Test}]
+ [abstract
+ [monad {"+" do}]]
+ [control
+ ["[0]" function]]
+ [math
+ ["[0]" random {"+" Random}]
+ [number
+ ["n" nat]]]]]
+ [\\library
+ ["[0]" / {"+" Apply}]]
+ [//
+ [functor {"+" Injection Comparison}]])
-(def: (identity injection comparison (^open "#[0]"))
+(def: (identity injection comparison (^open "/#[0]"))
(All (_ f) (-> (Injection f) (Comparison f) (Apply f) Test))
(do [! random.monad]
[sample (# ! each injection random.nat)]
(_.test "Identity."
((comparison n.=)
- (#on sample (injection function.identity))
+ (/#on sample (injection function.identity))
sample))))
-(def: (homomorphism injection comparison (^open "#[0]"))
+(def: (homomorphism injection comparison (^open "/#[0]"))
(All (_ f) (-> (Injection f) (Comparison f) (Apply f) Test))
(do [! random.monad]
[sample random.nat
increase (# ! each n.+ random.nat)]
(_.test "Homomorphism."
((comparison n.=)
- (#on (injection sample) (injection increase))
+ (/#on (injection sample) (injection increase))
(injection (increase sample))))))
-(def: (interchange injection comparison (^open "#[0]"))
+(def: (interchange injection comparison (^open "/#[0]"))
(All (_ f) (-> (Injection f) (Comparison f) (Apply f) Test))
(do [! random.monad]
[sample random.nat
increase (# ! each n.+ random.nat)]
(_.test "Interchange."
((comparison n.=)
- (#on (injection sample) (injection increase))
- (#on (injection increase) (injection (: (-> (-> Nat Nat) Nat)
- (function (_ f) (f sample)))))))))
+ (/#on (injection sample) (injection increase))
+ (/#on (injection increase) (injection (: (-> (-> Nat Nat) Nat)
+ (function (_ f) (f sample)))))))))
-(def: (composition injection comparison (^open "#[0]"))
+(def: (composition injection comparison (^open "/#[0]"))
(All (_ f) (-> (Injection f) (Comparison f) (Apply f) Test))
- (do [! random.monad]
- [sample random.nat
- increase (# ! each n.+ random.nat)
- decrease (# ! each n.- random.nat)]
- (_.test "Composition."
- ((comparison n.=)
- (|> (injection function.composite)
- (#on (injection increase))
- (#on (injection decrease))
- (#on (injection sample)))
- (#on (#on (injection sample)
- (injection increase))
- (injection decrease))))))
+ (:let [:$/1: (-> Nat Nat)]
+ (do [! random.monad]
+ [sample random.nat
+ increase (: (Random :$/1:)
+ (# ! each n.+ random.nat))
+ decrease (: (Random :$/1:)
+ (# ! each n.- random.nat))]
+ (_.test "Composition."
+ ((comparison n.=)
+ (|> (injection (: (-> :$/1: :$/1: :$/1:)
+ function.composite))
+ (/#on (injection increase))
+ (/#on (injection decrease))
+ (/#on (injection sample)))
+ (/#on (/#on (injection sample)
+ (injection increase))
+ (injection decrease)))))))
(def: .public (spec injection comparison apply)
(All (_ f) (-> (Injection f) (Comparison f) (Apply f) Test))
diff --git a/stdlib/source/test/lux/control/concatenative.lux b/stdlib/source/test/lux/control/concatenative.lux
index 00b421f97..85a1f4ac8 100644
--- a/stdlib/source/test/lux/control/concatenative.lux
+++ b/stdlib/source/test/lux/control/concatenative.lux
@@ -141,8 +141,10 @@
sample random.nat
start random.nat
.let [distance 10
- |++| (/.apply/1 ++)
- |test| (/.apply/1 (|>> (n.- start) (n.< distance)))]]
+ |++| (: (/.=> [Nat] [Nat])
+ (/.apply/1 ++))
+ |test| (: (/.=> [Nat] [Bit])
+ (/.apply/1 (|>> (n.- start) (n.< distance))))]]
($_ _.and
(_.cover [/.call /.apply/1]
(n.= (++ sample)
@@ -244,18 +246,21 @@
(_.cover [/.loop]
(n.= (n.+ distance start)
(||> (/.push start)
- (/.push (|>> |++| /.dup |test|))
+ (/.push (: (/.=> [Nat] [Nat Bit])
+ (|>> |++| /.dup |test|)))
/.loop)))
(_.cover [/.while]
(n.= (n.+ distance start)
(||> (/.push start)
- (/.push (|>> /.dup |test|))
+ (/.push (: (/.=> [Nat] [Nat Bit])
+ (|>> /.dup |test|)))
(/.push |++|)
/.while)))
(_.cover [/.do]
(n.= (++ sample)
(||> (/.push sample)
- (/.push (|>> (/.push false)))
+ (/.push (: (/.=> [] [Bit])
+ (|>> (/.push false))))
(/.push |++|)
/.do /.while)))
(_.cover [/.compose]
diff --git a/stdlib/source/test/lux/control/concurrency/frp.lux b/stdlib/source/test/lux/control/concurrency/frp.lux
index 466f1c61f..7b564d904 100644
--- a/stdlib/source/test/lux/control/concurrency/frp.lux
+++ b/stdlib/source/test/lux/control/concurrency/frp.lux
@@ -1,30 +1,30 @@
(.using
- [library
- [lux "*"
- ["_" test {"+" Test}]
- [abstract
- [monad {"+" do}]
- [\\specification
- ["$[0]" functor {"+" Injection Comparison}]
- ["$[0]" apply]
- ["$[0]" monad]]]
- [control
- ["[0]" try]
- ["[0]" exception]
- ["[0]" io {"+" IO io}]]
- [data
- [collection
- ["[0]" list ("[1]#[0]" mix monoid)]
- ["[0]" sequence {"+" Sequence}]]]
- [math
- ["[0]" random]
- [number
- ["n" nat]]]]]
- [\\library
- ["[0]" /
- [//
- ["[0]" async {"+" Async} ("[1]#[0]" monad)]
- ["[0]" atom {"+" Atom atom}]]]])
+ [library
+ [lux "*"
+ ["_" test {"+" Test}]
+ [abstract
+ [monad {"+" do}]
+ [\\specification
+ ["$[0]" functor {"+" Injection Comparison}]
+ ["$[0]" apply]
+ ["$[0]" monad]]]
+ [control
+ ["[0]" try]
+ ["[0]" exception]
+ ["[0]" io {"+" IO io}]]
+ [data
+ [collection
+ ["[0]" list ("[1]#[0]" mix monoid)]
+ ["[0]" sequence {"+" Sequence}]]]
+ [math
+ ["[0]" random]
+ [number
+ ["n" nat]]]]]
+ [\\library
+ ["[0]" /
+ [//
+ ["[0]" async {"+" Async} ("[1]#[0]" monad)]
+ ["[0]" atom {"+" Atom atom}]]]])
(def: injection
(Injection /.Channel)
@@ -86,7 +86,8 @@
(_.cover [/.Channel /.Sink /.channel]
(case (io.run!
(do (try.with io.monad)
- [.let [[channel sink] (/.channel [])]
+ [.let [[channel sink] (: [(/.Channel Nat) (/.Sink Nat)]
+ (/.channel []))]
_ (# sink feed sample)
_ (# sink close)]
(in channel)))
@@ -106,7 +107,8 @@
(_.cover [/.channel_is_already_closed]
(case (io.run!
(do (try.with io.monad)
- [.let [[channel sink] (/.channel [])]
+ [.let [[channel sink] (: [(/.Channel Nat) (/.Sink Nat)]
+ (/.channel []))]
_ (# sink close)]
(# sink feed sample)))
{try.#Success _}
diff --git a/stdlib/source/test/lux/control/maybe.lux b/stdlib/source/test/lux/control/maybe.lux
index a798c19aa..fe8528548 100644
--- a/stdlib/source/test/lux/control/maybe.lux
+++ b/stdlib/source/test/lux/control/maybe.lux
@@ -65,7 +65,8 @@
value random.nat]
(_.cover [/.else]
(and (same? default (/.else default
- {.#None}))
+ (: (Maybe Nat)
+ {.#None})))
(same? value (/.else default
{.#Some value})))))
diff --git a/stdlib/source/test/lux/extension.lux b/stdlib/source/test/lux/extension.lux
index 4c923924b..85b98df02 100644
--- a/stdlib/source/test/lux/extension.lux
+++ b/stdlib/source/test/lux/extension.lux
@@ -185,9 +185,7 @@
(in directive.no_requirements)))
(for [... TODO: No longer skip testing Lua after Rembulan isn't being used anymore.
- @.lua (as_is)
- ... TODO: No longer skip testing Python.
- @.python (as_is)]
+ @.lua (as_is)]
(`` ((~~ (static ..directive)) (n.* 2 3))))
))
diff --git a/stdlib/source/test/lux/tool.lux b/stdlib/source/test/lux/tool.lux
index c9a5cfb7c..8c154b3a0 100644
--- a/stdlib/source/test/lux/tool.lux
+++ b/stdlib/source/test/lux/tool.lux
@@ -24,7 +24,8 @@
["[1][0]" meta "_"
["[1]/[0]" archive]
["[1]/[0]" cli]
- ["[1]/[0]" export]]
+ ["[1]/[0]" export]
+ ["[1]/[0]" import]]
]])
(def: .public test
@@ -38,6 +39,7 @@
/meta/archive.test
/meta/cli.test
/meta/export.test
+ /meta/import.test
/phase/extension.test
/phase/analysis/simple.test
/phase/analysis/complex.test
diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/analysis/inference.lux b/stdlib/source/test/lux/tool/compiler/language/lux/analysis/inference.lux
index 97bdb7a54..3eec3a5b4 100644
--- a/stdlib/source/test/lux/tool/compiler/language/lux/analysis/inference.lux
+++ b/stdlib/source/test/lux/tool/compiler/language/lux/analysis/inference.lux
@@ -108,6 +108,8 @@
(_.cover [/.general]
(and (|> (/.general archive.empty ..analysis expected (list))
(//type.expecting expected)
+ (//module.with 0 (product.left name))
+ (/phase#each product.right)
(/phase.result state)
(try#each (|>> product.left (type#= expected)))
(try.else false))
@@ -115,6 +117,8 @@
(type.function (list.repeated arity .Nat) expected)
(list#each code.nat nats))
(//type.expecting expected)
+ (//module.with 0 (product.left name))
+ (/phase#each product.right)
(/phase.result state)
(try#each (function (_ [actual analysis/*])
(and (type#= expected actual)
@@ -126,6 +130,8 @@
(type (-> type/0 expected))
(list term/0))
(//type.expecting expected)
+ (//module.with 0 (product.left name))
+ (/phase#each product.right)
(/phase.result state)
(try#each (|>> product.left (type#= expected)))
(try.else false))
@@ -133,6 +139,8 @@
(type {.#Named name (-> type/0 expected)})
(list term/0))
(//type.expecting expected)
+ (//module.with 0 (product.left name))
+ (/phase#each product.right)
(/phase.result state)
(try#each (|>> product.left (type#= expected)))
(try.else false))
@@ -140,7 +148,9 @@
(type (All (_ a) (-> a a)))
(list term/0))
(//type.expecting type/0)
- (/phase#each (|>> product.left check.clean //type.check))
+ (//module.with 0 (product.left name))
+ (/phase#each product.right)
+ (/phase#each (|>> product.left (check.clean (list)) //type.check))
/phase#conjoint
(/phase.result state)
(try#each (type#= type/0))
@@ -149,6 +159,8 @@
(type ((All (_ a) (-> a a)) type/0))
(list term/0))
(//type.expecting type/0)
+ (//module.with 0 (product.left name))
+ (/phase#each product.right)
(/phase.result state)
(try#each (|>> product.left (type#= type/0)))
(try.else false))
@@ -157,11 +169,23 @@
_ (//type.check (check.check varT (type (-> type/0 expected))))]
(/.general archive.empty ..analysis varT (list term/0)))
(//type.expecting expected)
- (/phase#each (|>> product.left check.clean //type.check))
+ (//module.with 0 (product.left name))
+ (/phase#each product.right)
+ (/phase#each (|>> product.left (check.clean (list)) //type.check))
/phase#conjoint
(/phase.result state)
(try#each (type#= expected))
(try.else false))
+ (|> (/.general archive.empty ..analysis
+ (type (Ex (_ a) (-> a a)))
+ (list (` ("lux io error" ""))))
+ //type.inferring
+ (//module.with 0 (product.left name))
+ (/phase#each (|>> product.right product.left (check.clean (list)) //type.check))
+ /phase#conjoint
+ (/phase.result state)
+ (try#each //type.existential?)
+ (try.else false))
))
(_.cover [/.cannot_infer]
(and (|> (/.general archive.empty ..analysis expected (list term/0))
@@ -179,19 +203,9 @@
(type (-> expected expected))
(list term/0))
(//type.expecting expected)
- (/phase.result state)
- (..fails? /.cannot_infer_argument)))
- (_.cover [/.existential?]
- (|> (/.general archive.empty ..analysis
- (type (Ex (_ a) (-> a a)))
- (list (` ("lux io error" ""))))
- //type.inferring
(//module.with 0 (product.left name))
- (/phase#each (|>> product.right product.left check.clean //type.check))
- /phase#conjoint
(/phase.result state)
- (try#each /.existential?)
- (try.else false)))
+ (..fails? /.cannot_infer_argument)))
)))
(def: test|variant
diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/analysis/type.lux b/stdlib/source/test/lux/tool/compiler/language/lux/analysis/type.lux
index 2e63f1bc8..867ef7e5a 100644
--- a/stdlib/source/test/lux/tool/compiler/language/lux/analysis/type.lux
+++ b/stdlib/source/test/lux/tool/compiler/language/lux/analysis/type.lux
@@ -16,11 +16,12 @@
[\\library
["[0]" /
["/[1]" //
+ ["[2][0]" module]
[//
[phase
["[2][0]" extension]]
[///
- ["[2][0]" phase]]]]]])
+ ["[2][0]" phase ("[1]#[0]" functor)]]]]]])
(def: .public random_state
(Random Lux)
@@ -44,27 +45,36 @@
/extension.#state lux]]
expected ..primitive
dummy (random.only (|>> (type#= expected) not)
- ..primitive)]
+ ..primitive)
+ module (random.ascii/lower 1)]
($_ _.and
(_.cover [/.expecting /.inference]
(and (|> (/.inference expected)
(/.expecting expected)
+ (/module.with 0 module)
+ (/phase#each product.right)
(/phase.result state)
(case> {try.#Success _} true
{try.#Failure _} false))
(|> (/.inference dummy)
(/.expecting expected)
+ (/module.with 0 module)
+ (/phase#each product.right)
(/phase.result state)
(case> {try.#Success _} false
{try.#Failure _} true))
(|> (/.inference expected)
(/.expecting dummy)
+ (/module.with 0 module)
+ (/phase#each product.right)
(/phase.result state)
(case> {try.#Success _} false
{try.#Failure _} true))))
(_.cover [/.inferring]
(|> (/.inference expected)
/.inferring
+ (/module.with 0 module)
+ (/phase#each product.right)
(/phase.result state)
(try#each (|>> product.left (type#= expected)))
(try.else false)))
@@ -75,9 +85,19 @@
(in type)))]
(|> (/.inference exT)
(/.expecting exT)))
+ (/module.with 0 module)
+ (/phase#each product.right)
(/phase.result state)
(case> {try.#Success _} true
{try.#Failure _} false)))
+ (_.cover [/.existential /.existential?]
+ (|> (do /phase.monad
+ [:it: /.existential]
+ (in (/.existential? :it:)))
+ (/module.with 0 module)
+ (/phase#each product.right)
+ (/phase.result state)
+ (try.else false)))
(_.cover [/.fresh]
(and (|> (do /phase.monad
[varT (/.check (do check.monad
@@ -85,6 +105,8 @@
(in type)))]
(|> (/.inference expected)
(/.expecting varT)))
+ (/module.with 0 module)
+ (/phase#each product.right)
(/phase.result state)
(case> {try.#Success _} true
{try.#Failure _} false))
@@ -95,6 +117,8 @@
(|> (/.inference expected)
(/.expecting varT)
/.fresh))
+ (/module.with 0 module)
+ (/phase#each product.right)
(/phase.result state)
(case> {try.#Success _} false
{try.#Failure _} true))))
diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/function.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/function.lux
index 50fbc1c50..b5f2e4fc4 100644
--- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/function.lux
+++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/function.lux
@@ -195,59 +195,66 @@
(exception.otherwise (text.contains? (value@ exception.#label /.cannot_analyse)))))
)))
+(def: test|apply
+ Test
+ (do [! random.monad]
+ [lux $//type.random_state
+ .let [state [//extension.#bundle (//extension/analysis.bundle ..eval)
+ //extension.#state lux]]
+ [input/0 term/0] $//inference.simple_parameter
+ [input/1 term/1] (random.only (|>> product.left (same? input/0) not)
+ $//inference.simple_parameter)
+ output/0 ($type.random 0)
+ module/0 (random.ascii/lower 1)]
+ ($_ _.and
+ (_.cover [/.apply]
+ (let [reification? (: (-> Type (List Code) Type Bit)
+ (function (_ :abstraction: terms :expected:)
+ (|> (do //phase.monad
+ [[:actual: analysis] (|> (/.apply ..analysis terms
+ :abstraction:
+ (//analysis.unit)
+ archive.empty
+ (' []))
+ //type.inferring)]
+ (in (and (check.subsumes? :expected: :actual:)
+ (case analysis
+ {//analysis.#Apply _}
+ true
+
+ _
+ false))))
+ (//module.with 0 module/0)
+ (//phase#each product.right)
+ (//phase.result state)
+ (try.else false))))]
+ (and (reification? (-> input/0 input/1 output/0) (list term/0 term/1) output/0)
+ (reification? (-> input/0 input/1 output/0) (list term/0) (-> input/1 output/0))
+ (reification? (All (_ a) (-> a a)) (list term/0) input/0)
+ (reification? (All (_ a) (-> a a a)) (list term/0) (-> input/0 input/0))
+ (reification? (All (_ a) (-> input/0 a)) (list term/0) .Nothing)
+ (reification? (All (_ a b) (-> a b a)) (list term/0) (All (_ b) (-> b input/0)))
+ (reification? (Ex (_ a) (-> a input/0)) (list (` ("lux io error" ""))) input/0)
+ (reification? (Ex (_ a) (-> input/0 a)) (list term/0) .Any))))
+ (_.cover [/.cannot_apply]
+ (|> (do //phase.monad
+ [_ (|> (/.apply ..analysis (list term/1 term/0)
+ (-> input/0 input/1 output/0)
+ (//analysis.unit)
+ archive.empty
+ (' []))
+ (//type.expecting output/0))]
+ (in false))
+ (//module.with 0 module/0)
+ (//phase#each product.right)
+ (//phase.result state)
+ (exception.otherwise (text.contains? (value@ exception.#label /.cannot_apply)))))
+ )))
+
(def: .public test
Test
(<| (_.covering /._)
- (do [! random.monad]
- [lux $//type.random_state
- .let [state [//extension.#bundle (//extension/analysis.bundle ..eval)
- //extension.#state lux]]
- [input/0 term/0] $//inference.simple_parameter
- [input/1 term/1] $//inference.simple_parameter
- output/0 ($type.random 0)
- module/0 (random.ascii/lower 1)]
- ($_ _.and
- ..test|function
- (_.cover [/.apply]
- (let [reification? (: (-> Type (List Code) Type Bit)
- (function (_ :abstraction: terms :expected:)
- (|> (do //phase.monad
- [[:actual: analysis] (|> (/.apply ..analysis terms
- :abstraction:
- (//analysis.unit)
- archive.empty
- (' []))
- //type.inferring)]
- (in (and (check.subsumes? :expected: :actual:)
- (case analysis
- {//analysis.#Apply _}
- true
-
- _
- false))))
- (//module.with 0 module/0)
- (//phase#each product.right)
- (//phase.result state)
- (try.else false))))]
- (and (reification? (-> input/0 input/1 output/0) (list term/0 term/1) output/0)
- (reification? (-> input/0 input/1 output/0) (list term/0) (-> input/1 output/0))
- (reification? (All (_ a) (-> a a)) (list term/0) input/0)
- (reification? (All (_ a) (-> a a a)) (list term/0) (-> input/0 input/0))
- (reification? (All (_ a) (-> input/0 a)) (list term/0) .Nothing)
- (reification? (All (_ a b) (-> a b a)) (list term/0) (All (_ b) (-> b input/0)))
- (reification? (Ex (_ a) (-> a input/0)) (list (` ("lux io error" ""))) input/0)
- (reification? (Ex (_ a) (-> input/0 a)) (list term/0) .Any))))
- (_.cover [/.cannot_apply]
- (|> (do //phase.monad
- [_ (|> (/.apply ..analysis (list term/1 term/0)
- (-> input/0 input/1 output/0)
- (//analysis.unit)
- archive.empty
- (' []))
- (//type.expecting output/0))]
- (in false))
- (//module.with 0 module/0)
- (//phase#each product.right)
- (//phase.result state)
- (exception.otherwise (text.contains? (value@ exception.#label /.cannot_apply)))))
- ))))
+ ($_ _.and
+ ..test|function
+ ..test|apply
+ )))
diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/reference.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/reference.lux
index c16cbf491..af84eb488 100644
--- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/reference.lux
+++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/reference.lux
@@ -49,6 +49,8 @@
(//scope.with_local [expected_name expected_type])
//type.inferring
//scope.with
+ (//module.with 0 expected_module)
+ (//phase#each product.right)
(//phase.result state)
(try#each (|>> product.right
(case> (^ [actual_type (//analysis.local 0)])
@@ -64,6 +66,8 @@
//scope.with
(//scope.with_local [expected_name expected_type])
//scope.with
+ (//module.with 0 expected_module)
+ (//phase#each product.right)
(//phase.result state)
(try#each (|>> product.right
product.right
diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/simple.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/simple.lux
index a93b4c3e1..45c22f1ec 100644
--- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/simple.lux
+++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/simple.lux
@@ -8,6 +8,8 @@
[control
[pipe {"+" case>}]
["[0]" try]]
+ [data
+ ["[0]" product]]
[math
["[0]" random]]]]
[\\library
@@ -16,14 +18,17 @@
["[1][0]" extension]
[//
["[1][0]" analysis {"+" Analysis Operation}
- ["[2][0]" type]]
+ ["[2][0]" type]
+ ["[2][0]" module]]
[///
- ["[1][0]" phase]]]]]])
+ ["[1][0]" phase ("[1]#[0]" functor)]]]]]])
-(def: (analysis state type it ?)
- (-> Lux Type (Operation Analysis) (-> Analysis Bit) Bit)
+(def: (analysis state module type it ?)
+ (-> Lux Text Type (Operation Analysis) (-> Analysis Bit) Bit)
(and (|> it
(/type.expecting type)
+ (/module.with 0 module)
+ (/phase#each product.right)
(/phase.result [/extension.#bundle /extension.empty
/extension.#state state])
(case> (^ {try.#Success analysis})
@@ -33,6 +38,8 @@
false))
(|> it
(/type.expecting .Nothing)
+ (/module.with 0 module)
+ (/phase#each product.right)
(/phase.result [/extension.#bundle /extension.empty
/extension.#state state])
(case> (^ {try.#Failure error})
@@ -42,6 +49,8 @@
false))
(|> it
/type.inferring
+ (/module.with 0 module)
+ (/phase#each product.right)
(/phase.result [/extension.#bundle /extension.empty
/extension.#state state])
(case> (^ {try.#Success [inferred analysis]})
@@ -64,17 +73,18 @@
(<| (_.covering /._)
(do [! random.monad]
[version random.nat
- host (random.ascii/lower 5)
+ host (random.ascii/lower 1)
+ module (random.ascii/lower 2)
.let [state (/analysis.state (/analysis.info version host))]]
(`` ($_ _.and
(_.cover [/.unit]
- (..analysis state .Any /.unit
+ (..analysis state module .Any /.unit
(|>> (case> (^ (/analysis.unit)) true _ false))))
(~~ (template [<analysis> <type> <random> <tag>]
[(do !
[sample <random>]
(_.cover [<analysis>]
- (..analysis state <type> (<analysis> sample)
+ (..analysis state module <type> (<analysis> sample)
((..analysis? <type> <tag>) sample))))]
[/.bit .Bit random.bit /analysis.bit]
diff --git a/stdlib/source/test/lux/tool/compiler/meta/export.lux b/stdlib/source/test/lux/tool/compiler/meta/export.lux
index 11a6ea9ce..2864dabfd 100644
--- a/stdlib/source/test/lux/tool/compiler/meta/export.lux
+++ b/stdlib/source/test/lux/tool/compiler/meta/export.lux
@@ -75,15 +75,19 @@
export_tar (# ! in (<binary>.result tar.parser export_tar))]
(in [library_tar export_tar]))]
($_ _.and'
- (_.cover' [/.library]
+ (_.cover' [/.library /.mode /.ownership]
(|> it
(try#each (|>> product.left
sequence.list
- (case> (^ (list {tar.#Normal [actual_path/0 _ _ _ actual_content/0]}
- {tar.#Normal [actual_path/1 _ _ _ actual_content/1]}))
+ (case> (^ (list {tar.#Normal [actual_path/0 when/0 mode/0 ownership/0 actual_content/0]}
+ {tar.#Normal [actual_path/1 when/1 mode/1 ownership/1 actual_content/1]}))
(with_expansions [<test> (and (and (text#= file/0' (tar.from_path actual_path/0))
+ (same? /.mode mode/0)
+ (same? /.ownership ownership/0)
(binary#= content/0 (tar.data actual_content/0)))
(and (text#= file/1' (tar.from_path actual_path/1))
+ (same? /.mode mode/1)
+ (same? /.ownership ownership/1)
(binary#= content/1 (tar.data actual_content/1))))]
(or <test>
(let [[[actual_path/0 actual_content/0] [actual_path/1 actual_content/1]]
diff --git a/stdlib/source/test/lux/tool/compiler/meta/import.lux b/stdlib/source/test/lux/tool/compiler/meta/import.lux
new file mode 100644
index 000000000..7a24f9a82
--- /dev/null
+++ b/stdlib/source/test/lux/tool/compiler/meta/import.lux
@@ -0,0 +1,158 @@
+(.using
+ [library
+ [lux "*"
+ ["_" test {"+" Test}]
+ [abstract
+ [monad {"+" do}]]
+ [control
+ [pipe {"+" case>}]
+ ["[0]" maybe ("[1]#[0]" functor)]
+ ["[0]" try ("[1]#[0]" functor)]
+ ["[0]" exception]
+ [concurrency
+ ["[0]" async]]
+ [parser
+ ["<[0]>" binary]]]
+ [data
+ ["[0]" product]
+ ["[0]" binary {"+" Binary} ("[1]#[0]" equivalence)]
+ ["[0]" bit ("[1]#[0]" equivalence)]
+ ["[0]" format "_"
+ ["[0]" tar {"+" Tar}]
+ ["[1]" binary]]
+ ["[0]" text ("[1]#[0]" equivalence)
+ ["%" format {"+" format}]
+ [encoding
+ ["[0]" utf8]]]
+ [collection
+ ["[0]" sequence]
+ ["[0]" dictionary]]]
+ [math
+ ["[0]" random {"+" Random}]
+ [number
+ ["n" nat]]]
+ [world
+ ["[0]" file]]]]
+ [\\library
+ ["[0]" /
+ [//
+ ["[0]" export]
+ ["[0]" io "_"
+ ["[1]" context]]]]])
+
+(def: .public test
+ Test
+ (<| (_.covering /._)
+ (_.for [/.Import])
+ (do [! random.monad]
+ [library/0 (random.ascii/lower 1)
+ library/1 (random.ascii/lower 2)
+
+ .let [/ .module_separator
+ random_file (: (Random file.Path)
+ (# ! each (text.suffix io.lux_extension) (random.ascii/lower 3)))]
+ file/0 random_file
+
+ dir/0 (random.ascii/lower 4)
+ file/1 (# ! each (|>> (format dir/0 /)) random_file)
+
+ .let [random_content (: (Random Binary)
+ (# ! each (|>> %.nat (# utf8.codec encoded)) random.nat))]
+ now random.instant
+ content/0 random_content
+ content/1 random_content
+ .let [library_content (|> (do try.monad
+ [file/0 (tar.path file/0)
+ file/1 (tar.path file/1)
+ content/0 (tar.content content/0)
+ content/1 (tar.content content/1)]
+ (in (|> (sequence.sequence {tar.#Normal [file/0 now export.mode export.ownership content/0]}
+ {tar.#Normal [file/1 now export.mode export.ownership content/1]})
+ (format.result tar.writer))))
+ (try.else (binary.empty 0)))
+ library_content/0 (|> (do try.monad
+ [file/0 (tar.path file/0)
+ content/0 (tar.content content/0)]
+ (in (|> (sequence.sequence {tar.#Normal [file/0 now export.mode export.ownership content/0]})
+ (format.result tar.writer))))
+ (try.else (binary.empty 0)))
+ library_content/1 (|> (do try.monad
+ [file/1 (tar.path file/1)
+ content/1 (tar.content content/1)]
+ (in (|> (sequence.sequence {tar.#Normal [file/1 now export.mode export.ownership content/1]})
+ (format.result tar.writer))))
+ (try.else (binary.empty 0)))
+ library_content/-0 (|> (do try.monad
+ [file/0 (tar.path file/0)
+ content/0 (tar.content content/0)]
+ (in (|> (sequence.sequence {tar.#Contiguous [file/0 now export.mode export.ownership content/0]})
+ (format.result tar.writer))))
+ (try.else (binary.empty 0)))
+ library_content/-1 (|> (do try.monad
+ [file/0 (tar.path file/0)]
+ (in (|> (sequence.sequence {tar.#Symbolic_Link file/0})
+ (format.result tar.writer))))
+ (try.else (binary.empty 0)))
+ library_content/-2 (|> (do try.monad
+ [file/0 (tar.path file/0)]
+ (in (|> (sequence.sequence {tar.#Directory file/0})
+ (format.result tar.writer))))
+ (try.else (binary.empty 0)))
+ imported? (: (-> /.Import Bit)
+ (function (_ it)
+ (and (n.= 2 (dictionary.size it))
+ (|> it
+ (dictionary.value file/0)
+ (maybe#each (binary#= content/0))
+ (maybe.else false))
+ (|> it
+ (dictionary.value file/1)
+ (maybe#each (binary#= content/1))
+ (maybe.else false)))))]]
+ ($_ _.and
+ (in (do [! async.monad]
+ [it/0 (do (try.with !)
+ [.let [fs (file.mock /)]
+ _ (# fs write library_content library/0)]
+ (/.import fs (list library/0)))
+ it/1 (do (try.with !)
+ [.let [fs (file.mock /)]
+ _ (# fs write library_content/0 library/0)
+ _ (# fs write library_content/1 library/1)]
+ (/.import fs (list library/0 library/1)))]
+ (_.cover' [/.import]
+ (and (|> it/0
+ (try#each imported?)
+ (try.else false))
+ (|> it/1
+ (try#each imported?)
+ (try.else false))))))
+ (in (do [! async.monad]
+ [it (do (try.with !)
+ [.let [fs (file.mock /)]
+ _ (# fs write library_content library/0)
+ _ (/.import fs (list library/0 library/0))]
+ (in false))]
+ (_.cover' [/.duplicate]
+ (exception.otherwise (exception.match? /.duplicate) it))))
+ (in (do [! async.monad]
+ [it/0 (do (try.with !)
+ [.let [fs (file.mock /)]
+ _ (# fs write library_content/-0 library/0)
+ _ (/.import fs (list library/0))]
+ (in false))
+ it/1 (do (try.with !)
+ [.let [fs (file.mock /)]
+ _ (# fs write library_content/-1 library/0)
+ _ (/.import fs (list library/0))]
+ (in false))
+ it/2 (do (try.with !)
+ [.let [fs (file.mock /)]
+ _ (# fs write library_content/-2 library/0)
+ _ (/.import fs (list library/0))]
+ (in false))]
+ (_.cover' [/.useless_tar_entry]
+ (and (exception.otherwise (exception.match? /.useless_tar_entry) it/0)
+ (exception.otherwise (exception.match? /.useless_tar_entry) it/1)
+ (exception.otherwise (exception.match? /.useless_tar_entry) it/2)))))
+ ))))
diff --git a/stdlib/source/test/lux/type/check.lux b/stdlib/source/test/lux/type/check.lux
index 9d38c6f6d..818441adf 100644
--- a/stdlib/source/test/lux/type/check.lux
+++ b/stdlib/source/test/lux/type/check.lux
@@ -731,7 +731,7 @@
(_.cover [/.clean]
(and (|> (do /.monad
[[var_id varT] /.var
- cleanedT (/.clean (type_shape varT))]
+ cleanedT (/.clean (list) (type_shape varT))]
(in (type#= (type_shape varT)
cleanedT)))
(/.result /.fresh_context)
@@ -740,7 +740,7 @@
[[var_id varT] /.var
[_ replacementT] /.existential
_ (/.check varT replacementT)
- cleanedT (/.clean (type_shape varT))]
+ cleanedT (/.clean (list) (type_shape varT))]
(in (type#= (type_shape replacementT)
cleanedT)))
(/.result /.fresh_context)