diff options
| author | Eduardo Julian | 2022-02-22 16:29:17 -0400 |
|---|---|---|
| committer | Eduardo Julian | 2022-02-22 16:29:17 -0400 |
| commit | f07effd9faf3fdaa677f659d6bbccf98931c5e5a (patch) | |
| tree | 0b51a4b8492d06db6b3eca38a3b9143de1c1d735 /stdlib/source | |
| parent | 2d1348a73159ec87fa0da2bd3768d641236693fb (diff) | |
No more automatic conversions of primitive types in JVM FFI.
Diffstat (limited to 'stdlib/source')
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) |