From 2ac6926be617bf764c4c18a4f6fbba199f6be697 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Mon, 7 Mar 2022 04:16:47 -0400 Subject: Compilers for scripting languages now only depend on new JVM compiler. --- .../bookmark/math/geometry/geometric_algebra.md | 5 + documentation/bookmark/math/geometry/symplectic.md | 6 + documentation/bookmark/optimization.md | 6 +- documentation/bookmark/optimization/math.md | 6 + documentation/bookmark/security/authentication.md | 3 +- documentation/bookmark/security/sandboxing.md | 1 + lux-js/project.clj | 29 - lux-lua/project.clj | 41 - lux-python/project.clj | 30 - lux-ruby/commands.md | 4 +- lux-ruby/project.clj | 30 - lux-ruby/source/program.lux | 945 +++++++++++---------- .../source/library/lux/data/collection/array.lux | 2 +- stdlib/source/library/lux/ffi.old.lux | 67 +- stdlib/source/library/lux/target/ruby.lux | 8 +- .../language/lux/phase/extension/analysis/jvm.lux | 38 +- .../language/lux/phase/extension/directive/jvm.lux | 36 +- .../lux/phase/extension/generation/jvm/host.lux | 22 +- .../language/lux/phase/generation/ruby/runtime.lux | 14 +- .../library/lux/tool/compiler/meta/cache/purge.lux | 82 ++ .../library/lux/tool/compiler/meta/io/archive.lux | 83 +- stdlib/source/test/lux/data/collection/array.lux | 18 + .../test/lux/tool/compiler/meta/archive/module.lux | 20 +- .../source/test/lux/tool/compiler/meta/cache.lux | 2 + .../test/lux/tool/compiler/meta/cache/purge.lux | 141 +++ stdlib/source/unsafe/lux/data/collection/array.lux | 3 + 26 files changed, 894 insertions(+), 748 deletions(-) create mode 100644 documentation/bookmark/math/geometry/geometric_algebra.md create mode 100644 documentation/bookmark/math/geometry/symplectic.md create mode 100644 documentation/bookmark/optimization/math.md delete mode 100644 lux-js/project.clj delete mode 100644 lux-lua/project.clj delete mode 100644 lux-python/project.clj delete mode 100644 lux-ruby/project.clj create mode 100644 stdlib/source/library/lux/tool/compiler/meta/cache/purge.lux create mode 100644 stdlib/source/test/lux/tool/compiler/meta/cache/purge.lux diff --git a/documentation/bookmark/math/geometry/geometric_algebra.md b/documentation/bookmark/math/geometry/geometric_algebra.md new file mode 100644 index 000000000..b83e0c698 --- /dev/null +++ b/documentation/bookmark/math/geometry/geometric_algebra.md @@ -0,0 +1,5 @@ +# Reference + +0. [A Swift Introduction to Geometric Algebra](https://www.youtube.com/watch?v=60z_hpEAtD8) +0. [Addendum to A Swift Introduction to Geometric Algebra](https://www.youtube.com/watch?v=0bOiy0HVMqA) + diff --git a/documentation/bookmark/math/geometry/symplectic.md b/documentation/bookmark/math/geometry/symplectic.md new file mode 100644 index 000000000..582767c15 --- /dev/null +++ b/documentation/bookmark/math/geometry/symplectic.md @@ -0,0 +1,6 @@ +# Reference + +0. [Symplectic Geometry in 2D - Points, Lines, Circles](https://www.researchgate.net/publication/358747081_Symplectic_Geometry_in_2D_-_Points_Lines_Circles) +0. [Symplectic Geometry meets Geometric Algebra in 2D](https://www.researchgate.net/publication/356781838_Symplectic_Geometry_meets_Geometric_Algebra_in_2D) +0. [Coordinate Free Vector Algebra in R2](https://www.researchgate.net/publication/327989714_Coordinate_Free_Vector_Algebra_in_R2) + diff --git a/documentation/bookmark/optimization.md b/documentation/bookmark/optimization.md index b3d61c084..3ccbed5ac 100644 --- a/documentation/bookmark/optimization.md +++ b/documentation/bookmark/optimization.md @@ -6,11 +6,6 @@ 0. [Fibonacci Hashing: The Optimization that the World Forgot (or: a Better Alternative to Integer Modulo)](https://probablydance.com/2018/06/16/fibonacci-hashing-the-optimization-that-the-world-forgot-or-a-better-alternative-to-integer-modulo/) -# Arithmetic | Math - -0. [ensmallen: flexible C++ library for efficient numerical optimization](http://ensmallen.org/docs.html) -0. [Labor of Division (Episode I)](https://ridiculousfish.com/blog/posts/labor-of-division-episode-i.html) - # Compilation 0. ["Outperforming Imperative with Pure Functional Languages" by Richard Feldman](https://www.youtube.com/watch?v=vzfy4EKwG_Y) @@ -31,6 +26,7 @@ # Reference +0. [Finding Missed Optimizations through the Lens of Dead Code Elimination](https://ethz.ch/content/dam/ethz/special-interest/infk/ast-dam/documents/Theodoridis-ASPLOS22-DCE-Paper.pdf) 0. [Algorithms for Modern Hardware](https://en.algorithmica.org/hpc/) 0. [Refterm Lecture Part 1 - Philosophies of Optimization](https://www.youtube.com/watch?v=pgoetgxecw8) 0. [Optimizations enabled by -ffast-math](https://kristerw.github.io/2021/10/19/fast-math/) diff --git a/documentation/bookmark/optimization/math.md b/documentation/bookmark/optimization/math.md new file mode 100644 index 000000000..938ff8cf2 --- /dev/null +++ b/documentation/bookmark/optimization/math.md @@ -0,0 +1,6 @@ +# Reference + +0. [A Fast, Compact Approximation of the Exponential Function](https://nic.schraudolph.org/pubs/Schraudolph99.pdf) +0. [ensmallen: flexible C++ library for efficient numerical optimization](http://ensmallen.org/docs.html) +0. [Labor of Division (Episode I)](https://ridiculousfish.com/blog/posts/labor-of-division-episode-i.html) + diff --git a/documentation/bookmark/security/authentication.md b/documentation/bookmark/security/authentication.md index 09f954592..21c8c5bbd 100644 --- a/documentation/bookmark/security/authentication.md +++ b/documentation/bookmark/security/authentication.md @@ -1,4 +1,5 @@ # Reference -1. [WebAuthn.io](https://webauthn.io/) +0. [Move beyond passwords](https://developer.apple.com/videos/play/wwdc2021/10106/) +0. [WebAuthn.io](https://webauthn.io/) diff --git a/documentation/bookmark/security/sandboxing.md b/documentation/bookmark/security/sandboxing.md index 5c07ce363..3fb7526fb 100644 --- a/documentation/bookmark/security/sandboxing.md +++ b/documentation/bookmark/security/sandboxing.md @@ -1,4 +1,5 @@ # Reference +0. [Provably-Safe Multilingual Software Sandboxing using WebAssembly](https://www.jaybosamiya.com/publications/2022/usenix/provably-safe-sandboxing-wasm.pdf) 0. [WasmBoxC: Simple, Easy, and Fast VM-less Sandboxing](https://kripken.github.io/blog/wasm/2020/07/27/wasmboxc.html) diff --git a/lux-js/project.clj b/lux-js/project.clj deleted file mode 100644 index 6a8234403..000000000 --- a/lux-js/project.clj +++ /dev/null @@ -1,29 +0,0 @@ -(def version "0.6.4") -(def repo "https://github.com/LuxLang/lux") -(def sonatype-releases "https://oss.sonatype.org/service/local/staging/deploy/maven2/") -(def sonatype-snapshots "https://oss.sonatype.org/content/repositories/snapshots/") - -(defproject com.github.luxlang/lux-js #=(identity version) - :description "A JavaScript compiler for Lux." - :url ~repo - :license {:name "Lux License v0.1.2" - :url ~(str repo "/blob/master/license.txt")} - :scm {:name "git" - :url ~(str repo ".git")} - :pom-addition [:developers [:developer - [:name "Eduardo Julian"] - [:url "https://github.com/eduardoejp"]]] - - :repositories [["snapshots" ~sonatype-snapshots]] - :deploy-repositories [["releases" {:url ~sonatype-releases :creds :gpg}] - ["snapshots" {:url ~sonatype-snapshots :creds :gpg}]] - - :plugins [[com.github.luxlang/lein-luxc ~version]] - :dependencies [[com.github.luxlang/lux-bootstrapper ~version] - [com.github.luxlang/stdlib ~version] - [org.openjdk.nashorn/nashorn-core "15.1"]] - - :manifest {"lux" ~version} - :source-paths ["source"] - :lux {:program "program"} - ) diff --git a/lux-lua/project.clj b/lux-lua/project.clj deleted file mode 100644 index d6ae33e81..000000000 --- a/lux-lua/project.clj +++ /dev/null @@ -1,41 +0,0 @@ -(def lux_version "0.6.5") -(def repo "https://github.com/LuxLang/lux") -(def sonatype-releases "https://oss.sonatype.org/service/local/staging/deploy/maven2/") -(def sonatype-snapshots "https://oss.sonatype.org/content/repositories/snapshots/") - -(def asm_version "5.0.4") -(def rembulan_version "0.1") - -(defproject com.github.luxlang/lux-lua #=(identity lux_version) - :description "A Lua compiler for Lux." - :url ~repo - :license {:name "Lux License v0.1.2" - :url ~(str repo "/blob/master/license.txt")} - :scm {:name "git" - :url ~(str repo ".git")} - :pom-addition [:developers [:developer - [:name "Eduardo Julian"] - [:url "https://github.com/eduardoejp"]]] - - :repositories [["snapshots" ~sonatype-snapshots]] - :deploy-repositories [["releases" {:url ~sonatype-releases :creds :gpg}] - ["snapshots" {:url ~sonatype-snapshots :creds :gpg}]] - - :plugins [[com.github.luxlang/lein-luxc ~lux_version]] - :dependencies [[com.github.luxlang/lux-bootstrapper ~lux_version] - ;; [com.github.luxlang/stdlib ~lux_version] - - [org.ow2.asm/asm ~asm_version] - [org.ow2.asm/asm-commons ~asm_version] - [org.ow2.asm/asm-analysis ~asm_version] - [org.ow2.asm/asm-tree ~asm_version] - [org.ow2.asm/asm-util ~asm_version] - - [com.github.luxlang/rembulan-runtime ~rembulan_version] - [com.github.luxlang/rembulan-stdlib ~rembulan_version] - [com.github.luxlang/rembulan-compiler ~rembulan_version]] - - :manifest {"lux" ~lux_version} - :source-paths ["source"] - :lux {:program "program"} - ) diff --git a/lux-python/project.clj b/lux-python/project.clj deleted file mode 100644 index 8ceeb90ad..000000000 --- a/lux-python/project.clj +++ /dev/null @@ -1,30 +0,0 @@ -(def version "0.6.5") -(def repo "https://github.com/LuxLang/lux") -(def sonatype-releases "https://oss.sonatype.org/service/local/staging/deploy/maven2/") -(def sonatype-snapshots "https://oss.sonatype.org/content/repositories/snapshots/") - -(defproject com.github.luxlang/lux-python #=(identity version) - :description "A Python compiler for Lux." - :url ~repo - :license {:name "Lux License v0.1.2" - :url ~(str repo "/blob/master/license.txt")} - :scm {:name "git" - :url ~(str repo ".git")} - :pom-addition [:developers [:developer - [:name "Eduardo Julian"] - [:url "https://github.com/eduardoejp"]]] - - :repositories [["snapshots" ~sonatype-snapshots]] - :deploy-repositories [["releases" {:url ~sonatype-releases :creds :gpg}] - ["snapshots" {:url ~sonatype-snapshots :creds :gpg}]] - - :plugins [[com.github.luxlang/lein-luxc ~version]] - :dependencies [[com.github.luxlang/lux-bootstrapper ~version] - ;; [com.github.luxlang/stdlib ~version] - - [org.python/jython-standalone "2.7.2"]] - - :manifest {"lux" ~version} - :source-paths ["source"] - :lux {:program "program"} - ) diff --git a/lux-ruby/commands.md b/lux-ruby/commands.md index 5f4a401e8..d998b0f84 100644 --- a/lux-ruby/commands.md +++ b/lux-ruby/commands.md @@ -10,8 +10,8 @@ cd ~/lux/lux-ruby/ && lein clean && lein lux auto test ``` ## Develop cd ~/lux/lux-ruby/ \ -&& lein clean \ -&& lein lux auto build +&& lux clean \ +&& lux auto build ``` # Try diff --git a/lux-ruby/project.clj b/lux-ruby/project.clj deleted file mode 100644 index aabf9400f..000000000 --- a/lux-ruby/project.clj +++ /dev/null @@ -1,30 +0,0 @@ -(def version "0.6.5") -(def repo "https://github.com/LuxLang/lux") -(def sonatype-releases "https://oss.sonatype.org/service/local/staging/deploy/maven2/") -(def sonatype-snapshots "https://oss.sonatype.org/content/repositories/snapshots/") - -(defproject com.github.luxlang/lux-ruby #=(identity version) - :description "A Ruby compiler for Lux." - :url ~repo - :license {:name "Lux License v0.1.2" - :url ~(str repo "/blob/master/license.txt")} - :scm {:name "git" - :url ~(str repo ".git")} - :pom-addition [:developers [:developer - [:name "Eduardo Julian"] - [:url "https://github.com/eduardoejp"]]] - - :repositories [["snapshots" ~sonatype-snapshots]] - :deploy-repositories [["releases" {:url ~sonatype-releases :creds :gpg}] - ["snapshots" {:url ~sonatype-snapshots :creds :gpg}]] - - :plugins [[com.github.luxlang/lein-luxc ~version]] - :dependencies [[com.github.luxlang/lux-bootstrapper ~version] - ;; [com.github.luxlang/stdlib ~version] - - [org.jruby/jruby-complete "9.2.15.0"]] - - :manifest {"lux" ~version} - :source-paths ["source"] - :lux {:program "program"} - ) diff --git a/lux-ruby/source/program.lux b/lux-ruby/source/program.lux index 20bf0bc43..123fa1285 100644 --- a/lux-ruby/source/program.lux +++ b/lux-ruby/source/program.lux @@ -40,8 +40,8 @@ ["@" target ["_" ruby]] [tool - [compiler - ["[0]" phase {"+" Operation Phase}] + ["[0]" compiler + ["[0]" phase {"+" Operation Phase} ("[1]#[0]" monad)] [reference [variable {"+" Register}]] [language @@ -66,12 +66,12 @@ ["[0]" platform {"+" Platform}]] [meta [archive {"+" Archive}] + ["[0]" context] ["[0]" cli] ["[0]" packager "_" ["[1]" ruby]]]]]]] [program - ["/" compositor - ["/[0]" static]]]) + ["/" compositor]]) (import: java/lang/String) @@ -87,11 +87,11 @@ (import: java/lang/Integer ["[1]::[0]" - (longValue [] java/lang/Long)]) + (longValue [] long)]) (import: java/lang/Long ["[1]::[0]" - (intValue [] java/lang/Integer)]) + (intValue [] int)]) (import: org/jruby/RubyString ["[1]::[0]" @@ -127,13 +127,6 @@ (first [org/jruby/runtime/ThreadContext] org/jruby/runtime/builtin/IRubyObject) (size [org/jruby/runtime/ThreadContext] org/jruby/runtime/builtin/IRubyObject)]) -(ffi.interface: StructureValue - (getValue [] java/lang/Object)) - -(import: program/StructureValue - ["[1]::[0]" - (getValue [] java/lang/Object)]) - (import: org/jruby/runtime/JavaSites$CheckedSites) (import: org/jruby/runtime/builtin/Variable) (import: org/jruby/runtime/builtin/InstanceVariables) @@ -227,12 +220,12 @@ (def: (read_tuple read host_object) (-> Translator org/jruby/RubyArray (Try Any)) - (let [size (:as Nat (org/jruby/RubyArray::getLength host_object))] + (let [size (.nat (ffi.of_int (org/jruby/RubyArray::getLength host_object)))] (loop [idx 0 output (: (Array Any) (array.empty size))] (if (n.< size idx) - (case (org/jruby/RubyArray::get (.int idx) host_object) + (case (org/jruby/RubyArray::get (ffi.as_int (.int idx)) host_object) {.#None} (again (++ idx) output) @@ -247,29 +240,32 @@ (exception: (unknown_kind_of_object [object java/lang/Object]) (exception.report - ["Class" (java/lang/Object::toString (java/lang/Object::getClass object))] - ["Object" (java/lang/Object::toString object)])) + ["Class" (ffi.of_string (java/lang/Object::toString (java/lang/Object::getClass object)))] + ["Object" (ffi.of_string (java/lang/Object::toString object))])) (def: (read_variant read host_object) (-> Translator org/jruby/RubyHash (Try Any)) - (case [(org/jruby/RubyHash::get (:as java/lang/String runtime.variant_tag_field) host_object) - (org/jruby/RubyHash::get (:as java/lang/String runtime.variant_flag_field) host_object) - (org/jruby/RubyHash::get (:as java/lang/String runtime.variant_value_field) host_object)] + (case [(org/jruby/RubyHash::get (ffi.as_string runtime.variant_tag_field) host_object) + (org/jruby/RubyHash::get (ffi.as_string runtime.variant_flag_field) host_object) + (org/jruby/RubyHash::get (ffi.as_string runtime.variant_value_field) host_object)] [{.#Some tag} ?flag {.#Some value}] (do try.monad [value (read value)] - (in [(:as Any (java/lang/Long::intValue (:as java/lang/Long tag))) - (:as Any - (case ?flag - {.#Some _} - "" - - {.#None} - (ffi.null))) - (:as Any value)])) + (in [(: Any (|> tag + (:as java/lang/Long) + java/lang/Long::intValue + (: java/lang/Integer))) + (: Any + (case ?flag + {.#Some _} + "" + + {.#None} + (: java/lang/Object (ffi.null)))) + (: Any value)])) _ - (exception.except ..unknown_kind_of_object [(:as java/lang/Object host_object)]))) + (exception.except ..unknown_kind_of_object [(ffi.:as java/lang/Object host_object)]))) (exception: .public nil_has_no_lux_representation) @@ -306,8 +302,9 @@ (org/jruby/Ruby::getNil ..initial_ruby_runtime)) (def: lux_unit - org/jruby/RubyString - (org/jruby/RubyString::newInternalFromJavaExternal ..initial_ruby_runtime "")) + org/jruby/runtime/builtin/IRubyObject + (<| (ffi.:as org/jruby/runtime/builtin/IRubyObject) + (org/jruby/RubyString::newInternalFromJavaExternal ..initial_ruby_runtime (ffi.as_string "")))) (def: (wrapped_lux_value useful_object_class lux_structure) (-> (-> (-> java/lang/Object org/jruby/runtime/builtin/IRubyObject) @@ -319,7 +316,9 @@ (`` (<| (~~ (template [ ] [(case (ffi.check value) {.#Some value} - (|> value ) + (|> value + + (ffi.:as org/jruby/runtime/builtin/IRubyObject)) {.#None})] @@ -331,9 +330,10 @@ [org/jruby/runtime/builtin/IRubyObject (<|)] )) ... (:as org/jruby/runtime/builtin/IRubyObject value) - (org/jruby/java/proxies/JavaProxy::new ..initial_ruby_runtime - (useful_object_class again (:as (Array java/lang/Object) value)) - (:as java/lang/Object value)))))) + (<| (ffi.:as org/jruby/runtime/builtin/IRubyObject) + (org/jruby/java/proxies/JavaProxy::new ..initial_ruby_runtime + (useful_object_class again (:as (Array java/lang/Object) value)) + (ffi.:as java/lang/Object value))))))) (exception: (invalid_variant_access [field Text]) (exception.report @@ -343,9 +343,11 @@ (exception.report ["Class" (|> index java/lang/Object::getClass - java/lang/Object::toString)] + java/lang/Object::toString + ffi.of_string)] ["Index" (|> index - java/lang/Object::toString)])) + java/lang/Object::toString + ffi.of_string)])) (import: java/util/Arrays ["[1]::[0]" @@ -355,236 +357,283 @@ (exception.report ["Arity" (%.nat arity)])) -(def: (lux_wrapper_call useful_object_class lux_structure value) +(def: (::call useful_object_class lux_structure value) (-> (-> (-> (Array java/lang/Object) org/jruby/runtime/builtin/IRubyObject) (Array java/lang/Object) org/jruby/RubyClass) (-> (Array java/lang/Object) org/jruby/runtime/builtin/IRubyObject) (-> (Array java/lang/Object) org/jruby/internal/runtime/methods/DynamicMethod)) - (ffi.object [] org/jruby/internal/runtime/methods/DynamicMethod [] - [java/lang/String "call"] - - (org/jruby/internal/runtime/methods/DynamicMethod - [] (call self [thread_context org/jruby/runtime/ThreadContext - self org/jruby/runtime/builtin/IRubyObject - module org/jruby/RubyModule - method java/lang/String - args [org/jruby/runtime/builtin/IRubyObject] - block org/jruby/runtime/Block]) - org/jruby/runtime/builtin/IRubyObject - (let [arity (ffi.length args)] - (try.trusted - (do [! try.monad] - [args (|> arity - list.indices - (list#each (function (_ index) - (ffi.read! index args))) - (monad.each ! (|>> (:as java/lang/Object) ..read))) - output (case args - (^ (list arg/0)) - (in ((:as (-> Any Any) value) - arg/0)) - - (^ (list arg/0 arg/1)) - (in ((:as (-> Any Any Any) value) - arg/0 arg/1)) - - (^ (list arg/0 arg/1 arg/2)) - (in ((:as (-> Any Any Any Any) value) - arg/0 arg/1 arg/2)) - - (^ (list arg/0 arg/1 arg/2 arg/3)) - (in ((:as (-> Any Any Any Any Any) value) - arg/0 arg/1 arg/2 arg/3)) - - (^ (list arg/0 arg/1 arg/2 arg/3 arg/4)) - (in ((:as (-> Any Any Any Any Any Any) value) - arg/0 arg/1 arg/2 arg/3 arg/4)) - - (^ (list arg/0 arg/1 arg/2 arg/3 arg/4 arg/5)) - (in ((:as (-> Any Any Any Any Any Any Any) value) - arg/0 arg/1 arg/2 arg/3 arg/4 arg/5)) - - (^ (list arg/0 arg/1 arg/2 arg/3 arg/4 arg/5 arg/6)) - (in ((:as (-> Any Any Any Any Any Any Any Any) value) - arg/0 arg/1 arg/2 arg/3 arg/4 arg/5 arg/6)) - - (^ (list arg/0 arg/1 arg/2 arg/3 arg/4 arg/5 arg/6 arg/7)) - (in ((:as (-> Any Any Any Any Any Any Any Any Any) value) - arg/0 arg/1 arg/2 arg/3 arg/4 arg/5 arg/6 arg/7)) - - _ - (exception.except ..invalid_arity [arity]))] - (in (|> output - (:as java/lang/Object) - (wrapped_lux_value useful_object_class lux_structure))))))))) - -(def: (lux_wrapper_access useful_object_class lux_structure value) + (<| (ffi.:as org/jruby/internal/runtime/methods/DynamicMethod) + (ffi.object [] org/jruby/internal/runtime/methods/DynamicMethod [] + [java/lang/String (ffi.as_string "call")] + + (org/jruby/internal/runtime/methods/DynamicMethod + [] (dup this []) + org/jruby/internal/runtime/methods/DynamicMethod + (undefined)) + + (org/jruby/internal/runtime/methods/DynamicMethod + [] (call this [thread_context org/jruby/runtime/ThreadContext + self org/jruby/runtime/builtin/IRubyObject + module org/jruby/RubyModule + method java/lang/String + args [org/jruby/runtime/builtin/IRubyObject] + block org/jruby/runtime/Block]) + org/jruby/runtime/builtin/IRubyObject + (let [arity (ffi.length args)] + (try.trusted + (do [! try.monad] + [args (|> arity + list.indices + (list#each (function (_ index) + (ffi.read! index args))) + (monad.each ! (|>> (ffi.:as java/lang/Object) ..read))) + output (case args + (^ (list arg/0)) + (in ((:as (-> Any java/lang/Object) value) + arg/0)) + + (^ (list arg/0 arg/1)) + (in ((:as (-> Any Any java/lang/Object) value) + arg/0 arg/1)) + + (^ (list arg/0 arg/1 arg/2)) + (in ((:as (-> Any Any Any java/lang/Object) value) + arg/0 arg/1 arg/2)) + + (^ (list arg/0 arg/1 arg/2 arg/3)) + (in ((:as (-> Any Any Any Any java/lang/Object) value) + arg/0 arg/1 arg/2 arg/3)) + + (^ (list arg/0 arg/1 arg/2 arg/3 arg/4)) + (in ((:as (-> Any Any Any Any Any java/lang/Object) value) + arg/0 arg/1 arg/2 arg/3 arg/4)) + + (^ (list arg/0 arg/1 arg/2 arg/3 arg/4 arg/5)) + (in ((:as (-> Any Any Any Any Any Any java/lang/Object) value) + arg/0 arg/1 arg/2 arg/3 arg/4 arg/5)) + + (^ (list arg/0 arg/1 arg/2 arg/3 arg/4 arg/5 arg/6)) + (in ((:as (-> Any Any Any Any Any Any Any java/lang/Object) value) + arg/0 arg/1 arg/2 arg/3 arg/4 arg/5 arg/6)) + + (^ (list arg/0 arg/1 arg/2 arg/3 arg/4 arg/5 arg/6 arg/7)) + (in ((:as (-> Any Any Any Any Any Any Any Any java/lang/Object) value) + arg/0 arg/1 arg/2 arg/3 arg/4 arg/5 arg/6 arg/7)) + + _ + (exception.except ..invalid_arity [arity]))] + (in (wrapped_lux_value (:expected useful_object_class) lux_structure output))))))))) + +(def: (::access useful_object_class lux_structure value) (-> (-> (-> (Array java/lang/Object) org/jruby/runtime/builtin/IRubyObject) (Array java/lang/Object) org/jruby/RubyClass) (-> (Array java/lang/Object) org/jruby/runtime/builtin/IRubyObject) (-> (Array java/lang/Object) org/jruby/internal/runtime/methods/DynamicMethod)) - (ffi.object [] org/jruby/internal/runtime/methods/DynamicMethod [] - [java/lang/String "[]"] - - (org/jruby/internal/runtime/methods/DynamicMethod - [] (call self [thread_context org/jruby/runtime/ThreadContext - self org/jruby/runtime/builtin/IRubyObject - module org/jruby/RubyModule - method java/lang/String - args [org/jruby/runtime/builtin/IRubyObject] - block org/jruby/runtime/Block]) - org/jruby/runtime/builtin/IRubyObject - (let [member (ffi.read! 0 args)] - (<| (case (ffi.check org/jruby/RubyFixnum member) - {.#Some member} - (case (array.read! (org/jruby/RubyFixnum::getLongValue member) value) - {.#Some value} - (wrapped_lux_value useful_object_class lux_structure value) - - {.#None} - ..ruby_nil) - - {.#None}) - (case (ffi.check org/jruby/RubyString member) - {.#Some member} - (case (:as Text (org/jruby/RubyString::asJavaString member)) - (^ (static runtime.variant_tag_field)) - (|> value - (array.read! 0) - maybe.trusted - (:as java/lang/Integer) - java/lang/Integer::longValue - (org/jruby/RubyFixnum::new ..initial_ruby_runtime)) - - (^ (static runtime.variant_flag_field)) - (case (array.read! 1 value) - {.#None} - ..ruby_nil + (<| (ffi.:as org/jruby/internal/runtime/methods/DynamicMethod) + (ffi.object [] org/jruby/internal/runtime/methods/DynamicMethod [] + [java/lang/String (ffi.as_string "[]")] + + (org/jruby/internal/runtime/methods/DynamicMethod + [] (dup this []) + org/jruby/internal/runtime/methods/DynamicMethod + (undefined)) + + (org/jruby/internal/runtime/methods/DynamicMethod + [] (call this [thread_context org/jruby/runtime/ThreadContext + self org/jruby/runtime/builtin/IRubyObject + module org/jruby/RubyModule + method java/lang/String + args [org/jruby/runtime/builtin/IRubyObject] + block org/jruby/runtime/Block]) + org/jruby/runtime/builtin/IRubyObject + (let [member (ffi.read! 0 args)] + (<| (case (ffi.check org/jruby/RubyFixnum member) + {.#Some member} + (case (array.read! (.nat (ffi.of_long (org/jruby/RubyFixnum::getLongValue member))) value) + {.#Some value} + (wrapped_lux_value (:expected useful_object_class) lux_structure value) + + {.#None} + ..ruby_nil) + + {.#None}) + (case (ffi.check org/jruby/RubyString member) + {.#Some member} + (case (ffi.of_string (org/jruby/RubyString::asJavaString member)) + (^ (static runtime.variant_tag_field)) + (|> value + (array.read! 0) + maybe.trusted + (:as java/lang/Integer) + java/lang/Integer::longValue + (org/jruby/RubyFixnum::new ..initial_ruby_runtime) + (ffi.:as org/jruby/runtime/builtin/IRubyObject)) + + (^ (static runtime.variant_flag_field)) + (case (array.read! 1 value) + {.#None} + ..ruby_nil + + {.#Some flag} + ..lux_unit) + + (^ (static runtime.variant_value_field)) + (case (array.read! 2 value) + {.#Some value} + (wrapped_lux_value (:expected useful_object_class) lux_structure value) + + {.#None} + (panic! (exception.error ..nil_has_no_lux_representation []))) + + field + (panic! (exception.error ..invalid_variant_access [field]))) - {.#Some flag} - ..lux_unit) - - (^ (static runtime.variant_value_field)) - (case (array.read! 2 value) - {.#Some value} - (wrapped_lux_value useful_object_class lux_structure value) - - {.#None} - (panic! (exception.error ..nil_has_no_lux_representation []))) - - field - (panic! (exception.error ..invalid_variant_access [field]))) - - {.#None}) - (case (ffi.check org/jruby/RubyRange member) - {.#Some member} - (case [(|> member (org/jruby/RubyRange::first thread_context) (ffi.check org/jruby/RubyFixnum)) - (|> member (org/jruby/RubyRange::size thread_context) (ffi.check org/jruby/RubyFixnum))] - [{.#Some first} {.#Some size}] - (let [first (org/jruby/RubyFixnum::getLongValue first) - size (org/jruby/RubyFixnum::getLongValue size)] - (lux_structure (java/util/Arrays::copyOfRange value first (i.+ first size)))) - - _ - (panic! (exception.error ..invalid_index (:as java/lang/Object member)))) - - {.#None}) - (panic! (exception.error ..invalid_index (:as java/lang/Object member)))))))) - -(def: (lux_wrapper_equality value) + {.#None}) + (case (ffi.check org/jruby/RubyRange member) + {.#Some member} + (case [(|> member (org/jruby/RubyRange::first thread_context) (ffi.check org/jruby/RubyFixnum)) + (|> member (org/jruby/RubyRange::size thread_context) (ffi.check org/jruby/RubyFixnum))] + [{.#Some first} {.#Some size}] + (let [first (ffi.of_long (org/jruby/RubyFixnum::getLongValue first)) + size (ffi.of_long (org/jruby/RubyFixnum::getLongValue size))] + (lux_structure (java/util/Arrays::copyOfRange value (ffi.as_int first) (ffi.as_int (i.+ first size))))) + + _ + (panic! (exception.error ..invalid_index [(ffi.:as java/lang/Object member)]))) + + {.#None}) + (panic! (exception.error ..invalid_index [(ffi.:as java/lang/Object member)])))))))) + +(def: (::= value) (-> (Array java/lang/Object) org/jruby/internal/runtime/methods/DynamicMethod) - (ffi.object [] org/jruby/internal/runtime/methods/DynamicMethod [] - [java/lang/String "=="] - - (org/jruby/internal/runtime/methods/DynamicMethod - [] (call self [thread_context org/jruby/runtime/ThreadContext - self org/jruby/runtime/builtin/IRubyObject - module org/jruby/RubyModule - method java/lang/String - args [org/jruby/runtime/builtin/IRubyObject] - block org/jruby/runtime/Block]) - org/jruby/runtime/builtin/IRubyObject - (let [reference (ffi.read! 0 args)] - (case (..read (:as java/lang/Object reference)) - {try.#Success reference} - (org/jruby/RubyBoolean::newBoolean ..initial_ruby_runtime (same? (: Any reference) (: Any value))) - - {try.#Failure error} - (org/jruby/RubyBoolean::newBoolean ..initial_ruby_runtime false)))))) - -(def: (lux_wrapper_length value) + (<| (ffi.:as org/jruby/internal/runtime/methods/DynamicMethod) + (ffi.object [] org/jruby/internal/runtime/methods/DynamicMethod [] + [java/lang/String (ffi.as_string "==")] + + (org/jruby/internal/runtime/methods/DynamicMethod + [] (dup this []) + org/jruby/internal/runtime/methods/DynamicMethod + (undefined)) + + (org/jruby/internal/runtime/methods/DynamicMethod + [] (call this [thread_context org/jruby/runtime/ThreadContext + self org/jruby/runtime/builtin/IRubyObject + module org/jruby/RubyModule + method java/lang/String + args [org/jruby/runtime/builtin/IRubyObject] + block org/jruby/runtime/Block]) + org/jruby/runtime/builtin/IRubyObject + (<| (ffi.:as org/jruby/runtime/builtin/IRubyObject) + (org/jruby/RubyBoolean::newBoolean ..initial_ruby_runtime) + ffi.as_boolean + (case (|> args + (ffi.read! 0) + (ffi.:as java/lang/Object) + ..read) + {try.#Success reference} + (same? (: Any reference) (: Any value)) + + {try.#Failure error} + false)))))) + +(def: (::length value) (-> (Array java/lang/Object) org/jruby/internal/runtime/methods/DynamicMethod) - (ffi.object [] org/jruby/internal/runtime/methods/DynamicMethod [] - [java/lang/String "length"] - - (org/jruby/internal/runtime/methods/DynamicMethod - [] (call self [thread_context org/jruby/runtime/ThreadContext - self org/jruby/runtime/builtin/IRubyObject - module org/jruby/RubyModule - method java/lang/String - args [org/jruby/runtime/builtin/IRubyObject] - block org/jruby/runtime/Block]) - org/jruby/runtime/builtin/IRubyObject - (|> value - array.size - (org/jruby/RubyFixnum::new ..initial_ruby_runtime))))) - -(def: (lux_wrapper_to_s value) + (<| (ffi.:as org/jruby/internal/runtime/methods/DynamicMethod) + (ffi.object [] org/jruby/internal/runtime/methods/DynamicMethod [] + [java/lang/String (ffi.as_string "length")] + + (org/jruby/internal/runtime/methods/DynamicMethod + [] (dup this []) + org/jruby/internal/runtime/methods/DynamicMethod + (undefined)) + + (org/jruby/internal/runtime/methods/DynamicMethod + [] (call this [thread_context org/jruby/runtime/ThreadContext + self org/jruby/runtime/builtin/IRubyObject + module org/jruby/RubyModule + method java/lang/String + args [org/jruby/runtime/builtin/IRubyObject] + block org/jruby/runtime/Block]) + org/jruby/runtime/builtin/IRubyObject + (|> value + array.size + .int + ffi.as_long + (org/jruby/RubyFixnum::new ..initial_ruby_runtime) + (ffi.:as org/jruby/runtime/builtin/IRubyObject)))))) + +(def: (::to_s value) (-> (Array java/lang/Object) org/jruby/internal/runtime/methods/DynamicMethod) - (ffi.object [] org/jruby/internal/runtime/methods/DynamicMethod [] - [java/lang/String "to_s"] - - (org/jruby/internal/runtime/methods/DynamicMethod - [] (call self [thread_context org/jruby/runtime/ThreadContext - self org/jruby/runtime/builtin/IRubyObject - module org/jruby/RubyModule - method java/lang/String - args [org/jruby/runtime/builtin/IRubyObject] - block org/jruby/runtime/Block]) - org/jruby/runtime/builtin/IRubyObject - (|> value - debug.inspection - (org/jruby/RubyString::newInternalFromJavaExternal ..initial_ruby_runtime))))) + (<| (ffi.:as org/jruby/internal/runtime/methods/DynamicMethod) + (ffi.object [] org/jruby/internal/runtime/methods/DynamicMethod [] + [java/lang/String (ffi.as_string "to_s")] + + (org/jruby/internal/runtime/methods/DynamicMethod + [] (dup this []) + org/jruby/internal/runtime/methods/DynamicMethod + (undefined)) + + (org/jruby/internal/runtime/methods/DynamicMethod + [] (call this [thread_context org/jruby/runtime/ThreadContext + self org/jruby/runtime/builtin/IRubyObject + module org/jruby/RubyModule + method java/lang/String + args [org/jruby/runtime/builtin/IRubyObject] + block org/jruby/runtime/Block]) + org/jruby/runtime/builtin/IRubyObject + (|> value + debug.inspection + ffi.as_string + (org/jruby/RubyString::newInternalFromJavaExternal ..initial_ruby_runtime) + (ffi.:as org/jruby/runtime/builtin/IRubyObject)))))) (exception: (invalid_operation [method Text]) (exception.report ["Method" (%.text method)])) -(def: (lux_wrapper_respond_to? value) +(def: (::respond_to? value) (-> (Array java/lang/Object) org/jruby/internal/runtime/methods/DynamicMethod) - (ffi.object [] org/jruby/internal/runtime/methods/DynamicMethod [] - [java/lang/String "respond_to?"] - - (org/jruby/internal/runtime/methods/DynamicMethod - [] (call self [thread_context org/jruby/runtime/ThreadContext - self org/jruby/runtime/builtin/IRubyObject - module org/jruby/RubyModule - method java/lang/String - args [org/jruby/runtime/builtin/IRubyObject] - block org/jruby/runtime/Block]) - org/jruby/runtime/builtin/IRubyObject - (case (|> args - (ffi.read! 0) - (ffi.check org/jruby/RubySymbol)) - {.#Some method} - (|> (case (|> method - org/jruby/RubySymbol::asJavaString - (:as Text)) - (^or "==" "equal?" - "to_s" "inspect" - "[]" "length" "respond_to?" - ... "to_hash" - ) - true - - _ - false) - (org/jruby/RubyBoolean::newBoolean ..initial_ruby_runtime)) - - {.#None} - (panic! (exception.error ..invalid_operation ["respond_to?"])))))) + (<| (ffi.:as org/jruby/internal/runtime/methods/DynamicMethod) + (ffi.object [] org/jruby/internal/runtime/methods/DynamicMethod [] + [java/lang/String (ffi.as_string "respond_to?")] + + (org/jruby/internal/runtime/methods/DynamicMethod + [] (dup this []) + org/jruby/internal/runtime/methods/DynamicMethod + (undefined)) + + (org/jruby/internal/runtime/methods/DynamicMethod + [] (call this [thread_context org/jruby/runtime/ThreadContext + self org/jruby/runtime/builtin/IRubyObject + module org/jruby/RubyModule + method java/lang/String + args [org/jruby/runtime/builtin/IRubyObject] + block org/jruby/runtime/Block]) + org/jruby/runtime/builtin/IRubyObject + (case (|> args + (ffi.read! 0) + (ffi.check org/jruby/RubySymbol)) + {.#Some method} + (|> (case (|> method + org/jruby/RubySymbol::asJavaString + ffi.of_string) + (^or "==" "equal?" + "to_s" "inspect" + "[]" "length" "respond_to?" + ... "to_hash" + ) + true + + _ + false) + ffi.as_boolean + (org/jruby/RubyBoolean::newBoolean ..initial_ruby_runtime) + (ffi.:as org/jruby/runtime/builtin/IRubyObject)) + + {.#None} + (panic! (exception.error ..invalid_operation ["respond_to?"]))))))) (exception: (unknown_method [method Text]) (exception.report @@ -594,47 +643,50 @@ (-> (-> (Array java/lang/Object) org/jruby/runtime/builtin/IRubyObject) (Array java/lang/Object) org/jruby/RubyClass) - (ffi.object [] org/jruby/RubyClass [] - [org/jruby/Ruby ..initial_ruby_runtime] + (<| (ffi.:as org/jruby/RubyClass) + (ffi.object [] org/jruby/RubyClass [] + [org/jruby/Ruby ..initial_ruby_runtime] - (org/jruby/RubyClass - [] (searchWithCache self [method java/lang/String]) - org/jruby/runtime/callsite/CacheEntry - (case (:as Text method) - "call" - (org/jruby/runtime/callsite/CacheEntry::new (..lux_wrapper_call useful_object_class lux_structure value) 0) - - "[]" - (org/jruby/runtime/callsite/CacheEntry::new (..lux_wrapper_access useful_object_class lux_structure value) 0) + (org/jruby/RubyClass + [] (searchWithCache this [method java/lang/String]) + org/jruby/runtime/callsite/CacheEntry + (case (ffi.of_string method) + "call" + (org/jruby/runtime/callsite/CacheEntry::new (::call useful_object_class lux_structure value) (ffi.as_int +0)) + + "[]" + (org/jruby/runtime/callsite/CacheEntry::new (::access useful_object_class lux_structure value) (ffi.as_int +1)) - (^or "==" "equal?") - (org/jruby/runtime/callsite/CacheEntry::new (..lux_wrapper_equality value) 1) + (^or "==" "equal?") + (org/jruby/runtime/callsite/CacheEntry::new (::= value) (ffi.as_int +2)) - (^or "count" "length" "size") - (org/jruby/runtime/callsite/CacheEntry::new (..lux_wrapper_length value) 2) + (^or "count" "length" "size") + (org/jruby/runtime/callsite/CacheEntry::new (::length value) (ffi.as_int +3)) - (^or "to_s" "inspect") - (org/jruby/runtime/callsite/CacheEntry::new (..lux_wrapper_to_s value) 3) + (^or "to_s" "inspect") + (org/jruby/runtime/callsite/CacheEntry::new (::to_s value) (ffi.as_int +4)) - "respond_to?" - (org/jruby/runtime/callsite/CacheEntry::new (..lux_wrapper_respond_to? value) 4) + "respond_to?" + (org/jruby/runtime/callsite/CacheEntry::new (::respond_to? value) (ffi.as_int +5)) - _ - (panic! (exception.error ..unknown_method [(:as Text method)])))))) + method + (panic! (exception.error ..unknown_method [method]))))))) (def: (lux_structure value) (-> (Array java/lang/Object) org/jruby/runtime/builtin/IRubyObject) - (org/jruby/java/proxies/JavaProxy::new ..initial_ruby_runtime - (useful_object_class lux_structure value) - (:as java/lang/Object value))) + (<| (ffi.:as org/jruby/runtime/builtin/IRubyObject) + (org/jruby/java/proxies/JavaProxy::new ..initial_ruby_runtime + (useful_object_class lux_structure value) + (ffi.:as java/lang/Object value)))) (exception: (cannot_apply_a_non_function [object java/lang/Object]) (exception.report - ["Non-function" (java/lang/Object::toString object)])) + ["Non-function" (ffi.of_string (java/lang/Object::toString object))])) -(def: ensure_macro +(def: macro! (-> Macro (Maybe org/jruby/RubyProc)) - (|>> (:as java/lang/Object) (ffi.check org/jruby/RubyProc))) + (|>> (:as java/lang/Object) + (ffi.check org/jruby/RubyProc))) (def: to_host (-> Any org/jruby/runtime/builtin/IRubyObject) @@ -650,11 +702,11 @@ (ffi.write! 0 (..to_host inputs)) (ffi.write! 1 (..to_host lux))) macro)] - (..read (:as java/lang/Object expansion))))) + (..read (ffi.:as java/lang/Object expansion))))) (def: (expander macro inputs lux) Expander - (case (ensure_macro macro) + (case (macro! macro) {.#Some macro} (case (call_macro inputs lux macro) {try.#Success output} @@ -674,17 +726,17 @@ (io (let [run! (: (-> (_.Code Any) (Try Any)) (function (_ code) (do try.monad - [output (org/jruby/embed/ScriptingContainer::runScriptlet (_.code code) ..interpreter)] + [output (org/jruby/embed/ScriptingContainer::runScriptlet (ffi.as_string (_.code code)) ..interpreter)] (..read (maybe.else (:as java/lang/Object []) output)))))] (: (Host _.Expression _.Statement) (implementation - (def: (evaluate context code) + (def: (evaluate context [_ code]) (run! code)) (def: execute run!) - (def: (define context custom input) + (def: (define context custom [_ input]) (let [global (maybe.else (reference.artifact context) custom) @global (_.global global)] @@ -707,149 +759,177 @@ [_ (run! content)] (run! (_.global (reference.artifact context)))))))))) -(for [@.old - (as_is (exception: .public (invaid_phase_application [partial_application (List Any) - arity (List Any)]) - (exception.report - ["Partial Application" (%.nat (list.size partial_application))] - ["Arity" (%.nat (list.size arity))])) - - (def: proc_type - org/jruby/runtime/Block$Type - (|> (org/jruby/runtime/Block::NULL_BLOCK) - (org/jruby/runtime/Block::type))) - - (def: phase_block_signature - org/jruby/runtime/Signature - (org/jruby/runtime/Signature::THREE_ARGUMENTS)) - - (def: dummy_static_scope - org/jruby/parser/StaticScope - (|> (org/jruby/parser/StaticScopeFactory::new (!ruby_runtime)) - (org/jruby/parser/StaticScopeFactory::getDummyScope))) - - (def: phase_block_body - org/jruby/runtime/BlockBody - (ffi.object [] org/jruby/runtime/BlockBody [] - [org/jruby/runtime/Signature ..phase_block_signature] - ... Methods - (org/jruby/runtime/BlockBody - [] (getFile self []) - java/lang/String - "YOLO") - (org/jruby/runtime/BlockBody - [] (getLine self []) - int - (ffi.long_to_int (hex "+ABC,123"))) - (org/jruby/runtime/BlockBody - [] (getStaticScope self []) - org/jruby/parser/StaticScope - ..dummy_static_scope))) - - (def: (host_phase partial_application phase) - (All (_ s i o) - (-> (List Any) (Phase [extension.Bundle s] i o) - org/jruby/RubyProc)) - (let [block (ffi.object [] org/jruby/runtime/Block [] - [org/jruby/runtime/BlockBody ..phase_block_body] - ... Methods - (org/jruby/runtime/Block - [] (call self [_ org/jruby/runtime/ThreadContext - inputs [org/jruby/runtime/builtin/IRubyObject] - _ org/jruby/runtime/Block]) - org/jruby/runtime/builtin/IRubyObject - (<| try.trusted - (do [! try.monad] - [inputs (|> inputs - (array.list {.#None}) - (monad.each ! (|>> (:as java/lang/Object) ..read)))]) - (case inputs - ... It seems that org/jruby/runtime/Block::call can misbehave when getting called with a Lux state value. - (^ (list info source location current_module modules scopes type_context expected seed scope_type_vars extensions eval host)) - (case partial_application - (^ (list partial/0 partial/1)) - (in (..to_host ((:as (-> Any Any Any Any) phase) - partial/0 - partial/1 - [info source location current_module modules scopes type_context expected seed scope_type_vars extensions eval host]))) - - _ - (exception.except ..invaid_phase_application [partial_application inputs])) - - (^ (list)) - {try.#Success (host_phase partial_application phase)} - - (^ (list input/0)) - (case partial_application - (^ (list)) - (in (host_phase (list input/0) phase)) - - (^ (list partial/0)) - (in (host_phase (list partial/0 input/0) phase)) - - (^ (list partial/0 partial/1)) - (in (..to_host ((:as (-> Any Any Any Any) phase) - partial/0 - partial/1 - input/0))) - - _ - (exception.except ..invaid_phase_application [partial_application inputs])) - - (^ (list input/0 input/1)) - (case partial_application - (^ (list)) - (in (host_phase (list input/0 input/1) phase)) - - (^ (list partial/0)) - (in (..to_host ((:as (-> Any Any Any Any) phase) - partial/0 - input/0 - input/1))) - - _ - (exception.except ..invaid_phase_application [partial_application inputs])) - - (^ (list input/0 input/1 input/2)) - (case partial_application - (^ (list)) - (in (..to_host ((:as (-> Any Any Any Any) phase) - input/0 - input/1 - input/2))) - - _ - (exception.except ..invaid_phase_application [partial_application inputs])) - - _ - (exception.except ..invaid_phase_application [partial_application inputs])))))] - (org/jruby/RubyProc::newProc (!ruby_runtime) block ..proc_type))) - - (def: (extender phase_wrapper) - (-> phase.Wrapper Extender) - ... TODO: Stop relying on coercions ASAP. - (<| (:as Extender) - (function (@self handler)) - (:as Handler) - (function (@self name phase)) - (:as Phase) - (function (@self archive parameters)) - (:as Operation) - (function (@self state)) - (:as Try) - try.trusted - (:as Try) - (do try.monad - [handler (try.of_maybe (..ensure_macro handler)) - output (org/jruby/RubyProc::call (!ruby_thread_context) - (|> (ffi.array org/jruby/runtime/builtin/IRubyObject 5) - (ffi.write! 0 (org/jruby/RubyString::newInternalFromJavaExternal (!ruby_runtime) name)) - (ffi.write! 1 (:as org/jruby/runtime/builtin/IRubyObject (phase_wrapper phase))) - (ffi.write! 2 (..to_host archive)) - (ffi.write! 3 (..to_host parameters)) - (ffi.write! 4 (..to_host state))) - handler)] - (..read (:as java/lang/Object output)))))) +(for [@.jvm (as_is (exception: .public (invaid_phase_application [partial_application (List Any) + arity (List Any)]) + (exception.report + ["Partial Application" (%.nat (list.size partial_application))] + ["Arity" (%.nat (list.size arity))])) + + (def: proc_type + org/jruby/runtime/Block$Type + (|> (org/jruby/runtime/Block::NULL_BLOCK) + (org/jruby/runtime/Block::type))) + + (def: phase_block_signature + org/jruby/runtime/Signature + (org/jruby/runtime/Signature::THREE_ARGUMENTS)) + + (def: dummy_static_scope + org/jruby/parser/StaticScope + (|> (org/jruby/parser/StaticScopeFactory::new (!ruby_runtime)) + (org/jruby/parser/StaticScopeFactory::getDummyScope))) + + (def: phase_block_body + org/jruby/runtime/BlockBody + (<| (ffi.:as org/jruby/runtime/BlockBody) + (ffi.object [] org/jruby/runtime/BlockBody [] + [org/jruby/runtime/Signature ..phase_block_signature] + ... Methods + (org/jruby/runtime/BlockBody + [] (getFile this []) + java/lang/String + (ffi.as_string "YOLO")) + + (org/jruby/runtime/BlockBody + [] (getLine this []) + int + (ffi.as_int (hex "+ABC,123"))) + + (org/jruby/runtime/BlockBody + [] (getStaticScope this []) + org/jruby/parser/StaticScope + ..dummy_static_scope) + + (org/jruby/runtime/BlockBody + [] (setStaticScope self [_ org/jruby/parser/StaticScope]) + void + []) + + (org/jruby/runtime/BlockBody + [] (doYield self [_ org/jruby/runtime/ThreadContext + _ org/jruby/runtime/Block + _ org/jruby/runtime/builtin/IRubyObject]) + org/jruby/runtime/builtin/IRubyObject + (undefined)) + + (org/jruby/runtime/BlockBody + [] (doYield self [_ org/jruby/runtime/ThreadContext + _ org/jruby/runtime/Block + _ [org/jruby/runtime/builtin/IRubyObject] + _ org/jruby/runtime/builtin/IRubyObject]) + org/jruby/runtime/builtin/IRubyObject + (undefined)) + ))) + + (def: (host_phase partial_application phase) + (All (_ s i o) + (-> (List Any) (Phase [extension.Bundle s] i o) + org/jruby/RubyProc)) + (let [block (ffi.object [] org/jruby/runtime/Block [] + [org/jruby/runtime/BlockBody ..phase_block_body] + ... Methods + (org/jruby/runtime/Block + [] (call this [_thread_context org/jruby/runtime/ThreadContext + inputs [org/jruby/runtime/builtin/IRubyObject] + _block org/jruby/runtime/Block]) + org/jruby/runtime/builtin/IRubyObject + (<| try.trusted + (do [! try.monad] + [inputs (|> inputs + (array.list {.#None}) + (monad.each ! (|>> (ffi.:as java/lang/Object) ..read)))]) + (case inputs + ... It seems that org/jruby/runtime/Block::call can misbehave when getting called with a Lux state value. + (^ (list info source location current_module modules scopes type_context expected seed scope_type_vars extensions eval host)) + (case partial_application + (^ (list partial/0 partial/1)) + (in (..to_host ((:as (-> Any Any Any Any) phase) + partial/0 + partial/1 + [info source location current_module modules scopes type_context expected seed scope_type_vars extensions eval host]))) + + _ + (exception.except ..invaid_phase_application [partial_application inputs])) + + (^ (list)) + {try.#Success (<| (ffi.:as org/jruby/runtime/builtin/IRubyObject) + (host_phase partial_application phase))} + + (^ (list input/0)) + (case partial_application + (^ (list)) + (in (<| (ffi.:as org/jruby/runtime/builtin/IRubyObject) + (host_phase (list input/0) phase))) + + (^ (list partial/0)) + (in (<| (ffi.:as org/jruby/runtime/builtin/IRubyObject) + (host_phase (list partial/0 input/0) phase))) + + (^ (list partial/0 partial/1)) + (in (..to_host ((:as (-> Any Any Any Any) phase) + partial/0 + partial/1 + input/0))) + + _ + (exception.except ..invaid_phase_application [partial_application inputs])) + + (^ (list input/0 input/1)) + (case partial_application + (^ (list)) + (in (<| (ffi.:as org/jruby/runtime/builtin/IRubyObject) + (host_phase (list input/0 input/1) phase))) + + (^ (list partial/0)) + (in (..to_host ((:as (-> Any Any Any Any) phase) + partial/0 + input/0 + input/1))) + + _ + (exception.except ..invaid_phase_application [partial_application inputs])) + + (^ (list input/0 input/1 input/2)) + (case partial_application + (^ (list)) + (in (..to_host ((:as (-> Any Any Any Any) phase) + input/0 + input/1 + input/2))) + + _ + (exception.except ..invaid_phase_application [partial_application inputs])) + + _ + (exception.except ..invaid_phase_application [partial_application inputs])))))] + (org/jruby/RubyProc::newProc (!ruby_runtime) block ..proc_type))) + + (def: (extender phase_wrapper) + (-> phase.Wrapper Extender) + ... TODO: Stop relying on coercions ASAP. + (<| (:as Extender) + (function (@self handler)) + (:as Handler) + (function (@self name phase)) + (:as Phase) + (function (@self archive parameters)) + (:as Operation) + (function (@self state)) + (:as Try) + try.trusted + (:as Try) + (do try.monad + [handler (try.of_maybe (..macro! handler)) + output (org/jruby/RubyProc::call (!ruby_thread_context) + (|> (ffi.array org/jruby/runtime/builtin/IRubyObject 5) + (ffi.write! 0 (<| (ffi.:as org/jruby/runtime/builtin/IRubyObject) + (org/jruby/RubyString::newInternalFromJavaExternal (!ruby_runtime) (ffi.as_string name)))) + (ffi.write! 1 (:as org/jruby/runtime/builtin/IRubyObject (phase_wrapper phase))) + (ffi.write! 2 (..to_host archive)) + (ffi.write! 3 (..to_host parameters)) + (ffi.write! 4 (..to_host state))) + handler)] + (..read (ffi.:as java/lang/Object output)))))) @.ruby (def: (extender phase_wrapper handler) @@ -858,11 +938,10 @@ (def: (phase_wrapper archive) (-> Archive (runtime.Operation phase.Wrapper)) - (do phase.monad - [] - (in (:as phase.Wrapper - (for [@.old (..host_phase (list)) - @.ruby (|>>)]))))) + (<| phase#in + (:as phase.Wrapper) + (for [@.jvm (..host_phase (list)) + @.ruby (|>>)]))) (def: platform (IO (Platform Register _.Expression _.Statement)) @@ -892,14 +971,16 @@ (-> Any (Async Any)) (async.future (# world/program.default exit +0))) +(def: (lux_compiler it) + (-> Any compiler.Custom) + (undefined)) + (program: [service cli.service] (let [extension ".rb"] (exec (do async.monad - [_ (/.compiler [/static.#host @.ruby - /static.#host_module_extension extension - /static.#target (cli.target service) - /static.#artifact_extension extension] + [_ (/.compiler ..lux_compiler + (context.ruby (cli.target service)) ..expander analysis.bundle ..platform diff --git a/stdlib/source/library/lux/data/collection/array.lux b/stdlib/source/library/lux/data/collection/array.lux index cef8b64c0..f3a0efe41 100644 --- a/stdlib/source/library/lux/data/collection/array.lux +++ b/stdlib/source/library/lux/data/collection/array.lux @@ -51,7 +51,7 @@ (def: .public (contains? index array) (All (_ a) (-> Nat (Array a) Bit)) - (not (!.lacks? index array))) + (!.has? index array)) (def: .public (update! index $ array) (All (_ a) diff --git a/stdlib/source/library/lux/ffi.old.lux b/stdlib/source/library/lux/ffi.old.lux index ec3693ece..0a6acfa83 100644 --- a/stdlib/source/library/lux/ffi.old.lux +++ b/stdlib/source/library/lux/ffi.old.lux @@ -1,30 +1,30 @@ (.using - [library - [lux {"-" type} - ["[0]" type ("[1]#[0]" equivalence)] - [abstract - ["[0]" monad {"+" Monad do}] - ["[0]" enum]] - [control - ["[0]" function] - ["[0]" io] - ["[0]" maybe] - ["[0]" try {"+" Try}] - ["<>" parser - ["<[0]>" code {"+" Parser}]]] - [data - ["[0]" product] - ["[0]" bit ("[1]#[0]" codec)] - ["[0]" text ("[1]#[0]" equivalence monoid) - ["%" format {"+" format}]] - [collection - ["[0]" array {"+" Array}] - ["[0]" list ("[1]#[0]" monad mix monoid)]]] - ["[0]" macro {"+" with_symbols} - [syntax {"+" syntax:}] - ["[0]" code] - ["[0]" template]] - ["[0]" meta]]]) + [library + [lux {"-" :as type} + ["[0]" type ("[1]#[0]" equivalence)] + [abstract + ["[0]" monad {"+" Monad do}] + ["[0]" enum]] + [control + ["[0]" function] + ["[0]" io] + ["[0]" maybe] + ["[0]" try {"+" Try}] + ["<>" parser + ["<[0]>" code {"+" Parser}]]] + [data + ["[0]" product] + ["[0]" bit ("[1]#[0]" codec)] + ["[0]" text ("[1]#[0]" equivalence monoid) + ["%" format {"+" format}]] + [collection + ["[0]" array {"+" Array}] + ["[0]" list ("[1]#[0]" monad mix monoid)]]] + ["[0]" macro {"+" with_symbols} + [syntax {"+" syntax:}] + ["[0]" code] + ["[0]" template]] + ["[0]" meta]]]) (template [ ] [(def: .public ( value) @@ -64,10 +64,10 @@ (template [ ] [(template: .public ( it) - [(|> it (: ) (:as (Primitive )))]) + [(|> it (: ) (.:as (Primitive )))]) (template: .public ( it) - [(|> it (: (Primitive )) (:as ))])] + [(|> it (: (Primitive )) (.:as ))])] [as_boolean .Bit "java.lang.Boolean" of_boolean] [as_long .Int "java.lang.Long" of_long] @@ -77,10 +77,10 @@ (template [ <$> <$'> ] [(template: .public ( it) - [(|> it (: ) (:as (Primitive )) <$> (: (Primitive )))]) + [(|> it (: ) (.:as (Primitive )) <$> (: (Primitive )))]) (template: .public ( it) - [(|> it (: (Primitive )) <$'> (: (Primitive )) (:as ))])] + [(|> it (: (Primitive )) <$'> (: (Primitive )) (.:as ))])] [as_byte .Int ..long_to_byte "java.lang.Long" ..byte_to_long "java.lang.Byte" of_byte] [as_short .Int ..long_to_short "java.lang.Long" ..short_to_long "java.lang.Short" of_short] @@ -1378,8 +1378,8 @@ (` (??? (~ return_term))) (let [g!temp (` ((~' ~') (~ (code.symbol ["" " Ω "]))))] (` (let [(~ g!temp) (~ return_term)] - (if (not (..null? (:as (Primitive "java.lang.Object") - (~ g!temp)))) + (if (not (..null? (.:as (Primitive "java.lang.Object") + (~ g!temp)))) (~ g!temp) (panic! (~ (code.text (format "Cannot produce null references from method calls @ " (value@ #class_name class) @@ -1733,3 +1733,6 @@ (syntax: .public (type [type (..generic_type^ (list))]) (in (list (..class_type {#ManualPrM} (list) type)))) + +(template: .public (:as type term) + [(.:as type term)]) diff --git a/stdlib/source/library/lux/target/ruby.lux b/stdlib/source/library/lux/target/ruby.lux index b81be8aab..c197f6a64 100644 --- a/stdlib/source/library/lux/target/ruby.lux +++ b/stdlib/source/library/lux/target/ruby.lux @@ -208,16 +208,16 @@ (def: .public array (-> (List Expression) Computation) - (|>> (list#each (|>> :representation)) - (text.interposed ..input_separator) + (|>> (list#each (|>> :representation (text.suffix ..input_separator))) + text.together (text.enclosed ["[" "]"]) :abstraction)) (def: .public hash (-> (List [Expression Expression]) Computation) (|>> (list#each (.function (_ [k v]) - (format (:representation k) " => " (:representation v)))) - (text.interposed ..input_separator) + (format (:representation k) " => " (:representation v) ..input_separator))) + text.together (text.enclosed ["{" "}"]) :abstraction)) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux index 132ceca10..df3c8bd71 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux @@ -2172,26 +2172,28 @@ bodyA 2 - {/////analysis.#Case (/////analysis.unit) - [[/////analysis.#when - {pattern.#Bind 2} - - /////analysis.#then - bodyA] - (list)]} + (let [forced_refencing (/////analysis.tuple (list#each (|>> /////analysis.local) (list.indices arity)))] + {/////analysis.#Case (/////analysis.unit) + [[/////analysis.#when + {pattern.#Bind 2} + + /////analysis.#then + (/////analysis.tuple (list forced_refencing bodyA))] + (list)]}) _ - {/////analysis.#Case (/////analysis.unit) - [[/////analysis.#when - {pattern.#Complex - {complex.#Tuple - (|> (-- arity) - list.indices - (list#each (|>> (n.+ 2) {pattern.#Bind})))}} - - /////analysis.#then - bodyA] - (list)]}))) + (let [forced_refencing (/////analysis.tuple (list#each (|>> /////analysis.local) (list.indices arity)))] + {/////analysis.#Case (/////analysis.unit) + [[/////analysis.#when + {pattern.#Complex + {complex.#Tuple + (|> (-- arity) + list.indices + (list#each (|>> (n.+ 2) {pattern.#Bind})))}} + + /////analysis.#then + (/////analysis.tuple (list forced_refencing bodyA))] + (list)]})))) (def: .public (analyse_overriden_method analyse archive selfT mapping supers method) (-> Phase Archive .Type Mapping (List (Type Class)) (Overriden_Method Code) (Operation Analysis)) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/jvm.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/jvm.lux index 8a2acf43e..27b3cf9d2 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/jvm.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/jvm.lux @@ -79,6 +79,9 @@ ["[0]" bundle] [analysis ["[0]" jvm]] + [generation + [jvm + ["[0]" host]]] [directive ["/" lux]]]]]]]] [type @@ -278,37 +281,6 @@ (.Parser (Typed Synthesis)) (.tuple (<>.and ..value_type_synthesis .any))) -(def: (hidden_method_body arity body) - (-> Nat Synthesis Synthesis) - (case [arity body] - [0 _] body - [1 _] body - - [2 {synthesis.#Control {synthesis.#Branch {synthesis.#Let _ 2 hidden}}}] - hidden - - [_ {synthesis.#Control {synthesis.#Branch {synthesis.#Case _ path}}}] - (loop [path (: synthesis.Path path)] - (case path - (^or {synthesis.#Pop} - {synthesis.#Access _} - {synthesis.#Bind _} - {synthesis.#Bit_Fork _} - {synthesis.#I64_Fork _} - {synthesis.#F64_Fork _} - {synthesis.#Text_Fork _} - {synthesis.#Alt _}) - body - - {synthesis.#Seq _ next} - (again next) - - {synthesis.#Then hidden} - hidden)) - - _ - body)) - (def: (method_body arity) (-> Nat (.Parser Synthesis)) (<| (<>#each (function (_ [env offset inits it]) it)) @@ -317,7 +289,7 @@ .tuple ($_ <>.either (<| (<>.after (.text! "")) - (<>#each (..hidden_method_body arity)) + (<>#each (host.hidden_method_body arity)) .any) .any))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux index cbcfac6ec..296f0394b 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux @@ -853,31 +853,23 @@ [1 _]) body - (^or [2 {//////synthesis.#Control {//////synthesis.#Branch {//////synthesis.#Let _ 2 hidden}}}] - [2 {//////synthesis.#Control {//////synthesis.#Branch {//////synthesis.#Exec _ hidden}}}]) + (^ [2 {//////synthesis.#Control {//////synthesis.#Branch {//////synthesis.#Let _ 2 (//////synthesis.tuple (list _ hidden))}}}]) hidden [_ {//////synthesis.#Control {//////synthesis.#Branch {//////synthesis.#Case _ path}}}] (loop [path (: Path path)] (case path - (^or {//////synthesis.#Pop} - {//////synthesis.#Access _} - {//////synthesis.#Bind _} - {//////synthesis.#Bit_Fork _} - {//////synthesis.#I64_Fork _} - {//////synthesis.#F64_Fork _} - {//////synthesis.#Text_Fork _} - {//////synthesis.#Alt _}) - body - {//////synthesis.#Seq _ next} (again next) - {//////synthesis.#Then hidden} - hidden)) + (^ {//////synthesis.#Then (//////synthesis.tuple (list _ hidden))}) + hidden + + _ + (undefined))) _ - body)) + (undefined))) (def: overriden_method_definition (Parser [(Environment Synthesis) (/.Overriden_Method Synthesis)]) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/runtime.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/runtime.lux index f6a61ca8c..99a2784cb 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/runtime.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/runtime.lux @@ -22,7 +22,8 @@ ["[0]" code]] [math [number {"+" hex} - ["[0]" i64]]] + ["[0]" i64] + ["[0]" int ("[1]#[0]" interval)]]] ["@" target ["_" ruby {"+" Expression LVar Computation Literal Statement}]]]] ["[0]" /// "_" @@ -393,10 +394,13 @@ (|> input i32##high (_.bit_shr (_.- (_.int +32) shift))))))))) (runtime: (i64##/ parameter subject) - (let [extra (_.do "remainder" (list parameter) {.#None} subject)] - (_.return (|> subject - (_.- extra) - (_./ parameter))))) + (_.return (_.? (_.and (_.= (_.int -1) parameter) + (_.= (_.int int#bottom) subject)) + subject + (let [extra (_.do "remainder" (list parameter) {.#None} subject)] + (|> subject + (_.- extra) + (_./ parameter)))))) (runtime: (i64##+ parameter subject) [..normal_ruby? (_.return (i64##i64 (_.+ parameter subject)))] diff --git a/stdlib/source/library/lux/tool/compiler/meta/cache/purge.lux b/stdlib/source/library/lux/tool/compiler/meta/cache/purge.lux new file mode 100644 index 000000000..c5f2f577a --- /dev/null +++ b/stdlib/source/library/lux/tool/compiler/meta/cache/purge.lux @@ -0,0 +1,82 @@ +(.using + [library + [lux "*" + [abstract + [predicate {"+" Predicate}] + ["[0]" monad {"+" Monad do}]] + [control + ["[0]" try {"+" Try} ("[1]#[0]" functor)] + [concurrency + ["[0]" async {"+" Async}]]] + [data + ["[0]" text ("[1]#[0]" equivalence)] + [collection + ["[0]" list ("[1]#[0]" mix functor)] + ["[0]" dictionary {"+" Dictionary}] + ["[0]" set]]] + [math + [number + ["n" nat]]] + [world + ["[0]" file]]]] + ["[0]" // "_" + ["[1][0]" module] + ["[0]" dependency "_" + ["[1]" module]] + ["/[1]" // "_" + [context {"+" Context}] + ["/[1]" // {"+" Input}] + ["[0]" archive + [registry {"+" Registry}] + ["[0]" module + ["[0]" descriptor {"+" Descriptor}]]]]]) + +(type: .public Cache + [Bit descriptor.Module module.ID (module.Module Any) Registry]) + +(type: .public Purge + (Dictionary descriptor.Module module.ID)) + +... TODO: Make the monad parameterizable. +(def: .public (purge! fs context @module) + (-> (file.System Async) Context module.ID (Async (Try Any))) + (do [! (try.with async.monad)] + [.let [cache (//module.path fs context @module)] + _ (|> cache + (# fs directory_files) + (# ! each (monad.each ! (# fs delete))) + (# ! conjoint))] + (# fs delete cache))) + +(def: .public (valid? expected actual) + (-> Descriptor Input Bit) + (and (text#= (value@ descriptor.#name expected) + (value@ ////.#module actual)) + (text#= (value@ descriptor.#file expected) + (value@ ////.#file actual)) + (n.= (value@ descriptor.#hash expected) + (value@ ////.#hash actual)))) + +(def: initial + (-> (List Cache) Purge) + (|>> (list.all (function (_ [valid? module_name @module _]) + (if valid? + {.#None} + {.#Some [module_name @module]}))) + (dictionary.of_list text.hash))) + +(def: .public (purge caches load_order) + (-> (List Cache) (dependency.Order Any) Purge) + (list#mix (function (_ [module_name [@module entry]] purge) + (let [purged? (: (Predicate descriptor.Module) + (dictionary.key? purge))] + (if (purged? module_name) + purge + (if (|> entry + (value@ [archive.#module module.#descriptor descriptor.#references]) + set.list + (list.any? purged?)) + (dictionary.has module_name @module purge) + purge)))) + (..initial caches) + load_order)) diff --git a/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux b/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux index 346a05e56..f625ba952 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux @@ -3,8 +3,7 @@ [lux "*" [target {"+" Target}] [abstract - [predicate {"+" Predicate}] - ["[0]" monad {"+" do}]] + ["[0]" monad {"+" Monad do}]] [control ["[0]" try {"+" Try}] [concurrency @@ -17,13 +16,10 @@ ["[0]" text ("[1]#[0]" equivalence) ["%" format {"+" format}]] [collection - ["[0]" list ("[1]#[0]" functor mix)] + [set {"+" Set}] + ["[0]" list ("[1]#[0]" mix)] ["[0]" dictionary {"+" Dictionary}] - ["[0]" sequence {"+" Sequence}] - ["[0]" set {"+" Set}]]] - [math - [number - ["n" nat]]] + ["[0]" sequence {"+" Sequence}]]] [meta ["[0]" configuration {"+" Configuration}] ["[0]" version]] @@ -45,9 +41,10 @@ ["[0]" cache ["[1]/[0]" archive] ["[1]/[0]" module] + ["[1]/[0]" purge {"+" Cache Purge}] ["[0]" dependency "_" ["[1]" module]]] - ["/[1]" // {"+" Input} + [// [language ["$" lux ["[0]" analysis] @@ -261,58 +258,6 @@ (with@ archive.#output output)) bundles]))) -(def: (purge! fs context [module_name @module]) - (-> (file.System Async) Context [descriptor.Module module.ID] (Async (Try Any))) - (do [! (try.with async.monad)] - [.let [cache (cache/module.path fs context @module)] - _ (|> cache - (# fs directory_files) - (# ! each (monad.each ! (# fs delete))) - (# ! conjoint))] - (# fs delete cache))) - -(def: (valid_cache? expected actual) - (-> Descriptor Input Bit) - (and (text#= (value@ descriptor.#name expected) - (value@ ////.#module actual)) - (text#= (value@ descriptor.#file expected) - (value@ ////.#file actual)) - (n.= (value@ descriptor.#hash expected) - (value@ ////.#hash actual)))) - -(type: Cache - [descriptor.Module [module.ID [(module.Module .Module) Registry]]]) - -(type: Purge - (Dictionary descriptor.Module module.ID)) - -(def: initial_purge - (-> (List [Bit Cache]) - Purge) - (|>> (list.all (function (_ [valid_cache? [module_name [@module _]]]) - (if valid_cache? - {.#None} - {.#Some [module_name @module]}))) - (dictionary.of_list text.hash))) - -(def: (full_purge caches load_order) - (-> (List [Bit Cache]) - (dependency.Order .Module) - Purge) - (list#mix (function (_ [module_name [@module entry]] purge) - (let [purged? (: (Predicate descriptor.Module) - (dictionary.key? purge))] - (if (purged? module_name) - purge - (if (|> entry - (value@ [archive.#module module.#descriptor descriptor.#references]) - set.list - (list.any? purged?)) - (dictionary.has module_name @module purge) - purge)))) - (..initial_purge caches) - load_order)) - (def: pseudo_module Text "(Lux Caching System)") @@ -320,8 +265,8 @@ (def: (valid_cache fs context import contexts [module_name @module]) (-> (file.System Async) Context Import (List //.Context) [descriptor.Module module.ID] - (Async (Try [Bit Cache]))) - (with_expansions [ [module_name [@module [module registry]]]] + (Async (Try Cache))) + (with_expansions [ (as_is module_name @module module registry)] (do [! (try.with async.monad)] [data (: (Async (Try Binary)) (cache/module.cache fs context @module)) @@ -330,11 +275,11 @@ (in [true ]) (do ! [input (//context.read fs ..pseudo_module import contexts (value@ context.#host_module_extension context) module_name)] - (in [(..valid_cache? (value@ module.#descriptor module) input) ])))))) + (in [(cache/purge.valid? (value@ module.#descriptor module) input) ])))))) (def: (pre_loaded_caches fs context import contexts archive) (-> (file.System Async) Context Import (List //.Context) Archive - (Async (Try (List [Bit Cache])))) + (Async (Try (List Cache)))) (do [! (try.with async.monad)] [... TODO: Stop needing to wrap this expression in an unnecessary "do" expression. it (|> archive @@ -344,11 +289,11 @@ (in it))) (def: (load_order archive pre_loaded_caches) - (-> Archive (List [Bit Cache]) + (-> Archive (List Cache) (Try (dependency.Order .Module))) (|> pre_loaded_caches (monad.mix try.monad - (function (_ [_ [module [@module [|module| registry]]]] archive) + (function (_ [_ [module @module |module| registry]] archive) (archive.has module [archive.#module |module| archive.#output (: Output sequence.empty) @@ -381,10 +326,10 @@ (do [! (try.with async.monad)] [pre_loaded_caches (..pre_loaded_caches fs context import contexts archive) load_order (async#in (load_order archive pre_loaded_caches)) - .let [purge (..full_purge pre_loaded_caches load_order)] + .let [purge (cache/purge.purge pre_loaded_caches load_order)] _ (|> purge dictionary.entries - (monad.each ! (..purge! fs context))) + (monad.each ! (|>> product.right (cache/purge.purge! fs context)))) loaded_caches (..loaded_caches host_environment fs context purge load_order)] (async#in (do [! try.monad] diff --git a/stdlib/source/test/lux/data/collection/array.lux b/stdlib/source/test/lux/data/collection/array.lux index b0daba12a..2e2904b3d 100644 --- a/stdlib/source/test/lux/data/collection/array.lux +++ b/stdlib/source/test/lux/data/collection/array.lux @@ -181,6 +181,18 @@ (!.has! 0 expected) (!.lacks! 0) (!.lacks? 0))) + (_.cover [!.lacks?] + (let [the_array (|> (!.empty 2) + (: (Array Nat)) + (!.has! 0 expected))] + (and (not (!.lacks? 0 the_array)) + (!.lacks? 1 the_array)))) + (_.cover [!.has?] + (let [the_array (|> (!.empty 2) + (: (Array Nat)) + (!.has! 0 expected))] + (and (!.has? 0 the_array) + (not (!.has? 1 the_array))))) (_.cover [!.revised!] (|> (!.empty 1) (: (Array Nat)) @@ -342,6 +354,12 @@ _ false))) + (_.cover [/.lacks?] + (let [the_array (|> (/.empty 2) + (: (Array Nat)) + (/.write! 0 expected))] + (and (not (/.lacks? 0 the_array)) + (/.lacks? 1 the_array)))) (_.cover [/.contains?] (let [the_array (|> (/.empty 2) (: (Array Nat)) diff --git a/stdlib/source/test/lux/tool/compiler/meta/archive/module.lux b/stdlib/source/test/lux/tool/compiler/meta/archive/module.lux index 311f1f80d..2a98f38be 100644 --- a/stdlib/source/test/lux/tool/compiler/meta/archive/module.lux +++ b/stdlib/source/test/lux/tool/compiler/meta/archive/module.lux @@ -5,15 +5,31 @@ [abstract [monad {"+" do}]] [math - ["[0]" random] + ["[0]" random {"+" Random}] [number ["n" nat]]]]] [\\library - ["[0]" /]] + ["[0]" / + ["[0]" document] + [// + ["[0]" key] + ["[0]" signature "_" + ["$[1]" \\test]]]]] ["[0]" / "_" ["[1][0]" document] ["[1][0]" descriptor]]) +(def: .public (random it) + (All (_ a) (-> (Random a) (Random (/.Module a)))) + ($_ random.and + random.nat + (/descriptor.random 0) + (do random.monad + [signature $signature.random + example it] + (in (document.document (key.key signature example) + example))))) + (def: .public test Test (<| (_.covering /._) diff --git a/stdlib/source/test/lux/tool/compiler/meta/cache.lux b/stdlib/source/test/lux/tool/compiler/meta/cache.lux index 66d5cfc9c..d48c3297e 100644 --- a/stdlib/source/test/lux/tool/compiler/meta/cache.lux +++ b/stdlib/source/test/lux/tool/compiler/meta/cache.lux @@ -18,6 +18,7 @@ ["[1][0]" archive] ["[1][0]" module] ["[1][0]" artifact] + ["[1][0]" purge] ["$/[1]" // "_" ["[1][0]" context]]]) @@ -49,4 +50,5 @@ /archive.test /module.test /artifact.test + /purge.test )))) diff --git a/stdlib/source/test/lux/tool/compiler/meta/cache/purge.lux b/stdlib/source/test/lux/tool/compiler/meta/cache/purge.lux new file mode 100644 index 000000000..9a190448a --- /dev/null +++ b/stdlib/source/test/lux/tool/compiler/meta/cache/purge.lux @@ -0,0 +1,141 @@ +(.using + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [monad {"+" do}]] + [control + ["[0]" try] + ["[0]" exception] + [concurrency + ["[0]" async]]] + [data + ["[0]" text + ["%" format]] + ["[0]" binary + ["$[1]" \\test]] + [collection + ["[0]" dictionary] + ["[0]" sequence] + ["[0]" set]]] + [math + ["[0]" random {"+" Random}] + [number + ["n" nat]]] + [world + ["[0]" file]]]] + [\\library + ["[0]" / + ["/[1]" // "_" + ["[1][0]" module] + ["[0]" dependency "_" + ["[1]" module]] + ["/[1]" // "_" + ["[0]" context + ["$[1]" \\test]] + ["[0]" archive + ["[0]" registry] + ["[0]" module + ["$[1]" \\test] + ["[0]" descriptor + ["$[1]" \\test]]]] + ["/[1]" //]]]]]) + +(def: .public test + Test + (<| (_.covering /._) + (do [! random.monad] + [descriptor ($descriptor.random 0) + source_code (random.ascii/upper 1) + name/0 (random.ascii/lower 1) + module/0 ($module.random random.nat) + content/0 ($binary.random 1) + name/1 (random.ascii/lower 2) + module/1 (|> ($module.random random.nat) + (# ! each (with@ [module.#descriptor descriptor.#references] + (set.of_list text.hash (list name/0))))) + content/1 ($binary.random 2) + .let [id/0 (value@ module.#id module/0) + id/1 (value@ module.#id module/1) + input [////.#module (value@ descriptor.#name descriptor) + ////.#file (value@ descriptor.#file descriptor) + ////.#hash (value@ descriptor.#hash descriptor) + ////.#code source_code] + / "/" + fs (file.mock /)] + context $context.random] + ($_ _.and + (_.for [/.Cache] + ($_ _.and + (_.cover [/.valid?] + (and (/.valid? descriptor input) + (not (/.valid? descriptor (with@ ////.#module source_code input))) + (not (/.valid? descriptor (with@ ////.#file source_code input))) + (not (/.valid? descriptor (revised@ ////.#hash ++ input))))) + )) + (_.for [/.Purge] + ($_ _.and + (_.cover [/.purge] + (and (dictionary.empty? (/.purge (list) (list))) + (let [order (: (dependency.Order Nat) + (list [name/0 id/0 + [archive.#module module/0 + archive.#output (sequence.sequence) + archive.#registry registry.empty]]))] + (and (let [cache (: (List /.Cache) + (list [#1 name/0 id/0 module/0 registry.empty]))] + (dictionary.empty? (/.purge cache order))) + (let [cache (: (List /.Cache) + (list [#0 name/0 id/0 module/0 registry.empty]))] + (dictionary.key? (/.purge cache order) name/0)))) + (let [order (: (dependency.Order Nat) + (list [name/0 id/0 + [archive.#module module/0 + archive.#output (sequence.sequence) + archive.#registry registry.empty]] + [name/1 id/1 + [archive.#module module/1 + archive.#output (sequence.sequence) + archive.#registry registry.empty]]))] + (and (let [cache (: (List /.Cache) + (list [#1 name/0 id/0 module/0 registry.empty] + [#1 name/1 id/1 module/1 registry.empty])) + purge (/.purge cache order)] + (dictionary.empty? purge)) + (let [cache (: (List /.Cache) + (list [#1 name/0 id/0 module/0 registry.empty] + [#0 name/1 id/1 module/1 registry.empty])) + purge (/.purge cache order)] + (and (not (dictionary.key? (/.purge cache order) name/0)) + (dictionary.key? (/.purge cache order) name/1))) + (let [cache (: (List /.Cache) + (list [#0 name/0 id/0 module/0 registry.empty] + [#1 name/1 id/1 module/1 registry.empty])) + purge (/.purge cache order)] + (and (dictionary.key? (/.purge cache order) name/0) + (dictionary.key? (/.purge cache order) name/1))))))) + (in (do [! async.monad] + [_ (//module.enable! ! fs context id/0) + .let [dir (//module.path fs context id/0) + file/0 (%.format dir / name/0) + file/1 (%.format dir / name/1)] + _ (# fs write content/0 file/0) + _ (# fs write content/1 file/1) + pre (# fs directory_files dir) + _ (/.purge! fs context id/0) + post (# fs directory_files dir)] + (_.cover' [/.purge!] + (<| (try.else false) + (do try.monad + [pre pre] + (in (and (# set.equivalence = + (set.of_list text.hash pre) + (set.of_list text.hash (list file/0 file/1))) + (case post + {try.#Failure error} + (exception.match? file.cannot_find_directory error) + + success + false)))))))) + )) + )))) diff --git a/stdlib/source/unsafe/lux/data/collection/array.lux b/stdlib/source/unsafe/lux/data/collection/array.lux index cd6bebf63..83b7e5202 100644 --- a/stdlib/source/unsafe/lux/data/collection/array.lux +++ b/stdlib/source/unsafe/lux/data/collection/array.lux @@ -95,6 +95,9 @@ .true)))) )])) + (template: .public (has? index array) + [(.not (..lacks? index array))]) + (`` (template: .public (item ) [((.: (.All (_ a) (.-> .Nat (..Array a) a)) -- cgit v1.2.3