diff options
Diffstat (limited to '')
36 files changed, 551 insertions, 300 deletions
diff --git a/documentation/research/math.md b/documentation/research/math.md index a9fc8c7af..52dc2a6ce 100644 --- a/documentation/research/math.md +++ b/documentation/research/math.md @@ -170,6 +170,7 @@ # Geometric Algebra | Clifford Algebra +1. [Plane-based Geometric Algebra for Computer Science](https://bivector.net/PGA4CS.html) 1. [Differential geometric algebra foundations: Grassmann.jl Ascend](https://www.youtube.com/watch?v=7hlDRLEhc8o&feature=youtu.be) 1. [Projective Geometric Algebra Done Right](http://terathon.com/blog/projective-geometric-algebra-done-right/) 1. [Siggraph2019 Geometric Algebra](https://www.youtube.com/watch?v=tX4H_ctggYo) diff --git a/lux-jvm/source/luxc/lang/directive/jvm.lux b/lux-jvm/source/luxc/lang/directive/jvm.lux index 23d2fb6d5..798cf8298 100644 --- a/lux-jvm/source/luxc/lang/directive/jvm.lux +++ b/lux-jvm/source/luxc/lang/directive/jvm.lux @@ -37,7 +37,7 @@ ["." jvm (#+ Inst) ["_" inst]]]]) -(import: #long org/objectweb/asm/Label +(import: org/objectweb/asm/Label (new [])) (def: (literal literal) diff --git a/lux-jvm/source/luxc/lang/host/jvm.lux b/lux-jvm/source/luxc/lang/host/jvm.lux index 9301ab4ae..6d2e49b22 100644 --- a/lux-jvm/source/luxc/lang/host/jvm.lux +++ b/lux-jvm/source/luxc/lang/host/jvm.lux @@ -31,14 +31,14 @@ (import: org/objectweb/asm/ClassWriter) -(import: #long org/objectweb/asm/Label +(import: org/objectweb/asm/Label (new [])) (type: #export Def - (-> ClassWriter ClassWriter)) + (-> org/objectweb/asm/ClassWriter org/objectweb/asm/ClassWriter)) (type: #export Inst - (-> MethodVisitor MethodVisitor)) + (-> org/objectweb/asm/MethodVisitor org/objectweb/asm/MethodVisitor)) (type: #export Label org/objectweb/asm/Label) diff --git a/lux-jvm/source/luxc/lang/host/jvm/def.lux b/lux-jvm/source/luxc/lang/host/jvm/def.lux index f274da61f..642f42018 100644 --- a/lux-jvm/source/luxc/lang/host/jvm/def.lux +++ b/lux-jvm/source/luxc/lang/host/jvm/def.lux @@ -26,8 +26,8 @@ (def: descriptor (|>> type.descriptor descriptor.descriptor)) (def: class-name (|>> type.descriptor descriptor.class-name name.read)) -(import: #long java/lang/Object) -(import: #long java/lang/String) +(import: java/lang/Object) +(import: java/lang/String) (import: org/objectweb/asm/Opcodes (#static ACC_PUBLIC int) @@ -68,15 +68,15 @@ (#static COMPUTE_MAXS int) (#static COMPUTE_FRAMES int) (new [int]) - (visit [int int String String String [String]] void) + (visit [int int java/lang/String java/lang/String java/lang/String [java/lang/String]] void) (visitEnd [] void) - (visitField [int String String String Object] FieldVisitor) - (visitMethod [int String String String [String]] MethodVisitor) + (visitField [int java/lang/String java/lang/String java/lang/String java/lang/Object] org/objectweb/asm/FieldVisitor) + (visitMethod [int java/lang/String java/lang/String java/lang/String [java/lang/String]] org/objectweb/asm/MethodVisitor) (toByteArray [] [byte])) (def: (string-array values) (-> (List Text) (Array Text)) - (let [output (host.array String (list.size values))] + (let [output (host.array java/lang/String (list.size values))] (exec (list@map (function (_ [idx value]) (host.array-write idx value output)) (list.enumerate values)) @@ -85,43 +85,43 @@ (def: (version-flag version) (-> //.Version Int) (case version - #//.V1_1 (Opcodes::V1_1) - #//.V1_2 (Opcodes::V1_2) - #//.V1_3 (Opcodes::V1_3) - #//.V1_4 (Opcodes::V1_4) - #//.V1_5 (Opcodes::V1_5) - #//.V1_6 (Opcodes::V1_6) - #//.V1_7 (Opcodes::V1_7) - #//.V1_8 (Opcodes::V1_8))) + #//.V1_1 (org/objectweb/asm/Opcodes::V1_1) + #//.V1_2 (org/objectweb/asm/Opcodes::V1_2) + #//.V1_3 (org/objectweb/asm/Opcodes::V1_3) + #//.V1_4 (org/objectweb/asm/Opcodes::V1_4) + #//.V1_5 (org/objectweb/asm/Opcodes::V1_5) + #//.V1_6 (org/objectweb/asm/Opcodes::V1_6) + #//.V1_7 (org/objectweb/asm/Opcodes::V1_7) + #//.V1_8 (org/objectweb/asm/Opcodes::V1_8))) (def: (visibility-flag visibility) (-> //.Visibility Int) (case visibility - #//.Public (Opcodes::ACC_PUBLIC) - #//.Protected (Opcodes::ACC_PROTECTED) - #//.Private (Opcodes::ACC_PRIVATE) + #//.Public (org/objectweb/asm/Opcodes::ACC_PUBLIC) + #//.Protected (org/objectweb/asm/Opcodes::ACC_PROTECTED) + #//.Private (org/objectweb/asm/Opcodes::ACC_PRIVATE) #//.Default +0)) (def: (class-flags config) (-> //.Class-Config Int) ($_ i.+ - (if (get@ #//.finalC config) (Opcodes::ACC_FINAL) +0))) + (if (get@ #//.finalC config) (org/objectweb/asm/Opcodes::ACC_FINAL) +0))) (def: (method-flags config) (-> //.Method-Config Int) ($_ i.+ - (if (get@ #//.staticM config) (Opcodes::ACC_STATIC) +0) - (if (get@ #//.finalM config) (Opcodes::ACC_FINAL) +0) - (if (get@ #//.synchronizedM config) (Opcodes::ACC_SYNCHRONIZED) +0) - (if (get@ #//.strictM config) (Opcodes::ACC_STRICT) +0))) + (if (get@ #//.staticM config) (org/objectweb/asm/Opcodes::ACC_STATIC) +0) + (if (get@ #//.finalM config) (org/objectweb/asm/Opcodes::ACC_FINAL) +0) + (if (get@ #//.synchronizedM config) (org/objectweb/asm/Opcodes::ACC_SYNCHRONIZED) +0) + (if (get@ #//.strictM config) (org/objectweb/asm/Opcodes::ACC_STRICT) +0))) (def: (field-flags config) (-> //.Field-Config Int) ($_ i.+ - (if (get@ #//.staticF config) (Opcodes::ACC_STATIC) +0) - (if (get@ #//.finalF config) (Opcodes::ACC_FINAL) +0) - (if (get@ #//.transientF config) (Opcodes::ACC_TRANSIENT) +0) - (if (get@ #//.volatileF config) (Opcodes::ACC_VOLATILE) +0))) + (if (get@ #//.staticF config) (org/objectweb/asm/Opcodes::ACC_STATIC) +0) + (if (get@ #//.finalF config) (org/objectweb/asm/Opcodes::ACC_FINAL) +0) + (if (get@ #//.transientF config) (org/objectweb/asm/Opcodes::ACC_TRANSIENT) +0) + (if (get@ #//.volatileF config) (org/objectweb/asm/Opcodes::ACC_VOLATILE) +0))) (def: param-signature (-> (Type Class) Text) @@ -154,8 +154,8 @@ (def: class-computes Int ($_ i.+ - (ClassWriter::COMPUTE_MAXS) - ## (ClassWriter::COMPUTE_FRAMES) + (org/objectweb/asm/ClassWriter::COMPUTE_MAXS) + ## (org/objectweb/asm/ClassWriter::COMPUTE_FRAMES) )) (def: binary-name (|>> name.internal name.read)) @@ -165,25 +165,25 @@ definitions) (-> //.Version //.Visibility //.Class-Config Text (List Constraint) (Type Class) (List (Type Class)) //.Def (host.type [byte])) - (let [writer (|> (do-to (ClassWriter::new class-computes) - (ClassWriter::visit (version-flag version) - ($_ i.+ - (Opcodes::ACC_SUPER) - <flag> - (visibility-flag visibility) - (class-flags config)) - (..binary-name name) - (constraints-signature constraints super interfaces) - (..class-name super) - (|> interfaces - (list@map ..class-name) - string-array))) + (let [writer (|> (do-to (org/objectweb/asm/ClassWriter::new class-computes) + (org/objectweb/asm/ClassWriter::visit (version-flag version) + ($_ i.+ + (org/objectweb/asm/Opcodes::ACC_SUPER) + <flag> + (visibility-flag visibility) + (class-flags config)) + (..binary-name name) + (constraints-signature constraints super interfaces) + (..class-name super) + (|> interfaces + (list@map ..class-name) + string-array))) definitions) - _ (ClassWriter::visitEnd writer)] - (ClassWriter::toByteArray writer)))] + _ (org/objectweb/asm/ClassWriter::visitEnd writer)] + (org/objectweb/asm/ClassWriter::toByteArray writer)))] [class +0] - [abstract (Opcodes::ACC_ABSTRACT)] + [abstract (org/objectweb/asm/Opcodes::ACC_ABSTRACT)] ) (def: $Object @@ -194,84 +194,84 @@ definitions) (-> //.Version //.Visibility //.Class-Config Text (List Constraint) (List (Type Class)) //.Def (host.type [byte])) - (let [writer (|> (do-to (ClassWriter::new class-computes) - (ClassWriter::visit (version-flag version) - ($_ i.+ - (Opcodes::ACC_SUPER) - (Opcodes::ACC_INTERFACE) - (visibility-flag visibility) - (class-flags config)) - (..binary-name name) - (constraints-signature constraints $Object interfaces) - (..class-name $Object) - (|> interfaces - (list@map ..class-name) - string-array))) + (let [writer (|> (do-to (org/objectweb/asm/ClassWriter::new class-computes) + (org/objectweb/asm/ClassWriter::visit (version-flag version) + ($_ i.+ + (org/objectweb/asm/Opcodes::ACC_SUPER) + (org/objectweb/asm/Opcodes::ACC_INTERFACE) + (visibility-flag visibility) + (class-flags config)) + (..binary-name name) + (constraints-signature constraints $Object interfaces) + (..class-name $Object) + (|> interfaces + (list@map ..class-name) + string-array))) definitions) - _ (ClassWriter::visitEnd writer)] - (ClassWriter::toByteArray writer))) + _ (org/objectweb/asm/ClassWriter::visitEnd writer)] + (org/objectweb/asm/ClassWriter::toByteArray writer))) (def: #export (method visibility config name type then) (-> //.Visibility //.Method-Config Text (Type Method) //.Inst //.Def) (function (_ writer) - (let [=method (ClassWriter::visitMethod ($_ i.+ - (visibility-flag visibility) - (method-flags config)) - (..binary-name name) - (..descriptor type) - (..signature type) - (string-array (list)) - writer) - _ (MethodVisitor::visitCode =method) + (let [=method (org/objectweb/asm/ClassWriter::visitMethod ($_ i.+ + (visibility-flag visibility) + (method-flags config)) + (..binary-name name) + (..descriptor type) + (..signature type) + (string-array (list)) + writer) + _ (org/objectweb/asm/MethodVisitor::visitCode =method) _ (then =method) - _ (MethodVisitor::visitMaxs +0 +0 =method) - _ (MethodVisitor::visitEnd =method)] + _ (org/objectweb/asm/MethodVisitor::visitMaxs +0 +0 =method) + _ (org/objectweb/asm/MethodVisitor::visitEnd =method)] writer))) (def: #export (abstract-method visibility config name type) (-> //.Visibility //.Method-Config Text (Type Method) //.Def) (function (_ writer) - (let [=method (ClassWriter::visitMethod ($_ i.+ - (visibility-flag visibility) - (method-flags config) - (Opcodes::ACC_ABSTRACT)) - (..binary-name name) - (..descriptor type) - (..signature type) - (string-array (list)) - writer) - _ (MethodVisitor::visitEnd =method)] + (let [=method (org/objectweb/asm/ClassWriter::visitMethod ($_ i.+ + (visibility-flag visibility) + (method-flags config) + (org/objectweb/asm/Opcodes::ACC_ABSTRACT)) + (..binary-name name) + (..descriptor type) + (..signature type) + (string-array (list)) + writer) + _ (org/objectweb/asm/MethodVisitor::visitEnd =method)] writer))) (def: #export (field visibility config name type) (-> //.Visibility //.Field-Config Text (Type Value) //.Def) (function (_ writer) - (let [=field (do-to (ClassWriter::visitField ($_ i.+ - (visibility-flag visibility) - (field-flags config)) - (..binary-name name) - (..descriptor type) - (..signature type) - (host.null) - writer) - (FieldVisitor::visitEnd))] + (let [=field (do-to (org/objectweb/asm/ClassWriter::visitField ($_ i.+ + (visibility-flag visibility) + (field-flags config)) + (..binary-name name) + (..descriptor type) + (..signature type) + (host.null) + writer) + (org/objectweb/asm/FieldVisitor::visitEnd))] writer))) (template [<name> <lux-type> <jvm-type> <prepare>] [(def: #export (<name> visibility config name value) (-> //.Visibility //.Field-Config Text <lux-type> //.Def) (function (_ writer) - (let [=field (do-to (ClassWriter::visitField ($_ i.+ - (visibility-flag visibility) - (field-flags config)) - (..binary-name name) - (..descriptor <jvm-type>) - (..signature <jvm-type>) - (<prepare> value) - writer) - (FieldVisitor::visitEnd))] + (let [=field (do-to (org/objectweb/asm/ClassWriter::visitField ($_ i.+ + (visibility-flag visibility) + (field-flags config)) + (..binary-name name) + (..descriptor <jvm-type>) + (..signature <jvm-type>) + (<prepare> value) + writer) + (org/objectweb/asm/FieldVisitor::visitEnd))] writer)))] [boolean-field Bit type.boolean function.identity] diff --git a/lux-jvm/source/luxc/lang/host/jvm/inst.lux b/lux-jvm/source/luxc/lang/host/jvm/inst.lux index b673c7d7e..69f822591 100644 --- a/lux-jvm/source/luxc/lang/host/jvm/inst.lux +++ b/lux-jvm/source/luxc/lang/host/jvm/inst.lux @@ -39,15 +39,15 @@ (def: reflection (|>> type.reflection reflection.reflection)) ## [Host] -(import: #long java/lang/Object) -(import: #long java/lang/String) +(import: java/lang/Object) +(import: java/lang/String) (syntax: (declare {codes (p.many s.local-identifier)}) (|> codes (list@map (function (_ code) (` ((~' #static) (~ (code.local-identifier code)) (~' int))))) wrap)) -(`` (import: #long org/objectweb/asm/Opcodes +(`` (import: org/objectweb/asm/Opcodes (#static NOP int) ## Conversion @@ -122,10 +122,10 @@ (~~ (declare RETURN IRETURN LRETURN FRETURN DRETURN ARETURN)) )) -(import: #long org/objectweb/asm/Label +(import: org/objectweb/asm/Label (new [])) -(import: #long org/objectweb/asm/MethodVisitor +(import: org/objectweb/asm/MethodVisitor (visitCode [] void) (visitMaxs [int int] void) (visitEnd [] void) diff --git a/lux-jvm/source/luxc/lang/translation/jvm.lux b/lux-jvm/source/luxc/lang/translation/jvm.lux index 0ffea0e42..30a130150 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm.lux @@ -41,16 +41,16 @@ ["." inst]]]] ) -(import: #long java/lang/reflect/Field +(import: java/lang/reflect/Field (get [#? java/lang/Object] #try #? java/lang/Object)) -(import: #long (java/lang/Class a) +(import: (java/lang/Class a) (getField [java/lang/String] #try java/lang/reflect/Field)) -(import: #long java/lang/Object +(import: java/lang/Object (getClass [] (java/lang/Class java/lang/Object))) -(import: #long java/lang/ClassLoader) +(import: java/lang/ClassLoader) (type: #export ByteCode Binary) diff --git a/lux-jvm/source/luxc/lang/translation/jvm/extension/common.lux b/lux-jvm/source/luxc/lang/translation/jvm/extension/common.lux index 383415c0a..0388c5c7f 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/extension/common.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/extension/common.lux @@ -53,8 +53,8 @@ (phase.throw extension.invalid-syntax [extension-name %synthesis input])))) (import: java/lang/Double - (#static MIN_VALUE Double) - (#static MAX_VALUE Double)) + (#static MIN_VALUE java/lang/Double) + (#static MAX_VALUE java/lang/Double)) (def: $String (type.class "java.lang.String" (list))) (def: $CharSequence (type.class "java.lang.CharSequence" (list))) @@ -164,9 +164,9 @@ (Nullary Inst) (|>> <const> (_.wrap <type>)))] - [f64::smallest (_.double (Double::MIN_VALUE)) type.double] - [f64::min (_.double (f.* -1.0 (Double::MAX_VALUE))) type.double] - [f64::max (_.double (Double::MAX_VALUE)) type.double] + [f64::smallest (_.double (java/lang/Double::MIN_VALUE)) type.double] + [f64::min (_.double (f.* -1.0 (java/lang/Double::MAX_VALUE))) type.double] + [f64::max (_.double (java/lang/Double::MAX_VALUE)) type.double] ) (template [<name> <type> <op>] diff --git a/lux-jvm/source/luxc/lang/translation/jvm/primitive.lux b/lux-jvm/source/luxc/lang/translation/jvm/primitive.lux index 24eeef49e..d8ab2cbee 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/primitive.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/primitive.lux @@ -22,11 +22,11 @@ (function (_ value) (operation@wrap (_.GETSTATIC Boolean (if value "TRUE" "FALSE") Boolean))))) -(import: #long java/lang/Byte +(import: java/lang/Byte (#static MAX_VALUE byte) (#static MIN_VALUE byte)) -(import: #long java/lang/Short +(import: java/lang/Short (#static MAX_VALUE short) (#static MIN_VALUE short)) @@ -63,7 +63,7 @@ (|> value .int _.long))] (operation@wrap (|>> constantI (_.wrap type.long)))))) -(import: #long java/lang/Double +(import: java/lang/Double (#static doubleToRawLongBits #manual [double] int)) (def: d0-bits diff --git a/lux-jvm/source/luxc/lang/translation/jvm/structure.lux b/lux-jvm/source/luxc/lang/translation/jvm/structure.lux index c61f96bb8..4a4c30e0f 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/structure.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/structure.lux @@ -60,11 +60,11 @@ (_.array //runtime.$Value) membersI)))) -(import: #long java/lang/Byte +(import: java/lang/Byte (#static MAX_VALUE byte) (#static MIN_VALUE byte)) -(import: #long java/lang/Short +(import: java/lang/Short (#static MAX_VALUE short) (#static MIN_VALUE short)) diff --git a/lux-jvm/source/program.lux b/lux-jvm/source/program.lux index 1114dd3b6..61d97a9c7 100644 --- a/lux-jvm/source/program.lux +++ b/lux-jvm/source/program.lux @@ -65,13 +65,13 @@ ["#/." program] ["translation" extension]]]]]) -(import: #long java/lang/reflect/Method +(import: java/lang/reflect/Method (invoke [java/lang/Object [java/lang/Object]] #try java/lang/Object)) -(import: #long (java/lang/Class c) +(import: (java/lang/Class c) (getMethod [java/lang/String [(java/lang/Class java/lang/Object)]] #try java/lang/reflect/Method)) -(import: #long java/lang/Object +(import: java/lang/Object (getClass [] (java/lang/Class java/lang/Object))) (def: _object-class diff --git a/luxc/src/lux/analyser/module.clj b/luxc/src/lux/analyser/module.clj index 3d53155cb..d41eb73d5 100644 --- a/luxc/src/lux/analyser/module.clj +++ b/luxc/src/lux/analyser/module.clj @@ -126,8 +126,6 @@ (defn define [module name exported? def-type def-meta def-value] (fn [state] - (when (and (= "Macro'" name) (= "lux" module)) - (&type/set-macro*-type! def-value)) (|case (&/get$ &/$scopes state) (&/$Cons ?env (&/$Nil)) (return* (->> state @@ -264,7 +262,7 @@ (&/$Right [exported? ?type ?meta ?value]) (if (or (.equals ^Object current-module module) (and exported? - (or (.equals ^Object module "lux") + (or (.equals ^Object module &/prelude) (imports? state module current-module)))) (return* state (&/T [(&/T [module name]) (&/T [exported? ?type ?meta ?value])])) diff --git a/luxc/src/lux/analyser/proc/common.clj b/luxc/src/lux/analyser/proc/common.clj index 8cdcea970..267ea3465 100644 --- a/luxc/src/lux/analyser/proc/common.clj +++ b/luxc/src/lux/analyser/proc/common.clj @@ -4,7 +4,8 @@ clojure.core.match.array (lux [base :as & :refer [|let |do return* return |case assert!]] [type :as &type]) - (lux.analyser [base :as &&]))) + (lux.analyser [base :as &&] + [module :as &&module]))) (defn- analyse-lux-is [analyse exo-type ?values] (&type/with-var @@ -31,7 +32,8 @@ (defn- analyse-lux-macro [analyse exo-type ?values] (|do [:let [(&/$Cons macro (&/$Nil)) ?values] - [[=macro*-type =location] =macro] (&&/analyse-1 analyse &type/Macro* macro) + [_real-name [_exported? _def-type _meta macro-type]] (&&module/find-def! &/prelude "Macro'") + [[=macro*-type =location] =macro] (&&/analyse-1 analyse macro-type macro) _ (&type/check exo-type &type/Macro)] (return (&/|list (&&/|meta exo-type =location =macro))))) @@ -257,7 +259,7 @@ (try (case proc "lux is" (analyse-lux-is analyse exo-type ?values) "lux try" (analyse-lux-try analyse exo-type ?values) - "lux macro" (analyse-lux-macro analyse exo-type ?values) + "lux macro" (analyse-lux-macro analyse exo-type ?values) "lux io log" (analyse-io-log analyse exo-type ?values) "lux io error" (analyse-io-error analyse exo-type ?values) diff --git a/luxc/src/lux/base.clj b/luxc/src/lux/base.clj index cc109b0f7..5ef710a03 100644 --- a/luxc/src/lux/base.clj +++ b/luxc/src/lux/base.clj @@ -4,6 +4,9 @@ [clojure.core.match :as M :refer [matchv]] clojure.core.match.array)) +(def prelude + "lux") + (def !log! (atom false)) (defn flag-prn! [& args] (when @!log! diff --git a/luxc/src/lux/compiler/jvm.clj b/luxc/src/lux/compiler/jvm.clj index e1a51b73a..07c28dfac 100644 --- a/luxc/src/lux/compiler/jvm.clj +++ b/luxc/src/lux/compiler/jvm.clj @@ -157,7 +157,7 @@ (let [compile-expression* (partial compile-expression nil)] (&/T [(partial &&lux/compile-def compile-expression) (partial &&lux/compile-program compile-expression*) - (fn [macro args state] (-> macro (.apply args) (.apply state))) + (fn [macro args state] (.apply macro args state)) (partial &&proc-host/compile-jvm-class compile-expression*) &&proc-host/compile-jvm-interface]))) diff --git a/luxc/src/lux/lexer.clj b/luxc/src/lux/lexer.clj index 962e1e9bd..49e29710a 100644 --- a/luxc/src/lux/lexer.clj +++ b/luxc/src/lux/lexer.clj @@ -88,7 +88,7 @@ (return (&/T [meta (&/T [module-name token])]))) (|do [[meta _ _] (&reader/read-text &/+name-separator+) [_ _ token] (&reader/read-regex +ident-re+)] - (return (&/T [meta (&/T ["lux" token])]))) + (return (&/T [meta (&/T [&/prelude token])]))) ))) (def ^:private lex-identifier diff --git a/luxc/src/lux/type.clj b/luxc/src/lux/type.clj index 924489a53..8853224b5 100644 --- a/luxc/src/lux/type.clj +++ b/luxc/src/lux/type.clj @@ -168,9 +168,6 @@ (let [w (&/$Apply Location Meta)] (&/$Apply (&/$Apply w Code*) w)))) -(def Macro*) -(defn set-macro*-type! [type] (def Macro* type)) - (def Macro (&/$Named (&/T ["lux" "Macro"]) (&/$Primitive "#Macro" &/$Nil))) diff --git a/stdlib/source/lux/data/number/frac.lux b/stdlib/source/lux/data/number/frac.lux index 47ad25f30..633872f9c 100644 --- a/stdlib/source/lux/data/number/frac.lux +++ b/stdlib/source/lux/data/number/frac.lux @@ -5,6 +5,7 @@ [monoid (#+ Monoid)] [equivalence (#+ Equivalence)] [codec (#+ Codec)] + [predicate (#+ Predicate)] ["." order (#+ Order)]] [control ["." try (#+ Try)]] @@ -29,7 +30,7 @@ ("lux f64 <" reference sample)) (def: #export (<= reference sample) - {#.doc "Frac(tion) less-than-equal."} + {#.doc "Frac(tion) less-than or equal."} (-> Frac Frac Bit) (or ("lux f64 <" reference sample) ("lux f64 =" reference sample))) @@ -40,11 +41,21 @@ ("lux f64 <" sample reference)) (def: #export (>= reference sample) - {#.doc "Frac(tion) greater-than-equal."} + {#.doc "Frac(tion) greater-than or equal."} (-> Frac Frac Bit) (or ("lux f64 <" sample reference) ("lux f64 =" sample reference))) +(template [<comparison> <name>] + [(def: #export <name> + (Predicate Frac) + (<comparison> +0.0))] + + [..> positive?] + [..< negative?] + [..= zero?] + ) + (template [<name> <op> <doc>] [(def: #export (<name> param subject) {#.doc <doc>} @@ -63,7 +74,9 @@ [(../ param subject) (..% param subject)]) -(def: #export negate (-> Frac Frac) (..* -1.0)) +(def: #export negate + (-> Frac Frac) + (..* -1.0)) (def: #export (abs x) (-> Frac Frac) diff --git a/stdlib/source/lux/data/number/int.lux b/stdlib/source/lux/data/number/int.lux index fb1ceb224..f2bcdfeb9 100644 --- a/stdlib/source/lux/data/number/int.lux +++ b/stdlib/source/lux/data/number/int.lux @@ -7,6 +7,7 @@ [monoid (#+ Monoid)] [equivalence (#+ Equivalence)] [codec (#+ Codec)] + [predicate (#+ Predicate)] ["." order (#+ Order)]] [control ["." try (#+ Try)]] @@ -28,7 +29,7 @@ ("lux i64 <" reference sample)) (def: #export (<= reference sample) - {#.doc "Int(eger) less-than-equal."} + {#.doc "Int(eger) less-than or equal."} (-> Int Int Bit) (if ("lux i64 <" reference sample) #1 @@ -40,12 +41,22 @@ ("lux i64 <" sample reference)) (def: #export (>= reference sample) - {#.doc "Int(eger) greater-than-equal."} + {#.doc "Int(eger) greater-than or equal."} (-> Int Int Bit) (if ("lux i64 <" sample reference) #1 ("lux i64 =" reference sample))) +(template [<comparison> <name>] + [(def: #export <name> + (Predicate Int) + (<comparison> +0))] + + [..> positive?] + [..< negative?] + [..= zero?] + ) + (template [<name> <test> <doc>] [(def: #export (<name> left right) {#.doc <doc>} diff --git a/stdlib/source/lux/data/number/nat.lux b/stdlib/source/lux/data/number/nat.lux index 9f370fb51..dd5e52ad1 100644 --- a/stdlib/source/lux/data/number/nat.lux +++ b/stdlib/source/lux/data/number/nat.lux @@ -48,7 +48,7 @@ #0)))) (def: #export (<= reference sample) - {#.doc "Nat(ural) less-than-equal."} + {#.doc "Nat(ural) less-than or equal."} (-> Nat Nat Bit) (if (..< reference sample) #1 @@ -60,7 +60,7 @@ (..< sample reference)) (def: #export (>= reference sample) - {#.doc "Nat(ural) greater-than-equal."} + {#.doc "Nat(ural) greater-than or equal."} (-> Nat Nat Bit) (if (..< sample reference) #1 diff --git a/stdlib/source/lux/data/number/rev.lux b/stdlib/source/lux/data/number/rev.lux index 881043013..be4959726 100644 --- a/stdlib/source/lux/data/number/rev.lux +++ b/stdlib/source/lux/data/number/rev.lux @@ -32,7 +32,7 @@ (:coerce Nat sample))) (def: #export (<= reference sample) - {#.doc "Rev(olution) less-than-equal."} + {#.doc "Rev(olution) less-than or equal."} (-> Rev Rev Bit) (if (//nat.< (:coerce Nat reference) (:coerce Nat sample)) @@ -45,7 +45,7 @@ (..< sample reference)) (def: #export (>= reference sample) - {#.doc "Rev(olution) greater-than-equal."} + {#.doc "Rev(olution) greater-than or equal."} (-> Rev Rev Bit) (if (..< sample reference) #1 diff --git a/stdlib/source/lux/data/text.lux b/stdlib/source/lux/data/text.lux index fb2bc0728..c82dd5e41 100644 --- a/stdlib/source/lux/data/text.lux +++ b/stdlib/source/lux/data/text.lux @@ -106,6 +106,11 @@ _ false)) +(def: #export (encloses? boundary value) + (-> Text Text Bit) + (and (starts-with? boundary value) + (ends-with? boundary value))) + (def: #export (contains? sub text) (-> Text Text Bit) (case ("lux text index" 0 sub text) @@ -155,18 +160,18 @@ #.None (#.Cons sample #.Nil))) -(def: #export (replace-once pattern value template) +(def: #export (replace-once pattern replacement template) (-> Text Text Text Text) (<| (maybe.default template) (do maybe.monad [[pre post] (split-with pattern template)] - (wrap ($_ "lux text concat" pre value post))))) + (wrap ($_ "lux text concat" pre replacement post))))) -(def: #export (replace-all pattern value template) +(def: #export (replace-all pattern replacement template) (-> Text Text Text Text) (case (..split-with pattern template) (#.Some [pre post]) - ($_ "lux text concat" pre value (replace-all pattern value post)) + ($_ "lux text concat" pre replacement (replace-all pattern replacement post)) #.None template)) @@ -264,6 +269,7 @@ (..enclose' ..double-quote)) (def: #export space + Text " ") (def: #export (space? char) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux index 72096032a..59241f43d 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux @@ -192,16 +192,32 @@ (def: (caster input output) (-> Type Type Handler) - (function (_ extension-name analyse archive args) - (case args - (^ (list valueC)) - (do ////.monad + (..custom + [<c>.any + (function (_ extension-name phase archive valueC) + (do {@ ////.monad} [_ (typeA.infer output)] (typeA.with-type input - (analyse archive valueC))) - - _ - (////analysis.throw ///.incorrect-arity [extension-name 1 (list.size args)])))) + (phase archive valueC))))])) + +(def: lux::macro + Handler + (..custom + [<c>.any + (function (_ extension-name phase archive valueC) + (do {@ ////.monad} + [_ (typeA.infer .Macro) + input-type (loop [input-name (name-of .Macro')] + (do @ + [input-type (///.lift (meta.find-def (name-of .Macro')))] + (case input-type + (#.Definition [exported? def-type def-data def-value]) + (wrap (:coerce Type def-value)) + + (#.Alias real-name) + (recur real-name))))] + (typeA.with-type input-type + (phase archive valueC))))])) (def: (bundle::lux eval) (-> Eval Bundle) @@ -211,7 +227,7 @@ (///bundle.install "try" lux::try) (///bundle.install "check" (lux::check eval)) (///bundle.install "coerce" (lux::coerce eval)) - (///bundle.install "macro" (..caster .Macro' .Macro)) + (///bundle.install "macro" ..lux::macro) (///bundle.install "check type" (..caster .Type .Type)) (///bundle.install "in-module" lux::in-module))) diff --git a/stdlib/source/program/aedifex.lux b/stdlib/source/program/aedifex.lux index e29af6e7a..c2fa69e11 100644 --- a/stdlib/source/program/aedifex.lux +++ b/stdlib/source/program/aedifex.lux @@ -132,7 +132,7 @@ (case (do try.monad [data data project (..project data)] - (/project.profile project profile)) + (/project.profile profile project)) (#try.Success profile) (case operation #/cli.POM diff --git a/stdlib/source/program/aedifex/artifact/type.lux b/stdlib/source/program/aedifex/artifact/type.lux new file mode 100644 index 000000000..e5836d13f --- /dev/null +++ b/stdlib/source/program/aedifex/artifact/type.lux @@ -0,0 +1,16 @@ +(.module: + [lux (#- Type)]) + +## https://maven.apache.org/ref/3.6.3/maven-core/artifact-handlers.html +(type: #export Type + Text) + +(template [<type> <name>] + [(def: #export <name> + Type + <type>)] + + ["tar" lux-library] + ["jar" jvm-library] + ["pom" pom] + ) diff --git a/stdlib/source/program/aedifex/command/build.lux b/stdlib/source/program/aedifex/command/build.lux index eb7842e45..2c4b26aed 100644 --- a/stdlib/source/program/aedifex/command/build.lux +++ b/stdlib/source/program/aedifex/command/build.lux @@ -25,9 +25,10 @@ ["#." action] ["#." command (#+ Command)] ["#." local] - ["#." artifact (#+ Group Name Artifact)] ["#." dependency (#+ Dependency Resolution)] - ["#." shell]]) + ["#." shell] + ["#." artifact (#+ Group Name Artifact) + ["#/." type]]]) (type: Finder (-> Resolution (Maybe Dependency))) @@ -86,7 +87,7 @@ (def: libraries (-> Resolution (List Path)) (|>> dictionary.keys - (list.filter (|>> (get@ #///dependency.type) (text@= ///dependency.lux-library))) + (list.filter (|>> (get@ #///dependency.type) (text@= ///artifact/type.lux-library))) (list@map (|>> (get@ #///dependency.artifact) (///local.path file.system))))) (import: java/lang/String) diff --git a/stdlib/source/program/aedifex/command/deploy.lux b/stdlib/source/program/aedifex/command/deploy.lux index 1081322b4..a4b076733 100644 --- a/stdlib/source/program/aedifex/command/deploy.lux +++ b/stdlib/source/program/aedifex/command/deploy.lux @@ -30,7 +30,9 @@ ["#." command (#+ Command)] ["#." dependency] ["#." pom] - ["#." hash]]) + ["#." hash] + ["#." artifact + ["#/." type]]]) (exception: #export (cannot-find-repository {repository Text} {options (Dictionary Text ///dependency.Repository)}) @@ -51,7 +53,7 @@ (promise@wrap (exception.throw ..cannot-find-repository [repository (get@ #/.deploy-repositories profile)])) [(#.Some identity) (#.Some repository)] - (let [deploy! (: (-> ///dependency.Type Binary (Action Any)) + (let [deploy! (: (-> ///artifact/type.Type Binary (Action Any)) (function (_ type content) (promise.future (//.upload repository @@ -65,8 +67,8 @@ (export.library (file.async file.system) (set.to-list (get@ #/.sources profile)))) pom (promise@wrap (///pom.project profile)) - _ (deploy! ///dependency.pom (|> pom (:: xml.codec encode) encoding.to-utf8)) - _ (deploy! ///dependency.lux-library library) + _ (deploy! ///artifact/type.pom (|> pom (:: xml.codec encode) encoding.to-utf8)) + _ (deploy! ///artifact/type.lux-library library) _ (deploy! "sha1" (///hash.sha1 library)) _ (deploy! "md5" (///hash.md5 library))] (wrap []))))) diff --git a/stdlib/source/program/aedifex/dependency.lux b/stdlib/source/program/aedifex/dependency.lux index 2086a4d06..3128bb3f3 100644 --- a/stdlib/source/program/aedifex/dependency.lux +++ b/stdlib/source/program/aedifex/dependency.lux @@ -1,5 +1,5 @@ (.module: - [lux (#- Name Type) + [lux (#- Name) ["." host (#+ import:)] [abstract [monad (#+ do)] @@ -30,19 +30,16 @@ ["." uri]]]] ["." // #_ ["#." extension] - ["#." artifact (#+ Artifact)] - ["#." hash]]) + ["#." hash] + ["#." artifact (#+ Artifact) + ["#/." type]]]) (type: #export Repository URL) -## https://maven.apache.org/ref/3.6.3/maven-core/artifact-handlers.html -(type: #export Type - Text) - (type: #export Dependency {#artifact Artifact - #type ..Type}) + #type //artifact/type.Type}) (def: #export equivalence (Equivalence Dependency) @@ -58,16 +55,6 @@ text.hash )) -(template [<type> <name>] - [(def: #export <name> - Type - <type>)] - - ["tar" lux-library] - ["jar" jvm-library] - ["pom" pom] - ) - (import: java/lang/String) (import: java/lang/AutoCloseable @@ -200,7 +187,7 @@ #//artifact.version version} #type (|> properties (dictionary.get ["" "type"]) - (maybe.default ..lux-library))}))))) + (maybe.default //artifact/type.lux-library))}))))) (def: parse-dependencies (Parser (List Dependency)) diff --git a/stdlib/source/program/aedifex/format.lux b/stdlib/source/program/aedifex/format.lux index 1107f4d13..4ec8b8ae6 100644 --- a/stdlib/source/program/aedifex/format.lux +++ b/stdlib/source/program/aedifex/format.lux @@ -11,8 +11,9 @@ ["." // #_ ["/" profile] ["#." project (#+ Project)] - ["#." artifact (#+ Artifact)] - ["#." dependency (#+ Dependency)]]) + ["#." dependency (#+ Dependency)] + ["#." artifact (#+ Artifact) + ["#/." type]]]) (type: #export (Format a) (-> a Code)) @@ -125,7 +126,7 @@ (def: (dependency [artifact type]) (Format Dependency) - (if (text@= //dependency.lux-library type) + (if (text@= //artifact/type.lux-library type) (` [(~+ (..artifact' artifact))]) (` [(~+ (..artifact' artifact)) (~ (code.text type))]))) diff --git a/stdlib/source/program/aedifex/local.lux b/stdlib/source/program/aedifex/local.lux index 1b8a02f1a..60b5e8881 100644 --- a/stdlib/source/program/aedifex/local.lux +++ b/stdlib/source/program/aedifex/local.lux @@ -32,9 +32,10 @@ ["/" profile (#+ Profile)] ["#." extension] ["#." pom] - ["#." artifact (#+ Artifact)] ["#." dependency (#+ Package Resolution Dependency)] - ["#." hash]]) + ["#." hash] + ["#." artifact (#+ Artifact) + ["#/." type]]]) (def: (local system) (All [a] (-> (file.System a) Path)) @@ -78,7 +79,7 @@ #let [artifact-name (format repository (:: system separator) (//artifact.identity identity))] package (export.library system (set.to-list (get@ #/.sources profile))) _ (..save! system (binary.run tar.writer package) - (format artifact-name "." //dependency.lux-library)) + (format artifact-name "." //artifact/type.lux-library)) pom (:: promise.monad wrap (//pom.project profile))] (..save! system (|> pom (:: xml.codec encode) encoding.to-utf8) (format artifact-name //extension.pom))) diff --git a/stdlib/source/program/aedifex/parser.lux b/stdlib/source/program/aedifex/parser.lux index 1799db09e..867b3b81f 100644 --- a/stdlib/source/program/aedifex/parser.lux +++ b/stdlib/source/program/aedifex/parser.lux @@ -20,8 +20,9 @@ ["." // #_ ["/" profile] ["#." project (#+ Project)] - ["#." artifact (#+ Artifact)] - ["#." dependency]]) + ["#." dependency] + ["#." artifact (#+ Artifact) + ["#/." type]]]) (def: (as-input input) (-> (Maybe Code) (List Code)) @@ -139,7 +140,7 @@ ..url) (def: type - (Parser //dependency.Type) + (Parser //artifact/type.Type) <c>.text) (def: dependency @@ -147,7 +148,7 @@ (<c>.tuple ($_ <>.and ..artifact' - (<>.default //dependency.lux-library ..type) + (<>.default //artifact/type.lux-library ..type) ))) (def: source diff --git a/stdlib/source/test/aedifex/artifact.lux b/stdlib/source/test/aedifex/artifact.lux index 1ba27d0b6..72715fdef 100644 --- a/stdlib/source/test/aedifex/artifact.lux +++ b/stdlib/source/test/aedifex/artifact.lux @@ -9,6 +9,8 @@ ["$." equivalence]]}] [math ["." random (#+ Random)]]] + ["." / #_ + ["#." type]] {#program ["." /]}) @@ -27,4 +29,6 @@ ($_ _.and (_.with-cover [/.equivalence] ($equivalence.spec /.equivalence ..random)) + + /type.test )))) diff --git a/stdlib/source/test/aedifex/artifact/type.lux b/stdlib/source/test/aedifex/artifact/type.lux new file mode 100644 index 000000000..fd815f19e --- /dev/null +++ b/stdlib/source/test/aedifex/artifact/type.lux @@ -0,0 +1,28 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [monad (#+ do)]] + [data + ["." text] + [number + ["n" nat]] + [collection + ["." set] + ["." list]]] + [math + ["." random (#+ Random)]]] + {#program + ["." /]}) + +(def: #export test + Test + (<| (_.covering /._) + (_.with-cover [/.Type] + ($_ _.and + (_.cover [/.lux-library /.jvm-library /.pom] + (let [options (list /.lux-library /.jvm-library /.pom) + uniques (set.from-list text.hash options)] + (n.= (list.size options) + (set.size uniques)))) + )))) diff --git a/stdlib/source/test/lux/data/product.lux b/stdlib/source/test/lux/data/product.lux index 20e62ef86..74057ad63 100644 --- a/stdlib/source/test/lux/data/product.lux +++ b/stdlib/source/test/lux/data/product.lux @@ -18,6 +18,7 @@ (def: #export test Test (<| (_.covering /._) + (_.with-cover [.&]) (do random.monad [expected random.nat shift random.nat diff --git a/stdlib/source/test/lux/data/sum.lux b/stdlib/source/test/lux/data/sum.lux index 972677361..3bbf65bc9 100644 --- a/stdlib/source/test/lux/data/sum.lux +++ b/stdlib/source/test/lux/data/sum.lux @@ -22,6 +22,7 @@ (def: #export test Test (<| (_.covering /._) + (_.with-cover [.|]) (do {@ random.monad} [expected random.nat shift random.nat]) diff --git a/stdlib/source/test/lux/data/text.lux b/stdlib/source/test/lux/data/text.lux index a1a0ec7b1..6fbee6ec5 100644 --- a/stdlib/source/test/lux/data/text.lux +++ b/stdlib/source/test/lux/data/text.lux @@ -1,137 +1,295 @@ (.module: - [lux #* - ["%" data/text/format (#+ format)] + [lux (#- char) ["_" test (#+ Test)] [abstract - [monad (#+ do Monad)] + [monad (#+ do)] {[0 #spec] [/ ["$." equivalence] - ["$." order]]}] + ["$." order] + ["$." monoid]]}] [control pipe] [data + ["." maybe] [number ["n" nat]] [collection - ["." list]]] + ["." list] + ["." set]]] [math - ["r" random]]] + ["." random]]] {1 ["." /]}) (def: bounded-size - (r.Random Nat) - (|> r.nat - (:: r.monad map (|>> (n.% 20) (n.+ 1))))) + (random.Random Nat) + (|> random.nat + (:: random.monad map (|>> (n.% 20) (n.+ 1))))) -(def: #export test +(def: size Test - (<| (_.context (%.name (name-of .Text))) - ($_ _.and - ($equivalence.spec /.equivalence (r.ascii 2)) - ($order.spec /.order (r.ascii 2)) + (do {@ random.monad} + [size (:: @ map (n.% 10) random.nat) + sample (random.unicode size)] + ($_ _.and + (_.cover [/.size] + (n.= size (/.size sample))) + (_.cover [/.empty?] + (or (/.empty? sample) + (not (n.= 0 size))))))) - (do {@ r.monad} - [size (:: @ map (n.% 10) r.nat) - sample (r.unicode size)] - ($_ _.and - (_.test "Can get the size of text." - (n.= size (/.size sample))) - (_.test "Text with size 0 is considered 'empty'." - (or (not (n.= 0 size)) - (/.empty? sample))))) - (do {@ r.monad} - [size bounded-size - idx (:: @ map (n.% size) r.nat) - sample (r.unicode size)] - (_.test "Character locations." - (|> sample - (/.nth idx) - (case> (^multi (#.Some char) - [(/.from-code char) char] - [[(/.index-of char sample) - (/.last-index-of char sample) - (/.index-of' char idx sample) - (/.last-index-of' char idx sample)] - [(#.Some io) (#.Some lio) - (#.Some io') (#.Some lio')]]) - (and (n.<= idx io) - (n.>= idx lio) +(def: affix + Test + (do {@ random.monad} + [inner (random.unicode 1) + outer (random.filter (|>> (:: /.equivalence = inner) not) + (random.unicode 1)) + left (random.unicode 1) + right (random.unicode 1) + #let [full (:: /.monoid compose inner outer) + fake-index (.nat -1)]] + (`` ($_ _.and + (~~ (template [<affix> <predicate>] + [(_.cover [<affix> <predicate>] + (<predicate> outer (<affix> outer inner)))] + + [/.prefix /.starts-with?] + [/.suffix /.ends-with?] + [/.enclose' /.encloses?] + )) + (_.cover [/.enclose] + (let [value (/.enclose [left right] inner)] + (and (/.starts-with? left value) + (/.ends-with? right value)))) + (_.cover [/.encode] + (let [sample (/.encode inner)] + (and (/.encloses? /.double-quote sample) + (/.contains? inner sample)))) + )))) + +(def: index + Test + (do {@ random.monad} + [inner (random.unicode 1) + outer (random.filter (|>> (:: /.equivalence = inner) not) + (random.unicode 1)) + #let [fake-index (.nat -1)]] + ($_ _.and + (_.cover [/.contains?] + (let [full (:: /.monoid compose inner outer)] + (and (/.contains? inner full) + (/.contains? outer full)))) + (_.cover [/.index-of] + (and (|> (/.index-of inner (:: /.monoid compose inner outer)) + (maybe.default fake-index) + (n.= 0)) + (|> (/.index-of outer (:: /.monoid compose inner outer)) + (maybe.default fake-index) + (n.= 1)))) + (_.cover [/.index-of'] + (let [full (:: /.monoid compose inner outer)] + (and (|> (/.index-of' inner 0 full) + (maybe.default fake-index) + (n.= 0)) + (|> (/.index-of' inner 1 full) + (maybe.default fake-index) + (n.= fake-index)) + + (|> (/.index-of' outer 0 full) + (maybe.default fake-index) + (n.= 1)) + (|> (/.index-of' outer 1 full) + (maybe.default fake-index) + (n.= 1)) + (|> (/.index-of' outer 2 full) + (maybe.default fake-index) + (n.= fake-index))))) + (_.cover [/.last-index-of] + (let [full ($_ (:: /.monoid compose) outer inner outer)] + (and (|> (/.last-index-of inner full) + (maybe.default fake-index) + (n.= 1)) + (|> (/.last-index-of outer full) + (maybe.default fake-index) + (n.= 2))))) + (_.cover [/.last-index-of'] + (let [full ($_ (:: /.monoid compose) outer inner outer)] + (and (|> (/.last-index-of' inner 0 full) + (maybe.default fake-index) + (n.= 1)) + (|> (/.last-index-of' inner 2 full) + (maybe.default fake-index) + (n.= fake-index)) + + (|> (/.last-index-of' outer 0 full) + (maybe.default fake-index) + (n.= 2)) + (|> (/.last-index-of' outer 2 full) + (maybe.default fake-index) + (n.= 2)) + (|> (/.last-index-of' outer 3 full) + (maybe.default fake-index) + (n.= fake-index))))) + ))) + +(def: char + Test + ($_ _.and + (_.with-cover [/.Char /.from-code] + (`` ($_ _.and + (~~ (template [<short> <long>] + [(_.cover [<short> <long>] + (:: /.equivalence = <short> <long>))] - (n.= idx io') - (n.>= idx lio') + [/.\0 /.null] + [/.\a /.alarm] + [/.\b /.back-space] + [/.\t /.tab] + [/.\n /.new-line] + [/.\v /.vertical-tab] + [/.\f /.form-feed] + [/.\r /.carriage-return] + [/.\'' /.double-quote])) + (_.cover [/.line-feed] + (:: /.equivalence = /.new-line /.line-feed)) + ))) + (do {@ random.monad} + [size (:: @ map (|>> (n.% 10) inc) random.nat) + characters (random.set /.hash size (random.ascii/alpha 1)) + #let [sample (|> characters set.to-list /.concat)] + expected (:: @ map (n.% size) random.nat)] + (_.cover [/.nth] + (case (/.nth expected sample) + (#.Some char) + (case (/.index-of (/.from-code char) sample) + (#.Some actual) + (n.= expected actual) - (/.contains? char sample)) + _ + false) + + #.None + false))) + (_.cover [/.space /.space?] + (`` (and (~~ (template [<char>] + [(/.space? (`` (.char (~~ (static <char>)))))] + + [/.tab] + [/.vertical-tab] + [/.space] + [/.new-line] + [/.carriage-return] + [/.form-feed] + ))))) + )) - _ - #0 - )) - )) - (do r.monad +(def: manipulation + Test + (do {@ random.monad} + [size (:: @ map (|>> (n.% 10) (n.+ 2)) random.nat) + characters (random.set /.hash size (random.ascii/alpha 1)) + separator (random.filter (|>> (set.member? characters) not) + (random.ascii/alpha 1)) + #let [with-no-separator (|> characters set.to-list /.concat)] + static (random.ascii/alpha 1) + #let [dynamic (random.filter (|>> (:: /.equivalence = static) not) + (random.ascii/alpha 1))] + pre dynamic + post dynamic] + ($_ _.and + (_.cover [/.concat] + (n.= (set.size characters) + (/.size (/.concat (set.to-list characters))))) + (_.cover [/.join-with /.split-all-with] + (and (|> (set.to-list characters) + (/.join-with separator) + (/.split-all-with separator) + (set.from-list /.hash) + (:: set.equivalence = characters)) + (:: /.equivalence = + (/.concat (set.to-list characters)) + (/.join-with "" (set.to-list characters))))) + (_.cover [/.replace-once] + (:: /.equivalence = + (:: /.monoid compose post static) + (/.replace-once pre post (:: /.monoid compose pre static)))) + (_.cover [/.split-with] + (case (/.split-with static ($_ (:: /.monoid compose) pre static post)) + (#.Some [left right]) + (and (:: /.equivalence = pre left) + (:: /.equivalence = post right)) + + #.None + false)) + ))) + +(def: #export test + Test + (<| (_.covering /._) + (_.with-cover [.Text]) + ($_ _.and + (_.with-cover [/.equivalence] + ($equivalence.spec /.equivalence (random.ascii 2))) + (_.with-cover [/.order] + ($order.spec /.order (random.ascii 2))) + (_.with-cover [/.monoid] + ($monoid.spec /.equivalence /.monoid (random.ascii 2))) + + ..size + ..affix + ..index + ..char + ..manipulation + + (do random.monad [sizeL bounded-size sizeR bounded-size - sampleL (r.unicode sizeL) - sampleR (r.unicode sizeR) + sampleL (random.unicode sizeL) + sampleR (random.unicode sizeR) + middle (random.unicode 1) #let [sample (/.concat (list sampleL sampleR)) (^open "/@.") /.equivalence]] ($_ _.and - (_.test "Can join text snippets." - (and (not (/@= sample - (/.join-with " " (list sampleL sampleR)))) - (/@= sample - (/.join-with "" (list sampleL sampleR))))) - (_.test "Can check sub-texts at the borders." - (and (/.starts-with? sampleL sample) - (/.ends-with? sampleR sample))) - (_.test "Can enclose text in another texts." - (/@= (/.enclose [sampleR sampleR] sampleL) - (/.enclose' sampleR sampleL))) - (_.test "Can split text." - (|> (/.split sizeL sample) - (case> (#.Right [_l _r]) - (and (/@= sampleL _l) - (/@= sampleR _r) - (/@= sample (/.concat (list _l _r)))) + (_.cover [/.split] + (|> (/.split sizeL sample) + (case> (#.Right [_l _r]) + (and (/@= sampleL _l) + (/@= sampleR _r) + (/@= sample (/.concat (list _l _r)))) - _ - #0))) - (_.test "Can clip text." - (|> [(/.clip 0 sizeL sample) - (/.clip sizeL (/.size sample) sample) - (/.clip' sizeL sample) - (/.clip' 0 sample)] - (case> [(#.Right _l) (#.Right _r) (#.Right _r') (#.Right _f)] - (and (/@= sampleL _l) - (/@= sampleR _r) - (/@= _r _r') - (/@= sample _f)) + _ + #0))) + (_.cover [/.clip /.clip'] + (|> [(/.clip 0 sizeL sample) + (/.clip sizeL (/.size sample) sample) + (/.clip' sizeL sample) + (/.clip' 0 sample)] + (case> [(#.Right _l) (#.Right _r) (#.Right _r') (#.Right _f)] + (and (/@= sampleL _l) + (/@= sampleR _r) + (/@= _r _r') + (/@= sample _f)) - _ - #0))) + _ + #0))) )) - (do {@ r.monad} + (do {@ random.monad} [sizeP bounded-size sizeL bounded-size #let [## The wider unicode charset includes control characters that ## can make text replacement work improperly. ## Because of that, I restrict the charset. - normal-char-gen (|> r.nat (:: @ map (|>> (n.% 128) (n.max 1))))] - sep1 (r.text normal-char-gen 1) - sep2 (r.text normal-char-gen 1) - #let [part-gen (|> (r.text normal-char-gen sizeP) - (r.filter (|>> (/.contains? sep1) not)))] - parts (r.list sizeL part-gen) + normal-char-gen (|> random.nat (:: @ map (|>> (n.% 128) (n.max 1))))] + sep1 (random.text normal-char-gen 1) + sep2 (random.text normal-char-gen 1) + #let [part-gen (|> (random.text normal-char-gen sizeP) + (random.filter (|>> (/.contains? sep1) not)))] + parts (random.list sizeL part-gen) #let [sample1 (/.concat (list.interpose sep1 parts)) sample2 (/.concat (list.interpose sep2 parts)) (^open "/@.") /.equivalence]] - ($_ _.and - (_.test "Can split text multiple times through a separator." - (n.= (list.size parts) - (list.size (/.split-all-with sep1 sample1)))) - - (_.test "Can replace occurrences of a piece of text inside a larger text." - (/@= sample2 - (/.replace-all sep1 sep2 sample1))) - )) + (_.cover [/.replace-all] + (/@= sample2 + (/.replace-all sep1 sep2 sample1)))) ))) diff --git a/stdlib/source/test/lux/target/jvm.lux b/stdlib/source/test/lux/target/jvm.lux index b9639a82f..e1c4dbfe3 100644 --- a/stdlib/source/test/lux/target/jvm.lux +++ b/stdlib/source/test/lux/target/jvm.lux @@ -237,6 +237,11 @@ #random ..$Float::random #literal ..$Float::literal}) +(def: valid-float + (Random java/lang/Float) + (random.filter (|>> host.float-to-double (:coerce Frac) f.not-a-number? not) + ..$Float::random)) + (def: $Double (/type.class "java.lang.Double" (list))) (def: $Double::wrap (/.invokestatic ..$Double "valueOf" (/type.method [(list /type.double) ..$Double (list)]))) (def: $Double::random (:coerce (Random java/lang/Double) random.frac)) @@ -678,10 +683,8 @@ comparison (: (-> (Bytecode Any) (-> java/lang/Double java/lang/Double Bit) (Random Bit)) (function (_ instruction standard) (do random.monad - [#let [valid-double (random.filter (|>> (:coerce Frac) f.not-a-number? not) - ..$Double::random)] - reference valid-double - subject valid-double + [reference ..valid-double + subject ..valid-double #let [expected (if (for {@.old ("jvm deq" reference subject) @@ -1184,15 +1187,15 @@ (let [test (!::= java/lang/Float "jvm feq" "jvm float =")] ($_ _.and (_.lift "FSTORE_0/FLOAD_0" - (store-and-load ..$Float::random ..$Float::literal ..$Float::wrap [(function.constant /.fstore-0) (function.constant /.fload-0)] test)) + (store-and-load ..valid-float ..$Float::literal ..$Float::wrap [(function.constant /.fstore-0) (function.constant /.fload-0)] test)) (_.lift "FSTORE_1/FLOAD_1" - (store-and-load ..$Float::random ..$Float::literal ..$Float::wrap [(function.constant /.fstore-1) (function.constant /.fload-1)] test)) + (store-and-load ..valid-float ..$Float::literal ..$Float::wrap [(function.constant /.fstore-1) (function.constant /.fload-1)] test)) (_.lift "FSTORE_2/FLOAD_2" - (store-and-load ..$Float::random ..$Float::literal ..$Float::wrap [(function.constant /.fstore-2) (function.constant /.fload-2)] test)) + (store-and-load ..valid-float ..$Float::literal ..$Float::wrap [(function.constant /.fstore-2) (function.constant /.fload-2)] test)) (_.lift "FSTORE_3/FLOAD_3" - (store-and-load ..$Float::random ..$Float::literal ..$Float::wrap [(function.constant /.fstore-3) (function.constant /.fload-3)] test)) + (store-and-load ..valid-float ..$Float::literal ..$Float::wrap [(function.constant /.fstore-3) (function.constant /.fload-3)] test)) (_.lift "FSTORE/FLOAD" - (store-and-load ..$Float::random ..$Float::literal ..$Float::wrap [/.fstore /.fload] test))))) + (store-and-load ..valid-float ..$Float::literal ..$Float::wrap [/.fstore /.fload] test))))) (<| (_.context "double") (let [test (!::= java/lang/Double "jvm deq" "jvm double =")] ($_ _.and |