aboutsummaryrefslogtreecommitdiff
path: root/stdlib
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/library/lux/control/concurrency/atom.lux35
-rw-r--r--stdlib/source/library/lux/control/concurrency/thread.lux7
-rw-r--r--stdlib/source/library/lux/data/text/buffer.lux43
-rw-r--r--stdlib/source/library/lux/data/text/encoding/utf8.lux13
-rw-r--r--stdlib/source/library/lux/debug.lux13
-rw-r--r--stdlib/source/library/lux/ffi.jvm.lux148
-rw-r--r--stdlib/source/library/lux/ffi.old.lux33
-rw-r--r--stdlib/source/library/lux/target/jvm/constant.lux4
-rw-r--r--stdlib/source/library/lux/target/jvm/loader.lux4
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/analysis/inference.lux6
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis.lux190
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/complex.lux39
-rw-r--r--stdlib/source/library/lux/tool/compiler/meta/archive/artifact/category.lux2
-rw-r--r--stdlib/source/library/lux/tool/compiler/meta/packager/jvm.lux15
-rw-r--r--stdlib/source/library/lux/world/console.lux41
-rw-r--r--stdlib/source/library/lux/world/file.lux70
-rw-r--r--stdlib/source/library/lux/world/file/watch.lux9
-rw-r--r--stdlib/source/library/lux/world/net/http/client.lux20
-rw-r--r--stdlib/source/library/lux/world/program.lux98
-rw-r--r--stdlib/source/library/lux/world/shell.lux84
-rw-r--r--stdlib/source/test/lux/data/binary.lux2
-rw-r--r--stdlib/source/test/lux/ffi.jvm.lux101
-rw-r--r--stdlib/source/test/lux/math/number/frac.lux4
-rw-r--r--stdlib/source/test/lux/target/jvm.lux2
-rw-r--r--stdlib/source/test/lux/tool.lux13
-rw-r--r--stdlib/source/test/lux/tool/compiler/language/lux/analysis/coverage.lux20
-rw-r--r--stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis.lux980
-rw-r--r--stdlib/source/test/lux/tool/compiler/meta/archive/artifact/category.lux14
-rw-r--r--stdlib/source/test/lux/tool/compiler/meta/archive/registry.lux132
-rw-r--r--stdlib/source/test/lux/world/file.lux39
-rw-r--r--stdlib/source/unsafe/lux/data/binary.lux13
31 files changed, 1618 insertions, 576 deletions
diff --git a/stdlib/source/library/lux/control/concurrency/atom.lux b/stdlib/source/library/lux/control/concurrency/atom.lux
index a30b3bc73..c865b8e33 100644
--- a/stdlib/source/library/lux/control/concurrency/atom.lux
+++ b/stdlib/source/library/lux/control/concurrency/atom.lux
@@ -1,19 +1,19 @@
(.using
- [library
- [lux "*"
- ["@" target]
- ["[0]" ffi]
- [abstract
- [monad {"+" do}]]
- [control
- ["[0]" function]
- ["[0]" io {"+" IO} ("[1]#[0]" functor)]]
- [data
- ["[0]" product]
- [collection
- ["[0]" array]]]
- [type
- abstract]]])
+ [library
+ [lux "*"
+ ["@" target]
+ ["[0]" ffi]
+ [abstract
+ [monad {"+" do}]]
+ [control
+ ["[0]" function]
+ ["[0]" io {"+" IO} ("[1]#[0]" functor)]]
+ [data
+ ["[0]" product]
+ [collection
+ ["[0]" array]]]
+ [type
+ abstract]]])
(with_expansions [<jvm> (as_is (ffi.import: (java/util/concurrent/atomic/AtomicReference a)
["[1]::[0]"
@@ -68,12 +68,13 @@
(def: .public (compare_and_swap! current new atom)
(All (_ a) (-> a a (Atom a) (IO Bit)))
- (io.io (with_expansions [<jvm> (java/util/concurrent/atomic/AtomicReference::compareAndSet current new (:representation atom))]
+ (io.io (with_expansions [<jvm> (ffi.of_boolean (java/util/concurrent/atomic/AtomicReference::compareAndSet current new (:representation atom)))]
(for [@.old <jvm>
@.jvm <jvm>]
(let [old (<read> 0 (:representation atom))]
(if (same? old current)
- (exec (<write> 0 new (:representation atom))
+ (exec
+ (<write> 0 new (:representation atom))
true)
false))))))
))
diff --git a/stdlib/source/library/lux/control/concurrency/thread.lux b/stdlib/source/library/lux/control/concurrency/thread.lux
index 9d91b6ee8..07de8c1c7 100644
--- a/stdlib/source/library/lux/control/concurrency/thread.lux
+++ b/stdlib/source/library/lux/control/concurrency/thread.lux
@@ -23,6 +23,7 @@
["[0]" atom {"+" Atom}]])
(with_expansions [<jvm> (as_is (ffi.import: java/lang/Object)
+ (ffi.import: java/lang/Long)
(ffi.import: java/lang/Runtime
["[1]::[0]"
@@ -69,6 +70,7 @@
Nat
(with_expansions [<jvm> (|> (java/lang/Runtime::getRuntime)
(java/lang/Runtime::availableProcessors)
+ ffi.of_int
.nat)]
(for [@.old <jvm>
@.jvm <jvm>]
@@ -77,7 +79,10 @@
(with_expansions [<jvm> (as_is (def: runner
java/util/concurrent/ScheduledThreadPoolExecutor
- (java/util/concurrent/ScheduledThreadPoolExecutor::new (.int ..parallelism))))]
+ (|> ..parallelism
+ .int
+ ffi.as_int
+ java/util/concurrent/ScheduledThreadPoolExecutor::new)))]
(for [@.old <jvm>
@.jvm <jvm>
@.js (as_is)
diff --git a/stdlib/source/library/lux/data/text/buffer.lux b/stdlib/source/library/lux/data/text/buffer.lux
index 30c6714fd..a07e65250 100644
--- a/stdlib/source/library/lux/data/text/buffer.lux
+++ b/stdlib/source/library/lux/data/text/buffer.lux
@@ -1,23 +1,23 @@
(.using
- [library
- [lux "*"
- ["@" target]
- ["[0]" ffi {"+" import:}]
- [control
- ["[0]" function]]
- [data
- ["[0]" product]
- [text
- ["%" format {"+" format}]]
- [collection
- ["[0]" array]
- ["[0]" sequence {"+" Sequence} ("[1]#[0]" mix)]]]
- [math
- [number
- ["n" nat]]]
- [type
- abstract]]]
- ["[0]" //])
+ [library
+ [lux "*"
+ ["@" target]
+ ["[0]" ffi {"+" import:}]
+ [control
+ ["[0]" function]]
+ [data
+ ["[0]" product]
+ [text
+ ["%" format {"+" format}]]
+ [collection
+ ["[0]" array]
+ ["[0]" sequence {"+" Sequence} ("[1]#[0]" mix)]]]
+ [math
+ [number
+ ["n" nat]]]
+ [type
+ abstract]]]
+ ["[0]" //])
(with_expansions [<jvm> (as_is (import: java/lang/CharSequence)
@@ -113,9 +113,10 @@
(def: .public (text buffer)
(-> Buffer Text)
(with_expansions [<jvm> (let [[capacity transform] (:representation buffer)]
- (|> (java/lang/StringBuilder::new (.int capacity))
+ (|> (java/lang/StringBuilder::new (ffi.as_int (.int capacity)))
transform
- java/lang/StringBuilder::toString))]
+ java/lang/StringBuilder::toString
+ ffi.of_string))]
(for [@.old <jvm>
@.jvm <jvm>
@.js (let [[capacity transform] (:representation buffer)]
diff --git a/stdlib/source/library/lux/data/text/encoding/utf8.lux b/stdlib/source/library/lux/data/text/encoding/utf8.lux
index baef37aa1..bcc1a0ee2 100644
--- a/stdlib/source/library/lux/data/text/encoding/utf8.lux
+++ b/stdlib/source/library/lux/data/text/encoding/utf8.lux
@@ -65,15 +65,12 @@
(def: (encoded value)
(-> Text Binary)
(for [@.old
- (java/lang/String::getBytes (//.name //.utf_8)
- ... TODO: Remove coercion below.
- ... The coercion below may seem
- ... gratuitous, but removing it
- ... causes a grave compilation problem.
- (:as java/lang/String value))
+ (java/lang/String::getBytes (ffi.as_string (//.name //.utf_8))
+ (ffi.as_string value))
@.jvm
- (java/lang/String::getBytes (//.name //.utf_8) value)
+ (java/lang/String::getBytes (ffi.as_string (//.name //.utf_8))
+ (ffi.as_string value))
@.js
(cond ffi.on_nashorn?
@@ -113,7 +110,7 @@
(def: (decoded value)
(-> Binary (Try Text))
- (with_expansions [<jvm> {try.#Success (java/lang/String::new value (//.name //.utf_8))}]
+ (with_expansions [<jvm> {try.#Success (ffi.of_string (java/lang/String::new value (ffi.as_string (//.name //.utf_8))))}]
(for [@.old <jvm>
@.jvm <jvm>
diff --git a/stdlib/source/library/lux/debug.lux b/stdlib/source/library/lux/debug.lux
index e042ad9d1..2e4e790fe 100644
--- a/stdlib/source/library/lux/debug.lux
+++ b/stdlib/source/library/lux/debug.lux
@@ -147,12 +147,13 @@
[(case (ffi.check <class> object)
{.#Some value}
(`` (|> value (~~ (template.spliced <processing>))))
+
{.#None})]
- [java/lang/Boolean [(:as .Bit) %.bit]]
- [java/lang/Long [(:as .Int) %.int]]
- [java/lang/Number [java/lang/Number::doubleValue %.frac]]
- [java/lang/String [(:as .Text) %.text]]
+ [java/lang/Boolean [ffi.of_boolean %.bit]]
+ [java/lang/Long [ffi.of_long %.int]]
+ [java/lang/Number [java/lang/Number::doubleValue ffi.of_double %.frac]]
+ [java/lang/String [ffi.of_string %.text]]
))
(case (ffi.check [java/lang/Object] object)
{.#Some value}
@@ -166,7 +167,7 @@
(let [last? (case last?
{.#Some _} #1
{.#None} #0)]
- (|> (%.format (%.nat (.nat (java/lang/Integer::longValue tag)))
+ (|> (%.format (%.nat (.nat (ffi.of_long (java/lang/Integer::longValue tag))))
" " (%.bit last?)
" " (inspection choice))
(text.enclosed ["(" ")"])))
@@ -174,7 +175,7 @@
_
(tuple_inspection inspection value)))
{.#None})
- (java/lang/Object::toString object))))]
+ (ffi.of_string (java/lang/Object::toString object)))))]
(for [@.old <jvm>
@.jvm <jvm>
diff --git a/stdlib/source/library/lux/ffi.jvm.lux b/stdlib/source/library/lux/ffi.jvm.lux
index 46ffa8021..8439ae24a 100644
--- a/stdlib/source/library/lux/ffi.jvm.lux
+++ b/stdlib/source/library/lux/ffi.jvm.lux
@@ -1,42 +1,42 @@
(.using
- [library
- ["[0]" lux {"-" Primitive Type type int char :as}
- ["[1]_[0]" type ("[1]#[0]" equivalence)]
- [abstract
- ["[0]" monad {"+" Monad do}]
- ["[0]" enum]]
- [control
- ["[0]" function]
- ["[0]" io]
- ["[0]" maybe]
- ["[0]" try {"+" Try}]
- ["[0]" exception {"+" Exception exception:}]
- ["<>" parser ("[1]#[0]" monad)
- ["<[0]>" code {"+" Parser}]]]
- [data
- ["[0]" product]
- ["[0]" text ("[1]#[0]" equivalence)
- ["%" format {"+" format}]]
- [collection
- ["[0]" array]
- ["[0]" list ("[1]#[0]" monad mix monoid)]
- ["[0]" dictionary {"+" Dictionary}]]]
- [macro {"+" with_symbols}
- [syntax {"+" syntax:}]
- ["[0]" code]
- ["[0]" template]]
- ["[0]" meta]
- [target
- [jvm
- [encoding
- ["[0]" name {"+" External}]]
- ["[0]" type {"+" Type Argument Typed}
- ["[0]" category {"+" Void Value' Value Return' Return Method Primitive Object Class Array Var Parameter Declaration}]
- ["[0]" box]
- ["[0]" descriptor]
- ["[0]" signature]
- ["[0]" reflection]
- ["[0]" parser]]]]]])
+ [library
+ ["[0]" lux {"-" Primitive Type type int char :as}
+ ["[1]_[0]" type ("[1]#[0]" equivalence)]
+ [abstract
+ ["[0]" monad {"+" Monad do}]
+ ["[0]" enum]]
+ [control
+ ["[0]" function]
+ ["[0]" io]
+ ["[0]" maybe]
+ ["[0]" try {"+" Try}]
+ ["[0]" exception {"+" Exception exception:}]
+ ["<>" parser ("[1]#[0]" monad)
+ ["<[0]>" code {"+" Parser}]]]
+ [data
+ ["[0]" product]
+ ["[0]" text ("[1]#[0]" equivalence)
+ ["%" format {"+" format}]]
+ [collection
+ ["[0]" array]
+ ["[0]" list ("[1]#[0]" monad mix monoid)]
+ ["[0]" dictionary {"+" Dictionary}]]]
+ [macro {"+" with_symbols}
+ [syntax {"+" syntax:}]
+ ["[0]" code]
+ ["[0]" template]]
+ ["[0]" meta]
+ [target
+ [jvm
+ [encoding
+ ["[0]" name {"+" External}]]
+ ["[0]" type {"+" Type Argument Typed}
+ ["[0]" category {"+" Void Value' Value Return' Return Method Primitive Object Class Array Var Parameter Declaration}]
+ ["[0]" box]
+ ["[0]" descriptor]
+ ["[0]" signature]
+ ["[0]" reflection]
+ ["[0]" parser]]]]]])
(def: internal
(-> External Text)
@@ -66,6 +66,7 @@
[Float box.float]
[Double box.double]
[Character box.char]
+ [String "java.lang.String"]
)
(template [<name> <class>]
@@ -1396,9 +1397,6 @@
[with_return_io #import_member_io? (` ((~! io.io) (~ return_term)))]
)
-(def: $String
- (type.class "java.lang.String" (list)))
-
(template [<input?> <name> <unbox/box> <special+>]
[(def: (<name> mode [unboxed raw])
(-> Primitive_Mode [(Type Value) Code] Code)
@@ -1409,10 +1407,10 @@
{#AutoPrM}
(with_expansions [<special+>' (template.spliced <special+>)
- <cond_cases> (template [<old> <new> <pre> <post>]
- [(# type.equivalence = <old> unboxed)
+ <cond_cases> (template [<primitive> <pre> <post>]
+ [(# type.equivalence = <primitive> unboxed)
(with_expansions [<post>' (template.spliced <post>)]
- [<new>
+ [<primitive>
(` (.|> (~ raw) (~+ <pre>)))
(list <post>')])]
@@ -1438,29 +1436,21 @@
(` (.|> (~ unboxed/boxed) (~+ post))))))]
[#1 with_automatic_input_conversion ..unbox
- [[type.boolean type.boolean (list (` (.: .Bit)) (` (.:as (.Primitive (~ (code.text box.boolean)))))) []]
- [type.byte type.byte (list (` (.: .Int)) (` (.:as (.Primitive (~ (code.text box.long))))) (` ..long_to_byte)) []]
- [type.short type.short (list (` (.: .Int)) (` (.:as (.Primitive (~ (code.text box.long))))) (` ..long_to_short)) []]
- [type.int type.int (list (` (.: .Int)) (` (.:as (.Primitive (~ (code.text box.long))))) (` ..long_to_int)) []]
- [type.long type.long (list (` (.: .Int)) (` (.:as (.Primitive (~ (code.text box.long)))))) []]
- [type.float type.float (list (` (.: .Frac)) (` (.:as (.Primitive (~ (code.text box.double))))) (` ..double_to_float)) []]
- [type.double type.double (list (` (.: .Frac)) (` (.:as (.Primitive (~ (code.text box.double)))))) []]
- [..$String ..$String (list (` (.: .Text)) (` (.:as (.Primitive (~ (code.text (..reflection ..$String))))))) []]
- [(type.class box.boolean (list)) (type.class box.boolean (list)) (list (` (.: .Bit)) (` (.:as (.Primitive (~ (code.text box.boolean)))))) []]
- [(type.class box.long (list)) (type.class box.long (list)) (list (` (.: .Int)) (` (.:as (.Primitive (~ (code.text box.long)))))) []]
- [(type.class box.double (list)) (type.class box.double (list)) (list (` (.: .Frac)) (` (.:as (.Primitive (~ (code.text box.double)))))) []]]]
+ [[type.boolean (list (` (.:as (.Primitive (~ (code.text box.boolean)))))) []]
+ [type.byte (list (` (.:as (.Primitive (~ (code.text box.byte)))))) []]
+ [type.short (list (` (.:as (.Primitive (~ (code.text box.short)))))) []]
+ [type.int (list (` (.: (.Primitive (~ (code.text box.int)))))) []]
+ [type.long (list (` (.:as (.Primitive (~ (code.text box.long)))))) []]
+ [type.float (list (` (.:as (.Primitive (~ (code.text box.float)))))) []]
+ [type.double (list (` (.:as (.Primitive (~ (code.text box.double)))))) []]]]
[#0 with_automatic_output_conversion ..box
- [[type.boolean type.boolean (list) [(` (.: (.Primitive (~ (code.text box.boolean))))) (` (.:as .Bit))]]
- [type.byte type.long (list (` "jvm conversion byte-to-long")) [(` (.: (.Primitive (~ (code.text box.long))))) (` (.:as .Int))]]
- [type.short type.long (list (` "jvm conversion short-to-long")) [(` (.: (.Primitive (~ (code.text box.long))))) (` (.:as .Int))]]
- [type.int type.long (list (` "jvm conversion int-to-long")) [(` (.: (.Primitive (~ (code.text box.long))))) (` (.:as .Int))]]
- [type.long type.long (list) [(` (.: (.Primitive (~ (code.text box.long))))) (` (.:as .Int))]]
- [type.float type.double (list (` "jvm conversion float-to-double")) [(` (.: (.Primitive (~ (code.text box.double))))) (` (.:as .Frac))]]
- [type.double type.double (list) [(` (.: (.Primitive (~ (code.text box.double))))) (` (.:as .Frac))]]
- [..$String ..$String (list) [(` (.: (.Primitive (~ (code.text (..reflection ..$String)))))) (` (.:as .Text))]]
- [(type.class box.boolean (list)) (type.class box.boolean (list)) (list) [(` (.: (.Primitive (~ (code.text box.boolean))))) (` (.:as .Bit))]]
- [(type.class box.long (list)) (type.class box.long (list)) (list) [(` (.: (.Primitive (~ (code.text box.long))))) (` (.:as .Int))]]
- [(type.class box.double (list)) (type.class box.double (list)) (list) [(` (.: (.Primitive (~ (code.text box.double))))) (` (.:as .Frac))]]]]
+ [[type.boolean (list) [(` (.: (.Primitive (~ (code.text box.boolean)))))]]
+ [type.byte (list) [(` (.: (.Primitive (~ (code.text box.byte)))))]]
+ [type.short (list) [(` (.: (.Primitive (~ (code.text box.short)))))]]
+ [type.int (list) [(` (.: (.Primitive (~ (code.text box.int)))))]]
+ [type.long (list) [(` (.: (.Primitive (~ (code.text box.long)))))]]
+ [type.float (list) [(` (.: (.Primitive (~ (code.text box.float)))))]]
+ [type.double (list) [(` (.: (.Primitive (~ (code.text box.double)))))]]]]
)
(def: (un_quoted quoted)
@@ -1930,3 +1920,29 @@
_
(meta.failure (exception.error ..cannot_cast_to_non_object [type]))))
+
+(template [<forward> <from> <to> <backward>]
+ [(template: .public (<forward> it)
+ [(|> it (: <from>) (:as <to>))])
+
+ (template: .public (<backward> it)
+ [(|> it (: <to>) (:as <from>))])]
+
+ [as_boolean .Bit ..Boolean of_boolean]
+ [as_long .Int ..Long of_long]
+ [as_double .Frac ..Double of_double]
+ [as_string .Text ..String of_string]
+ )
+
+(template [<forward> <from> <$> <mid> <$'> <to> <backward>]
+ [(template: .public (<forward> it)
+ [(|> it (: <from>) (:as <mid>) <$> (: <to>))])
+
+ (template: .public (<backward> it)
+ [(|> it (: <to>) <$'> (: <mid>) (:as <from>))])]
+
+ [as_byte .Int ..long_to_byte ..Long ..byte_to_long ..Byte of_byte]
+ [as_short .Int ..long_to_short ..Long ..short_to_long ..Short of_short]
+ [as_int .Int ..long_to_int ..Long ..int_to_long ..Integer of_int]
+ [as_float .Frac ..double_to_float ..Double ..float_to_double ..Float of_float]
+ )
diff --git a/stdlib/source/library/lux/ffi.old.lux b/stdlib/source/library/lux/ffi.old.lux
index 3b8fdc613..ec3693ece 100644
--- a/stdlib/source/library/lux/ffi.old.lux
+++ b/stdlib/source/library/lux/ffi.old.lux
@@ -62,6 +62,32 @@
[char_to_long "jvm convert char-to-long" "java.lang.Character" "java.lang.Long"]
)
+(template [<forward> <from> <to> <backward>]
+ [(template: .public (<forward> it)
+ [(|> it (: <from>) (:as (Primitive <to>)))])
+
+ (template: .public (<backward> it)
+ [(|> it (: (Primitive <to>)) (:as <from>))])]
+
+ [as_boolean .Bit "java.lang.Boolean" of_boolean]
+ [as_long .Int "java.lang.Long" of_long]
+ [as_double .Frac "java.lang.Double" of_double]
+ [as_string .Text "java.lang.String" of_string]
+ )
+
+(template [<forward> <from> <$> <mid> <$'> <to> <backward>]
+ [(template: .public (<forward> it)
+ [(|> it (: <from>) (:as (Primitive <mid>)) <$> (: (Primitive <to>)))])
+
+ (template: .public (<backward> it)
+ [(|> it (: (Primitive <to>)) <$'> (: (Primitive <mid>)) (:as <from>))])]
+
+ [as_byte .Int ..long_to_byte "java.lang.Long" ..byte_to_long "java.lang.Byte" of_byte]
+ [as_short .Int ..long_to_short "java.lang.Long" ..short_to_long "java.lang.Short" of_short]
+ [as_int .Int ..long_to_int "java.lang.Long" ..int_to_long "java.lang.Integer" of_int]
+ [as_float .Frac ..double_to_float "java.lang.Double" ..float_to_double "java.lang.Float" of_float]
+ )
+
... [Utils]
(def: constructor_method_name "<init>")
(def: member_separator "::")
@@ -1396,12 +1422,7 @@
expression
{#AutoPrM}
- (case class
- "byte" (` (<byte> (~ expression)))
- "short" (` (<short> (~ expression)))
- "int" (` (<int> (~ expression)))
- "float" (` (<float> (~ expression)))
- _ expression)))]
+ expression))]
[auto_convert_input long_to_byte long_to_short long_to_int double_to_float]
[auto_convert_output byte_to_long short_to_long int_to_long float_to_double]
diff --git a/stdlib/source/library/lux/target/jvm/constant.lux b/stdlib/source/library/lux/target/jvm/constant.lux
index 370dbdabb..8f6358470 100644
--- a/stdlib/source/library/lux/target/jvm/constant.lux
+++ b/stdlib/source/library/lux/target/jvm/constant.lux
@@ -119,9 +119,9 @@
(~~ (template.spliced <writer>)))))]
[integer_writer Integer [] [binaryF.bits/32]]
- [float_writer Float [java/lang/Float::floatToRawIntBits ffi.int_to_long (:as I64)] [i32.i32 binaryF.bits/32]]
+ [float_writer Float [java/lang/Float::floatToRawIntBits ffi.of_int .i64] [i32.i32 binaryF.bits/32]]
[long_writer Long [] [binaryF.bits/64]]
- [double_writer Double [java/lang/Double::doubleToRawLongBits] [binaryF.bits/64]]
+ [double_writer Double [java/lang/Double::doubleToRawLongBits ffi.of_long] [binaryF.bits/64]]
[string_writer String [] [//index.writer]]
)
)
diff --git a/stdlib/source/library/lux/target/jvm/loader.lux b/stdlib/source/library/lux/target/jvm/loader.lux
index 99a4573bc..26e67f2e9 100644
--- a/stdlib/source/library/lux/target/jvm/loader.lux
+++ b/stdlib/source/library/lux/target/jvm/loader.lux
@@ -74,7 +74,7 @@
(java/lang/Integer::TYPE)))
(ffi.write! 3 (:as <elemT>
(java/lang/Integer::TYPE))))]
- (do_to (java/lang/Class::getDeclaredMethod "defineClass"
+ (do_to (java/lang/Class::getDeclaredMethod (ffi.as_string "defineClass")
signature
(ffi.class_for java/lang/ClassLoader))
(java/lang/reflect/AccessibleObject::setAccessible true)))))
@@ -140,4 +140,4 @@
(def: .public (load name loader)
(-> Text java/lang/ClassLoader
(IO (Try (java/lang/Class java/lang/Object))))
- (java/lang/ClassLoader::loadClass name loader))
+ (java/lang/ClassLoader::loadClass (ffi.as_string name) loader))
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 6ca7137d2..fa9e2e0fb 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
@@ -80,9 +80,9 @@
([.#UnivQ]
[.#ExQ])
- (^or {.#Parameter @}
- {.#Ex @}
- {.#Named name anonymous})
+ (^or {.#Parameter _}
+ {.#Ex _}
+ {.#Named _})
:it:))
... Type-inference works by applying some (potentially quantified) type
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis.lux
index 657096c10..085e071a7 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis.lux
@@ -10,6 +10,8 @@
["%" format {"+" format}]]
[collection
["[0]" list]]]
+ [macro
+ ["[0]" code]]
[math
[number
["n" nat]]]
@@ -33,105 +35,97 @@
[meta
[archive {"+" Archive}]]]]]])
-(exception: .public (unrecognized_syntax [code Code])
+(exception: .public (invalid [syntax Code])
(exception.report
- ["Code" (%.code code)]))
-
-... TODO: Had to split the 'compile' function due to compilation issues
-... with old-luxc. Must re-combine all the code ASAP
-
-(type: (Fix a)
- (-> a a))
-
-(def: (compile|literal archive compile else code')
- (-> Archive Phase (Fix (-> (Code' (Ann Location)) (Operation Analysis))))
- (case code'
- (^template [<tag> <analyser>]
- [{<tag> value}
- (<analyser> value)])
- ([.#Bit /simple.bit]
- [.#Nat /simple.nat]
- [.#Int /simple.int]
- [.#Rev /simple.rev]
- [.#Frac /simple.frac]
- [.#Text /simple.text])
-
- (^ {.#Variant (list& [_ {.#Symbol tag}]
- values)})
- (case values
- {.#Item value {.#End}}
- (/complex.variant compile tag archive value)
-
- _
- (/complex.variant compile tag archive (` [(~+ values)])))
-
- (^ {.#Variant (list& [_ {.#Nat lefts}] [_ {.#Bit right?}]
- values)})
- (case values
- {.#Item value {.#End}}
- (/complex.sum compile lefts right? archive value)
-
- _
- (/complex.sum compile lefts right? archive (` [(~+ values)])))
-
- (^ {.#Tuple elems})
- (/complex.record compile archive elems)
-
- _
- (else code')))
-
-(def: (compile|others expander archive compile code')
- (-> Expander Archive Phase (-> (Code' (Ann Location)) (Operation Analysis)))
- (case code'
- {.#Symbol reference}
- (/reference.reference reference)
-
- (^ {.#Form (list [_ {.#Variant branches}] input)})
- (case (list.pairs branches)
- {.#Some branches}
- (/case.case compile branches archive input)
-
- {.#None}
- (//.except ..unrecognized_syntax [location.dummy code']))
-
- (^ {.#Form (list& [_ {.#Text extension_name}] extension_args)})
- (//extension.apply archive compile [extension_name extension_args])
-
- (^ {.#Form (list [_ {.#Tuple (list [_ {.#Symbol ["" function_name]}]
- [_ {.#Symbol ["" arg_name]}])}]
- body)})
- (/function.function compile function_name arg_name archive body)
-
- (^ {.#Form (list& functionC argsC+)})
- (do [! //.monad]
- [[functionT functionA] (/type.inferring
- (compile archive functionC))]
- (case functionA
- {/.#Reference {reference.#Constant def_name}}
- (do !
- [?macro (//extension.lifted (meta.macro def_name))]
- (case ?macro
- {.#Some macro}
- (do !
- [expansion (//extension.lifted (/macro.single_expansion expander def_name macro argsC+))]
- (compile archive expansion))
-
- _
- (/function.apply compile argsC+ functionT functionA archive functionC)))
-
- _
- (/function.apply compile argsC+ functionT functionA archive functionC)))
-
- _
- (//.except ..unrecognized_syntax [location.dummy code'])))
+ ["Syntax" (%.code syntax)]))
+
+(template: (variant_analysis analysis archive tag values)
+ ... (-> Phase Archive Symbol (List Code) (Operation Analysis))
+ [(case values
+ (^ (list value))
+ (/complex.variant analysis tag archive value)
+
+ _
+ (/complex.variant analysis tag archive (code.tuple values)))])
+
+(template: (sum_analysis analysis archive lefts right? values)
+ ... (-> Phase Archive Nat Bit (List Code) (Operation Analysis))
+ [(case values
+ (^ (list value))
+ (/complex.sum analysis lefts right? archive value)
+
+ _
+ (/complex.sum analysis lefts right? archive (code.tuple values)))])
+
+(template: (case_analysis analysis archive input branches code)
+ ... (-> Phase Archive Code (List Code) Code (Operation Analysis))
+ [(case (list.pairs branches)
+ {.#Some branches}
+ (/case.case analysis branches archive input)
+
+ {.#None}
+ (//.except ..invalid [code]))])
+
+(template: (apply_analysis expander analysis archive functionC argsC+)
+ ... (-> Expander Phase Archive Code (List Code) (Operation Analysis))
+ [(do [! //.monad]
+ [[functionT functionA] (/type.inferring
+ (analysis archive functionC))]
+ (case functionA
+ (^ (/.constant def_name))
+ (do !
+ [?macro (//extension.lifted (meta.macro def_name))]
+ (case ?macro
+ {.#Some macro}
+ (do !
+ [expansion (//extension.lifted (/macro.single_expansion expander def_name macro argsC+))]
+ (analysis archive expansion))
+
+ _
+ (/function.apply analysis argsC+ functionT functionA archive functionC)))
+
+ _
+ (/function.apply analysis argsC+ functionT functionA archive functionC)))])
(def: .public (phase expander)
(-> Expander Phase)
- (function (compile archive code)
- (let [[location code'] code]
- ... The location must be set in the state for the sake
- ... of having useful error messages.
- (/.with_location location
- (compile|literal archive compile
- (compile|others expander archive compile)
- code')))))
+ (function (analysis archive code)
+ (<| (let [[location code'] code])
+ ... The location must be set in the state for the sake
+ ... of having useful error messages.
+ (/.with_location location)
+ (case code
+ (^template [<tag> <analyser>]
+ [[_ {<tag> value}]
+ (<analyser> value)])
+ ([.#Symbol /reference.reference]
+ [.#Text /simple.text]
+ [.#Nat /simple.nat]
+ [.#Bit /simple.bit]
+ [.#Frac /simple.frac]
+ [.#Int /simple.int]
+ [.#Rev /simple.rev])
+
+ (^code [(~+ elems)])
+ (/complex.record analysis archive elems)
+
+ (^code {(~ [_ {.#Symbol tag}]) (~+ values)})
+ (..variant_analysis analysis archive tag values)
+
+ (^code ({(~+ branches)} (~ input)))
+ (..case_analysis analysis archive input branches code)
+
+ (^code ([(~ [_ {.#Symbol ["" function_name]}]) (~ [_ {.#Symbol ["" arg_name]}])] (~ body)))
+ (/function.function analysis function_name arg_name archive body)
+
+ (^code ((~ [_ {.#Text extension_name}]) (~+ extension_args)))
+ (//extension.apply archive analysis [extension_name extension_args])
+
+ (^code ((~ functionC) (~+ argsC+)))
+ (..apply_analysis expander analysis archive functionC argsC+)
+
+ (^code {(~ [_ {.#Nat lefts}]) (~ [_ {.#Bit right?}]) (~+ values)})
+ (..sum_analysis analysis archive lefts right? values)
+
+ _
+ (//.except ..invalid [code])))))
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 1bf6a48b9..54b2cf1dd 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
@@ -134,15 +134,17 @@
_
(/.except ..cannot_infer_sum [expectedT lefts right? valueC])))
- (^template [<tag> <instancer>]
- [{<tag> _}
- (do !
- [[@instance :instance:] (/type.check <instancer>)]
- (<| (/type.expecting (maybe.trusted (type.applied (list :instance:) expectedT)))
- (again valueC)))])
- ([.#UnivQ check.existential]
- [.#ExQ check.var])
-
+ {.#UnivQ _}
+ (do !
+ [[@instance :instance:] (/type.check check.existential)]
+ (<| (/type.expecting (maybe.trusted (type.applied (list :instance:) expectedT)))
+ (again valueC)))
+ {.#ExQ _}
+ (<| /type.with_var
+ (function (_ [@instance :instance:]))
+ (/type.expecting (maybe.trusted (type.applied (list :instance:) expectedT)))
+ (again valueC))
+
{.#Apply inputT funT}
(case funT
{.#Var funT_id}
@@ -247,14 +249,17 @@
(type.tuple (list#each product.left membersTA))))]
(in (/.tuple (list#each product.right membersTA))))))
- (^template [<tag> <instancer>]
- [{<tag> _}
- (do !
- [[@instance :instance:] (/type.check <instancer>)]
- (<| (/type.expecting (maybe.trusted (type.applied (list :instance:) expectedT)))
- (product analyse archive membersC)))])
- ([.#UnivQ check.existential]
- [.#ExQ check.var])
+ {.#UnivQ _}
+ (do !
+ [[@instance :instance:] (/type.check check.existential)]
+ (<| (/type.expecting (maybe.trusted (type.applied (list :instance:) expectedT)))
+ (product analyse archive membersC)))
+
+ {.#ExQ _}
+ (<| /type.with_var
+ (function (_ [@instance :instance:]))
+ (/type.expecting (maybe.trusted (type.applied (list :instance:) expectedT)))
+ (product analyse archive membersC))
{.#Apply inputT funT}
(case funT
diff --git a/stdlib/source/library/lux/tool/compiler/meta/archive/artifact/category.lux b/stdlib/source/library/lux/tool/compiler/meta/archive/artifact/category.lux
index 526a8bce1..61698487d 100644
--- a/stdlib/source/library/lux/tool/compiler/meta/archive/artifact/category.lux
+++ b/stdlib/source/library/lux/tool/compiler/meta/archive/artifact/category.lux
@@ -17,7 +17,7 @@
(type: .public Definition
[Text (Maybe [Arity [Nat Nat]])])
-(def: definition_equivalence
+(def: .public definition_equivalence
(Equivalence Definition)
($_ product.equivalence
text.equivalence
diff --git a/stdlib/source/library/lux/tool/compiler/meta/packager/jvm.lux b/stdlib/source/library/lux/tool/compiler/meta/packager/jvm.lux
index 7f672fd92..4b5a82a43 100644
--- a/stdlib/source/library/lux/tool/compiler/meta/packager/jvm.lux
+++ b/stdlib/source/library/lux/tool/compiler/meta/packager/jvm.lux
@@ -148,7 +148,7 @@
(do try.monad
[_ (java/util/jar/JarOutputStream::putNextEntry (java/util/jar/JarEntry::new class_path) sink)]
(in (do_to sink
- (java/util/zip/ZipOutputStream::write content +0 (.int (binary.size content)))
+ (java/util/zip/ZipOutputStream::write content (ffi.as_int +0) (ffi.as_int (.int (binary.size content))))
(java/io/Flushable::flush)
(java/util/zip/ZipOutputStream::closeEntry))))))
@@ -168,16 +168,16 @@
(-> java/util/jar/JarInputStream [Nat Binary])
(let [chunk (binary.empty ..mebi_byte)
chunk_size (.int ..mebi_byte)
- buffer (java/io/ByteArrayOutputStream::new chunk_size)]
+ buffer (java/io/ByteArrayOutputStream::new (ffi.as_int chunk_size))]
(loop [so_far 0]
- (case (java/io/InputStream::read chunk 0 chunk_size input)
+ (case (ffi.of_int (java/io/InputStream::read chunk (ffi.as_int +0) (ffi.as_int chunk_size) input))
-1
[so_far
(java/io/ByteArrayOutputStream::toByteArray buffer)]
bytes_read
(exec
- (java/io/OutputStream::write chunk +0 bytes_read buffer)
+ (java/io/OutputStream::write chunk (ffi.as_int +0) (ffi.as_int bytes_read) buffer)
(again (|> bytes_read .nat (n.+ so_far))))))))
(def: (read_jar_entry_with_known_size expected_size input)
@@ -185,7 +185,8 @@
(let [buffer (binary.empty expected_size)]
(loop [so_far 0]
(let [so_far' (|> input
- (java/io/InputStream::read buffer (.int so_far) (.int (n.- so_far expected_size)))
+ (java/io/InputStream::read buffer (ffi.as_int (.int so_far)) (ffi.as_int (.int (n.- so_far expected_size))))
+ ffi.of_int
.nat
(n.+ so_far))]
(if (n.= expected_size so_far')
@@ -241,7 +242,7 @@
(again (set.has entry_path entries)
duplicates
(do_to sink
- (java/util/zip/ZipOutputStream::write entry_data +0 (.int entry_size))
+ (java/util/zip/ZipOutputStream::write entry_data (ffi.as_int +0) (ffi.as_int (.int entry_size)))
(java/io/Flushable::flush)
(java/util/zip/ZipOutputStream::closeEntry)))))
(again entries
@@ -254,7 +255,7 @@
(do [! try.monad]
[.let [necessary_dependencies (cache/artifact.necessary_dependencies archive)]
order (cache/module.load_order $.key archive)
- .let [buffer (java/io/ByteArrayOutputStream::new (.int ..mebi_byte))]
+ .let [buffer (java/io/ByteArrayOutputStream::new (ffi.as_int (.int ..mebi_byte)))]
sink (|> order
(list#each (function (_ [module [module_id entry]])
[module_id (value@ archive.#output entry)]))
diff --git a/stdlib/source/library/lux/world/console.lux b/stdlib/source/library/lux/world/console.lux
index c10521e74..cf75af0a5 100644
--- a/stdlib/source/library/lux/world/console.lux
+++ b/stdlib/source/library/lux/world/console.lux
@@ -1,21 +1,21 @@
(.using
- [library
- [lux "*"
- ["@" target]
- ["[0]" ffi {"+" import:}]
- [abstract
- [monad {"+" do}]]
- [control
- ["[0]" maybe]
- ["[0]" try {"+" Try}]
- ["[0]" exception {"+" exception:}]
- ["[0]" io {"+" IO io}]
- [concurrency
- ["[0]" async {"+" Async} ("[1]#[0]" monad)]
- ["[0]" atom]]]
- [data
- ["[0]" text {"+" Char}
- ["%" format {"+" format}]]]]])
+ [library
+ [lux "*"
+ ["@" target]
+ ["[0]" ffi {"+" import:}]
+ [abstract
+ [monad {"+" do}]]
+ [control
+ ["[0]" maybe]
+ ["[0]" try {"+" Try} ("[1]#[0]" functor)]
+ ["[0]" exception {"+" exception:}]
+ ["[0]" io {"+" IO io} ("[1]#[0]" functor)]
+ [concurrency
+ ["[0]" async {"+" Async} ("[1]#[0]" monad)]
+ ["[0]" atom]]]
+ [data
+ ["[0]" text {"+" Char}
+ ["%" format {"+" format}]]]]])
(type: .public (Console !)
(Interface
@@ -82,13 +82,14 @@
(def: (read _)
(|> jvm_input
java/io/InputStream::read
- (# (try.with io.monad) each .nat)))
+ (# (try.with io.monad) each (|>> ffi.of_int .nat))))
(def: (read_line _)
- (java/io/Console::readLine jvm_console))
+ (io#each (try#each (|>> ffi.of_string))
+ (java/io/Console::readLine jvm_console)))
(def: (write message)
- (java/io/PrintStream::print message jvm_output))
+ (java/io/PrintStream::print (ffi.as_string message) jvm_output))
(def: close
(|>> (exception.except ..cannot_close) in)))))))))]
diff --git a/stdlib/source/library/lux/world/file.lux b/stdlib/source/library/lux/world/file.lux
index 5fc2b5e2c..d597ee7da 100644
--- a/stdlib/source/library/lux/world/file.lux
+++ b/stdlib/source/library/lux/world/file.lux
@@ -155,17 +155,9 @@
[cannot_make_directory]
[cannot_find_directory]
-
- [cannot_read_all_data]
)
-(with_expansions [<for_jvm> (as_is (exception: .public (cannot_modify_file [instant Instant
- file Path])
- (exception.report
- ["Instant" (%.instant instant)]
- ["Path" file]))
-
- (ffi.import: java/lang/String)
+(with_expansions [<for_jvm> (as_is (ffi.import: java/lang/String)
(`` (ffi.import: java/io/File
["[1]::[0]"
@@ -211,33 +203,34 @@
(System IO)
(def: separator
- (java/io/File::separator))
+ (ffi.of_string (java/io/File::separator)))
(~~ (template [<name> <method>]
[(def: <name>
- (|>> java/io/File::new
+ (|>> ffi.as_string
+ java/io/File::new
<method>
- (io#each (|>> (try.else false)))))]
+ (io#each (|>> (try#each (|>> ffi.of_boolean)) (try.else false)))))]
[file? java/io/File::isFile]
[directory? java/io/File::isDirectory]
))
- (def: (make_directory path)
- (|> path
- java/io/File::new
- java/io/File::mkdir))
+ (def: make_directory
+ (|>> ffi.as_string
+ java/io/File::new
+ java/io/File::mkdir))
(~~ (template [<name> <method>]
[(def: (<name> path)
(do [! (try.with io.monad)]
- [?children (java/io/File::listFiles (java/io/File::new path))]
+ [?children (java/io/File::listFiles (java/io/File::new (ffi.as_string path)))]
(case ?children
{.#Some children}
(|> children
(array.list {.#None})
- (monad.only ! (|>> <method>))
- (# ! each (monad.each ! (|>> java/io/File::getAbsolutePath)))
+ (monad.only ! (|>> <method> (# ! each (|>> ffi.of_boolean))))
+ (# ! each (monad.each ! (|>> java/io/File::getAbsolutePath (# ! each (|>> ffi.of_string)))))
(# ! conjoint))
{.#None}
@@ -248,57 +241,62 @@
))
(def: file_size
- (|>> java/io/File::new
+ (|>> ffi.as_string
+ java/io/File::new
java/io/File::length
- (# (try.with io.monad) each .nat)))
+ (# (try.with io.monad) each (|>> ffi.of_long .nat))))
(def: last_modified
- (|>> java/io/File::new
+ (|>> ffi.as_string
+ java/io/File::new
(java/io/File::lastModified)
- (# (try.with io.monad) each (|>> duration.of_millis instant.absolute))))
+ (# (try.with io.monad) each (|>> ffi.of_long duration.of_millis instant.absolute))))
(def: can_execute?
- (|>> java/io/File::new
- java/io/File::canExecute))
+ (|>> ffi.as_string
+ java/io/File::new
+ java/io/File::canExecute
+ (io#each (try#each (|>> ffi.of_boolean)))))
(def: (read path)
(do (try.with io.monad)
- [.let [file (java/io/File::new path)]
+ [.let [file (java/io/File::new (ffi.as_string path))]
size (java/io/File::length file)
- .let [data (binary.empty (.nat size))]
stream (java/io/FileInputStream::new file)
+ .let [data (binary.empty (.nat (ffi.of_long size)))]
bytes_read (java/io/InputStream::read data stream)
_ (java/lang/AutoCloseable::close stream)]
- (if (i.= size bytes_read)
- (in data)
- (# io.monad in (exception.except ..cannot_read_all_data path)))))
+ (in data)))
(def: (delete path)
(|> path
+ ffi.as_string
java/io/File::new
java/io/File::delete))
(def: (modify time_stamp path)
(|> path
+ ffi.as_string
java/io/File::new
- (java/io/File::setLastModified (|> time_stamp instant.relative duration.millis))))
+ (java/io/File::setLastModified (|> time_stamp instant.relative duration.millis ffi.as_long))))
- (~~ (template [<name> <flag>]
+ (~~ (template [<flag> <name>]
[(def: (<name> data path)
(do (try.with io.monad)
- [stream (java/io/FileOutputStream::new (java/io/File::new path) <flag>)
+ [stream (java/io/FileOutputStream::new (java/io/File::new (ffi.as_string path)) (ffi.as_boolean <flag>))
_ (java/io/OutputStream::write data stream)
_ (java/io/OutputStream::flush stream)]
(java/lang/AutoCloseable::close stream)))]
- [write #0]
- [append #1]
+ [#0 write]
+ [#1 append]
))
(def: (move destination origin)
(|> origin
+ ffi.as_string
java/io/File::new
- (java/io/File::renameTo (java/io/File::new destination))))
+ (java/io/File::renameTo (java/io/File::new (ffi.as_string destination)))))
)))]
(for [@.old (as_is <for_jvm>)
@.jvm (as_is <for_jvm>)
diff --git a/stdlib/source/library/lux/world/file/watch.lux b/stdlib/source/library/lux/world/file/watch.lux
index a4c5cfa57..c26923c54 100644
--- a/stdlib/source/library/lux/world/file/watch.lux
+++ b/stdlib/source/library/lux/world/file/watch.lux
@@ -273,12 +273,12 @@
(def: (default_list list)
(All (_ a) (-> (java/util/List a) (List a)))
- (let [size (.nat (java/util/List::size list))]
+ (let [size (.nat (ffi.of_int (java/util/List::size list)))]
(loop [idx 0
output {.#End}]
(if (n.< size idx)
(again (++ idx)
- {.#Item (java/util/List::get (.int idx) list)
+ {.#Item (java/util/List::get (ffi.as_int (.int idx)) list)
output})
output))))
@@ -366,7 +366,7 @@
(async.future
(java/nio/file/Path::register watcher
watch_events'
- (|> path java/io/File::new java/io/File::toPath)))))
+ (|> path ffi.as_string java/io/File::new java/io/File::toPath)))))
(def: (default_poll watcher)
(-> java/nio/file/WatchService (IO (Try (List [Concern //.Path]))))
@@ -378,12 +378,13 @@
{.#Some key}
(do [! io.monad]
[valid? (java/nio/file/WatchKey::reset key)]
- (if valid?
+ (if (ffi.of_boolean valid?)
(do !
[.let [path (|> key
java/nio/file/WatchKey::watchable
(:as java/nio/file/Path)
java/nio/file/Path::toString
+ ffi.of_string
(:as //.Path))]
the_concern (..default_key_concern key)]
(again {.#Item [the_concern path]
diff --git a/stdlib/source/library/lux/world/net/http/client.lux b/stdlib/source/library/lux/world/net/http/client.lux
index fd5709140..9dd11a62f 100644
--- a/stdlib/source/library/lux/world/net/http/client.lux
+++ b/stdlib/source/library/lux/world/net/http/client.lux
@@ -133,7 +133,8 @@
(loop [so_far +0]
(do [! (try.with io.monad)]
[.let [remaining (i.- so_far (.int buffer_size))]
- bytes_read (java/io/BufferedInputStream::read buffer so_far remaining input)]
+ bytes_read (# ! each (|>> ffi.of_int)
+ (java/io/BufferedInputStream::read buffer (ffi.as_int so_far) (ffi.as_int remaining) input))]
(case bytes_read
-1 (do !
[_ (java/lang/AutoCloseable::close input)]
@@ -146,7 +147,8 @@
output (# binary.monoid identity)]
(do [! (try.with io.monad)]
[.let [remaining (i.- so_far (.int buffer_size))]
- bytes_read (java/io/BufferedInputStream::read buffer so_far remaining input)]
+ bytes_read (# ! each (|>> ffi.of_int)
+ (java/io/BufferedInputStream::read buffer (ffi.as_int so_far) (ffi.as_int remaining) input))]
(case bytes_read
-1 (do !
[_ (java/lang/AutoCloseable::close input)]
@@ -170,13 +172,13 @@
(loop [index +0
headers //.empty]
(do [! (try.with io.monad)]
- [?name (java/net/URLConnection::getHeaderFieldKey index connection)]
+ [?name (java/net/URLConnection::getHeaderFieldKey (ffi.as_int index) connection)]
(case ?name
{.#Some name}
(do !
- [?value (java/net/URLConnection::getHeaderField index connection)]
+ [?value (java/net/URLConnection::getHeaderField (ffi.as_int index) connection)]
(again (++ index)
- (dictionary.has name (maybe.else "" ?value) headers)))
+ (dictionary.has (ffi.of_string name) (maybe.else "" (maybe#each (|>> ffi.of_string) ?value)) headers)))
{.#None}
(in headers)))))
@@ -187,11 +189,11 @@
(def: (request method url headers data)
(: (IO (Try (//.Response IO)))
(do [! (try.with io.monad)]
- [connection (|> url java/net/URL::new java/net/URL::openConnection)
+ [connection (|> url ffi.as_string java/net/URL::new java/net/URL::openConnection)
.let [connection (:as java/net/HttpURLConnection connection)]
- _ (java/net/HttpURLConnection::setRequestMethod (..jvm_method method) connection)
+ _ (java/net/HttpURLConnection::setRequestMethod (ffi.as_string (..jvm_method method)) connection)
_ (monad.each ! (function (_ [name value])
- (java/net/URLConnection::setRequestProperty name value connection))
+ (java/net/URLConnection::setRequestProperty (ffi.as_string name) (ffi.as_string value) connection))
(dictionary.entries headers))
_ (case data
{.#Some data}
@@ -210,7 +212,7 @@
input (|> connection
java/net/URLConnection::getInputStream
(# ! each (|>> java/io/BufferedInputStream::new)))]
- (in [(.nat status)
+ (in [(.nat (ffi.of_int status))
[//.#headers headers
//.#body (..default_body input)]]))))))]
(for [@.old (as_is <jvm>)
diff --git a/stdlib/source/library/lux/world/program.lux b/stdlib/source/library/lux/world/program.lux
index 5fdc9cc21..2eb9e3f62 100644
--- a/stdlib/source/library/lux/world/program.lux
+++ b/stdlib/source/library/lux/world/program.lux
@@ -1,39 +1,39 @@
(.using
- [library
- [lux "*"
- ["@" target]
- ["[0]" ffi {"+" import:}]
- [abstract
- ["[0]" monad {"+" Monad do}]]
- [control
- ["[0]" function]
- ["[0]" io {"+" IO}]
- ["[0]" maybe]
- ["[0]" try {"+" Try}]
- ["[0]" exception {"+" exception:}]
- [concurrency
- ["[0]" atom]
- ["[0]" async {"+" Async}]]
- [parser
- ["[0]" environment {"+" Environment}]]]
- [data
- ["[0]" bit ("[1]#[0]" equivalence)]
- ["[0]" text
- ["%" format {"+" format}]]
- [collection
- ["[0]" array {"+" Array}]
- ["[0]" dictionary {"+" Dictionary}]
- ["[0]" list ("[1]#[0]" functor)]]]
- ["[0]" macro
- ["[0]" template]]
- [math
- [number
- ["i" int]]]
- [type
- abstract]]]
- [//
- [file {"+" Path}]
- [shell {"+" Exit}]])
+ [library
+ [lux "*"
+ ["@" target]
+ ["[0]" ffi {"+" import:}]
+ [abstract
+ ["[0]" monad {"+" Monad do}]]
+ [control
+ ["[0]" function]
+ ["[0]" io {"+" IO}]
+ ["[0]" maybe ("[1]#[0]" functor)]
+ ["[0]" try {"+" Try}]
+ ["[0]" exception {"+" exception:}]
+ [concurrency
+ ["[0]" atom]
+ ["[0]" async {"+" Async}]]
+ [parser
+ ["[0]" environment {"+" Environment}]]]
+ [data
+ ["[0]" bit ("[1]#[0]" equivalence)]
+ ["[0]" text
+ ["%" format {"+" format}]]
+ [collection
+ ["[0]" array {"+" Array}]
+ ["[0]" dictionary {"+" Dictionary}]
+ ["[0]" list ("[1]#[0]" functor)]]]
+ ["[0]" macro
+ ["[0]" template]]
+ [math
+ [number
+ ["i" int]]]
+ [type
+ abstract]]]
+ [//
+ [file {"+" Path}]
+ [shell {"+" Exit}]])
(exception: .public (unknown_environment_variable [name Text])
(exception.report
@@ -136,7 +136,7 @@
(def: (jvm##consume iterator)
(All (_ a) (-> (java/util/Iterator a) (List a)))
- (if (java/util/Iterator::hasNext iterator)
+ (if (ffi.of_boolean (java/util/Iterator::hasNext iterator))
{.#Item (java/util/Iterator::next iterator)
(jvm##consume iterator)}
{.#End}))
@@ -347,16 +347,16 @@
])))
(def: (variable name)
- (template.let [(!fetch <method>)
+ (template.let [(!fetch <method> <post>)
[(do io.monad
- [value (<method> name)]
+ [value (|> name <method>)]
(in (case value
{.#Some value}
- {try.#Success value}
+ {try.#Success (<post> value)}
{.#None}
(exception.except ..unknown_environment_variable [name]))))]]
- (with_expansions [<jvm> (!fetch java/lang/System::resolveEnv)]
+ (with_expansions [<jvm> (!fetch (<| java/lang/System::resolveEnv ffi.as_string) ffi.of_string)]
(for [@.old <jvm>
@.jvm <jvm>
@.js (io.io (if ffi.on_node_js?
@@ -370,15 +370,18 @@
{.#None}
(exception.except ..unknown_environment_variable [name]))
(exception.except ..unknown_environment_variable [name])))
- @.python (!fetch os/environ::get)
- @.lua (!fetch os/getenv)
- @.ruby (!fetch RubyEnv::fetch)
+ @.python (!fetch os/environ::get |>)
+ @.lua (!fetch os/getenv |>)
+ @.ruby (!fetch RubyEnv::fetch |>)
]))))
(def: home
(io.run!
(with_expansions [<default> (io.io "~")
- <jvm> (io.io (maybe.else "" (java/lang/System::getProperty "user.home")))]
+ <jvm> (|> (java/lang/System::getProperty (ffi.as_string "user.home"))
+ (maybe#each (|>> ffi.of_string))
+ (maybe.else "")
+ io.io)]
(for [@.old <jvm>
@.jvm <jvm>
@.js (if ffi.on_node_js?
@@ -401,7 +404,10 @@
(def: directory
(io.run!
(with_expansions [<default> "."
- <jvm> (io.io (maybe.else "" (java/lang/System::getProperty "user.dir")))]
+ <jvm> (|> (java/lang/System::getProperty (ffi.as_string "user.dir"))
+ (maybe#each (|>> ffi.of_string))
+ (maybe.else "")
+ io.io)]
(for [@.old <jvm>
@.jvm <jvm>
@.js (if ffi.on_node_js?
@@ -431,7 +437,7 @@
(def: (exit code)
(with_expansions [<jvm> (do io.monad
- [_ (java/lang/System::exit code)]
+ [_ (java/lang/System::exit (ffi.as_int code))]
(in (undefined)))]
(for [@.old <jvm>
@.jvm <jvm>
diff --git a/stdlib/source/library/lux/world/shell.lux b/stdlib/source/library/lux/world/shell.lux
index cba2e4d7e..22f63e05b 100644
--- a/stdlib/source/library/lux/world/shell.lux
+++ b/stdlib/source/library/lux/world/shell.lux
@@ -1,37 +1,37 @@
(.using
- [library
- [lux "*"
- ["@" target]
- ["jvm" ffi {"+" import:}]
- [abstract
- [monad {"+" do}]]
- [control
- ["[0]" function]
- ["[0]" try {"+" Try}]
- ["[0]" exception {"+" exception:}]
- ["[0]" io {"+" IO}]
- [security
- ["?" policy {"+" Context Safety Safe}]]
- [concurrency
- ["[0]" atom {"+" Atom}]
- ["[0]" async {"+" Async}]]
- [parser
- [environment {"+" Environment}]]]
- [data
- ["[0]" product]
- ["[0]" text
- ["%" format {"+" format}]
- [encoding
- ["[0]" utf8]]]
- [collection
- ["[0]" array {"+" Array}]
- ["[0]" list ("[1]#[0]" mix functor)]
- ["[0]" dictionary]]]
- [math
- [number {"+" hex}
- ["n" nat]]]]]
- [//
- [file {"+" Path}]])
+ [library
+ [lux "*"
+ ["@" target]
+ ["[0]" ffi {"+" import:}]
+ [abstract
+ [monad {"+" do}]]
+ [control
+ ["[0]" function]
+ ["[0]" try {"+" Try}]
+ ["[0]" exception {"+" exception:}]
+ ["[0]" io {"+" IO}]
+ [security
+ ["?" policy {"+" Context Safety Safe}]]
+ [concurrency
+ ["[0]" atom {"+" Atom}]
+ ["[0]" async {"+" Async}]]
+ [parser
+ [environment {"+" Environment}]]]
+ [data
+ ["[0]" product]
+ ["[0]" text
+ ["%" format {"+" format}]
+ [encoding
+ ["[0]" utf8]]]
+ [collection
+ ["[0]" array {"+" Array}]
+ ["[0]" list ("[1]#[0]" mix functor)]
+ ["[0]" dictionary]]]
+ [math
+ [number {"+" hex}
+ ["n" nat]]]]]
+ [//
+ [file {"+" Path}]])
(type: .public Exit
Int)
@@ -178,10 +178,10 @@
(-> (List Argument) (Array java/lang/String))
(product.right
(list#mix (function (_ argument [idx output])
- [(++ idx) (jvm.write! idx
- (:as java/lang/String argument)
+ [(++ idx) (ffi.write! idx
+ (ffi.as_string argument)
output)])
- [0 (jvm.array java/lang/String (list.size arguments))]
+ [0 (ffi.array java/lang/String (list.size arguments))]
arguments)))
(import: (java/util/Map k v)
@@ -250,7 +250,7 @@
[output (java/io/BufferedReader::readLine <stream>)]
(case output
{.#Some output}
- (in output)
+ (in (ffi.of_string output))
{.#None}
(# io.monad in (exception.except ..no_more_output [])))))]
@@ -262,10 +262,10 @@
(java/io/OutputStream::write (# utf8.codec encoded message) jvm_output))
(~~ (template [<name> <method>]
[(def: (<name> _)
- (<method> process))]
+ (|> process <method>))]
[destroy java/lang/Process::destroy]
- [await java/lang/Process::waitFor]
+ [await (<| (# ! each (|>> ffi.of_int)) java/lang/Process::waitFor)]
))))))))
(import: java/io/File
@@ -287,8 +287,8 @@
(def: windows?
(IO (Try Bit))
(# (try.with io.monad) each
- (|>> java/lang/String::toLowerCase (text.starts_with? "windows"))
- (java/lang/System::getProperty "os.name")))
+ (|>> java/lang/String::toLowerCase ffi.of_string (text.starts_with? "windows"))
+ (java/lang/System::getProperty (ffi.as_string "os.name"))))
(implementation: .public default
(Shell IO)
@@ -298,7 +298,7 @@
[.let [builder (|> (list& the_command arguments)
..jvm::arguments_array
java/lang/ProcessBuilder::new
- (java/lang/ProcessBuilder::directory (java/io/File::new working_directory)))]
+ (java/lang/ProcessBuilder::directory (java/io/File::new (ffi.as_string working_directory))))]
_ (|> builder
java/lang/ProcessBuilder::environment
(# try.functor each (..jvm::load_environment environment))
diff --git a/stdlib/source/test/lux/data/binary.lux b/stdlib/source/test/lux/data/binary.lux
index c9e821229..e2072944f 100644
--- a/stdlib/source/test/lux/data/binary.lux
+++ b/stdlib/source/test/lux/data/binary.lux
@@ -152,7 +152,7 @@
sample (..random size)
value random.nat
.let [gen_idx (|> random.nat (# ! each (n.% size)))]
- offset gen_idx
+ offset (# ! each (n.max 1) gen_idx)
length (# ! each (n.% (n.- offset size)) random.nat)]
($_ _.and
(_.for [/.equivalence]
diff --git a/stdlib/source/test/lux/ffi.jvm.lux b/stdlib/source/test/lux/ffi.jvm.lux
index 7684d7b96..765ea00e3 100644
--- a/stdlib/source/test/lux/ffi.jvm.lux
+++ b/stdlib/source/test/lux/ffi.jvm.lux
@@ -75,13 +75,13 @@
(def: for_conversions
Test
(do [! random.monad]
- [long (# ! each (|>> (:as /.Long)) random.int)
- integer (# ! each (|>> (:as /.Long) /.long_to_int) random.int)
- byte (# ! each (|>> (:as /.Long) /.long_to_byte) random.int)
- short (# ! each (|>> (:as /.Long) /.long_to_short) random.int)
+ [long (# ! each (|>> /.as_long) random.int)
+ integer (# ! each (|>> /.as_int) random.int)
+ byte (# ! each (|>> /.as_byte) random.int)
+ short (# ! each (|>> /.as_short) random.int)
float (|> random.frac
(random.only (|>> f.not_a_number? not))
- (# ! each (|>> (:as /.Double) /.double_to_float)))]
+ (# ! each (|>> /.as_float)))]
(`` ($_ _.and
(~~ (template [<sample> <=> <to> <from>]
[(_.cover [<to> <from>]
@@ -112,7 +112,7 @@
(do [! random.monad]
[size (|> random.nat (# ! each (|>> (n.% 100) (n.max 1))))
idx (|> random.nat (# ! each (n.% size)))
- value (# ! each (|>> (:as java/lang/Long)) random.int)]
+ value (# ! each (|>> /.as_long) random.int)]
($_ _.and
(_.cover [/.array /.length]
(|> size
@@ -123,8 +123,8 @@
(|> (/.array java/lang/Long size)
(/.write! idx value)
(/.read! idx)
- (:as Int)
- (i.= (:as Int value))))
+ /.of_long
+ (i.= (/.of_long value))))
(_.cover [/.cannot_convert_to_jvm_type]
(let [array (:as (Array Nothing)
(array.empty 1))]
@@ -138,19 +138,19 @@
(`` (do [! random.monad]
[sample (# ! each (|>> (:as java/lang/Object))
(random.ascii 1))
- boolean (# ! each (|>> (:as /.Boolean)) random.bit)
- byte (# ! each (|>> (:as /.Long) /.long_to_byte) random.int)
- short (# ! each (|>> (:as /.Long) /.long_to_short) random.int)
- integer (# ! each (|>> (:as /.Long) /.long_to_int) random.int)
- long (# ! each (|>> (:as /.Long)) random.int)
+ boolean (# ! each (|>> /.as_boolean) random.bit)
+ byte (# ! each (|>> /.as_byte) random.int)
+ short (# ! each (|>> /.as_short) random.int)
+ integer (# ! each (|>> /.as_int) random.int)
+ long (# ! each (|>> /.as_long) random.int)
float (|> random.frac
(random.only (|>> f.not_a_number? not))
- (# ! each (|>> (:as /.Double) /.double_to_float)))
+ (# ! each (|>> /.as_float)))
double (|> random.frac
(random.only (|>> f.not_a_number? not))
- (# ! each (|>> (:as /.Double))))
- character (# ! each (|>> (:as /.Long) /.long_to_int /.int_to_char) random.int)
- string (# ! each (|>> (:as java/lang/String))
+ (# ! each (|>> /.as_double)))
+ character (# ! each (|>> /.as_int /.int_to_char) random.int)
+ string (# ! each (|>> /.as_string)
(random.ascii 1))]
($_ _.and
(_.cover [/.check]
@@ -161,7 +161,7 @@
(_.cover [/.synchronized]
(/.synchronized sample #1))
(_.cover [/.class_for]
- (text#= "java.lang.Class" (java/lang/Class::getName (/.class_for java/lang/Class))))
+ (text#= "java.lang.Class" (/.of_string (java/lang/Class::getName (/.class_for java/lang/Class)))))
(_.cover [/.null /.null?]
(and (/.null? (/.null))
(not (/.null? sample))))
@@ -273,8 +273,7 @@
(test/TestInterface0
[] (actual0 self [])
java/lang/Long
- (:as java/lang/Long
- expected)))
+ (/.as_long (.int expected))))
example/0!
(same? (: Any expected)
(: Any (test/TestInterface0::actual0 object/0)))
@@ -285,19 +284,18 @@
[] (actual1 self [throw? java/lang/Boolean])
java/lang/Long
"throws" [java/lang/Throwable]
- (if (:as Bit throw?)
+ (if (/.of_boolean throw?)
(panic! "YOLO")
- (:as java/lang/Long
- expected))))
+ (/.as_long (.int expected)))))
example/1!
- (and (case (test/TestInterface1::actual1 false object/1)
+ (and (case (test/TestInterface1::actual1 (/.as_boolean false) object/1)
{try.#Success actual}
(same? (: Any expected)
(: Any actual))
{try.#Failure error}
false)
- (case (test/TestInterface1::actual1 true object/1)
+ (case (test/TestInterface1::actual1 (/.as_boolean true) object/1)
{try.#Success actual}
false
@@ -312,15 +310,14 @@
input))
example/2!
(same? (: Any expected)
- (: Any (test/TestInterface2::actual2 (:as java/lang/Long expected) object/2)))
+ (: Any (test/TestInterface2::actual2 (/.as_long (.int expected)) object/2)))
object/3 (/.object [] [(test/TestInterface3 java/lang/Long)]
[]
((test/TestInterface3 a)
[] (actual3 self [])
a
- (:as java/lang/Long
- expected)))
+ (/.as_long (.int expected))))
example/3!
(same? (: Any expected)
(: Any (test/TestInterface3::actual3 object/3)))
@@ -333,18 +330,16 @@
[] (actual4 self [actual_left long
actual_right long])
long
- (:as java/lang/Long
- (i.+ (:as Int actual_left)
- (:as Int actual_right)))))]
+ (/.as_long (i.+ (/.of_long actual_left)
+ (/.of_long actual_right)))))]
(i.= expected
- (test/TestInterface4::actual4 left right object/4)))]]
+ (/.of_long (test/TestInterface4::actual4 left right object/4))))]]
(_.cover [/.interface: /.object]
(and example/0!
example/1!
example/2!
example/3!
- example/4!
- ))))
+ example/4!))))
(/.class: "final" test/TestClass0 [test/TestInterface0]
... Fields
@@ -371,7 +366,7 @@
(test/TestInterface1 [] (actual1 self [throw? java/lang/Boolean])
java/lang/Long
"throws" [java/lang/Throwable]
- (if (:as Bit throw?)
+ (if (/.of_boolean throw?)
(panic! "YOLO")
::value)))
@@ -470,9 +465,9 @@
[] (actual4 self [actual_left long
actual_right long])
long
- (:as java/lang/Long
- (i.+ (:as Int actual_left)
- (:as Int actual_right)))))
+ (/.as_long
+ (i.+ (/.of_long actual_left)
+ (/.of_long actual_right)))))
(/.import: test/TestClass8
["[1]::[0]"
@@ -503,21 +498,21 @@
left random.int
right random.int
- .let [object/0 (test/TestClass0::new (.int expected))
+ .let [object/0 (test/TestClass0::new (/.as_long (.int expected)))
example/0!
(n.= expected
- (:as Nat (test/TestInterface0::actual0 object/0)))
+ (.nat (/.of_long (test/TestInterface0::actual0 object/0))))
- object/1 (test/TestClass1::new (.int expected))
+ object/1 (test/TestClass1::new (/.as_long (.int expected)))
example/1!
- (and (case (test/TestInterface1::actual1 false object/1)
+ (and (case (test/TestInterface1::actual1 (/.as_boolean false) object/1)
{try.#Success actual}
(n.= expected
- (:as Nat actual))
+ (.nat (/.of_long actual)))
{try.#Failure error}
false)
- (case (test/TestInterface1::actual1 true object/1)
+ (case (test/TestInterface1::actual1 (/.as_boolean true) object/1)
{try.#Success actual}
false
@@ -527,36 +522,36 @@
object/2 (test/TestClass2::new)
example/2!
(n.= expected
- (: Nat (test/TestInterface2::actual2 (:as java/lang/Long expected) object/2)))
+ (.nat (/.of_long (test/TestInterface2::actual2 (/.as_long (.int expected)) object/2))))
object/3 (: (test/TestClass3 java/lang/Long)
- (test/TestClass3::new (:as java/lang/Long expected)))
+ (test/TestClass3::new (/.as_long (.int expected))))
example/3!
(n.= expected
- (: Nat (test/TestInterface3::actual3 object/3)))
+ (.nat (/.of_long (test/TestInterface3::actual3 object/3))))
object/4 (test/TestClass4::new)
example/4!
(n.= expected
- (.nat (test/TestClass4::actual4 (.int expected) object/4)))
+ (.nat (/.of_long (test/TestClass4::actual4 (/.as_long (.int expected)) object/4))))
example/5!
(n.= expected
- (.nat (test/TestClass5::actual5 (.int expected))))
+ (.nat (/.of_long (test/TestClass5::actual5 (/.as_long (.int expected))))))
object/7 (test/TestClass7::new)
example/7!
(n.= expected
- (.nat (test/TestClass6::actual6 (.int expected) object/7)))
+ (.nat (/.of_long (test/TestClass6::actual6 (/.as_long (.int expected)) object/7))))
example/8!
(let [expected (i.+ left right)
object/8 (test/TestClass8::new)]
(i.= expected
- (test/TestInterface4::actual4 left right object/8)))]
+ (/.of_long (test/TestInterface4::actual4 (/.as_long left) (/.as_long right) object/8))))]
.let [random_long (: (Random java/lang/Long)
- (# ! each (|>> (:as java/lang/Long))
+ (# ! each (|>> /.as_long)
random.int))]
dummy/0 random_long
dummy/1 random_long
@@ -569,7 +564,7 @@
example/9!
(|> object/9
test/TestClass9::get_actual9
- (:as java/lang/Long)
+ /.as_long
(same? dummy/2))]]
($_ _.and
(_.cover [/.class: /.import:]
diff --git a/stdlib/source/test/lux/math/number/frac.lux b/stdlib/source/test/lux/math/number/frac.lux
index bc77f1f32..b74a80786 100644
--- a/stdlib/source/test/lux/math/number/frac.lux
+++ b/stdlib/source/test/lux/math/number/frac.lux
@@ -190,7 +190,7 @@
(with_expansions [<jvm> ($_ _.and
(let [test (: (-> Frac Bit)
(function (_ value)
- (n.= (.nat (java/lang/Double::doubleToRawLongBits value))
+ (n.= (.nat (ffi.of_long (java/lang/Double::doubleToRawLongBits (ffi.as_double value))))
(/.bits value))))]
(do random.monad
[sample random.frac]
@@ -204,7 +204,7 @@
(do random.monad
[sample random.i64]
(_.cover [/.of_bits]
- (let [expected (java/lang/Double::longBitsToDouble sample)
+ (let [expected (ffi.of_double (java/lang/Double::longBitsToDouble (ffi.as_long sample)))
actual (/.of_bits sample)]
(or (/.= expected actual)
(and (/.not_a_number? expected)
diff --git a/stdlib/source/test/lux/target/jvm.lux b/stdlib/source/test/lux/target/jvm.lux
index 6a85e0354..a10c0e0e1 100644
--- a/stdlib/source/test/lux/target/jvm.lux
+++ b/stdlib/source/test/lux/target/jvm.lux
@@ -96,7 +96,7 @@
(def: (get_method name class)
(-> Text (java/lang/Class java/lang/Object) java/lang/reflect/Method)
- (java/lang/Class::getDeclaredMethod name
+ (java/lang/Class::getDeclaredMethod (ffi.as_string name)
(ffi.array (java/lang/Class java/lang/Object) 0)
class))
diff --git a/stdlib/source/test/lux/tool.lux b/stdlib/source/test/lux/tool.lux
index ed089e095..265f0a0c6 100644
--- a/stdlib/source/test/lux/tool.lux
+++ b/stdlib/source/test/lux/tool.lux
@@ -14,12 +14,7 @@
["[1][0]" analysis]
["[1][0]" phase "_"
["[1]/[0]" extension]
- ["[1]/[0]" analysis "_"
- ["[1]/[0]" simple]
- ["[1]/[0]" complex]
- ["[1]/[0]" reference]
- ["[1]/[0]" function]
- ["[1]/[0]" case]]
+ ["[1]/[0]" analysis]
... ["[1]/[0]" synthesis]
]]]
["[1][0]" meta "_"
@@ -46,11 +41,7 @@
/meta/context.test
/meta/cache.test
/phase/extension.test
- /phase/analysis/simple.test
- /phase/analysis/complex.test
- /phase/analysis/reference.test
- /phase/analysis/function.test
- /phase/analysis/case.test
+ /phase/analysis.test
... /syntax.test
... /synthesis.test
))
diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/analysis/coverage.lux b/stdlib/source/test/lux/tool/compiler/language/lux/analysis/coverage.lux
index ab856f9a1..d8ae7a32e 100644
--- a/stdlib/source/test/lux/tool/compiler/language/lux/analysis/coverage.lux
+++ b/stdlib/source/test/lux/tool/compiler/language/lux/analysis/coverage.lux
@@ -218,18 +218,29 @@
(n.= expected_maximum (/.maximum [{.#Some expected_maximum} cases]))))
))))
+(def: random_value_pattern
+ (Random [/.Coverage Pattern])
+ (random.only (function (_ [coverage pattern])
+ (case coverage
+ (^or {/.#Alt _} {/.#Seq _})
+ false
+
+ _
+ true))
+ ..random_partial_pattern))
+
(def: test|composite
Test
(<| (let [(^open "/#[0]") /.equivalence])
(do [! random.monad]
- [[expected/0 pattern/0] ..random_partial_pattern
+ [[expected/0 pattern/0] ..random_value_pattern
[expected/1 pattern/1] (random.only (|>> product.left (/#= expected/0) not)
- ..random_partial_pattern)
+ ..random_value_pattern)
[expected/2 pattern/2] (random.only ($_ predicate.and
(|>> product.left (/#= expected/0) not)
(|>> product.left (/#= expected/1) not)
(|>> product.left (case> {/.#Variant _} false _ true)))
- ..random_partial_pattern)
+ ..random_value_pattern)
bit random.bit
nat random.nat
@@ -414,8 +425,7 @@
[{/.#Text (set.of_list text.hash (list text))}]
[{/.#Variant {.#None} (dictionary.of_list n.hash (list [tag/0 expected/0]))}]
[{/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/0 expected/0]))}]
- [{/.#Seq expected/0 expected/1}]
- ))
+ [{/.#Seq expected/0 expected/1}]))
(redundant? (/.composite {/.#Seq expected/0 expected/1} expected/0))))))
(_.cover [/.variant_mismatch]
(let [mismatch? (..failure? /.variant_mismatch)]
diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis.lux
index d710f4fad..e2ee0a546 100644
--- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis.lux
+++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis.lux
@@ -1,24 +1,966 @@
(.using
+ [library
[lux "*"
- ["_" test {"+" Test}]]
- ["[0]" / "_"
- ["[1][0]" primitive]
- ["[1][0]" structure]
- ["[1][0]" reference]
- ["[1][0]" case]
- ["[1][0]" function]
- ["/[1]" // "_"
- [extension
- [analysis
- ["[1][0]" lux]]]]])
+ ["_" test {"+" Test}]
+ [abstract
+ [monad {"+" do}]]
+ [control
+ ["[0]" try]
+ ["[0]" exception]]
+ [data
+ ["[0]" product]
+ ["[0]" text]
+ [collection
+ ["[0]" list]]]
+ [macro
+ ["[0]" code]]
+ [math
+ ["[0]" random]
+ [number
+ ["n" nat]]]
+ ["[0]" type ("[1]#[0]" equivalence)
+ ["[0]" check]]]]
+ [\\library
+ ["[0]" /
+ [//
+ ["[0]" extension
+ ["[1]/[0]" analysis "_"
+ ["[1]" lux]]]
+ [//
+ ["/[1]" analysis {"+" Analysis Operation}
+ [evaluation {"+" Eval}]
+ ["[1][0]" macro]
+ ["[1][0]" scope]
+ ["[1][0]" module]
+ ["[1][0]" pattern]
+ ["[1][0]" type
+ ["$[1]" \\test]]]
+ [///
+ ["[0]" phase ("[1]#[0]" monad)]
+ [meta
+ ["[0]" archive]]]]]]]
+ ["[0]" / "_"
+ ["[1][0]" simple]
+ ["[1][0]" complex]
+ ["[1][0]" reference]
+ ["[1][0]" function]
+ ["[1][0]" case]])
+
+(def: (eval archive type term)
+ Eval
+ (phase#in []))
+
+(def: (expander macro inputs state)
+ //macro.Expander
+ {try.#Success ((.macro macro) inputs state)})
+
+(def: (can_analyse_unit! lux module/0)
+ (-> Lux Text Bit)
+ (let [state [extension.#bundle (extension/analysis.bundle ..eval)
+ extension.#state lux]]
+ (|> (do phase.monad
+ [[:it: it] (|> (' [])
+ (/.phase ..expander archive.empty)
+ //type.inferring)]
+ (in (and (type#= .Any :it:)
+ (case it
+ (^ (//.unit))
+ true
+
+ _
+ false))))
+ //scope.with
+ (//module.with 0 module/0)
+ (phase#each (|>> product.right product.right))
+ (phase.result state)
+ (try.else false))))
+
+(def: (can_analyse_simple_literal_or_singleton_tuple! lux module/0 [bit/0 nat/0 int/0 rev/0 frac/0 text/0])
+ (-> Lux Text [.Bit .Nat .Int .Rev .Frac .Text] Bit)
+ (let [state [extension.#bundle (extension/analysis.bundle ..eval)
+ extension.#state lux]]
+ (`` (and (~~ (template [<expected> <code> <type> <analysis>]
+ [(|> (do phase.monad
+ [[:it: it] (|> <expected>
+ <code>
+ (/.phase ..expander archive.empty)
+ //type.inferring)]
+ (in (and (type#= <type> :it:)
+ (case it
+ (^ (<analysis> it))
+ (same? <expected> it)
+
+ _
+ false))))
+ //scope.with
+ (//module.with 0 module/0)
+ (phase#each (|>> product.right product.right))
+ (phase.result state)
+ (try.else false))]
+
+ [bit/0 code.bit .Bit //.bit]
+ [nat/0 code.nat .Nat //.nat]
+ [int/0 code.int .Int //.int]
+ [rev/0 code.rev .Rev //.rev]
+ [frac/0 code.frac .Frac //.frac]
+ [text/0 code.text .Text //.text]
+
+ ... Singleton tuple
+ [bit/0 (<| code.tuple list code.bit) .Bit //.bit]
+ [nat/0 (<| code.tuple list code.nat) .Nat //.nat]
+ [int/0 (<| code.tuple list code.int) .Int //.int]
+ [rev/0 (<| code.tuple list code.rev) .Rev //.rev]
+ [frac/0 (<| code.tuple list code.frac) .Frac //.frac]
+ [text/0 (<| code.tuple list code.text) .Text //.text]
+ ))
+ ))))
+
+(def: (can_analyse_sum! lux module/0 [@any @bit @nat @int @rev @frac @text] [bit/0 nat/0 int/0 rev/0 frac/0 text/0] [@left @right])
+ (-> Lux Text [.Text .Text .Text .Text .Text .Text .Text] [.Bit .Nat .Int .Rev .Frac .Text] [.Text .Text] Bit)
+ (let [state [extension.#bundle (extension/analysis.bundle ..eval)
+ extension.#state lux]
+ :record: (And .Any .Bit .Nat .Int .Rev .Frac .Text)
+ :variant: (Or .Any .Bit .Nat .Int .Rev .Frac .Text)
+
+ can_analyse_unary!
+ (`` (and (|> (do phase.monad
+ [it (|> (code.variant (list (code.nat 0) (code.bit #0) (` [])))
+ (/.phase ..expander archive.empty)
+ (//type.expecting :variant:))]
+ (in (case it
+ (^ (//.variant [0 #0 (//.unit)]))
+ true
+
+ _
+ false)))
+ //scope.with
+ (//module.with 0 module/0)
+ (phase#each (|>> product.right product.right))
+ (phase.result state)
+ (try.else false))
+ (~~ (template [<lefts> <right> <expected> <tag> <code> <analysis>]
+ [(|> (do phase.monad
+ [it (|> (code.variant (list (code.nat <lefts>) (code.bit <right>) (<code> <expected>)))
+ (/.phase ..expander archive.empty)
+ (//type.expecting :variant:))]
+ (in (case it
+ (^ (//.variant [<lefts> <right> (<analysis> actual)]))
+ (same? <expected> actual)
+
+ _
+ false)))
+ //scope.with
+ (//module.with 0 module/0)
+ (phase#each (|>> product.right product.right))
+ (phase.result state)
+ (try.else false))]
+
+ [1 #0 bit/0 @bit code.bit //.bit]
+ [2 #0 nat/0 @nat code.nat //.nat]
+ [3 #0 int/0 @int code.int //.int]
+ [4 #0 rev/0 @rev code.rev //.rev]
+ [5 #0 frac/0 @frac code.frac //.frac]
+ [5 #1 text/0 @text code.text //.text]
+ ))))
+
+ can_analyse_nullary!
+ (|> (do phase.monad
+ [.let [:either: (Or .Any :record:)]
+ it (|> (code.variant (list (code.nat 0) (code.bit #0)))
+ (/.phase ..expander archive.empty)
+ (//type.expecting :either:))]
+ (in (case it
+ (^ (//.variant [0 #0 (//.unit)]))
+ true
+
+ _
+ false)))
+ //scope.with
+ (//module.with 0 module/0)
+ (phase#each (|>> product.right product.right))
+ (phase.result state)
+ (try.else false))
+
+ can_analyse_multiary!
+ (|> (do phase.monad
+ [.let [:either: (Or .Any :record:)]
+ it (|> (code.variant (list (code.nat 0)
+ (code.bit #1)
+ (` [])
+ (code.bit bit/0)
+ (code.nat nat/0)
+ (code.int int/0)
+ (code.rev rev/0)
+ (code.frac frac/0)
+ (code.text text/0)))
+ (/.phase ..expander archive.empty)
+ (//type.expecting :either:))]
+ (in (case it
+ (^ (//.variant [0 #1 (//.tuple (list (//.unit)
+ (//.bit bit/?)
+ (//.nat nat/?)
+ (//.int int/?)
+ (//.rev rev/?)
+ (//.frac frac/?)
+ (//.text text/?)))]))
+ (and (same? bit/0 bit/?)
+ (same? nat/0 nat/?)
+ (same? int/0 int/?)
+ (same? rev/0 rev/?)
+ (same? frac/0 frac/?)
+ (same? text/0 text/?))
+
+ _
+ false)))
+ //scope.with
+ (//module.with 0 module/0)
+ (phase#each (|>> product.right product.right))
+ (phase.result state)
+ (try.else false))]
+ (and can_analyse_unary!
+ can_analyse_nullary!
+ can_analyse_multiary!
+ )))
+
+(def: (can_analyse_variant! lux module/0 [@any @bit @nat @int @rev @frac @text] [bit/0 nat/0 int/0 rev/0 frac/0 text/0] [@left @right])
+ (-> Lux Text [.Text .Text .Text .Text .Text .Text .Text] [.Bit .Nat .Int .Rev .Frac .Text] [.Text .Text] Bit)
+ (let [state [extension.#bundle (extension/analysis.bundle ..eval)
+ extension.#state lux]
+ :record: {.#Named [module/0 @text]
+ (type [.Any .Bit .Nat .Int .Rev .Frac .Text])}
+ slots/* (list @any @bit @nat @int @rev @frac @text)
+ :variant: {.#Named [module/0 @text]
+ (type (Or .Any .Bit .Nat .Int .Rev .Frac .Text))}
+ tags/* (list @any @bit @nat @int @rev @frac @text)
+
+ can_analyse_unary!
+ (`` (and (|> (do phase.monad
+ [_ (//module.declare_labels false tags/* false :variant:)
+ [:it: it] (|> (code.variant (list (code.local_symbol @any) (` [])))
+ (/.phase ..expander archive.empty)
+ //type.inferring)]
+ (in (and (type#= :variant:
+ :it:)
+ (case it
+ (^ (//.variant [0 #0 (//.unit)]))
+ true
+
+ _
+ false))))
+ //scope.with
+ (//module.with 0 module/0)
+ (phase#each (|>> product.right product.right))
+ (phase.result state)
+ (try.else false))
+ (~~ (template [<lefts> <right> <expected> <tag> <code> <analysis>]
+ [(|> (do phase.monad
+ [_ (//module.declare_labels false tags/* false :variant:)
+ [:it: it] (|> (code.variant (list (code.local_symbol <tag>) (<code> <expected>)))
+ (/.phase ..expander archive.empty)
+ //type.inferring)]
+ (in (and (type#= :variant:
+ :it:)
+ (case it
+ (^ (//.variant [<lefts> <right> (<analysis> actual)]))
+ (same? <expected> actual)
+
+ _
+ false))))
+ //scope.with
+ (//module.with 0 module/0)
+ (phase#each (|>> product.right product.right))
+ (phase.result state)
+ (try.else false))]
+
+ [1 #0 bit/0 @bit code.bit //.bit]
+ [2 #0 nat/0 @nat code.nat //.nat]
+ [3 #0 int/0 @int code.int //.int]
+ [4 #0 rev/0 @rev code.rev //.rev]
+ [5 #0 frac/0 @frac code.frac //.frac]
+ [5 #1 text/0 @text code.text //.text]
+ ))))
+
+ can_analyse_nullary!
+ (|> (do phase.monad
+ [_ (//module.declare_labels true slots/* false :record:)
+ .let [:either: {.#Named [module/0 module/0]
+ (type (Or .Any :record:))}]
+ _ (//module.declare_labels false (list @left @right) false :either:)
+ [:it: it] (|> (code.variant (list (code.local_symbol @left)))
+ (/.phase ..expander archive.empty)
+ //type.inferring)]
+ (in (and (type#= :either:
+ :it:)
+ (case it
+ (^ (//.variant [0 #0 (//.unit)]))
+ true
+
+ _
+ false))))
+ //scope.with
+ (//module.with 0 module/0)
+ (phase#each (|>> product.right product.right))
+ (phase.result state)
+ (try.else false))
+
+ can_analyse_multiary!
+ (|> (do phase.monad
+ [_ (//module.declare_labels true slots/* false :record:)
+ .let [:either: {.#Named [module/0 module/0]
+ (type (Or .Any :record:))}]
+ _ (//module.declare_labels false (list @left @right) false :either:)
+ [:it: it] (|> (code.variant (list (code.local_symbol @right)
+ (` [])
+ (code.bit bit/0)
+ (code.nat nat/0)
+ (code.int int/0)
+ (code.rev rev/0)
+ (code.frac frac/0)
+ (code.text text/0)))
+ (/.phase ..expander archive.empty)
+ //type.inferring)]
+ (in (and (type#= :either:
+ :it:)
+ (case it
+ (^ (//.variant [0 #1 (//.tuple (list (//.unit)
+ (//.bit bit/?)
+ (//.nat nat/?)
+ (//.int int/?)
+ (//.rev rev/?)
+ (//.frac frac/?)
+ (//.text text/?)))]))
+ (and (same? bit/0 bit/?)
+ (same? nat/0 nat/?)
+ (same? int/0 int/?)
+ (same? rev/0 rev/?)
+ (same? frac/0 frac/?)
+ (same? text/0 text/?))
+
+ _
+ false))))
+ //scope.with
+ (//module.with 0 module/0)
+ (phase#each (|>> product.right product.right))
+ (phase.result state)
+ (try.else false))]
+ (and can_analyse_unary!
+ can_analyse_nullary!
+ can_analyse_multiary!)))
+
+(def: (can_analyse_tuple! lux module/0 [bit/0 nat/0 int/0 rev/0 frac/0 text/0])
+ (-> Lux Text [.Bit .Nat .Int .Rev .Frac .Text] Bit)
+ (let [state [extension.#bundle (extension/analysis.bundle ..eval)
+ extension.#state lux]]
+ (|> (do phase.monad
+ [[:it: it] (|> (code.tuple (list (` [])
+ (code.bit bit/0)
+ (code.nat nat/0)
+ (code.int int/0)
+ (code.rev rev/0)
+ (code.frac frac/0)
+ (code.text text/0)))
+ (/.phase ..expander archive.empty)
+ //type.inferring)]
+ (in (and (type#= (type [.Any .Bit .Nat .Int .Rev .Frac .Text])
+ :it:)
+ (case it
+ (^ (//.tuple (list (//.unit)
+ (//.bit bit/?)
+ (//.nat nat/?)
+ (//.int int/?)
+ (//.rev rev/?)
+ (//.frac frac/?)
+ (//.text text/?))))
+ (and (same? bit/0 bit/?)
+ (same? nat/0 nat/?)
+ (same? int/0 int/?)
+ (same? rev/0 rev/?)
+ (same? frac/0 frac/?)
+ (same? text/0 text/?))
+
+ _
+ false))))
+ //scope.with
+ (//module.with 0 module/0)
+ (phase#each (|>> product.right product.right))
+ (phase.result state)
+ (try.else false))))
+
+(def: (can_analyse_record! lux module/0 [@any @bit @nat @int @rev @frac @text] [bit/0 nat/0 int/0 rev/0 frac/0 text/0])
+ (-> Lux Text [.Text .Text .Text .Text .Text .Text .Text] [.Bit .Nat .Int .Rev .Frac .Text] Bit)
+ (let [state [extension.#bundle (extension/analysis.bundle ..eval)
+ extension.#state lux]
+ :record: {.#Named [module/0 @text]
+ (type [.Any .Bit .Nat .Int .Rev .Frac .Text])}
+ slots/* (list @any @bit @nat @int @rev @frac @text)]
+ (|> (do phase.monad
+ [_ (//module.declare_labels true slots/* false :record:)
+ [:it: it] (|> (code.tuple (list (code.local_symbol @text) (code.text text/0)
+ (code.local_symbol @bit) (code.bit bit/0)
+ (code.local_symbol @rev) (code.rev rev/0)
+ (code.local_symbol @int) (code.int int/0)
+ (code.local_symbol @nat) (code.nat nat/0)
+ (code.local_symbol @frac) (code.frac frac/0)
+ (code.local_symbol @any) (` [])))
+ (/.phase ..expander archive.empty)
+ //type.inferring)]
+ (in (and (type#= :record:
+ :it:)
+ (case it
+ (^ (//.tuple (list (//.unit)
+ (//.bit bit/?)
+ (//.nat nat/?)
+ (//.int int/?)
+ (//.rev rev/?)
+ (//.frac frac/?)
+ (//.text text/?))))
+ (and (same? bit/0 bit/?)
+ (same? nat/0 nat/?)
+ (same? int/0 int/?)
+ (same? rev/0 rev/?)
+ (same? frac/0 frac/?)
+ (same? text/0 text/?))
+
+ _
+ false))))
+ //scope.with
+ (//module.with 0 module/0)
+ (phase#each (|>> product.right product.right))
+ (phase.result state)
+ (try.else false))))
+
+(def: (can_analyse_function! lux module/0 nat/0 [$abstraction/0 $parameter/0 $abstraction/1 $parameter/1])
+ (-> Lux Text Nat [Code Code Code Code] Bit)
+ (let [state [extension.#bundle (extension/analysis.bundle ..eval)
+ extension.#state lux]
+
+ can_make_abstraction!
+ (|> (do phase.monad
+ [[:it: it] (|> (` ([(~ $abstraction/0) (~ $parameter/0)] (~ (code.nat nat/0))))
+ (/.phase ..expander archive.empty)
+ //type.inferring)]
+ (in (and (type#= (All (_ a) (-> a .Nat))
+ :it:)
+ (case it
+ (^ {//.#Function (list) (//.nat nat/?)})
+ (same? nat/0 nat/?)
+
+ _
+ false))))
+ //scope.with
+ (//module.with 0 module/0)
+ (phase#each (|>> product.right product.right))
+ (phase.result state)
+ (try.else false))
+
+ can_nest_abstraction!
+ (|> (do phase.monad
+ [[:it: it] (|> (` ([(~ $abstraction/0) (~ $parameter/0)]
+ ([(~ $abstraction/1) (~ $parameter/1)]
+ (~ (code.nat nat/0)))))
+ (/.phase ..expander archive.empty)
+ //type.inferring)]
+ (in (and (type#= (All (_ a) (-> a (All (_ b) (-> b .Nat))))
+ :it:)
+ (case it
+ (^ {//.#Function (list) {//.#Function (list) (//.nat nat/?)}})
+ (same? nat/0 nat/?)
+
+ _
+ false))))
+ //scope.with
+ (//module.with 0 module/0)
+ (phase#each (|>> product.right product.right))
+ (phase.result state)
+ (try.else false))
+
+ can_refer_to_parameter!
+ (|> (do phase.monad
+ [[:it: it] (|> (` ([(~ $abstraction/0) (~ $parameter/0)]
+ ([(~ $abstraction/1) (~ $parameter/1)]
+ (~ $parameter/1))))
+ (/.phase ..expander archive.empty)
+ //type.inferring)]
+ (in (and (type#= (All (_ a) (-> a (All (_ b) (-> b b))))
+ :it:)
+ (case it
+ (^ {//.#Function (list) {//.#Function (list) (//.local 1)}})
+ true
+
+ _
+ false))))
+ //scope.with
+ (//module.with 0 module/0)
+ (phase#each (|>> product.right product.right))
+ (phase.result state)
+ (try.else false))
+
+ can_refer_to_closure!
+ (|> (do phase.monad
+ [[:it: it] (|> (` ([(~ $abstraction/0) (~ $parameter/0)]
+ ([(~ $abstraction/1) (~ $parameter/1)]
+ (~ $parameter/0))))
+ (/.phase ..expander archive.empty)
+ //type.inferring)]
+ (in (and (case it
+ (^ {//.#Function (list) {//.#Function (list (//.local 1)) (//.foreign 0)}})
+ true
+
+ _
+ false)
+ ... TODO: Un-comment
+ ... (type#= (All (_ a) (-> a (All (_ b) (-> b a))))
+ ... :it:)
+ )))
+ //scope.with
+ (//module.with 0 module/0)
+ (phase#each (|>> product.right product.right))
+ (phase.result state)
+ (try.else false))]
+ (and can_make_abstraction!
+ can_nest_abstraction!
+ can_refer_to_parameter!
+ can_refer_to_closure!
+ ... TODO: Un-comment
+ ... (|> (do phase.monad
+ ... [[:it: it] (|> (` ([(~ $abstraction/0) (~ $parameter/0)]
+ ... ([(~ $abstraction/1) (~ $parameter/1)]
+ ... (~ $abstraction/1))))
+ ... (/.phase ..expander archive.empty)
+ ... //type.inferring)]
+ ... (in (case it
+ ... (^ {//.#Function (list) {//.#Function (list) (//.local 0)}})
+ ... true
+
+ ... _
+ ... false)))
+ ... //scope.with
+ ... (//module.with 0 module/0)
+ ... (phase#each (|>> product.right product.right))
+ ... (phase.result state)
+ ... (try.else false))
+ ... TODO: Un-comment
+ ... (|> (do phase.monad
+ ... [[:it: it] (|> (` ([(~ $abstraction/0) (~ $parameter/0)]
+ ... ([(~ $abstraction/1) (~ $parameter/1)]
+ ... (~ $abstraction/0))))
+ ... (/.phase ..expander archive.empty)
+ ... //type.inferring)]
+ ... (in (case it
+ ... (^ {//.#Function (list) {//.#Function (list (//.local 0)) (//.foreign 0)}})
+ ... true
+
+ ... _
+ ... false)))
+ ... //scope.with
+ ... (//module.with 0 module/0)
+ ... (phase#each (|>> product.right product.right))
+ ... (phase.result state)
+ ... (try.else false))
+ )))
+
+(def: (can_analyse_apply! lux module/0 bit/0 nat/0 [$abstraction/0 $parameter/0 $abstraction/1 $parameter/1])
+ (-> Lux Text Bit Nat [Code Code Code Code] Bit)
+ (let [state [extension.#bundle (extension/analysis.bundle ..eval)
+ extension.#state lux]
+
+ constant!
+ (|> (do phase.monad
+ [[:it: it] (|> (` (([(~ $abstraction/0) (~ $parameter/0)] (~ (code.bit bit/0)))
+ (~ (code.nat nat/0))))
+ (/.phase ..expander archive.empty)
+ //type.inferring)]
+ (in (and (type#= .Bit :it:)
+ (case it
+ (^ {//.#Apply (//.nat nat/?)
+ {//.#Function (list) (//.bit bit/?)}})
+ (and (same? bit/0 bit/?)
+ (same? nat/0 nat/?))
+
+ _
+ false))))
+ //scope.with
+ (//module.with 0 module/0)
+ (phase#each (|>> product.right product.right))
+ (phase.result state)
+ (try.else false))
+
+ variable!
+ (|> (do phase.monad
+ [[:it: it] (|> (` (([(~ $abstraction/0) (~ $parameter/0)] (~ $parameter/0))
+ (~ (code.nat nat/0))))
+ (/.phase ..expander archive.empty)
+ //type.inferring)]
+ (in (and (type#= .Nat :it:)
+ (case it
+ (^ {//.#Apply (//.nat nat/?)
+ {//.#Function (list) (//.local 1)}})
+ (same? nat/0 nat/?)
+
+ _
+ false))))
+ //scope.with
+ (//module.with 0 module/0)
+ (phase#each (|>> product.right product.right))
+ (phase.result state)
+ (try.else false))
+
+ partial!
+ (|> (do phase.monad
+ [[:it: it] (|> (` (([(~ $abstraction/0) (~ $parameter/0)]
+ ([(~ $abstraction/1) (~ $parameter/1)]
+ (~ (code.bit bit/0))))
+ (~ (code.nat nat/0))))
+ (/.phase ..expander archive.empty)
+ //type.inferring)]
+ (in (and (check.subsumes? (All (_ a) (-> a Bit)) :it:)
+ (case it
+ (^ {//.#Apply (//.nat nat/?)
+ {//.#Function (list)
+ {//.#Function (list) (//.bit bit/?)}}})
+ (and (same? bit/0 bit/?)
+ (same? nat/0 nat/?))
+
+ _
+ false))))
+ //scope.with
+ (//module.with 0 module/0)
+ (phase#each (|>> product.right product.right))
+ (phase.result state)
+ (try.else false))]
+ (and constant!
+ variable!
+ partial!)))
+
+(def: (can_analyse_extension! lux module/0 text/0)
+ (-> Lux Text Text Bit)
+ (let [state [extension.#bundle (extension/analysis.bundle ..eval)
+ extension.#state lux]]
+ (|> (do phase.monad
+ [[:it: it] (|> (` ("lux text concat" (~ (code.text text/0)) (~ (code.text text/0))))
+ (/.phase ..expander archive.empty)
+ //type.inferring)]
+ (in (and (type#= .Text :it:)
+ (case it
+ (^ {//.#Extension "lux text concat" (list (//.text left) (//.text right))})
+ (and (same? text/0 left)
+ (same? text/0 right))
+
+ _
+ false))))
+ //scope.with
+ (//module.with 0 module/0)
+ (phase#each (|>> product.right product.right))
+ (phase.result state)
+ (try.else false))))
+
+(def: (can_analyse_pattern_matching! lux module/0 [@any @bit @nat @int @rev @frac @text] [bit/0 nat/0 int/0 rev/0 frac/0 text/0] $parameter/0)
+ (-> Lux Text [.Text .Text .Text .Text .Text .Text .Text] [.Bit .Nat .Int .Rev .Frac .Text] Code Bit)
+ (let [state [extension.#bundle (extension/analysis.bundle ..eval)
+ extension.#state lux]
+
+ :variant: {.#Named [module/0 module/0]
+ (type (Or .Any .Bit .Nat .Int .Rev .Frac .Text))}
+ tags/* (list @any @bit @nat @int @rev @frac @text)
+
+ :record: {.#Named [module/0 module/0]
+ (type (And .Any .Bit .Nat .Int .Rev .Frac .Text))}
+ slots/* (list @any @bit @nat @int @rev @frac @text)
+
+ simple!
+ (`` (and (~~ (template [<input> <code> <analysis> <pattern>]
+ [(|> (do phase.monad
+ [[:it: it] (|> (` ({(~ $parameter/0) (~ (code.frac frac/0))} (~ (<code> <input>))))
+ (/.phase ..expander archive.empty)
+ //type.inferring)]
+ (in (and (type#= .Frac :it:)
+ (case it
+ (^ {//.#Case (<analysis> input/?)
+ [[//.#when (//pattern.bind 0)
+ //.#then (//.frac frac/?)]
+ (list)]})
+ (and (same? <input> input/?)
+ (same? frac/0 frac/?))
+
+ _
+ false))))
+ //scope.with
+ (//module.with 0 module/0)
+ (phase#each (|>> product.right product.right))
+ (phase.result state)
+ (try.else false))
+ (|> (do phase.monad
+ [[:it: it] (|> (` ({(~ (<code> <input>))
+ (~ (code.frac frac/0))
+
+ (~ $parameter/0)
+ (~ (code.frac frac/0))}
+ (~ (<code> <input>))))
+ (/.phase ..expander archive.empty)
+ //type.inferring)]
+ (in (and (type#= .Frac :it:)
+ (case it
+ (^ {//.#Case (<analysis> input/?)
+ [[//.#when (<pattern> pattern/?)
+ //.#then (//.frac frac/?)]
+ (list [//.#when (//pattern.bind 0)
+ //.#then (//.frac frac/?)])]})
+ (and (same? <input> input/?)
+ (same? <input> pattern/?)
+ (same? frac/0 frac/?))
+
+ _
+ false))))
+ //scope.with
+ (//module.with 0 module/0)
+ (phase#each (|>> product.right product.right))
+ (phase.result state)
+ (try.else false))]
+
+ [bit/0 code.bit //.bit //pattern.bit]
+ [nat/0 code.nat //.nat //pattern.nat]
+ [int/0 code.int //.int //pattern.int]
+ [rev/0 code.rev //.rev //pattern.rev]
+ [frac/0 code.frac //.frac //pattern.frac]
+ [text/0 code.text //.text //pattern.text]
+ ))))
+
+ bit!
+ (|> (do phase.monad
+ [[:it: it] (|> (` ({#0
+ (~ (code.frac frac/0))
+
+ #1
+ (~ (code.frac frac/0))}
+ (~ (code.bit bit/0))))
+ (/.phase ..expander archive.empty)
+ //type.inferring)]
+ (in (and (type#= .Frac :it:)
+ (case it
+ (^ {//.#Case (//.bit bit/?)
+ [[//.#when (//pattern.bit #0)
+ //.#then (//.frac false/?)]
+ (list [//.#when (//pattern.bit #1)
+ //.#then (//.frac true/?)])]})
+ (and (same? bit/0 bit/?)
+ (same? frac/0 false/?)
+ (same? frac/0 true/?))
+
+ _
+ false))))
+ //scope.with
+ (//module.with 0 module/0)
+ (phase#each (|>> product.right product.right))
+ (phase.result state)
+ (try.else false))
+
+ variant!
+ (`` (and (~~ (template [<lefts> <right?> <expected> <tag> <code> <analysis> <pattern>]
+ [(|> (do phase.monad
+ [_ (//module.declare_labels false tags/* false :variant:)
+ [:it: it] (|> (` ({{(~ (code.local_symbol <tag>)) (~ (<code> <expected>))}
+ (~ (code.frac frac/0))
+
+ (~ $parameter/0)
+ (~ (code.frac frac/0))}
+ {(~ (code.local_symbol <tag>)) (~ (<code> <expected>))}))
+ (/.phase ..expander archive.empty)
+ //type.inferring)]
+ (in (and (type#= .Frac :it:)
+ (case it
+ (^ {//.#Case (//.variant [<lefts> <right?> (<analysis> analysis/?)])
+ [[//.#when (//pattern.variant [<lefts> <right?> (<pattern> pattern/?)])
+ //.#then (//.frac match/?)]
+ (list [//.#when (//pattern.bind 0)
+ //.#then (//.frac mismatch/?)])]})
+ (and (same? <expected> analysis/?)
+ (same? <expected> pattern/?)
+ (same? frac/0 match/?)
+ (same? frac/0 mismatch/?))
+
+ _
+ false))))
+ //scope.with
+ (//module.with 0 module/0)
+ (phase#each (|>> product.right product.right))
+ (phase.result state)
+ (try.else false))]
+
+ [1 #0 bit/0 @bit code.bit //.bit //pattern.bit]
+ [2 #0 nat/0 @nat code.nat //.nat //pattern.nat]
+ [3 #0 int/0 @int code.int //.int //pattern.int]
+ [4 #0 rev/0 @rev code.rev //.rev //pattern.rev]
+ [5 #0 frac/0 @frac code.frac //.frac //pattern.frac]
+ [5 #1 text/0 @text code.text //.text //pattern.text]
+ ))))
+
+ tuple!
+ (|> (do phase.monad
+ [[:it: it] (|> (` ({[#0 (~ $parameter/0)]
+ (~ (code.frac frac/0))
+
+ [#1 (~ $parameter/0)]
+ (~ (code.frac frac/0))}
+ [(~ (code.bit bit/0))
+ (~ (code.nat nat/0))]))
+ (/.phase ..expander archive.empty)
+ //type.inferring)]
+ (in (and (type#= .Frac :it:)
+ (case it
+ (^ {//.#Case (//.tuple (list (//.bit bit/?) (//.nat nat/?)))
+ [[//.#when (//pattern.tuple (list (//pattern.bit #0) (//pattern.bind 0)))
+ //.#then (//.frac false/?)]
+ (list [//.#when (//pattern.tuple (list (//pattern.bit #1) (//pattern.bind 0)))
+ //.#then (//.frac true/?)])]})
+ (and (same? bit/0 bit/?)
+ (same? nat/0 nat/?)
+ (same? frac/0 false/?)
+ (same? frac/0 true/?))
+
+ _
+ false))))
+ //scope.with
+ (//module.with 0 module/0)
+ (phase#each (|>> product.right product.right))
+ (phase.result state)
+ (try.else false))
+
+ record!
+ (|> (do phase.monad
+ [_ (//module.declare_labels true slots/* false :record:)
+ [:it: it] (|> (` ({[(~ (code.symbol [module/0 @any])) []
+ (~ (code.symbol [module/0 @bit])) (~ (code.bit bit/0))
+ (~ (code.symbol [module/0 @nat])) (~ (code.nat nat/0))
+ (~ (code.symbol [module/0 @int])) (~ (code.int int/0))
+ (~ (code.symbol [module/0 @rev])) (~ (code.rev rev/0))
+ (~ (code.symbol [module/0 @frac])) (~ (code.frac frac/0))
+ (~ (code.symbol [module/0 @text])) (~ (code.text text/0))]
+ (~ (code.frac frac/0))
+
+ (~ $parameter/0)
+ (~ (code.frac frac/0))}
+ [(~ (code.local_symbol @any)) []
+ (~ (code.local_symbol @bit)) (~ (code.bit bit/0))
+ (~ (code.local_symbol @nat)) (~ (code.nat nat/0))
+ (~ (code.local_symbol @int)) (~ (code.int int/0))
+ (~ (code.local_symbol @rev)) (~ (code.rev rev/0))
+ (~ (code.local_symbol @frac)) (~ (code.frac frac/0))
+ (~ (code.local_symbol @text)) (~ (code.text text/0))]))
+ (/.phase ..expander archive.empty)
+ //type.inferring)]
+ (in (and (type#= .Frac :it:)
+ (case it
+ (^ {//.#Case (//.tuple (list (//.unit)
+ (//.bit bit/?)
+ (//.nat nat/?)
+ (//.int int/?)
+ (//.rev rev/?)
+ (//.frac frac/?)
+ (//.text text/?)))
+ [[//.#when (//pattern.tuple (list (//pattern.unit)
+ (//pattern.bit bit/?')
+ (//pattern.nat nat/?')
+ (//pattern.int int/?')
+ (//pattern.rev rev/?')
+ (//pattern.frac frac/?')
+ (//pattern.text text/?')))
+ //.#then (//.frac match/?)]
+ (list [//.#when (//pattern.bind 0)
+ //.#then (//.frac mismatch/?)])]})
+ (and (same? bit/0 bit/?) (same? bit/0 bit/?')
+ (same? nat/0 nat/?) (same? nat/0 nat/?')
+ (same? int/0 int/?) (same? int/0 int/?')
+ (same? rev/0 rev/?) (same? rev/0 rev/?')
+ (same? frac/0 frac/?) (same? frac/0 frac/?')
+ (same? text/0 text/?) (same? text/0 text/?')
+ (same? frac/0 match/?)
+ (same? frac/0 mismatch/?))
+
+ _
+ false))))
+ //scope.with
+ (//module.with 0 module/0)
+ (phase#each (|>> product.right product.right))
+ (phase.result state)
+ (try.else false))]
+ (and simple!
+ bit!
+ variant!
+ tuple!
+ record!)))
(def: .public test
Test
- ($_ _.and
- /primitive.test
- /structure.test
- /reference.test
- /case.test
- /function.test
- //lux.test
- ))
+ (<| (_.covering /._)
+ (do [! random.monad]
+ [lux $//type.random_state
+ .let [state [extension.#bundle (extension/analysis.bundle ..eval)
+ extension.#state lux]]
+
+ .let [[module/0 _] (symbol ._)]
+
+ bit/0 random.bit
+ nat/0 random.nat
+ int/0 random.int
+ rev/0 random.rev
+ frac/0 random.frac
+ text/0 (random.ascii/lower 1)
+
+ @any (random.ascii/lower 2)
+ @bit (random.ascii/lower 3)
+ @nat (random.ascii/lower 4)
+ @int (random.ascii/lower 5)
+ @rev (random.ascii/lower 6)
+ @frac (random.ascii/lower 7)
+ @text (random.ascii/lower 8)
+
+ @left (random.ascii/lower 9)
+ @right (random.ascii/lower 10)
+
+ $abstraction/0 (# ! each code.local_symbol (random.ascii/lower 11))
+ $parameter/0 (# ! each code.local_symbol (random.ascii/lower 12))
+ $abstraction/1 (# ! each code.local_symbol (random.ascii/lower 13))
+ $parameter/1 (# ! each code.local_symbol (random.ascii/lower 14))])
+ ($_ _.and
+ (_.cover [/.phase]
+ (and (..can_analyse_unit! lux module/0)
+ (..can_analyse_simple_literal_or_singleton_tuple! lux module/0 [bit/0 nat/0 int/0 rev/0 frac/0 text/0])
+ (..can_analyse_sum! lux module/0 [@any @bit @nat @int @rev @frac @text] [bit/0 nat/0 int/0 rev/0 frac/0 text/0] [@left @right])
+ (..can_analyse_variant! lux module/0 [@any @bit @nat @int @rev @frac @text] [bit/0 nat/0 int/0 rev/0 frac/0 text/0] [@left @right])
+ (..can_analyse_tuple! lux module/0 [bit/0 nat/0 int/0 rev/0 frac/0 text/0])
+ (..can_analyse_record! lux module/0 [@any @bit @nat @int @rev @frac @text] [bit/0 nat/0 int/0 rev/0 frac/0 text/0])
+ (..can_analyse_function! lux module/0 nat/0 [$abstraction/0 $parameter/0 $abstraction/1 $parameter/1])
+ (..can_analyse_apply! lux module/0 bit/0 nat/0 [$abstraction/0 $parameter/0 $abstraction/1 $parameter/1])
+ (..can_analyse_extension! lux module/0 text/0)
+ (..can_analyse_pattern_matching! lux module/0 [@any @bit @nat @int @rev @frac @text] [bit/0 nat/0 int/0 rev/0 frac/0 text/0] $parameter/0)
+ ))
+ (_.cover [/.invalid]
+ (`` (and (~~ (template [<syntax>]
+ [(|> (do phase.monad
+ [_ (|> <syntax>
+ (/.phase ..expander archive.empty)
+ (//type.expecting .Any))]
+ (in false))
+ //scope.with
+ (//module.with 0 module/0)
+ (phase#each (|>> product.right product.right))
+ (phase.result state)
+ (exception.otherwise (text.contains? (value@ exception.#label /.invalid))))]
+
+ [(` ({#0} (~ (code.bit bit/0))))]
+ [(` ({#0 [] #1} (~ (code.bit bit/0))))]
+ [(` {(~ (code.bit bit/0)) (~ (code.nat nat/0)) (~ (code.int int/0)) (~ (code.rev rev/0)) (~ (code.frac frac/0)) (~ (code.text text/0))})]
+ [(` {(~ (code.nat nat/0)) (~ (code.int int/0)) (~ (code.rev rev/0)) (~ (code.frac frac/0)) (~ (code.text text/0)) (~ (code.bit bit/0))})]
+ [(` {(~ (code.int int/0)) (~ (code.rev rev/0)) (~ (code.frac frac/0)) (~ (code.text text/0)) (~ (code.bit bit/0)) (~ (code.nat nat/0))})]
+ [(` {(~ (code.rev rev/0)) (~ (code.frac frac/0)) (~ (code.text text/0)) (~ (code.bit bit/0)) (~ (code.nat nat/0)) (~ (code.int int/0))})]
+ [(` {(~ (code.frac frac/0)) (~ (code.text text/0)) (~ (code.bit bit/0)) (~ (code.nat nat/0)) (~ (code.int int/0)) (~ (code.rev rev/0))})]
+ [(` {(~ (code.text text/0)) (~ (code.bit bit/0)) (~ (code.nat nat/0)) (~ (code.int int/0)) (~ (code.rev rev/0)) (~ (code.frac frac/0))})]
+ ))
+ )))
+
+ /simple.test
+ /complex.test
+ /reference.test
+ /function.test
+ /case.test
+ )))
diff --git a/stdlib/source/test/lux/tool/compiler/meta/archive/artifact/category.lux b/stdlib/source/test/lux/tool/compiler/meta/archive/artifact/category.lux
index 8f31cca51..358f35350 100644
--- a/stdlib/source/test/lux/tool/compiler/meta/archive/artifact/category.lux
+++ b/stdlib/source/test/lux/tool/compiler/meta/archive/artifact/category.lux
@@ -10,11 +10,23 @@
[\\library
["[0]" /]])
+(def: random_definition
+ (Random /.Definition)
+ ($_ random.and
+ (random.ascii/lower 1)
+ (random.maybe
+ ($_ random.and
+ random.nat
+ random.nat
+ random.nat
+ ))
+ ))
+
(def: .public random
(Random /.Category)
($_ random.or
(random#in [])
- (random.ascii/lower 1)
+ ..random_definition
(random.ascii/lower 2)
(random.ascii/lower 3)
(random.ascii/lower 4)
diff --git a/stdlib/source/test/lux/tool/compiler/meta/archive/registry.lux b/stdlib/source/test/lux/tool/compiler/meta/archive/registry.lux
index f9499d442..893f1da72 100644
--- a/stdlib/source/test/lux/tool/compiler/meta/archive/registry.lux
+++ b/stdlib/source/test/lux/tool/compiler/meta/archive/registry.lux
@@ -15,7 +15,7 @@
[collection
["[0]" sequence {"+" Sequence}]
["[0]" set {"+" Set}]
- ["[0]" list ("[1]#[0]" mix)]]
+ ["[0]" list ("[1]#[0]" mix functor)]]
[format
["[0]" binary]]]
[math
@@ -78,97 +78,103 @@
_
false)))
- (~~ (template [<new> <query> <tag> <wrong_new>]
+ (~~ (template [<new> <expected>' <query> <tag> <wrong_new> <wrong_expected>']
[(_.cover [<new> <query>]
- (and (let [[@it registry] (<new> expected_name mandatory? expected_dependencies /.empty)]
- (and (case (<query> registry)
- (^ (list actual_name))
- (same? expected_name actual_name)
+ (let [<expected> <expected>'
+ <wrong_expected> <wrong_expected>']
+ (and (let [[@it registry] (<new> <expected> mandatory? expected_dependencies /.empty)]
+ (and (case (<query> registry)
+ (^ (list actual_name))
+ (same? <expected> actual_name)
- _
- false)
- (case (sequence.list (/.artifacts registry))
- (^ (list [artifact actual_dependencies]))
- (and (same? @it (value@ artifact.#id artifact))
- (same? mandatory? (value@ artifact.#mandatory? artifact))
- (case (value@ artifact.#category artifact)
- {<tag> actual_name}
- (same? expected_name actual_name)
+ _
+ false)
+ (case (sequence.list (/.artifacts registry))
+ (^ (list [artifact actual_dependencies]))
+ (and (same? @it (value@ artifact.#id artifact))
+ (same? mandatory? (value@ artifact.#mandatory? artifact))
+ (case (value@ artifact.#category artifact)
+ {<tag> actual_name}
+ (same? <expected> actual_name)
- _
- false)
- (same? expected_dependencies actual_dependencies))
+ _
+ false)
+ (same? expected_dependencies actual_dependencies))
- _
- false)))
- (let [[@it registry] (<wrong_new> expected_name mandatory? expected_dependencies /.empty)]
- (case (<query> registry)
- (^ (list))
- true
+ _
+ false)))
+ (let [[@it registry] (<wrong_new> <wrong_expected> mandatory? expected_dependencies /.empty)]
+ (case (<query> registry)
+ (^ (list))
+ true
- _
- false))))]
+ _
+ false)))))]
- [/.definition /.definitions category.#Definition /.analyser]
- [/.analyser /.analysers category.#Analyser /.synthesizer]
- [/.synthesizer /.synthesizers category.#Synthesizer /.generator]
- [/.generator /.generators category.#Generator /.directive]
- [/.directive /.directives category.#Directive /.custom]
- [/.custom /.customs category.#Custom /.definition]
+ [/.definition (: category.Definition [expected_name {.#None}]) /.definitions category.#Definition /.analyser expected_name]
+ [/.analyser expected_name /.analysers category.#Analyser /.synthesizer expected_name]
+ [/.synthesizer expected_name /.synthesizers category.#Synthesizer /.generator expected_name]
+ [/.generator expected_name /.generators category.#Generator /.directive expected_name]
+ [/.directive expected_name /.directives category.#Directive /.custom expected_name]
+ [/.custom expected_name /.customs category.#Custom /.definition (: category.Definition [expected_name {.#None}])]
))
(_.cover [/.id]
- (and (~~ (template [<new>]
- [(let [[@expected registry] (<new> expected_name mandatory? expected_dependencies /.empty)]
- (|> (/.id expected_name registry)
+ (and (~~ (template [<new> <expected>' <name>]
+ [(let [<expected> <expected>'
+ [@expected registry] (<new> <expected> mandatory? expected_dependencies /.empty)]
+ (|> (/.id (<name> <expected>) registry)
(maybe#each (same? @expected))
(maybe.else false)))]
- [/.definition]
- [/.analyser]
- [/.synthesizer]
- [/.generator]
- [/.directive]
- [/.custom]
+ [/.definition (: category.Definition [expected_name {.#None}]) product.left]
+ [/.analyser expected_name |>]
+ [/.synthesizer expected_name |>]
+ [/.generator expected_name |>]
+ [/.directive expected_name |>]
+ [/.custom expected_name |>]
))))
(_.cover [/.artifacts]
- (and (~~ (template [<new> <query>]
- [(let [[ids registry] (: [(Sequence artifact.ID) /.Registry]
- (list#mix (function (_ name [ids registry])
- (let [[@new registry] (<new> name mandatory? expected_dependencies registry)]
+ (and (~~ (template [<new> <query> <equivalence> <$>]
+ [(let [expected/* (list#each <$> expected_names)
+ [ids registry] (: [(Sequence artifact.ID) /.Registry]
+ (list#mix (function (_ expected [ids registry])
+ (let [[@new registry] (<new> expected mandatory? expected_dependencies registry)]
[(sequence.suffix @new ids) registry]))
[sequence.empty /.empty]
- expected_names))
+ expected/*))
it (/.artifacts registry)]
(and (n.= expected_amount (sequence.size it))
- (n.= expected_amount (sequence.size it))
(list.every? (function (_ [@it [it dependencies]])
(same? @it (value@ artifact.#id it)))
(list.zipped/2 (sequence.list ids) (sequence.list it)))
- (# (list.equivalence text.equivalence) = expected_names (<query> registry))))]
+ (# (list.equivalence <equivalence>) = expected/* (<query> registry))))]
- [/.definition /.definitions]
- [/.analyser /.analysers]
- [/.synthesizer /.synthesizers]
- [/.generator /.generators]
- [/.directive /.directives]
- [/.custom /.customs]
+ [/.definition /.definitions category.definition_equivalence (: (-> Text category.Definition)
+ (function (_ it)
+ [it {.#None}]))]
+ [/.analyser /.analysers text.equivalence (|>>)]
+ [/.synthesizer /.synthesizers text.equivalence (|>>)]
+ [/.generator /.generators text.equivalence (|>>)]
+ [/.directive /.directives text.equivalence (|>>)]
+ [/.custom /.customs text.equivalence (|>>)]
))))
(_.cover [/.writer /.parser]
- (and (~~ (template [<new>]
- [(let [[@expected before] (<new> expected_name mandatory? expected_dependencies /.empty)]
+ (and (~~ (template [<new> <expected>' <name>]
+ [(let [<expected> <expected>'
+ [@expected before] (<new> <expected> mandatory? expected_dependencies /.empty)]
(|> before
(binary.result /.writer)
(<binary>.result /.parser)
- (try#each (|>> (/.id expected_name)
+ (try#each (|>> (/.id (<name> <expected>))
(maybe#each (same? @expected))
(maybe.else false)))
(try.else false)))]
- [/.definition]
- [/.analyser]
- [/.synthesizer]
- [/.generator]
- [/.directive]
- [/.custom]
+ [/.definition (: category.Definition [expected_name {.#None}]) product.left]
+ [/.analyser expected_name |>]
+ [/.synthesizer expected_name |>]
+ [/.generator expected_name |>]
+ [/.directive expected_name |>]
+ [/.custom expected_name |>]
))))
)))))
diff --git a/stdlib/source/test/lux/world/file.lux b/stdlib/source/test/lux/world/file.lux
index ee313599f..5c05b5437 100644
--- a/stdlib/source/test/lux/world/file.lux
+++ b/stdlib/source/test/lux/world/file.lux
@@ -7,8 +7,9 @@
[control
["[0]" io {"+" IO}]
["[0]" try {"+" Try}]
+ ["[0]" exception]
[concurrency
- [async {"+" Async}]
+ ["[0]" async {"+" Async}]
["[0]" atom {"+" Atom}]]]
[data
["[0]" binary {"+" Binary} ("[1]#[0]" monoid)]
@@ -239,12 +240,46 @@
Test
(<| (_.covering /._)
(do [! random.monad]
- [/ (random.ascii/upper 1)]
+ [/ (random.ascii/upper 1)
+ file (random.ascii/lower 1)]
($_ _.and
(_.for [/.mock]
($/.spec (io.io (/.mock /))))
(_.for [/.async]
($/.spec (io.io (/.async (..fs /)))))
+
+ (in (do async.monad
+ [.let [fs (/.mock /)]
+ ? (# fs delete file)]
+ (_.cover' [/.cannot_delete]
+ (case ?
+ {try.#Failure error}
+ (exception.match? /.cannot_delete error)
+
+ _
+ false))))
+ (in (do async.monad
+ [.let [fs (/.mock /)]
+ ? (# fs read file)]
+ (_.cover' [/.cannot_find_file]
+ (case ?
+ {try.#Failure error}
+ (exception.match? /.cannot_find_file error)
+
+ _
+ false))))
+ (in (do async.monad
+ [.let [fs (/.mock /)]
+ ?/0 (# fs directory_files file)
+ ?/1 (# fs sub_directories file)]
+ (_.cover' [/.cannot_find_directory]
+ (case [?/0 ?/1]
+ [{try.#Failure error/0} {try.#Failure error/1}]
+ (and (exception.match? /.cannot_find_directory error/0)
+ (exception.match? /.cannot_find_directory error/1))
+
+ _
+ false))))
/watch.test
))))
diff --git a/stdlib/source/unsafe/lux/data/binary.lux b/stdlib/source/unsafe/lux/data/binary.lux
index ffc2b5e84..91726c57a 100644
--- a/stdlib/source/unsafe/lux/data/binary.lux
+++ b/stdlib/source/unsafe/lux/data/binary.lux
@@ -271,7 +271,8 @@
(with_expansions [<reference> (: ..Binary reference')
<sample> (: ..Binary sample')
- <jvm> (java/util/Arrays::equals <reference> <sample>)]
+ <jvm> (java/util/Arrays::equals <reference> <sample>)
+ <jvm> (ffi.of_boolean <jvm>)]
(template: .public (= reference' sample')
[(for [@.old <jvm>
@.jvm <jvm>]
@@ -290,9 +291,9 @@
... TODO: Turn into a template ASAP.
(inline: .public (copy! bytes source_offset source target_offset target)
(-> Nat Nat ..Binary Nat ..Binary ..Binary)
- (with_expansions [<jvm> (java/lang/System::arraycopy source (.int source_offset)
- target (.int target_offset)
- (.int bytes))
+ (with_expansions [<jvm> (java/lang/System::arraycopy source (ffi.as_int (.int source_offset))
+ target (ffi.as_int (.int target_offset))
+ (ffi.as_int (.int bytes)))
<jvm> (exec
<jvm>
target)]
@@ -311,8 +312,8 @@
... TODO: Turn into a template ASAP.
(with_expansions [<jvm> (java/util/Arrays::copyOfRange binary
- (.int offset)
- (.int limit))
+ (ffi.as_int (.int offset))
+ (ffi.as_int (.int limit)))
<jvm> (let [limit ("lux i64 +" size offset)]
<jvm>)]
(inline: .public (slice offset size binary)