diff options
| author | Eduardo Julian | 2021-01-28 20:14:11 -0400 |
|---|---|---|
| committer | Eduardo Julian | 2021-01-28 20:14:11 -0400 |
| commit | 1797521191746640e761cc1b4973d46b8c403dee (patch) | |
| tree | 197b60bf206f75c32a930b85910101c6d4c0d0f9 | |
| parent | 43d28326ad59c74439b96343cc8f619ed7d90231 (diff) | |
Implemented arithmetic right-shift in terms of logic right-shift.
56 files changed, 825 insertions, 598 deletions
@@ -178,4 +178,4 @@ I'll be putting there tasks that people can contribute to; both in the compiler Writing libraries in Lux will also help a lot in making this a more practical language for day to day use. -##### Copyright (c) 2014-2020 Eduardo Julian. All rights reserved. +##### Copyright (c) 2014-2021 Eduardo Julian. All rights reserved. diff --git a/compilers.md b/compilers.md index f454889b4..e50c3a621 100644 --- a/compilers.md +++ b/compilers.md @@ -27,7 +27,11 @@ cd ~/lux/lux-jvm/ && lein clean && lein lux auto test ``` cd ~/lux/lux-jvm/ && lein lux auto build -cd ~/lux/lux-jvm/ && lein clean && lein lux auto build + +## Use bootstrapping compiler to build new JVM compiler +cd ~/lux/lux-jvm/ \ +&& lein clean \ +&& lein lux auto build ``` ## REPL @@ -40,11 +44,20 @@ cd ~/lux/lux-jvm/ && java -jar target/program.jar repl --source ~/lux/stdlib/sou ``` cd ~/lux/lux-jvm/ && time java -jar target/program.jar build --source ~/lux/stdlib/source --target ~/lux/stdlib/target --module test/lux -cd ~/lux/stdlib/ && lein clean && cd ~/lux/lux-jvm/ && time java -jar target/program.jar build --source ~/lux/stdlib/source --target ~/lux/stdlib/target --module test/lux -cd ~/lux/stdlib/ && cd ~/lux/lux-jvm/ && time java -jar target/program.jar build --source ~/lux/stdlib/source --library ~/lux/stdlib/target/library.tar --target ~/lux/stdlib/target --module test/lux cd ~/lux/lux-jvm/ && java -jar target/program.jar export --source ~/lux/stdlib/source --target ~/lux/stdlib/target -cd ~/lux/stdlib/target/ && java -jar program.jar +cd ~/lux/stdlib/ \ +&& cd ~/lux/lux-jvm/ \ +&& time java -jar target/program.jar build --source ~/lux/stdlib/source --library ~/lux/stdlib/target/library.tar --target ~/lux/stdlib/target --module test/lux + +## Use new JVM compiler to compile tests for the Standard Library +cd ~/lux/stdlib/ \ +&& lein clean \ +&& time java -jar ~/lux/lux-jvm/target/program.jar build --source ~/lux/stdlib/source --target ~/lux/stdlib/target --module test/lux + +## Run tests for the Standard Library +cd ~/lux/stdlib/target/ \ +&& java -jar program.jar ``` ## Deploy @@ -88,12 +101,11 @@ cd ~/lux/lux-js/ \ cd ~/lux/lux-js/ \ && lein clean \ && time java -jar program.jar build --source ~/lux/lux-js/source --target ~/lux/lux-js/target --module program \ -&& mv target/program.js program.js +&& mv target/program.js _program.js ## Use JS/Node-based compiler to produce another JS/Node-based compiler. cd ~/lux/lux-js/ \ && lein clean \ -&& cd ~/lux/lux-js/ \ && time node --stack_size=8192 _program.js build --source ~/lux/lux-js/source --target ~/lux/lux-js/target --module program \ && mv target/program.js program.js ``` @@ -134,13 +146,19 @@ cd ~/lux/lux-python/ \ cd ~/lux/lux-python/ \ && lein clean \ && lein lux build \ -&& mv target/program.jar program.jar +&& mv target/program.jar jvm_based_compiler.jar ## Use JVM-based compiler to produce a Python-based compiler. cd ~/lux/lux-python/ \ && lein clean \ -&& time java -jar program.jar build --source ~/lux/lux-python/source --target ~/lux/lux-python/target --module program \ -&& mv target/program.py program.py +&& time java -jar jvm_based_compiler.jar build --source ~/lux/lux-python/source --target ~/lux/lux-python/target --module program \ +&& mv target/program.py python_based_compiler.py + +## Use Python-based compiler to produce another Python-based compiler. +cd ~/lux/lux-python/ \ +&& lein clean \ +&& time python3 python_based_compiler.py build --source ~/lux/lux-python/source --target ~/lux/lux-python/target --module program \ +&& mv target/program.py lux.py ``` ## Try diff --git a/license.json b/license.json index dad60edb1..488e0ad77 100644 --- a/license.json +++ b/license.json @@ -4,7 +4,7 @@ "name": "Eduardo Emilio Julián Pereyra", "period": { "start": 2014, - "end": 2020 + "end": 2021 } } ], diff --git a/license.txt b/license.txt index d2606a62c..361fb2926 100644 --- a/license.txt +++ b/license.txt @@ -1,7 +1,7 @@ Lux License 0.1.1 -Copyright (C) 2014-2020 Eduardo Emilio Julián Pereyra +Copyright (C) 2014-2021 Eduardo Emilio Julián Pereyra Definitions @@ -231,4 +231,4 @@ Once The Work has been published under a particular version of This License, Rec Recipient may also choose to use The Work under the terms of any subsequent version of This License published by The Licensor. No one other than The Licensor has the right to modify the terms applicable to The Work created under This License. -END OF TERMS AND CONDITIONS.
\ No newline at end of file +END OF TERMS AND CONDITIONS. diff --git a/lux-bootstrapper/project.clj b/lux-bootstrapper/project.clj index 0975939e7..ac69dcd8b 100644 --- a/lux-bootstrapper/project.clj +++ b/lux-bootstrapper/project.clj @@ -13,14 +13,13 @@ [:url "https://github.com/eduardoejp"]]] :dependencies [[org.clojure/clojure "1.6.0"] [org.clojure/core.match "0.2.1"] - [org.ow2.asm/asm-all "5.0.3"] + ;; [org.ow2.asm/asm-all "5.0.3"] - ;; [org.ow2.asm/asm "7.3.1"] - ;; [org.ow2.asm/asm-commons "7.3.1"] - ;; [org.ow2.asm/asm-analysis "7.3.1"] - ;; [org.ow2.asm/asm-tree "7.3.1"] - ;; [org.ow2.asm/asm-util "7.3.1"] - ] + [org.ow2.asm/asm "7.3.1"] + [org.ow2.asm/asm-commons "7.3.1"] + [org.ow2.asm/asm-analysis "7.3.1"] + [org.ow2.asm/asm-tree "7.3.1"] + [org.ow2.asm/asm-util "7.3.1"]] :warn-on-reflection true :repositories [["snapshots" "https://oss.sonatype.org/content/repositories/snapshots/"] ["releases" "https://oss.sonatype.org/service/local/staging/deploy/maven2/"]] diff --git a/lux-bootstrapper/src/lux/analyser/proc/common.clj b/lux-bootstrapper/src/lux/analyser/proc/common.clj index 1226e47f2..3f89b0ee4 100644 --- a/lux-bootstrapper/src/lux/analyser/proc/common.clj +++ b/lux-bootstrapper/src/lux/analyser/proc/common.clj @@ -139,12 +139,11 @@ (return (&/|list (&&/|meta exo-type _location (&&/$proc (&/T ["i64" <op>]) (&/|list =input =shift) (&/|list)))))))) - analyse-i64-left-shift "left-shift" - analyse-i64-arithmetic-right-shift "arithmetic-right-shift" - analyse-i64-logical-right-shift "logical-right-shift" + analyse-i64-left-shift "left-shift" + analyse-i64-right-shift "right-shift" ) -(do-template [<name> <proc> <input-type> <output-type>] +(do-template [<proc> <name> <input-type> <output-type>] (let [inputT <input-type> outputT <output-type>] (defn- <name> [analyse exo-type ?values] @@ -156,22 +155,22 @@ (return (&/|list (&&/|meta exo-type _location (&&/$proc (&/T <proc>) (&/|list subjectA parameterA) (&/|list)))))))) - analyse-i64-eq ["i64" "="] (&/$Apply &type/Any &type/I64) &type/Bit - analyse-i64-add ["i64" "+"] (&/$Apply &type/Any &type/I64) &type/I64 - analyse-i64-sub ["i64" "-"] (&/$Apply &type/Any &type/I64) &type/I64 + ["i64" "="] analyse-i64-eq (&/$Apply &type/Any &type/I64) &type/Bit + ["i64" "+"] analyse-i64-add (&/$Apply &type/Any &type/I64) &type/I64 + ["i64" "-"] analyse-i64-sub (&/$Apply &type/Any &type/I64) &type/I64 - analyse-int-mul ["i64" "*"] &type/Int &type/Int - analyse-int-div ["i64" "/"] &type/Int &type/Int - analyse-int-rem ["i64" "%"] &type/Int &type/Int - analyse-int-lt ["i64" "<"] &type/Int &type/Bit + ["i64" "*"] analyse-int-mul &type/Int &type/Int + ["i64" "/"] analyse-int-div &type/Int &type/Int + ["i64" "%"] analyse-int-rem &type/Int &type/Int + ["i64" "<"] analyse-int-lt &type/Int &type/Bit - analyse-frac-add ["f64" "+"] &type/Frac &type/Frac - analyse-frac-sub ["f64" "-"] &type/Frac &type/Frac - analyse-frac-mul ["f64" "*"] &type/Frac &type/Frac - analyse-frac-div ["f64" "/"] &type/Frac &type/Frac - analyse-frac-rem ["f64" "%"] &type/Frac &type/Frac - analyse-frac-eq ["f64" "="] &type/Frac &type/Bit - analyse-frac-lt ["f64" "<"] &type/Frac &type/Bit + ["f64" "+"] analyse-frac-add &type/Frac &type/Frac + ["f64" "-"] analyse-frac-sub &type/Frac &type/Frac + ["f64" "*"] analyse-frac-mul &type/Frac &type/Frac + ["f64" "/"] analyse-frac-div &type/Frac &type/Frac + ["f64" "%"] analyse-frac-rem &type/Frac &type/Frac + ["f64" "="] analyse-frac-eq &type/Frac &type/Bit + ["f64" "<"] analyse-frac-lt &type/Frac &type/Bit ) (do-template [<encode> <encode-op> <decode> <decode-op> <type>] @@ -249,20 +248,19 @@ "lux io error" (analyse-io-error analyse exo-type ?values) "lux io current-time" (analyse-io-current-time analyse exo-type ?values) - "lux text =" (analyse-text-eq analyse exo-type ?values) - "lux text <" (analyse-text-lt analyse exo-type ?values) - "lux text concat" (analyse-text-concat analyse exo-type ?values) - "lux text clip" (analyse-text-clip analyse exo-type ?values) - "lux text index" (analyse-text-index analyse exo-type ?values) - "lux text size" (analyse-text-size analyse exo-type ?values) - "lux text char" (analyse-text-char analyse exo-type ?values) + "lux text =" (analyse-text-eq analyse exo-type ?values) + "lux text <" (analyse-text-lt analyse exo-type ?values) + "lux text concat" (analyse-text-concat analyse exo-type ?values) + "lux text clip" (analyse-text-clip analyse exo-type ?values) + "lux text index" (analyse-text-index analyse exo-type ?values) + "lux text size" (analyse-text-size analyse exo-type ?values) + "lux text char" (analyse-text-char analyse exo-type ?values) - "lux i64 and" (analyse-i64-and analyse exo-type ?values) - "lux i64 or" (analyse-i64-or analyse exo-type ?values) - "lux i64 xor" (analyse-i64-xor analyse exo-type ?values) - "lux i64 left-shift" (analyse-i64-left-shift analyse exo-type ?values) - "lux i64 arithmetic-right-shift" (analyse-i64-arithmetic-right-shift analyse exo-type ?values) - "lux i64 logical-right-shift" (analyse-i64-logical-right-shift analyse exo-type ?values) + "lux i64 and" (analyse-i64-and analyse exo-type ?values) + "lux i64 or" (analyse-i64-or analyse exo-type ?values) + "lux i64 xor" (analyse-i64-xor analyse exo-type ?values) + "lux i64 left-shift" (analyse-i64-left-shift analyse exo-type ?values) + "lux i64 right-shift" (analyse-i64-right-shift analyse exo-type ?values) "lux i64 +" (analyse-i64-add analyse exo-type ?values) "lux i64 -" (analyse-i64-sub analyse exo-type ?values) "lux i64 =" (analyse-i64-eq analyse exo-type ?values) diff --git a/lux-bootstrapper/src/lux/compiler/jvm/proc/common.clj b/lux-bootstrapper/src/lux/compiler/jvm/proc/common.clj index f16d89e2a..ad01dfb31 100644 --- a/lux-bootstrapper/src/lux/compiler/jvm/proc/common.clj +++ b/lux-bootstrapper/src/lux/compiler/jvm/proc/common.clj @@ -56,8 +56,7 @@ (return nil))) Opcodes/LSHL ^:private compile-i64-left-shift - Opcodes/LSHR ^:private compile-i64-arithmetic-right-shift - Opcodes/LUSHR ^:private compile-i64-logical-right-shift + Opcodes/LUSHR ^:private compile-i64-right-shift ) (defn ^:private compile-lux-is [compile ?values special-args] @@ -420,21 +419,20 @@ "i64" (case proc - "and" (compile-i64-and compile ?values special-args) - "or" (compile-i64-or compile ?values special-args) - "xor" (compile-i64-xor compile ?values special-args) - "left-shift" (compile-i64-left-shift compile ?values special-args) - "arithmetic-right-shift" (compile-i64-arithmetic-right-shift compile ?values special-args) - "logical-right-shift" (compile-i64-logical-right-shift compile ?values special-args) - "=" (compile-i64-eq compile ?values special-args) - "+" (compile-i64-add compile ?values special-args) - "-" (compile-i64-sub compile ?values special-args) - "*" (compile-int-mul compile ?values special-args) - "/" (compile-int-div compile ?values special-args) - "%" (compile-int-rem compile ?values special-args) - "<" (compile-int-lt compile ?values special-args) - "f64" (compile-int-frac compile ?values special-args) - "char" (compile-int-char compile ?values special-args) + "and" (compile-i64-and compile ?values special-args) + "or" (compile-i64-or compile ?values special-args) + "xor" (compile-i64-xor compile ?values special-args) + "left-shift" (compile-i64-left-shift compile ?values special-args) + "right-shift" (compile-i64-right-shift compile ?values special-args) + "=" (compile-i64-eq compile ?values special-args) + "+" (compile-i64-add compile ?values special-args) + "-" (compile-i64-sub compile ?values special-args) + "*" (compile-int-mul compile ?values special-args) + "/" (compile-int-div compile ?values special-args) + "%" (compile-int-rem compile ?values special-args) + "<" (compile-int-lt compile ?values special-args) + "f64" (compile-int-frac compile ?values special-args) + "char" (compile-int-char compile ?values special-args) ) "f64" diff --git a/lux-js/source/program.lux b/lux-js/source/program.lux index 48392d358..aacbcdb54 100644 --- a/lux-js/source/program.lux +++ b/lux-js/source/program.lux @@ -285,7 +285,7 @@ [high low]]) (#.Some (.int (n.+ (|> high .nat (i64.left_shift 32)) (if (i.< +0 (.int low)) - (|> low .nat (i64.left_shift 32) (i64.logic_right_shift 32)) + (|> low .nat (i64.left_shift 32) (i64.right_shift 32)) (.nat low))))) _ 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 add0eefcc..fd86253d5 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/extension/common.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/extension/common.lux @@ -156,9 +156,8 @@ <op> (_.wrap type.long)))] - [i64::left_shift _.LSHL] - [i64::arithmetic_right_shift _.LSHR] - [i64::logical_right_shift _.LUSHR] + [i64::left_shift _.LSHL] + [i64::right_shift _.LUSHR] ) (template [<name> <const> <type>] @@ -329,8 +328,7 @@ (bundle.install "or" (binary i64::or)) (bundle.install "xor" (binary i64::xor)) (bundle.install "left-shift" (binary i64::left_shift)) - (bundle.install "logical-right-shift" (binary i64::logical_right_shift)) - (bundle.install "arithmetic-right-shift" (binary i64::arithmetic_right_shift)) + (bundle.install "right-shift" (binary i64::right_shift)) (bundle.install "=" (binary i64::=)) (bundle.install "<" (binary i64::<)) (bundle.install "+" (binary i64::+)) diff --git a/lux-mode/lux-mode.el b/lux-mode/lux-mode.el index d416c3b25..33bc0d736 100644 --- a/lux-mode/lux-mode.el +++ b/lux-mode/lux-mode.el @@ -335,7 +335,7 @@ Called by `imenu--generic-function'." ;; Data (data//record (altRE "get@" "set@" "update@")) (data//signature (altRE "open:" "structure" "\\\\")) - (data//implicit (altRE "implicit:" "implicit" "\\\\\\\\")) + (data//implicit (altRE "implicit:" "\\\\\\\\")) (data//collection (altRE "list" "list&" "row" "tree")) ;; Code (code//quotation (altRE "`" "`'" "'" "~" "~\\+" "~!" "~'")) diff --git a/lux-python/source/program.lux b/lux-python/source/program.lux index 6ac0af1ab..1b80fabfe 100644 --- a/lux-python/source/program.lux +++ b/lux-python/source/program.lux @@ -290,17 +290,19 @@ (evaluate! context (_.var (reference.artifact context)))))))))) @.python - (as_is (import: (eval [host.String] #try Any)) + (as_is (import: (dict [] host.Dict)) + (import: (eval [host.String host.Dict] #try Any)) (def: host (IO (Host (_.Expression Any) (_.Statement Any))) (io (: (Host (_.Expression Any) (_.Statement Any)) - (let [evaluate! (: (-> Context (_.Expression Any) (Try Any)) + (let [globals (..dict []) + evaluate! (: (-> Context (_.Expression Any) (Try Any)) (function (evaluate! context input) - (..eval (_.code input)))) + (..eval [(_.code input) globals]))) execute! (: (-> (_.Statement Any) (Try Any)) (function (execute! input) - (host.try ("python exec" (_.code input))))) + (host.try ("python exec" (_.code input) globals)))) define! (: (-> Context (_.Expression Any) (Try [Text Any (_.Statement Any)])) (function (define! context input) (let [global (reference.artifact context) @@ -342,7 +344,11 @@ (_.import "sys") (_.when (_.= (_.string "__main__") (_.var "__name__")) (_.statement (_.apply/2 program - (runtime.lux//program_args (|> (_.var "sys") (_.the "argv"))) + (|> (_.var "sys") (_.the "argv") + ## The first entry in the list will be the program.py file itself + ## so, it must be removed so only the program's arguments are left. + (_.slice_from (_.int +1)) + runtime.lux//program_args) _.none))))) (for {@.old @@ -382,11 +388,16 @@ (def: (scope body) (-> (_.Statement Any) (_.Statement Any)) - (let [@program (_.var "lux_program")] - ($_ _.then - (_.def @program (list) body) - (_.statement (_.apply/* @program (list))) - ))) + (let [@program (_.var "lux_program") + max_recursion (|> (_.int +10) (_.** (_.int +6))) + ; _.statement] + (<| (_.comment "-*- coding: utf-8 -*-") + ($_ _.then + (; (|> (_.__import__/1 (_.unicode "sys")) + (_.do "setrecursionlimit" (list max_recursion)))) + (_.def @program (list) body) + (; (_.apply/* @program (list))) + )))) (program: [{service /cli.service}] (let [extension ".py"] @@ -401,11 +412,12 @@ generation.bundle extension/bundle.empty ..program - [(& Register _.SVar) (type (_.Expression Any)) (type (_.Statement Any))] + [(type [Register _.SVar]) + (type (_.Expression Any)) + (type (_.Statement Any))] ..extender service - [(packager.package (<| (_.comment "-*- coding: utf-8 -*-") - (: (_.Statement Any) (_.manual ""))) + [(packager.package (: (_.Statement Any) (_.manual "")) _.code _.then ..scope) @@ -415,4 +427,3 @@ extension)])] (..declare_success! [])) (io.io [])))) - diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux index bd492b4aa..2b9d0b27e 100644 --- a/stdlib/source/lux.lux +++ b/stdlib/source/lux.lux @@ -2091,7 +2091,7 @@ (def:''' (high_bits value) (list) (-> ($' I64 Any) I64) - ("lux i64 logical-right-shift" 32 value)) + ("lux i64 right-shift" 32 value)) (def:''' low_mask (list) @@ -2167,7 +2167,7 @@ 0 1) (let' [quotient (|> subject - ("lux i64 logical-right-shift" 1) + ("lux i64 right-shift" 1) ("lux i64 /" ("lux coerce" Int param)) ("lux i64 left-shift" 1)) flat ("lux i64 *" diff --git a/stdlib/source/lux/control/concurrency/thread.lux b/stdlib/source/lux/control/concurrency/thread.lux index 9c77fc85f..2ae0afec9 100644 --- a/stdlib/source/lux/control/concurrency/thread.lux +++ b/stdlib/source/lux/control/concurrency/thread.lux @@ -49,7 +49,7 @@ @.python (host.import: threading/Timer (new [host.Float host.Function]) - (start [] #io Any))} + (start [] #io #? Any))} ## Default (type: Thread @@ -108,10 +108,12 @@ (n.frac milli_seconds)]) @.python - (|> (host.lambda [] (io.run action)) - [(|> milli_seconds n.frac (f./ +1,000.0))] - threading/Timer::new - (threading/Timer::start []))} + (do io.monad + [_ (|> (host.lambda [] (io.run action)) + [(|> milli_seconds n.frac (f./ +1,000.0))] + threading/Timer::new + (threading/Timer::start []))] + (wrap []))} ## Default (do io.monad diff --git a/stdlib/source/lux/data/binary.lux b/stdlib/source/lux/data/binary.lux index eb8405fc5..e74517756 100644 --- a/stdlib/source/lux/data/binary.lux +++ b/stdlib/source/lux/data/binary.lux @@ -1,7 +1,7 @@ (.module: [lux (#- i64) - ["." host] ["@" target] + ["." host] [abstract [monad (#+ do)] [equivalence (#+ Equivalence)] @@ -16,7 +16,7 @@ [collection ["." array]]] [math - [number + [number (#+ hex) ["n" nat] ["f" frac] ["." i64]]]]) @@ -65,11 +65,8 @@ @.jvm (|>> .int (:coerce (primitive "java.lang.Long")) host.long_to_byte)})))] - (for {@.old - (as_is <jvm>) - - @.jvm - (as_is <jvm>) + (for {@.old (as_is <jvm>) + @.jvm (as_is <jvm>) @.js (as_is (host.import: ArrayBuffer @@ -87,11 +84,8 @@ (primitive "bytearray"))})) (template: (!size binary) - (for {@.old - (host.array_length binary) - - @.jvm - (host.array_length binary) + (for {@.old (host.array_length binary) + @.jvm (host.array_length binary) @.js (f.nat (Uint8Array::length binary)) @@ -102,11 +96,8 @@ "python array length")})) (template: (!read idx binary) - (for {@.old - (..i64 (host.array_read idx binary)) - - @.jvm - (..i64 (host.array_read idx binary)) + (for {@.old (..i64 (host.array_read idx binary)) + @.jvm (..i64 (host.array_read idx binary)) @.js (|> binary @@ -122,11 +113,8 @@ ("python array read" idx))})) (template: (!write idx value binary) - (for {@.old - (host.array_write idx (..byte value) binary) - - @.jvm - (host.array_write idx (..byte value) binary) + (for {@.old (host.array_write idx (..byte value) binary) + @.jvm (host.array_write idx (..byte value) binary) @.js (|> binary @@ -138,7 +126,7 @@ @.python (|> binary (:coerce (array.Array (I64 Any))) - ("python array write" idx (:coerce (I64 Any) value)) + ("python array write" idx (:coerce (I64 Any) (i64.and (hex "FF") value))) (:coerce ..Binary))})) (def: #export size @@ -147,17 +135,14 @@ (def: #export create (-> Nat Binary) - (for {@.old - (|>> (host.array byte)) - - @.jvm - (|>> (host.array byte)) + (for {@.old (|>> (host.array byte)) + @.jvm (|>> (host.array byte)) @.js - (|>> n.frac [] ArrayBuffer::new Uint8Array::new) + (|>> n.frac ArrayBuffer::new Uint8Array::new) @.python - (|>> ("python apply" ("python constant" "bytearray")) + (|>> ("python apply" (:coerce host.Function ("python constant" "bytearray"))) (:coerce Binary))})) (def: #export (fold f init binary) @@ -210,64 +195,58 @@ (def: #export (write/8 idx value binary) (-> Nat (I64 Any) Binary (Try Binary)) (if (n.< (..!size binary) idx) - (exec (|> binary - (!write idx value)) - (#try.Success binary)) + (#try.Success (|> binary + (!write idx value))) (exception.throw ..index_out_of_bounds [(..!size binary) idx]))) (def: #export (write/16 idx value binary) (-> Nat (I64 Any) Binary (Try Binary)) (if (n.< (..!size binary) (n.+ 1 idx)) - (exec (|> binary - (!write idx (i64.logic_right_shift 8 value)) - (!write (n.+ 1 idx) value)) - (#try.Success binary)) + (#try.Success (|> binary + (!write idx (i64.right_shift 8 value)) + (!write (n.+ 1 idx) value))) (exception.throw ..index_out_of_bounds [(..!size binary) idx]))) (def: #export (write/32 idx value binary) (-> Nat (I64 Any) Binary (Try Binary)) (if (n.< (..!size binary) (n.+ 3 idx)) - (exec (|> binary - (!write idx (i64.logic_right_shift 24 value)) - (!write (n.+ 1 idx) (i64.logic_right_shift 16 value)) - (!write (n.+ 2 idx) (i64.logic_right_shift 8 value)) - (!write (n.+ 3 idx) value)) - (#try.Success binary)) + (#try.Success (|> binary + (!write idx (i64.right_shift 24 value)) + (!write (n.+ 1 idx) (i64.right_shift 16 value)) + (!write (n.+ 2 idx) (i64.right_shift 8 value)) + (!write (n.+ 3 idx) value))) (exception.throw ..index_out_of_bounds [(..!size binary) idx]))) (def: #export (write/64 idx value binary) (-> Nat (I64 Any) Binary (Try Binary)) (if (n.< (..!size binary) (n.+ 7 idx)) - (exec (|> binary - (!write idx (i64.logic_right_shift 56 value)) - (!write (n.+ 1 idx) (i64.logic_right_shift 48 value)) - (!write (n.+ 2 idx) (i64.logic_right_shift 40 value)) - (!write (n.+ 3 idx) (i64.logic_right_shift 32 value)) - (!write (n.+ 4 idx) (i64.logic_right_shift 24 value)) - (!write (n.+ 5 idx) (i64.logic_right_shift 16 value)) - (!write (n.+ 6 idx) (i64.logic_right_shift 8 value)) - (!write (n.+ 7 idx) value)) - (#try.Success binary)) + (#try.Success (|> binary + (!write idx (i64.right_shift 56 value)) + (!write (n.+ 1 idx) (i64.right_shift 48 value)) + (!write (n.+ 2 idx) (i64.right_shift 40 value)) + (!write (n.+ 3 idx) (i64.right_shift 32 value)) + (!write (n.+ 4 idx) (i64.right_shift 24 value)) + (!write (n.+ 5 idx) (i64.right_shift 16 value)) + (!write (n.+ 6 idx) (i64.right_shift 8 value)) + (!write (n.+ 7 idx) value))) (exception.throw ..index_out_of_bounds [(..!size binary) idx]))) (structure: #export equivalence (Equivalence Binary) (def: (= reference sample) - (for {@.old - (java/util/Arrays::equals reference sample) - - @.jvm - (java/util/Arrays::equals reference sample)} - (let [limit (!size reference)] - (and (n.= limit - (!size sample)) - (loop [idx 0] - (if (n.< limit idx) - (and (n.= (!read idx reference) - (!read idx sample)) - (recur (inc idx))) - true))))))) + (with_expansions [<jvm> (java/util/Arrays::equals reference sample)] + (for {@.old <jvm> + @.jvm <jvm>} + (let [limit (!size reference)] + (and (n.= limit + (!size sample)) + (loop [idx 0] + (if (n.< limit idx) + (and (n.= (!read idx reference) + (!read idx sample)) + (recur (inc idx))) + true)))))))) (for {@.old (as_is) @.jvm (as_is)} @@ -286,11 +265,8 @@ (with_expansions [<jvm> (as_is (do try.monad [_ (java/lang/System::arraycopy source (.int source_offset) target (.int target_offset) (.int bytes))] (wrap target)))] - (for {@.old - <jvm> - - @.jvm - <jvm>} + (for {@.old <jvm> + @.jvm <jvm>} ## Default (let [source_input (n.- source_offset (!size source)) @@ -312,11 +288,8 @@ (if (and (n.< size from) (n.< size to)) (with_expansions [<jvm> (as_is (#try.Success (java/util/Arrays::copyOfRange binary (.int from) (.int (inc to)))))] - (for {@.old - <jvm> - - @.jvm - <jvm>} + (for {@.old <jvm> + @.jvm <jvm>} ## Default (let [how_many (n.- from to)] diff --git a/stdlib/source/lux/data/collection/dictionary.lux b/stdlib/source/lux/data/collection/dictionary.lux index 9691c87cd..8e07a4ab4 100644 --- a/stdlib/source/lux/data/collection/dictionary.lux +++ b/stdlib/source/lux/data/collection/dictionary.lux @@ -168,7 +168,7 @@ (def: (level_index level hash) (-> Level Hash_Code Index) (i64.and hierarchy_mask - (i64.logic_right_shift level hash))) + (i64.right_shift level hash))) ## A mechanism to go from indices to bit-positions. (def: (->bit_position index) diff --git a/stdlib/source/lux/data/collection/row.lux b/stdlib/source/lux/data/collection/row.lux index e7780b6f9..560f7618a 100644 --- a/stdlib/source/lux/data/collection/row.lux +++ b/stdlib/source/lux/data/collection/row.lux @@ -77,7 +77,7 @@ (if (n.< full_node_size row_size) 0 (|> (dec row_size) - (i64.logic_right_shift branching_exponent) + (i64.right_shift branching_exponent) (i64.left_shift branching_exponent)))) (def: (new_path level tail) @@ -95,7 +95,7 @@ (def: (push_tail size level tail parent) (All [a] (-> Nat Level (Base a) (Hierarchy a) (Hierarchy a))) - (let [sub_idx (branch_idx (i64.logic_right_shift level (dec size))) + (let [sub_idx (branch_idx (i64.right_shift level (dec size))) ## If we're currently on a bottom node sub_node (if (n.= branching_exponent level) ## Just add the tail to it @@ -124,7 +124,7 @@ (def: (put' level idx val hierarchy) (All [a] (-> Level Index a (Hierarchy a) (Hierarchy a))) - (let [sub_idx (branch_idx (i64.logic_right_shift level idx))] + (let [sub_idx (branch_idx (i64.right_shift level idx))] (case (array.read sub_idx hierarchy) (#.Some (#Hierarchy sub_node)) (|> (array.clone hierarchy) @@ -142,7 +142,7 @@ (def: (pop_tail size level hierarchy) (All [a] (-> Nat Level (Hierarchy a) (Maybe (Hierarchy a)))) - (let [sub_idx (branch_idx (i64.logic_right_shift level (n.- 2 size)))] + (let [sub_idx (branch_idx (i64.right_shift level (n.- 2 size)))] (cond (n.= 0 sub_idx) #.None @@ -208,7 +208,7 @@ ## -------------------------------------------------------- ## Will the root experience an overflow with this addition? (|> (if (n.> (i64.left_shift (get@ #level row) 1) - (i64.logic_right_shift branching_exponent row_size)) + (i64.right_shift branching_exponent row_size)) ## If so, a brand-new root must be established, that is ## 1-level taller. (|> row @@ -248,7 +248,7 @@ (loop [level (get@ #level row) hierarchy (get@ #root row)] (case [(n.> branching_exponent level) - (array.read (branch_idx (i64.logic_right_shift level idx)) hierarchy)] + (array.read (branch_idx (i64.right_shift level idx)) hierarchy)] [#1 (#.Some (#Hierarchy sub))] (recur (level_down level) sub) diff --git a/stdlib/source/lux/data/format/tar.lux b/stdlib/source/lux/data/format/tar.lux index 052f35f77..598b52be6 100644 --- a/stdlib/source/lux/data/format/tar.lux +++ b/stdlib/source/lux/data/format/tar.lux @@ -562,7 +562,7 @@ (#Directory ..Directory) (#Contiguous ..Contiguous)) -(type: #export Device +(type: Device Small) (def: no_device diff --git a/stdlib/source/lux/host.js.lux b/stdlib/source/lux/host.js.lux index 9b990ae07..2935f9e16 100644 --- a/stdlib/source/lux/host.js.lux +++ b/stdlib/source/lux/host.js.lux @@ -148,11 +148,16 @@ (def: (without_null g!temp [nullable? outputT] output) (-> Code Nullable Code Code) (if nullable? - (` (let [(~ g!temp) (~ output)] - (if ("js object null?" (~ g!temp)) - #.None - (#.Some (~ g!temp))))) - output)) + (` (: (Maybe (~ outputT)) + (let [(~ g!temp) (~ output)] + (if ("js object null?" (~ g!temp)) + #.None + (#.Some (~ g!temp)))))) + (` (: (~ outputT) + (let [(~ g!temp) (~ output)] + (if ("js object null?" (~ g!temp)) + (.error "Null is an invalid value.") + (~ g!temp))))))) (type: Import (#Class [Text (List Member)]) diff --git a/stdlib/source/lux/host.py.lux b/stdlib/source/lux/host.py.lux index ed3497df8..5405d65a5 100644 --- a/stdlib/source/lux/host.py.lux +++ b/stdlib/source/lux/host.py.lux @@ -32,6 +32,7 @@ [None] [Function] + [Dict] ) (template [<name> <type>] @@ -148,11 +149,16 @@ (def: (without_none g!temp [noneable? outputT] output) (-> Code Noneable Code Code) (if noneable? - (` (let [(~ g!temp) (~ output)] - (if ("python object none?" (~ g!temp)) - #.None - (#.Some (~ g!temp))))) - output)) + (` (: (Maybe (~ outputT)) + (let [(~ g!temp) (~ output)] + (if ("python object none?" (~ g!temp)) + #.None + (#.Some (~ g!temp)))))) + (` (: (~ outputT) + (let [(~ g!temp) (~ output)] + (if ("python object none?" (~ g!temp)) + (.error! "None is an invalid value!") + (~ g!temp))))))) (type: Import (#Class [Text (List Member)]) @@ -213,7 +219,7 @@ (with_try try?) (without_none g!temp outputT) (` ("python apply" - (~ source) + (:coerce ..Function (~ source)) (~+ (list\map (with_none g!temp) g!inputs))))))))))) (syntax: #export (import: {import ..import}) @@ -228,7 +234,8 @@ imported (case (text.split_all_with "/" class) (#.Cons head tail) (list\fold (function (_ sub super) - (` ("python object get" (~ (code.text sub)) (~ super)))) + (` ("python object get" (~ (code.text sub)) + (:coerce (..Object .Any) (~ super))))) (` ("python import" (~ (code.text head)))) tail) @@ -247,27 +254,30 @@ (:assume ("python apply" (:coerce ..Function (~ imported)) - [(~+ (list\map (with_none g!temp) g!inputs))]))))) + (~+ (list\map (with_none g!temp) g!inputs))))))) (#Field [static? field fieldT]) (if static? (` ((~! syntax:) ((~ (qualify field))) (\ (~! meta.monad) (~' wrap) (list (` (.:coerce (~ (noneable_type fieldT)) - ("python object get" (~ (code.text field)) (~ imported)))))))) + ("python object get" (~ (code.text field)) + (:coerce (..Object .Any) (~ imported))))))))) (` (def: ((~ (qualify field)) (~ g!object)) (-> (~ g!type) (~ (noneable_type fieldT))) (:assume - (~ (without_none g!temp fieldT (` ("python object get" (~ (code.text field)) (~ g!object))))))))) + (~ (without_none g!temp fieldT (` ("python object get" (~ (code.text field)) + (:coerce (..Object .Any) (~ g!object)))))))))) (#Method method) (case method (#Static [method alias inputsT io? try? outputT]) (..make_function (qualify (maybe.default method alias)) g!temp - (` ("python object get" (~ (code.text method)) (~ imported))) + (` ("python object get" (~ (code.text method)) + (:coerce (..Object .Any) (~ imported)))) inputsT io? try? @@ -290,7 +300,7 @@ (` ("python object do" (~ (code.text method)) (~ g!object) - [(~+ (list\map (with_none g!temp) g!inputs))]))))))))))) + (~+ (list\map (with_none g!temp) g!inputs))))))))))))) members))))) (#Function [name alias inputsT io? try? outputT]) @@ -303,10 +313,6 @@ outputT))) ))) -(def: #export none - (<| (:coerce None) - ("python object none"))) - (template: #export (lambda <inputs> <output>) (.:coerce ..Function (`` ("python function" diff --git a/stdlib/source/lux/math/number/frac.lux b/stdlib/source/lux/math/number/frac.lux index 599c5cbbb..ccc6bd544 100644 --- a/stdlib/source/lux/math/number/frac.lux +++ b/stdlib/source/lux/math/number/frac.lux @@ -121,7 +121,7 @@ (def: frac_denominator (|> -1 - ("lux i64 logical-right-shift" ..exponent_size) + ("lux i64 right-shift" ..exponent_size) "lux i64 f64")) (def: #export rev @@ -174,7 +174,7 @@ [(def: #export <name> {#.doc <doc>} (|> <constant> - ("python apply" (:assume ("python constant" "float"))) + ("python apply" (:coerce Nothing ("python constant" "float"))) (:coerce Frac)))] [not_a_number "NaN" "Not a number."] @@ -310,7 +310,7 @@ [(def: <getter> (-> (I64 Any) I64) (let [mask (|> 1 (//i64.left_shift <size>) dec (//i64.left_shift <offset>))] - (|>> (//i64.and mask) (//i64.logic_right_shift <offset>) .i64)))] + (|>> (//i64.and mask) (//i64.right_shift <offset>) .i64)))] [mantissa ..mantissa_size 0] [exponent ..exponent_size ..mantissa_size] diff --git a/stdlib/source/lux/math/number/i64.lux b/stdlib/source/lux/math/number/i64.lux index d04a9c13a..e8dde83e0 100644 --- a/stdlib/source/lux/math/number/i64.lux +++ b/stdlib/source/lux/math/number/i64.lux @@ -26,22 +26,29 @@ (All [s] (-> <parameter_type> (I64 s) (I64 s))) (<op> parameter subject))] - [(I64 Any) or "lux i64 or" "Bitwise or."] - [(I64 Any) xor "lux i64 xor" "Bitwise xor."] - [(I64 Any) and "lux i64 and" "Bitwise and."] + [(I64 Any) or "lux i64 or" "Bitwise or."] + [(I64 Any) xor "lux i64 xor" "Bitwise xor."] + [(I64 Any) and "lux i64 and" "Bitwise and."] - [Nat left_shift "lux i64 left-shift" "Bitwise left-shift."] - [Nat logic_right_shift "lux i64 logical-right-shift" "Unsigned bitwise logic-right-shift."] - [Nat arithmetic_right_shift "lux i64 arithmetic-right-shift" "Signed bitwise arithmetic-right-shift."] + [Nat left_shift "lux i64 left-shift" "Bitwise left-shift."] + [Nat right_shift "lux i64 right-shift" "Unsigned/logic bitwise right-shift."] ) +(type: #export Mask + I64) + +(def: #export (bit position) + (-> Nat Mask) + (|> 1 .i64 (..left_shift (n.% ..width position)))) + +(def: #export sign + Mask + (..bit (dec ..width))) + (def: #export not {#.doc "Bitwise negation."} (All [s] (-> (I64 s) (I64 s))) - (xor (.i64 (dec 0)))) - -(type: #export Mask - I64) + (..xor (.i64 (dec 0)))) (def: #export false Mask @@ -59,25 +66,17 @@ 0 ..true bits (|> 1 .i64 (..left_shift (n.% ..width bits)) .dec)))) -(def: #export (bit position) - (-> Nat Mask) - (|> 1 .i64 (..left_shift (n.% ..width position)))) - -(def: #export sign - Mask - (..bit (dec ..width))) - (def: (add_shift shift value) (-> Nat Nat Nat) - (|> value (logic_right_shift shift) (n.+ value))) + (|> value (right_shift shift) (n.+ value))) (def: #export (count subject) {#.doc "Count the number of 1s in a bit-map."} (-> (I64 Any) Nat) - (let [count' (n.- (|> subject (logic_right_shift 1) (..and 6148914691236517205) i64) + (let [count' (n.- (|> subject (right_shift 1) (..and 6148914691236517205) i64) (i64 subject))] (|> count' - (logic_right_shift 2) (..and 3689348814741910323) (n.+ (..and 3689348814741910323 count')) + (right_shift 2) (..and 3689348814741910323) (n.+ (..and 3689348814741910323 count')) (add_shift 4) (..and 1085102592571150095) (add_shift 8) (add_shift 16) @@ -113,8 +112,8 @@ (..or (<forward> distance input) (<backward> (n.- (n.% ..width distance) ..width) input)))] - [rotate_left ..left_shift ..logic_right_shift] - [rotate_right ..logic_right_shift ..left_shift] + [rotate_left ..left_shift ..right_shift] + [rotate_right ..right_shift ..left_shift] ) (def: #export (region size offset) @@ -166,7 +165,7 @@ high (try.assume (\ n.binary decode pattern)) low (..rotate_right size high)] (function (_ value) - (..or (..logic_right_shift size (..and high value)) + (..or (..right_shift size (..and high value)) (..left_shift size (..and low value))))))) swap/01 (swapper 0) @@ -205,7 +204,7 @@ (def: &equivalence ..equivalence) (def: width width) (def: (narrow value) - (..or (|> value (..and ..sign) (..logic_right_shift sign_shift)) + (..or (|> value (..and ..sign) (..right_shift sign_shift)) (|> value (..and mantissa)))) (def: (widen value) (.i64 (case (.nat (..and sign value)) diff --git a/stdlib/source/lux/math/number/int.lux b/stdlib/source/lux/math/number/int.lux index ec4df8389..e43c5eb89 100644 --- a/stdlib/source/lux/math/number/int.lux +++ b/stdlib/source/lux/math/number/int.lux @@ -251,3 +251,9 @@ (def: &equivalence ..equivalence) (def: hash .nat)) + +(def: #export (right_shift parameter subject) + {#.doc "Signed/arithmetic bitwise right-shift."} + (-> Nat Int Int) + (//i64.or (//i64.and //i64.sign subject) + (//i64.right_shift parameter subject))) diff --git a/stdlib/source/lux/math/number/nat.lux b/stdlib/source/lux/math/number/nat.lux index 5d1f7a101..a9583ea8a 100644 --- a/stdlib/source/lux/math/number/nat.lux +++ b/stdlib/source/lux/math/number/nat.lux @@ -27,7 +27,7 @@ (def: high (-> (I64 Any) I64) - (|>> ("lux i64 logical-right-shift" 32))) + (|>> ("lux i64 right-shift" 32))) (def: low (-> (I64 Any) I64) @@ -94,7 +94,7 @@ 0 1) (let [quotient (|> subject - ("lux i64 logical-right-shift" 1) + ("lux i64 right-shift" 1) ("lux i64 /" ("lux coerce" Int parameter)) ("lux i64 left-shift" 1)) flat ("lux i64 *" diff --git a/stdlib/source/lux/math/number/rev.lux b/stdlib/source/lux/math/number/rev.lux index 36436bf99..2e7975f1d 100644 --- a/stdlib/source/lux/math/number/rev.lux +++ b/stdlib/source/lux/math/number/rev.lux @@ -91,7 +91,7 @@ (def: high (-> (I64 Any) I64) - (|>> ("lux i64 logical-right-shift" 32))) + (|>> ("lux i64 right-shift" 32))) (def: low (-> (I64 Any) I64) @@ -107,7 +107,7 @@ paramL (..low param) bottom (|> subjectL ("lux i64 *" paramL) - ("lux i64 logical-right-shift" 32)) + ("lux i64 right-shift" 32)) middle ("lux i64 +" ("lux i64 *" paramL subjectH) ("lux i64 *" paramH subjectL)) @@ -122,7 +122,7 @@ (def: (even_reciprocal numerator) (-> Nat Nat) - (//nat./ (//i64.logic_right_shift 1 numerator) + (//nat./ (//i64.right_shift 1 numerator) ..even_one)) (def: (odd_reciprocal numerator) @@ -173,7 +173,7 @@ (def: mantissa (-> (I64 Any) Frac) - (|>> ("lux i64 logical-right-shift" 11) + (|>> ("lux i64 right-shift" 11) "lux i64 f64")) (def: frac_denominator diff --git a/stdlib/source/lux/math/random.lux b/stdlib/source/lux/math/random.lux index c4767d27f..68c33e91c 100644 --- a/stdlib/source/lux/math/random.lux +++ b/stdlib/source/lux/math/random.lux @@ -358,11 +358,11 @@ (let [magic 6364136223846793005] (function (_ _) [(|> seed .nat (n.* magic) ("lux i64 +" increase) [increase] pcg32) - (let [rot (|> seed .i64 (i64.logic_right_shift 59))] + (let [rot (|> seed .i64 (i64.right_shift 59))] (|> seed - (i64.logic_right_shift 18) + (i64.right_shift 18) (i64.xor seed) - (i64.logic_right_shift 27) + (i64.right_shift 27) (i64.rotate_right rot) .i64))]))) @@ -386,7 +386,7 @@ (-> Nat PRNG) (let [twist (: (-> Nat Nat Nat) (function (_ shift value) - (i64.xor (i64.logic_right_shift shift value) + (i64.xor (i64.right_shift shift value) value))) mix n.*] (..prng (n.+ (hex "9E,37,79,B9,7F,4A,7C,15")) diff --git a/stdlib/source/lux/target/jvm/encoding/signed.lux b/stdlib/source/lux/target/jvm/encoding/signed.lux index 671cbb17d..7ce06ac28 100644 --- a/stdlib/source/lux/target/jvm/encoding/signed.lux +++ b/stdlib/source/lux/target/jvm/encoding/signed.lux @@ -59,8 +59,8 @@ (def: #export <constructor> (-> Int (Try <name>)) - (let [positive (|> <bytes> (n.* i64.bits_per_byte) i64.mask .nat) - negative (|> positive (i64.arithmetic_right_shift 1) i64.not)] + (let [positive (|> <bytes> (n.* i64.bits_per_byte) i64.mask) + negative (|> positive .int (i.right_shift 1) i64.not)] (function (_ value) (if (i.= (if (i.< +0 value) (i64.or negative value) diff --git a/stdlib/source/lux/target/python.lux b/stdlib/source/lux/target/python.lux index 7510eac7d..700dff481 100644 --- a/stdlib/source/lux/target/python.lux +++ b/stdlib/source/lux/target/python.lux @@ -172,7 +172,7 @@ (-> (List a) Literal))) (function (_ entries) (<| :abstraction - ..expression + ## ..expression (format left_delimiter (|> entries (list\map entry_serializer) @@ -191,13 +191,13 @@ (def: #export (slice from to list) (-> (Expression Any) (Expression Any) (Expression Any) Access) (<| :abstraction - ..expression + ## ..expression (format (:representation list) "[" (:representation from) ":" (:representation to) "]"))) (def: #export (slice_from from list) (-> (Expression Any) (Expression Any) Access) (<| :abstraction - ..expression + ## ..expression (format (:representation list) "[" (:representation from) ":]"))) (def: #export dict @@ -207,7 +207,7 @@ (def: #export (apply/* func args) (-> (Expression Any) (List (Expression Any)) (Computation Any)) (<| :abstraction - ..expression + ## ..expression (format (:representation func) "(" (text.join_with ", " (list\map ..code args)) ")"))) (template [<name> <brand> <prefix>] @@ -223,7 +223,7 @@ [(def: #export (<name> args extra func) (-> (List (Expression Any)) (Expression Any) (Expression Any) (Computation Any)) (<| :abstraction - ..expression + ## ..expression (format (:representation func) (format "(" (|> args (list\map (function (_ arg) (format (:representation arg) ", "))) @@ -295,7 +295,7 @@ (def: #export (not subject) (-> (Expression Any) (Computation Any)) (<| :abstraction - ..expression + ## ..expression (format "not " (:representation subject)))) (def: #export (lambda arguments body) @@ -362,12 +362,6 @@ (-> (Expression Any) (Statement Any)) (|>> :transmutation)) - (def: #export (exec code then) - (-> (Expression Any) (Statement Any) (Statement Any)) - (:abstraction - (format "exec" (..expression (:representation code)) text.new_line - (:representation then)))) - (def: #export pass (Statement Any) (:abstraction "pass")) @@ -389,17 +383,28 @@ (..nest (:representation catch!))))) (text.join_with ""))))) - (template [<name> <keyword>] - [(def: #export (<name> message) + (template [<name> <keyword> <pre>] + [(def: #export (<name> value) (-> (Expression Any) (Statement Any)) (:abstraction - (format <keyword> " " (:representation message))))] + (format <keyword> (<pre> (:representation value)))))] - [raise "raise"] - [return "return"] - [print "print"] + [raise "raise " |>] + [return "return " |>] + [print "print" ..expression] ) - + + (def: #export (exec code globals) + (-> (Expression Any) (Maybe (Expression Any)) (Statement Any)) + (let [extra (case globals + (#.Some globals) + (.list globals) + + #.None + (.list))] + (:abstraction + (format "exec" (:representation (..tuple (list& code extra))))))) + (def: #export (def name args body) (-> SVar (List (Ex [k] (Var k))) (Statement Any) (Statement Any)) (:abstraction @@ -457,6 +462,7 @@ ["len"] ["chr"] ["repr"] + ["__import__"] ["Exception"]]] [2 diff --git a/stdlib/source/lux/tool/compiler/default/platform.lux b/stdlib/source/lux/tool/compiler/default/platform.lux index 21fc0b343..72642db8d 100644 --- a/stdlib/source/lux/tool/compiler/default/platform.lux +++ b/stdlib/source/lux/tool/compiler/default/platform.lux @@ -95,12 +95,17 @@ write_artifact! (: (-> [Text Binary] (Action Any)) (function (_ [name content]) (ioW.write system static module_id name content)))] - (do ..monad + (do {! ..monad} [_ (ioW.prepare system static module_id) - _ (|> output - row.to_list - (monad.map ..monad write_artifact!) - (: (Action (List Any)))) + _ (for {@.python (|> output + row.to_list + (list.chunk 128) + (monad.map ! (monad.map ! write_artifact!)) + (: (Action (List (List Any)))))} + (|> output + row.to_list + (monad.map ..monad write_artifact!) + (: (Action (List Any))))) document (\ promise.monad wrap (document.check $.key document))] (ioW.cache system static module_id 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 0d18884cb..4e6a9f7ff 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 @@ -251,8 +251,7 @@ (///bundle.install "or" (binary I64* I64* I64)) (///bundle.install "xor" (binary I64* I64* I64)) (///bundle.install "left-shift" (binary Nat I64* I64)) - (///bundle.install "logical-right-shift" (binary Nat I64* I64)) - (///bundle.install "arithmetic-right-shift" (binary Nat I64* I64)) + (///bundle.install "right-shift" (binary Nat I64* I64)) (///bundle.install "=" (binary I64* I64* Bit)) (///bundle.install "<" (binary Int Int Bit)) (///bundle.install "+" (binary I64* I64* I64)) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/python.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/python.lux index 5c10bbc0f..78e1a4f5a 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/python.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/python.lux @@ -119,6 +119,10 @@ (for {@.python host.Function} Any)) +(def: Dict + (for {@.python host.Dict} + Any)) + (def: object::get Handler (custom @@ -201,13 +205,15 @@ (def: python::exec Handler (custom - [<c>.any - (function (_ extension phase archive codeC) + [($_ <>.and <c>.any <c>.any) + (function (_ extension phase archive [codeC globalsC]) (do phase.monad [codeA (analysis/type.with_type Text (phase archive codeC)) + globalsA (analysis/type.with_type ..Dict + (phase archive globalsC)) _ (analysis/type.infer .Any)] - (wrap (#analysis.Extension extension (list codeA)))))])) + (wrap (#analysis.Extension extension (list codeA globalsA)))))])) (def: #export bundle Bundle diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js/common.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js/common.lux index 4c1ab473f..ca0e8daa9 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js/common.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js/common.lux @@ -51,9 +51,8 @@ (Binary Expression) (<op> subjectG (//runtime.i64//to_number paramG)))] - [i64//left_shift //runtime.i64//left_shift] - [i64//arithmetic_right_shift //runtime.i64//arithmetic_right_shift] - [i64//logical_right_shift //runtime.i64//logic_right_shift] + [i64//left_shift //runtime.i64//left_shift] + [i64//right_shift //runtime.i64//right_shift] ) ## [[Numbers]] @@ -139,8 +138,7 @@ (/.install "or" (binary (product.uncurry //runtime.i64//or))) (/.install "xor" (binary (product.uncurry //runtime.i64//xor))) (/.install "left-shift" (binary i64//left_shift)) - (/.install "logical-right-shift" (binary i64//logical_right_shift)) - (/.install "arithmetic-right-shift" (binary i64//arithmetic_right_shift)) + (/.install "right-shift" (binary i64//right_shift)) (/.install "=" (binary (product.uncurry //runtime.i64//=))) (/.install "<" (binary (product.uncurry //runtime.i64//<))) (/.install "+" (binary (product.uncurry //runtime.i64//+))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/jvm/common.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/jvm/common.lux index 630e212c3..a9251f4d6 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/jvm/common.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/jvm/common.lux @@ -181,9 +181,8 @@ shiftG ..jvm-int <op> (///value.wrap type.long)))] - [i64::left-shift _.lshl] - [i64::arithmetic-right-shift _.lshr] - [i64::logical-right-shift _.lushr] + [i64::left-shift _.lshl] + [i64::right-shift _.lushr] ) (template [<name> <type> <op>] @@ -273,8 +272,7 @@ (/////bundle.install "or" (binary ..i64::or)) (/////bundle.install "xor" (binary ..i64::xor)) (/////bundle.install "left-shift" (binary ..i64::left-shift)) - (/////bundle.install "logical-right-shift" (binary ..i64::logical-right-shift)) - (/////bundle.install "arithmetic-right-shift" (binary ..i64::arithmetic-right-shift)) + (/////bundle.install "right-shift" (binary ..i64::right-shift)) (/////bundle.install "=" (binary ..i64::=)) (/////bundle.install "<" (binary ..i64::<)) (/////bundle.install "+" (binary ..i64::+)) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/python/common.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/python/common.lux index 9657fcb66..285499f13 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/python/common.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/python/common.lux @@ -9,7 +9,7 @@ ["<s>" synthesis (#+ Parser)]]] [data ["." product] - [text + ["." text ["%" format (#+ format)]] [collection ["." dictionary] @@ -101,8 +101,7 @@ (/.install "or" (binary (product.uncurry //runtime.i64//or))) (/.install "xor" (binary (product.uncurry //runtime.i64//xor))) (/.install "left-shift" (binary (product.uncurry //runtime.i64//left_shift))) - (/.install "logical-right-shift" (binary (product.uncurry //runtime.i64//logic_right_shift))) - (/.install "arithmetic-right-shift" (binary (product.uncurry _.bit_shr))) + (/.install "right-shift" (binary (product.uncurry //runtime.i64//right_shift))) (/.install "<" (binary (product.uncurry _.<))) (/.install "=" (binary (product.uncurry _.=))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/python/host.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/python/host.lux index fcf35aa99..0c1478eea 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/python/host.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/python/host.lux @@ -142,11 +142,12 @@ (def: python::exec (custom - [<s>.any - (function (_ extension phase archive codeS) + [($_ <>.and <s>.any <s>.any) + (function (_ extension phase archive [codeS globalsS]) (do {! ////////phase.monad} - [codeG (phase archive codeS)] - (wrap (//runtime.lux//exec codeG))))])) + [codeG (phase archive codeS) + globalsG (phase archive globalsS)] + (wrap (//runtime.lux//exec codeG globalsG))))])) (def: #export bundle Bundle diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux index c0f697584..5487cc628 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux @@ -66,7 +66,7 @@ (def: #export high (-> (I64 Any) (I64 Any)) - (i64.logic_right_shift 32)) + (i64.right_shift 32)) (def: #export low (-> (I64 Any) (I64 Any)) @@ -453,7 +453,7 @@ low (|> input (_.the ..i64_high_field) (_.arithmetic_right_shift (_.- (_.i32 +32) shift)))] (_.return (..i64 high low)))))) -(runtime: (i64//logic_right_shift input shift) +(runtime: (i64//right_shift input shift) ($_ _.then (..cap_shift! shift) (_.cond (list (..no_shift! shift input) @@ -476,7 +476,7 @@ @i64//not @i64//left_shift @i64//arithmetic_right_shift - @i64//logic_right_shift + @i64//right_shift )) (runtime: (i64//- parameter subject) @@ -576,7 +576,7 @@ [(i64//= i64//min parameter) (_.return i64//one)]) (with_vars [approximation] - (let [subject/2 (i64//arithmetic_right_shift subject (_.i32 +1))] + (let [subject/2 (..i64//arithmetic_right_shift subject (_.i32 +1))] ($_ _.then (_.define approximation (i64//left_shift (i64/// parameter subject/2) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/case.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/case.lux index ddaf1fe5b..a1ae27d5e 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/case.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/case.lux @@ -93,7 +93,7 @@ [#.Right //runtime.tuple//right]))] (method source))) valueO - pathP)))) + (list.reverse pathP))))) (def: @savepoint (_.var "lux_pm_savepoint")) (def: @cursor (_.var "lux_pm_cursor")) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux index ef213fb2c..f32712fc2 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux @@ -155,24 +155,23 @@ (~ code))))))))))))) (runtime: (lux//try op) - (with_vars [error value] - (_.try ($_ _.then - (_.set (list value) (_.apply/* op (list unit))) - (_.return (right value))) - (list [(list (_.var "Exception")) error - (_.return (left (_.str/1 error)))])))) + (with_vars [exception] + (_.try (_.return (..right (_.apply/* op (list ..unit)))) + (list [(list (_.var "Exception")) exception + (_.return (..left (_.str/1 exception)))])))) (runtime: (lux//program_args program_args) (with_vars [inputs value] ($_ _.then (_.set (list inputs) ..none) - (<| (_.for_in value program_args) + (<| (_.for_in value (_.apply/* (_.var "reversed") (list program_args))) (_.set (list inputs) - (..some (_.tuple (list value inputs))))) + (..some (_.list (list value inputs))))) (_.return inputs)))) -(runtime: (lux//exec code) - (<| (_.exec code) +(runtime: (lux//exec code globals) + ($_ _.then + (_.exec code (#.Some globals)) (_.return ..unit))) (def: runtime//lux @@ -304,7 +303,7 @@ ..as_nat ..i64//64))) -(runtime: (i64//logic_right_shift param subject) +(runtime: (i64//right_shift param subject) (_.return (|> subject ..as_nat (_.bit_shr param)))) @@ -328,13 +327,13 @@ @i64//top @i64//bottom @i64//64 - @i64//left_shift - @i64//logic_right_shift @i64//nat_top + @i64//left_shift + @i64//right_shift + @i64//remainder @i64//and @i64//or @i64//xor - @i64//remainder )) (runtime: (f64//decode input) @@ -397,11 +396,11 @@ (Statement Any) ($_ _.then runtime//lux + runtime//io runtime//adt runtime//i64 runtime//f64 runtime//text - runtime//io runtime//array )) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/case.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/case.lux index b303a258d..6bc35147b 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/case.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/case.lux @@ -386,13 +386,17 @@ (list\fold for_synthesis synthesis_storage environment) (^ (/.branch/case [inputS pathS])) - (|> synthesis_storage (for_synthesis inputS) (for_path pathS)) + (update@ #dependencies + (set.union (get@ #dependencies (for_path pathS synthesis_storage))) + (for_synthesis inputS synthesis_storage)) (^ (/.branch/let [inputS register exprS])) - (list\fold for_synthesis - (update@ #bindings (set.add (#///reference/variable.Local register)) - synthesis_storage) - (list inputS exprS)) + (update@ #dependencies + (set.union (|> synthesis_storage + (update@ #bindings (set.add (#///reference/variable.Local register))) + (for_synthesis exprS) + (get@ #dependencies))) + (for_synthesis inputS synthesis_storage)) (^ (/.branch/if [testS thenS elseS])) (list\fold for_synthesis synthesis_storage (list testS thenS elseS)) @@ -401,7 +405,15 @@ (for_synthesis whole synthesis_storage) (^ (/.loop/scope [start initsS+ iterationS])) - (list\fold for_synthesis synthesis_storage (#.Cons iterationS initsS+)) + (update@ #dependencies + (set.union (|> synthesis_storage + (update@ #bindings (set.union (|> initsS+ + list.enumeration + (list\map (|>> product.left (n.+ start) #///reference/variable.Local)) + (set.from_list ///reference/variable.hash)))) + (for_synthesis iterationS) + (get@ #dependencies))) + (list\fold for_synthesis synthesis_storage initsS+)) (^ (/.loop/recur replacementsS+)) (list\fold for_synthesis synthesis_storage replacementsS+) diff --git a/stdlib/source/lux/tool/compiler/language/lux/syntax.lux b/stdlib/source/lux/tool/compiler/language/lux/syntax.lux index 4bd39b8a9..8362c7054 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/syntax.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/syntax.lux @@ -26,6 +26,7 @@ ## location, which is helpful for documentation and debugging. (.module: [lux #* + ["@" target] [abstract monad] [control @@ -48,6 +49,10 @@ ["." rev] ["." frac]]]]) +(template: (inline: <declaration> <type> <body>) + (for {@.python (def: <declaration> <type> <body>)} + (template: <declaration> <body>))) + ## TODO: Implement "lux syntax char case!" as a custom extension. ## That way, it should be possible to obtain the char without wrapping ## it into a java.lang.Long, thereby improving performance. @@ -61,7 +66,8 @@ ## producing the locations only involved building them, without any need ## for pattern-matching and de-structuring. -(type: Char Nat) +(type: Char + Nat) (template [<name> <extension> <diff>] [(template: (<name> value) @@ -142,8 +148,8 @@ (def: amount_of_input_shown 64) -(template: (input_at start input) - ## (-> Offset Text Text) +(inline: (input_at start input) + (-> Offset Text Text) (let [end (|> start (!n/+ amount_of_input_shown) (n.min ("lux text size" input)))] (!clip start end input))) @@ -194,13 +200,13 @@ (!inc offset) source_code]) -(template: (!new_line where) - ## (-> Location Location) +(inline: (!new_line where) + (-> Location Location) (let [[where::file where::line where::column] where] [where::file (!inc where::line) 0])) -(template: (!forward length where) - ## (-> Nat Location Location) +(inline: (!forward length where) + (-> Nat Location Location) (let [[where::file where::line where::column] where] [where::file where::line (!n/+ length where::column)])) @@ -210,8 +216,9 @@ source_code]) (template [<name> <close> <tag>] - [(template: (<name> parse where offset source_code) - ## (-> (Parser Code) (Parser Code)) + [(inline: (<name> parse where offset source_code) + (-> (Parser Code) Location Offset Text + (Either [Source Text] [Source Code])) (loop [source (: Source [(!forward 1 where) offset source_code]) stack (: (List Code) #.Nil)] (case (parse source) @@ -231,8 +238,9 @@ [parse_tuple ..close_tuple #.Tuple] ) -(template: (parse_record parse where offset source_code) - ## (-> (Parser Code) (Parser Code)) +(inline: (parse_record parse where offset source_code) + (-> (Parser Code) Location Offset Text + (Either [Source Text] [Source Code])) (loop [source (: Source [(!forward 1 where) offset source_code]) stack (: (List [Code Code]) #.Nil)] (case (parse source) @@ -256,7 +264,7 @@ (exception.construct ..text_cannot_contain_new_lines content)]))) (def: (parse_text where offset source_code) - (-> Location Nat Text (Either [Source Text] [Source Code])) + (-> Location Offset Text (Either [Source Text] [Source Code])) (case ("lux text index" offset (static ..text_delimiter) source_code) (#.Some g!end) (<| (let [g!content (!clip offset g!end source_code)]) @@ -346,8 +354,9 @@ [..positive_sign] [..negative_sign])] - (template: (parse_frac source_code//size start where offset source_code) - ## (-> Nat Offset (Parser Code)) + (inline: (parse_frac source_code//size start where offset source_code) + (-> Nat Nat Location Offset Text + (Either [Source Text] [Source Code])) (loop [end offset exponent (static ..no_exponent)] (<| (!with_char+ source_code//size source_code end char/0 <frac_output>) @@ -370,8 +379,9 @@ <frac_output>)))) - (template: (parse_signed source_code//size start where offset source_code) - ## (-> Nat Offset (Parser Code)) + (inline: (parse_signed source_code//size start where offset source_code) + (-> Nat Nat Location Offset Text + (Either [Source Text] [Source Code])) (loop [end offset] (<| (!with_char+ source_code//size source_code end char <int_output>) (!if_digit?+ char @@ -384,8 +394,9 @@ ) (template [<parser> <codec> <tag>] - [(template: (<parser> source_code//size start where offset source_code) - ## (-> Nat Nat Location Nat Text (Either [Source Text] [Source Code])) + [(inline: (<parser> source_code//size start where offset source_code) + (-> Nat Nat Location Offset Text + (Either [Source Text] [Source Code])) (loop [g!end offset] (<| (!with_char+ source_code//size source_code g!end g!char (!number_output source_code start g!end <codec> <tag>)) (!if_digit?+ g!char @@ -408,8 +419,9 @@ end source_code] (!clip start end source_code)])] - (template: (parse_name_part start where offset source_code) - ## (-> Offset (Parser Text)) + (inline: (parse_name_part start where offset source_code) + (-> Nat Location Offset Text + (Either [Source Text] [Source Text])) (let [source_code//size ("lux text size" source_code)] (loop [end offset] (<| (!with_char+ source_code//size source_code end char <output>) diff --git a/stdlib/source/lux/type/dynamic.lux b/stdlib/source/lux/type/dynamic.lux index d8b3cd3f6..d50fefc27 100644 --- a/stdlib/source/lux/type/dynamic.lux +++ b/stdlib/source/lux/type/dynamic.lux @@ -6,7 +6,7 @@ ["." exception (#+ exception:)]] [data [text - ["%" format (#+ format)]]] + ["%" format]]] [macro (#+ with_gensyms) ["." syntax (#+ syntax:)]] ["." type @@ -43,7 +43,7 @@ (#try.Success (:coerce (~ type) (~ g!value))) ((~! exception.throw) ..wrong_type [(.type (~ type)) (~ g!type)]))))))))) - (def: #export (print value) + (def: #export (format value) (-> Dynamic (Try Text)) (let [[type value] (:representation value)] (debug.represent type value))) diff --git a/stdlib/source/lux/type/implicit.lux b/stdlib/source/lux/type/implicit.lux index d8c4fbe1f..9a6c1a832 100644 --- a/stdlib/source/lux/type/implicit.lux +++ b/stdlib/source/lux/type/implicit.lux @@ -146,7 +146,7 @@ (\ ! map (prepare_definitions this_module_name this_module_name) (meta.definitions this_module_name)))) -(def: import_structs +(def: imported_structs (Meta (List [Name Type])) (do {! meta.monad} [this_module_name meta.current_module_name @@ -238,7 +238,7 @@ ($_ meta.either (do meta.monad [alts ..local_env] (..test_provision provision context dep alts)) (do meta.monad [alts ..local_structs] (..test_provision provision context dep alts)) - (do meta.monad [alts ..import_structs] (..test_provision provision context dep alts)))) + (do meta.monad [alts ..imported_structs] (..test_provision provision context dep alts)))) (#.Left error) (check.fail error) @@ -287,9 +287,9 @@ (-> Type Nat (List Type) Type (Meta (List Instance))) (let [test (test_alternatives sig_type member_idx input_types output_type)] ($_ meta.either - (do meta.monad [alts local_env] (test alts)) - (do meta.monad [alts local_structs] (test alts)) - (do meta.monad [alts import_structs] (test alts))))) + (do meta.monad [alts ..local_env] (test alts)) + (do meta.monad [alts ..local_structs] (test alts)) + (do meta.monad [alts ..imported_structs] (test alts))))) (def: (var? input) (-> Code Bit) @@ -380,7 +380,7 @@ (Parser (List Code)) (s.tuple (p.many s.any))) -(syntax: #export (implicit {structures ..implicits} body) +(syntax: #export (with {structures ..implicits} body) (do meta.monad [g!implicit+ (implicit_bindings (list.size structures))] (wrap (list (` (let [(~+ (|> (list.zip/2 g!implicit+ structures) @@ -394,4 +394,6 @@ [g!implicit+ (implicit_bindings (list.size structures))] (wrap (|> (list.zip/2 g!implicit+ structures) (list\map (function (_ [g!implicit structure]) - (` (def: (~ g!implicit) (~ structure))))))))) + (` (def: (~ g!implicit) + {#.struct? #1} + (~ structure))))))))) diff --git a/stdlib/source/lux/world/file.lux b/stdlib/source/lux/world/file.lux index e8ebb7aac..b24f6fda4 100644 --- a/stdlib/source/lux/world/file.lux +++ b/stdlib/source/lux/world/file.lux @@ -680,7 +680,12 @@ (as_is (type: (Tuple/2 left right) (primitive "python_tuple[2]" [left right])) - (host.import: (open [host.String host.String] #io #try Any)) + (host.import: PyFile + (read [] #io #try Binary) + (write [Binary] #io #try #? Any) + (close [] #io #try #? Any)) + + (host.import: (open [host.String host.String] #io #try PyFile)) (host.import: (tuple [[host.Integer host.Integer]] (Tuple/2 host.Integer host.Integer))) (host.import: os @@ -689,17 +694,17 @@ (#static W_OK host.Integer) (#static X_OK host.Integer) - (#static mkdir [host.String] #io #try Any) + (#static mkdir [host.String] #io #try #? Any) (#static access [host.String host.Integer] #io #try host.Boolean) - (#static remove [host.String] #io #try Any) - (#static rmdir [host.String] #io #try Any) - (#static rename [host.String host.String] #io #try Any) - (#static utime [host.String (Tuple/2 host.Integer host.Integer)] #io #try Any) + (#static remove [host.String] #io #try #? Any) + (#static rmdir [host.String] #io #try #? Any) + (#static rename [host.String host.String] #io #try #? Any) + (#static utime [host.String (Tuple/2 host.Integer host.Integer)] #io #try #? Any) (#static listdir [host.String] #io #try (Array host.String))) (host.import: os/path - (#static isfile [] #io #try host.Boolean) - (#static isdir [] #io #try host.Boolean) + (#static isfile [host.String] #io #try host.Boolean) + (#static isdir [host.String] #io #try host.Boolean) (#static sep host.String) (#static basename [host.String] host.String) (#static getsize [host.String] #io #try host.Integer) @@ -713,10 +718,10 @@ (..can_modify (function (<name> data) (do (try.with io.monad) - [file (..open [path <mode>])] - (io.io (do try.monad - [_ (host.try ("python object do" "write" (:assume file) data))] - (host.try ("python object do" "close" (:assume file)))))))))] + [file (..open [path <mode>]) + _ (PyFile::write [data] file) + _ (PyFile::close [] file)] + (wrap [])))))] [over_write "wb"] [append "ab"] @@ -726,12 +731,10 @@ (..can_query (function (_ _) (do (try.with io.monad) - [file (..open [path "rb"])] - (io.io (do try.monad - [data (:coerce (Try Binary) - (host.try ("python object do" "read" (:assume file)))) - _ (host.try ("python object do" "close" (:assume file)))] - (wrap data))))))) + [file (..open [path "rb"]) + data (PyFile::read [] file) + _ (PyFile::close [] file)] + (wrap data))))) (def: name (..can_see @@ -844,16 +847,16 @@ (def: create_file (..can_open (function (create_file path) - (do io.monad - [outcome (..open [path "x"])] - (wrap (case outcome - (#try.Success _) - (do try.monad - [_ (host.try ("python object do" "close" (:assume outcome)))] - (wrap (..file path))) - - (#try.Failure error) - (exception.throw ..cannot_create_file [path]))))))) + (do {! io.monad} + [file (..open [path "x"])] + (case file + (#try.Success file) + (do (try.with !) + [_ (PyFile::close [] file)] + (wrap (..file path))) + + (#try.Failure error) + (wrap (exception.throw ..cannot_create_file [path]))))))) (def: create_directory (..can_open diff --git a/stdlib/source/poly/lux/data/format/json.lux b/stdlib/source/poly/lux/data/format/json.lux index b6c14eb14..947e3666a 100644 --- a/stdlib/source/poly/lux/data/format/json.lux +++ b/stdlib/source/poly/lux/data/format/json.lux @@ -59,7 +59,7 @@ (codec.Codec JSON Nat) (def: (encode input) - (let [high (|> input (i64.and high_mask) (i64.logic_right_shift 32)) + (let [high (|> input (i64.and high_mask) (i64.right_shift 32)) low (i64.and low_mask input)] (#/.Array (row (|> high .int int.frac #/.Number) (|> low .int int.frac #/.Number))))) diff --git a/stdlib/source/program/aedifex/artifact/snapshot/version.lux b/stdlib/source/program/aedifex/artifact/snapshot/version.lux new file mode 100644 index 000000000..905523bd0 --- /dev/null +++ b/stdlib/source/program/aedifex/artifact/snapshot/version.lux @@ -0,0 +1,71 @@ +(.module: + [lux (#- Type) + [abstract + [equivalence (#+ Equivalence)] + [monad (#+ do)]] + [control + ["<>" parser + ["<.>" xml (#+ Parser)] + ["<.>" text]]] + [data + ["." product] + ["." text] + [format + ["." xml (#+ XML)]]]] + ["." /// #_ + ["#." type (#+ Type)] + ["#." time (#+ Time)]]) + +(type: #export Version + {#extension Type + #value Text + #updated Time}) + +(def: #export equivalence + (Equivalence Version) + ($_ product.equivalence + text.equivalence + text.equivalence + ///time.equivalence + )) + +(template [<definition> <tag>] + [(def: <definition> xml.Tag ["" <tag>])] + + [<extension> "extension"] + [<value> "value"] + [<updated> "updated"] + + [<snapshot_version> "snapshotVersion"] + ) + +(def: (format_text tag value) + (-> xml.Tag Text XML) + (|> value #xml.Text list (#xml.Node tag xml.attributes))) + +(def: #export (format (^slots [#extension #value #updated])) + (-> Version XML) + (<| (#xml.Node ..<snapshot_version> xml.attributes) + (list (..format_text ..<extension> extension) + (..format_text ..<value> value) + (..format_text ..<updated> (///time.format updated))))) + +(def: (sub tag parser) + (All [a] (-> xml.Tag (Parser a) (Parser a))) + (do <>.monad + [_ (<xml>.node tag)] + (<xml>.children parser))) + +(def: (text tag) + (-> xml.Tag (Parser Text)) + (..sub tag <xml>.text)) + +(def: #export parser + (Parser Version) + (<| (..sub ..<snapshot_version>) + ($_ <>.and + (<xml>.somewhere (..text ..<extension>)) + (<xml>.somewhere (..text ..<value>)) + (<xml>.somewhere (<text>.embed ///time.parser + (..text ..<updated>))) + ))) diff --git a/stdlib/source/spec/lux/abstract/equivalence.lux b/stdlib/source/spec/lux/abstract/equivalence.lux index 5c5114f4d..f3d97e5b6 100644 --- a/stdlib/source/spec/lux/abstract/equivalence.lux +++ b/stdlib/source/spec/lux/abstract/equivalence.lux @@ -8,11 +8,11 @@ {1 ["." / (#+ Equivalence)]}) -(def: #export (spec (^open "_//.") generator) +(def: #export (spec (^open "_//.") random) (All [a] (-> (Equivalence a) (Random a) Test)) (do random.monad - [left generator - right generator] + [left random + right random] (<| (_.for [/.Equivalence]) ($_ _.and (_.test "Reflexivity." diff --git a/stdlib/source/spec/lux/abstract/hash.lux b/stdlib/source/spec/lux/abstract/hash.lux index 17f8d12f2..543ea2a85 100644 --- a/stdlib/source/spec/lux/abstract/hash.lux +++ b/stdlib/source/spec/lux/abstract/hash.lux @@ -12,11 +12,11 @@ {1 ["." /]}) -(def: #export (spec (^open "\.") generator) +(def: #export (spec (^open "\.") random) (All [a] (-> (/.Hash a) (Random a) Test)) (do random.monad - [parameter generator - subject generator] + [parameter random + subject random] (_.cover [/.Hash] (bit\= (\= parameter subject) (n.= (\hash parameter) (\hash subject)))))) diff --git a/stdlib/source/test/aedifex/artifact/snapshot.lux b/stdlib/source/test/aedifex/artifact/snapshot.lux index 1bdb9ca2d..371fde55e 100644 --- a/stdlib/source/test/aedifex/artifact/snapshot.lux +++ b/stdlib/source/test/aedifex/artifact/snapshot.lux @@ -15,7 +15,8 @@ ["$." / #_ ["#." build] ["#." time] - ["#." stamp]] + ["#." stamp] + ["#." version]] {#program ["." /]}) @@ -45,4 +46,5 @@ $/build.test $/time.test $/stamp.test + $/version.test )))) diff --git a/stdlib/source/test/aedifex/artifact/snapshot/version.lux b/stdlib/source/test/aedifex/artifact/snapshot/version.lux new file mode 100644 index 000000000..e08691c3c --- /dev/null +++ b/stdlib/source/test/aedifex/artifact/snapshot/version.lux @@ -0,0 +1,46 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [monad (#+ do)] + {[0 #spec] + [/ + ["$." equivalence]]}] + [control + ["." try ("#\." functor)] + [parser + ["<.>" xml]]] + [math + ["." random (#+ Random)]]] + {#program + ["." /]} + ["$." /// #_ + ["#." type] + ["#." time]]) + +(def: #export random + (Random /.Version) + ($_ random.and + $///type.random + (random.ascii/alpha 1) + $///time.random + )) + +(def: #export test + Test + (<| (_.covering /._) + (_.for [/.Version]) + ($_ _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) + + (do random.monad + [expected ..random] + (_.cover [/.format /.parser] + (|> expected + /.format + list + (<xml>.run /.parser) + (try\map (\ /.equivalence = expected)) + (try.default false)))) + ))) diff --git a/stdlib/source/test/aedifex/artifact/time.lux b/stdlib/source/test/aedifex/artifact/time.lux index 880bc1f83..4bf63018c 100644 --- a/stdlib/source/test/aedifex/artifact/time.lux +++ b/stdlib/source/test/aedifex/artifact/time.lux @@ -11,7 +11,7 @@ [parser ["<.>" text]]] [math - ["." random]] + ["." random (#+ Random)]] [time ["." instant]]] {#program @@ -20,16 +20,20 @@ ["#." date] ["#." time]]) +(def: #export random + (Random /.Time) + random.instant) + (def: #export test Test (<| (_.covering /._) (_.for [/.Time]) ($_ _.and (_.for [/.equivalence] - ($equivalence.spec /.equivalence random.instant)) + ($equivalence.spec /.equivalence ..random)) (do random.monad - [expected random.instant] + [expected ..random] (_.cover [/.format /.parser] (|> expected /.format diff --git a/stdlib/source/test/lux/data/collection/set/multi.lux b/stdlib/source/test/lux/data/collection/set/multi.lux index 718c971c3..feea35e2f 100644 --- a/stdlib/source/test/lux/data/collection/set/multi.lux +++ b/stdlib/source/test/lux/data/collection/set/multi.lux @@ -36,6 +36,78 @@ (list.zip/2 element_counts (set.to_list elements)))))) +(def: signature + Test + (do {! random.monad} + [diversity (\ ! map (n.% 10) random.nat)] + ($_ _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence (..random diversity n.hash ..count random.nat))) + (_.for [/.hash] + (|> random.nat + (\ random.monad map (function (_ single) + (/.add 1 single (/.new n.hash)))) + ($hash.spec /.hash))) + ))) + +(def: composition + Test + (do {! random.monad} + [diversity (\ ! map (n.% 10) random.nat) + sample (..random diversity n.hash ..count random.nat) + another (..random diversity n.hash ..count random.nat)] + (`` ($_ _.and + (~~ (template [<name> <composition>] + [(_.cover [<name>] + (let [|sample| (/.support sample) + |another| (/.support another) + sample_only (set.difference |another| |sample|) + another_only (set.difference |sample| |another|) + common (set.intersection |sample| |another|) + composed (<name> sample another) + + no_left_changes! (list.every? (function (_ member) + (n.= (/.multiplicity sample member) + (/.multiplicity composed member))) + (set.to_list sample_only)) + no_right_changes! (list.every? (function (_ member) + (n.= (/.multiplicity another member) + (/.multiplicity composed member))) + (set.to_list another_only)) + common_changes! (list.every? (function (_ member) + (n.= (<composition> (/.multiplicity sample member) + (/.multiplicity another member)) + (/.multiplicity composed member))) + (set.to_list common))] + (and no_left_changes! + no_right_changes! + common_changes!)))] + + [/.sum n.+] + [/.union n.max] + )) + (_.cover [/.intersection] + (let [|sample| (/.support sample) + |another| (/.support another) + sample_only (set.difference |another| |sample|) + another_only (set.difference |sample| |another|) + common (set.intersection |sample| |another|) + composed (/.intersection sample another) + + left_removals! (list.every? (|>> (/.member? composed) not) + (set.to_list sample_only)) + right_removals! (list.every? (|>> (/.member? composed) not) + (set.to_list another_only)) + common_changes! (list.every? (function (_ member) + (n.= (n.min (/.multiplicity sample member) + (/.multiplicity another member)) + (/.multiplicity composed member))) + (set.to_list common))] + (and left_removals! + right_removals! + common_changes!))) + )))) + (def: #export test Test (<| (_.covering /._) @@ -48,175 +120,121 @@ addition_count ..count partial_removal_count (\ ! map (n.% addition_count) random.nat) another (..random diversity n.hash ..count random.nat)] - (`` ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence (..random diversity n.hash ..count random.nat))) - (_.for [/.hash] - (|> random.nat - (\ random.monad map (function (_ single) - (/.add 1 single (/.new n.hash)))) - ($hash.spec /.hash))) - - (_.cover [/.to_list /.from_list] - (|> sample - /.to_list - (/.from_list n.hash) - (\ /.equivalence = sample))) - (_.cover [/.size] - (n.= (list.size (/.to_list sample)) - (/.size sample))) - (_.cover [/.empty?] - (bit\= (/.empty? sample) - (n.= 0 (/.size sample)))) - (_.cover [/.new] - (/.empty? (/.new n.hash))) - (_.cover [/.support] - (list.every? (set.member? (/.support sample)) - (/.to_list sample))) - (_.cover [/.member?] - (let [non_member_is_not_identified! - (not (/.member? sample non_member)) - - all_members_are_identified! - (list.every? (/.member? sample) - (/.to_list sample))] - (and non_member_is_not_identified! - all_members_are_identified!))) - (_.cover [/.multiplicity] - (let [non_members_have_0_multiplicity! - (n.= 0 (/.multiplicity sample non_member)) - - every_member_has_positive_multiplicity! - (list.every? (|>> (/.multiplicity sample) (n.> 0)) - (/.to_list sample))] - (and non_members_have_0_multiplicity! - every_member_has_positive_multiplicity!))) - (_.cover [/.add] - (let [null_scenario! - (|> sample - (/.add 0 non_member) - (\ /.equivalence = sample)) + ($_ _.and + (_.cover [/.to_list /.from_list] + (|> sample + /.to_list + (/.from_list n.hash) + (\ /.equivalence = sample))) + (_.cover [/.size] + (n.= (list.size (/.to_list sample)) + (/.size sample))) + (_.cover [/.empty?] + (bit\= (/.empty? sample) + (n.= 0 (/.size sample)))) + (_.cover [/.new] + (/.empty? (/.new n.hash))) + (_.cover [/.support] + (list.every? (set.member? (/.support sample)) + (/.to_list sample))) + (_.cover [/.member?] + (let [non_member_is_not_identified! + (not (/.member? sample non_member)) - normal_scenario! - (let [sample+ (/.add addition_count non_member sample)] - (and (not (/.member? sample non_member)) - (/.member? sample+ non_member) - (n.= addition_count (/.multiplicity sample+ non_member))))] - (and null_scenario! - normal_scenario!))) - (_.cover [/.remove] - (let [null_scenario! - (\ /.equivalence = - (|> sample - (/.add addition_count non_member)) - (|> sample - (/.add addition_count non_member) - (/.remove 0 non_member))) + all_members_are_identified! + (list.every? (/.member? sample) + (/.to_list sample))] + (and non_member_is_not_identified! + all_members_are_identified!))) + (_.cover [/.multiplicity] + (let [non_members_have_0_multiplicity! + (n.= 0 (/.multiplicity sample non_member)) - partial_scenario! - (let [sample* (|> sample - (/.add addition_count non_member) - (/.remove partial_removal_count non_member))] - (and (/.member? sample* non_member) - (n.= (n.- partial_removal_count - addition_count) - (/.multiplicity sample* non_member)))) + every_member_has_positive_multiplicity! + (list.every? (|>> (/.multiplicity sample) (n.> 0)) + (/.to_list sample))] + (and non_members_have_0_multiplicity! + every_member_has_positive_multiplicity!))) + (_.cover [/.add] + (let [null_scenario! + (|> sample + (/.add 0 non_member) + (\ /.equivalence = sample)) - total_scenario! - (|> sample - (/.add addition_count non_member) - (/.remove addition_count non_member) - (\ /.equivalence = sample))] - (and null_scenario! - partial_scenario! - total_scenario!))) - (_.cover [/.from_set] - (let [unary (|> sample /.support /.from_set)] - (list.every? (|>> (/.multiplicity unary) (n.= 1)) - (/.to_list unary)))) - (_.cover [/.sub?] - (let [unary (|> sample /.support /.from_set)] - (and (/.sub? sample unary) - (or (not (/.sub? unary sample)) - (\ /.equivalence = sample unary))))) - (_.cover [/.super?] - (let [unary (|> sample /.support /.from_set)] - (and (/.super? unary sample) - (or (not (/.super? sample unary)) - (\ /.equivalence = sample unary))))) - (~~ (template [<name> <composition>] - [(_.cover [<name>] - (let [|sample| (/.support sample) - |another| (/.support another) - sample_only (set.difference |another| |sample|) - another_only (set.difference |sample| |another|) - common (set.intersection |sample| |another|) - composed (<name> sample another) + normal_scenario! + (let [sample+ (/.add addition_count non_member sample)] + (and (not (/.member? sample non_member)) + (/.member? sample+ non_member) + (n.= addition_count (/.multiplicity sample+ non_member))))] + (and null_scenario! + normal_scenario!))) + (_.cover [/.remove] + (let [null_scenario! + (\ /.equivalence = + (|> sample + (/.add addition_count non_member)) + (|> sample + (/.add addition_count non_member) + (/.remove 0 non_member))) - no_left_changes! (list.every? (function (_ member) - (n.= (/.multiplicity sample member) - (/.multiplicity composed member))) - (set.to_list sample_only)) - no_right_changes! (list.every? (function (_ member) - (n.= (/.multiplicity another member) - (/.multiplicity composed member))) - (set.to_list another_only)) - common_changes! (list.every? (function (_ member) - (n.= (<composition> (/.multiplicity sample member) - (/.multiplicity another member)) - (/.multiplicity composed member))) - (set.to_list common))] - (and no_left_changes! - no_right_changes! - common_changes!)))] + partial_scenario! + (let [sample* (|> sample + (/.add addition_count non_member) + (/.remove partial_removal_count non_member))] + (and (/.member? sample* non_member) + (n.= (n.- partial_removal_count + addition_count) + (/.multiplicity sample* non_member)))) - [/.sum n.+] - [/.union n.max] - )) - (_.cover [/.intersection] - (let [|sample| (/.support sample) - |another| (/.support another) - sample_only (set.difference |another| |sample|) - another_only (set.difference |sample| |another|) - common (set.intersection |sample| |another|) - composed (/.intersection sample another) + total_scenario! + (|> sample + (/.add addition_count non_member) + (/.remove addition_count non_member) + (\ /.equivalence = sample))] + (and null_scenario! + partial_scenario! + total_scenario!))) + (_.cover [/.from_set] + (let [unary (|> sample /.support /.from_set)] + (list.every? (|>> (/.multiplicity unary) (n.= 1)) + (/.to_list unary)))) + (_.cover [/.sub?] + (let [unary (|> sample /.support /.from_set)] + (and (/.sub? sample unary) + (or (not (/.sub? unary sample)) + (\ /.equivalence = sample unary))))) + (_.cover [/.super?] + (let [unary (|> sample /.support /.from_set)] + (and (/.super? unary sample) + (or (not (/.super? sample unary)) + (\ /.equivalence = sample unary))))) + (_.cover [/.difference] + (let [|sample| (/.support sample) + |another| (/.support another) + sample_only (set.difference |another| |sample|) + another_only (set.difference |sample| |another|) + common (set.intersection |sample| |another|) + composed (/.difference sample another) - left_removals! (list.every? (|>> (/.member? composed) not) - (set.to_list sample_only)) - right_removals! (list.every? (|>> (/.member? composed) not) - (set.to_list another_only)) - common_changes! (list.every? (function (_ member) - (n.= (n.min (/.multiplicity sample member) - (/.multiplicity another member)) - (/.multiplicity composed member))) - (set.to_list common))] - (and left_removals! - right_removals! - common_changes!))) - (_.cover [/.difference] - (let [|sample| (/.support sample) - |another| (/.support another) - sample_only (set.difference |another| |sample|) - another_only (set.difference |sample| |another|) - common (set.intersection |sample| |another|) - composed (/.difference sample another) + ommissions! (list.every? (|>> (/.member? composed) not) + (set.to_list sample_only)) + intact! (list.every? (function (_ member) + (n.= (/.multiplicity another member) + (/.multiplicity composed member))) + (set.to_list another_only)) + subtractions! (list.every? (function (_ member) + (let [sample_multiplicity (/.multiplicity sample member) + another_multiplicity (/.multiplicity another member)] + (n.= (if (n.> another_multiplicity sample_multiplicity) + 0 + (n.- sample_multiplicity + another_multiplicity)) + (/.multiplicity composed member)))) + (set.to_list common))] + (and ommissions! + intact! + subtractions!))) - ommissions! (list.every? (|>> (/.member? composed) not) - (set.to_list sample_only)) - intact! (list.every? (function (_ member) - (n.= (/.multiplicity another member) - (/.multiplicity composed member))) - (set.to_list another_only)) - subtractions! (list.every? (function (_ member) - (let [sample_multiplicity (/.multiplicity sample member) - another_multiplicity (/.multiplicity another member)] - (n.= (if (n.> another_multiplicity sample_multiplicity) - 0 - (n.- sample_multiplicity - another_multiplicity)) - (/.multiplicity composed member)))) - (set.to_list common))] - (and ommissions! - intact! - subtractions!))) - ))))) + ..signature + ..composition + )))) diff --git a/stdlib/source/test/lux/data/format/tar.lux b/stdlib/source/test/lux/data/format/tar.lux index 1300012dd..10000ff52 100644 --- a/stdlib/source/test/lux/data/format/tar.lux +++ b/stdlib/source/test/lux/data/format/tar.lux @@ -11,7 +11,7 @@ [data ["." product] ["." maybe] - ["." binary ("#\." equivalence)] + ["." binary ("#\." equivalence monoid)] ["." text ("#\." equivalence) ["%" format (#+ format)] ["." encoding] @@ -51,6 +51,8 @@ (#try.Failure error) false)) + (_.cover [/.no_path] + (text\= "" (/.from_path /.no_path))) (_.cover [/.path_size /.path_is_too_long] (case (/.path invalid) (#try.Success _) @@ -398,6 +400,15 @@ (<b>.run /.parser) (\ try.monad map row.empty?) (try.default false))) + (_.cover [/.invalid_end_of_archive] + (let [dump (format.run /.writer row.empty)] + (case (<b>.run /.parser (binary\compose dump dump)) + (#try.Success _) + false + + (#try.Failure error) + (exception.match? /.invalid_end_of_archive error)))) + ..path ..name ..small diff --git a/stdlib/source/test/lux/data/name.lux b/stdlib/source/test/lux/data/name.lux index f68a58d9a..62c576d27 100644 --- a/stdlib/source/test/lux/data/name.lux +++ b/stdlib/source/test/lux/data/name.lux @@ -20,15 +20,10 @@ {1 ["." /]}) -(def: (part size) - (-> Nat (Random Text)) - (random.filter (|>> (text.contains? ".") not) - (random.unicode size))) - (def: #export (random module_size short_size) (-> Nat Nat (Random Name)) - (random.and (..part module_size) - (..part short_size))) + (random.and (random.ascii/alpha module_size) + (random.ascii/alpha short_size))) (def: #export test Test diff --git a/stdlib/source/test/lux/math/number/i64.lux b/stdlib/source/test/lux/math/number/i64.lux index 43e240675..9384e08c4 100644 --- a/stdlib/source/test/lux/math/number/i64.lux +++ b/stdlib/source/test/lux/math/number/i64.lux @@ -48,39 +48,22 @@ [pattern random.nat] ($_ _.and (do ! - [idx (\ ! map (n.% /.width) random.nat)] - (_.cover [/.arithmetic_right_shift] - (let [value (.int pattern) - - nullity! - (\= pattern (/.arithmetic_right_shift 0 pattern)) - - idempotency! - (\= value (/.arithmetic_right_shift /.width value)) - - sign_preservation! - (bit\= (i.negative? value) - (i.negative? (/.arithmetic_right_shift idx value)))] - (and nullity! - idempotency! - sign_preservation!)))) - (do ! [idx (\ ! map (|>> (n.% (dec /.width)) inc) random.nat)] - (_.cover [/.left_shift /.logic_right_shift] + (_.cover [/.left_shift /.right_shift] (let [nullity! (and (\= pattern (/.left_shift 0 pattern)) - (\= pattern (/.logic_right_shift 0 pattern))) + (\= pattern (/.right_shift 0 pattern))) idempotency! (and (\= pattern (/.left_shift /.width pattern)) - (\= pattern (/.logic_right_shift /.width pattern))) + (\= pattern (/.right_shift /.width pattern))) movement! (let [shift (n.- idx /.width)] (\= (/.and (/.mask idx) pattern) (|> pattern (/.left_shift shift) - (/.logic_right_shift shift))))] + (/.right_shift shift))))] (and nullity! idempotency! movement!)))) @@ -123,11 +106,11 @@ 0 (\= /.false (/.region size offset)) _ (\= (|> pattern ## NNNNYYYYNNNN - (/.logic_right_shift offset) + (/.right_shift offset) ## ____NNNNYYYY (/.left_shift spare) ## YYYY________ - (/.logic_right_shift spare) + (/.right_shift spare) ## ________YYYY (/.left_shift offset) ## ____YYYY____ diff --git a/stdlib/source/test/lux/math/number/int.lux b/stdlib/source/test/lux/math/number/int.lux index 3d9931ad1..c75ffb6bd 100644 --- a/stdlib/source/test/lux/math/number/int.lux +++ b/stdlib/source/test/lux/math/number/int.lux @@ -19,7 +19,9 @@ {1 ["." / [// - ["f" frac]]]}) + ["n" nat] + ["f" frac] + ["." i64]]]}) (def: signature Test @@ -178,6 +180,30 @@ [expected (\ ! map (/.% +1,000,000) random.int)] (_.cover [/.frac] (|> expected /.frac f.int (/.= expected)))) + (do {! random.monad} + [pattern random.int + idx (\ ! map (n.% i64.width) random.nat)] + (_.cover [/.right_shift] + (let [nullity! + (/.= pattern (/.right_shift 0 pattern)) + + idempotency! + (/.= pattern (/.right_shift i64.width pattern)) + + sign_mask (i64.left_shift (dec i64.width) 1) + mantissa_mask (i64.not sign_mask) + + sign_preservation! + (/.= (i64.and sign_mask pattern) + (i64.and sign_mask (/.right_shift idx pattern))) + + mantissa_parity! + (/.= (i64.and mantissa_mask (i64.right_shift idx pattern)) + (i64.and mantissa_mask (/.right_shift idx pattern)))] + (and nullity! + idempotency! + sign_preservation! + mantissa_parity!)))) ..predicate ..signature diff --git a/stdlib/source/test/lux/type/dynamic.lux b/stdlib/source/test/lux/type/dynamic.lux index 533b7fad0..e95f68146 100644 --- a/stdlib/source/test/lux/type/dynamic.lux +++ b/stdlib/source/test/lux/type/dynamic.lux @@ -37,8 +37,8 @@ (#try.Failure error) (exception.match? /.wrong_type error))) - (_.cover [/.print] - (case (/.print (/.:dynamic expected)) + (_.cover [/.format] + (case (/.format (/.:dynamic expected)) (#try.Success actual) (text\= (%.nat expected) actual) diff --git a/stdlib/source/test/lux/type/implicit.lux b/stdlib/source/test/lux/type/implicit.lux index 4978a9b3a..9ef12d3a0 100644 --- a/stdlib/source/test/lux/type/implicit.lux +++ b/stdlib/source/test/lux/type/implicit.lux @@ -1,10 +1,10 @@ (.module: [lux #* - ["%" data/text/format] ["_" test (#+ Test)] [abstract [equivalence (#+)] [functor (#+)] + [monoid (#+)] [monad (#+ do)] ["." enum]] [data @@ -18,28 +18,46 @@ {1 ["." /]}) +(/.implicit: [n.multiplication]) + (def: #export test Test - (<| (_.context (%.name (name_of /._))) + (<| (_.covering /._) (do {! random.monad} [#let [digit (\ ! map (n.% 10) random.nat)] left digit right digit #let [start (n.min left right) - end (n.max left right)]] + end (n.max left right)] + + left random.nat + right random.nat] ($_ _.and - (_.test "Can automatically select first-order structures." - (let [(^open "list\.") (list.equivalence n.equivalence)] - (and (bit\= (\ n.equivalence = left right) - (/.\\ = left right)) - (list\= (\ list.functor map inc (enum.range n.enum start end)) - (/.\\ map inc (enum.range n.enum start end)))))) - (_.test "Can automatically select second-order structures." - (/.\\ = - (enum.range n.enum start end) - (enum.range n.enum start end))) - (_.test "Can automatically select third-order structures." - (let [lln (/.\\ map (enum.range n.enum start) - (enum.range n.enum start end))] - (/.\\ = lln lln))) + (_.cover [/.\\] + (let [first_order! + (let [(^open "list\.") (list.equivalence n.equivalence)] + (and (bit\= (\ n.equivalence = left right) + (/.\\ = left right)) + (list\= (\ list.functor map inc (enum.range n.enum start end)) + (/.\\ map inc (enum.range n.enum start end))))) + + second_order! + (/.\\ = + (enum.range n.enum start end) + (enum.range n.enum start end)) + + third_order! + (let [lln (/.\\ map (enum.range n.enum start) + (enum.range n.enum start end))] + (/.\\ = lln lln))] + (and first_order! + second_order! + third_order!))) + (_.cover [/.with] + (/.with [n.addition] + (n.= (\ n.addition compose left right) + (/.\\ compose left right)))) + (_.cover [/.implicit:] + (n.= (\ n.multiplication compose left right) + (/.\\ compose left right))) )))) |