From 97ab1f076ac08992d6b64cd77bc0bef97b3fc50a Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Tue, 31 Jul 2018 22:23:07 -0400 Subject: Now implementing array functionality in stdlib instead of the compiler. --- luxc/src/lux/analyser/proc/common.clj | 60 ------------- luxc/src/lux/compiler/jvm/proc/common.clj | 98 ---------------------- .../common-lisp/procedure/common.jvm.lux | 29 ------- .../lang/translation/js/procedure/common.jvm.lux | 33 -------- .../luxc/lang/translation/js/runtime.jvm.lux | 30 ------- .../lang/translation/jvm/procedure/common.jvm.lux | 56 ------------- .../lang/translation/lua/procedure/common.jvm.lux | 33 -------- .../lang/translation/php/procedure/common.jvm.lux | 31 ------- .../translation/python/procedure/common.jvm.lux | 31 ------- .../lang/translation/r/procedure/common.jvm.lux | 25 ------ .../lang/translation/ruby/procedure/common.jvm.lux | 33 -------- .../test/test/luxc/lang/translation/common.lux | 54 ------------ .../default/phase/extension/analysis/common.lux | 37 -------- .../translation/scheme/extension/common.jvm.lux | 29 ------- stdlib/source/lux/data/collection/array.lux | 28 +++++-- stdlib/source/lux/data/number.lux | 12 +-- .../default/phase/analysis/procedure/common.lux | 75 ----------------- 17 files changed, 28 insertions(+), 666 deletions(-) diff --git a/luxc/src/lux/analyser/proc/common.clj b/luxc/src/lux/analyser/proc/common.clj index df6fb0051..ca0447548 100644 --- a/luxc/src/lux/analyser/proc/common.clj +++ b/luxc/src/lux/analyser/proc/common.clj @@ -233,60 +233,6 @@ (return (&/|list (&&/|meta exo-type _cursor (&&/$proc (&/T ["io" "current-time"]) (&/|list) (&/|list))))))) -(defn ^:private analyse-array-new [analyse exo-type ?values] - (|do [:let [(&/$Cons length (&/$Nil)) ?values] - =length (&&/analyse-1 analyse &type/Nat length) - _ (&type/check exo-type (&/$UnivQ (&/|list) (&type/Array (&/$Parameter 1)))) - _cursor &/cursor] - (return (&/|list (&&/|meta exo-type _cursor - (&&/$proc (&/T ["array" "new"]) (&/|list =length) (&/|list))))))) - -(defn ^:private analyse-array-get [analyse exo-type ?values] - (&type/with-var - (fn [$var] - (|do [:let [(&/$Cons array (&/$Cons idx (&/$Nil))) ?values] - =array (&&/analyse-1 analyse (&type/Array $var) array) - =idx (&&/analyse-1 analyse &type/Nat idx) - _ (&type/check exo-type (&/$Apply $var &type/Maybe)) - _cursor &/cursor] - (return (&/|list (&&/|meta exo-type _cursor - (&&/$proc (&/T ["array" "get"]) (&/|list =array =idx) (&/|list))))))))) - -(defn ^:private analyse-array-put [analyse exo-type ?values] - (&type/with-var - (fn [$var] - (|do [:let [(&/$Cons array (&/$Cons idx (&/$Cons elem (&/$Nil)))) ?values] - :let [array-type (&type/Array $var)] - =array (&&/analyse-1 analyse array-type array) - =idx (&&/analyse-1 analyse &type/Nat idx) - =elem (&&/analyse-1 analyse $var elem) - _ (&type/check exo-type array-type) - _cursor &/cursor] - (return (&/|list (&&/|meta exo-type _cursor - (&&/$proc (&/T ["array" "put"]) (&/|list =array =idx =elem) (&/|list))))))))) - -(defn ^:private analyse-array-remove [analyse exo-type ?values] - (&type/with-var - (fn [$var] - (|do [:let [(&/$Cons array (&/$Cons idx (&/$Nil))) ?values] - :let [array-type (&type/Array $var)] - =array (&&/analyse-1 analyse array-type array) - =idx (&&/analyse-1 analyse &type/Nat idx) - _ (&type/check exo-type array-type) - _cursor &/cursor] - (return (&/|list (&&/|meta exo-type _cursor - (&&/$proc (&/T ["array" "remove"]) (&/|list =array =idx) (&/|list))))))))) - -(defn ^:private analyse-array-size [analyse exo-type ?values] - (&type/with-var - (fn [$var] - (|do [:let [(&/$Cons array (&/$Nil)) ?values] - =array (&&/analyse-1 analyse (&type/Array $var) array) - _ (&type/check exo-type &type/Nat) - _cursor &/cursor] - (return (&/|list (&&/|meta exo-type _cursor - (&&/$proc (&/T ["array" "size"]) (&/|list =array) (&/|list))))))))) - (defn ^:private analyse-box-new [analyse exo-type ?values] (&type/with-var (fn [$var] @@ -344,12 +290,6 @@ "lux text size" (analyse-text-size analyse exo-type ?values) "lux text char" (analyse-text-char analyse exo-type ?values) - "lux array new" (analyse-array-new analyse exo-type ?values) - "lux array get" (analyse-array-get analyse exo-type ?values) - "lux array put" (analyse-array-put analyse exo-type ?values) - "lux array remove" (analyse-array-remove analyse exo-type ?values) - "lux array size" (analyse-array-size 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) diff --git a/luxc/src/lux/compiler/jvm/proc/common.clj b/luxc/src/lux/compiler/jvm/proc/common.clj index 6e89155bc..3f10bade1 100644 --- a/luxc/src/lux/compiler/jvm/proc/common.clj +++ b/luxc/src/lux/compiler/jvm/proc/common.clj @@ -22,96 +22,6 @@ AnnotationVisitor))) ;; [Resources] -(defn ^:private compile-array-new [compile ?values special-args] - (|do [:let [(&/$Cons ?length (&/$Nil)) ?values] - ^MethodVisitor *writer* &/get-writer - _ (compile ?length) - :let [_ (doto *writer* - &&/unwrap-long - (.visitInsn Opcodes/L2I))] - :let [_ (.visitTypeInsn *writer* Opcodes/ANEWARRAY "java/lang/Object")]] - (return nil))) - -(defn ^:private compile-array-get [compile ?values special-args] - (|do [:let [(&/$Cons ?array (&/$Cons ?idx (&/$Nil))) ?values - ;; (&/$Nil) special-args - ] - ^MethodVisitor *writer* &/get-writer - _ (compile ?array) - :let [_ (.visitTypeInsn *writer* Opcodes/CHECKCAST "[Ljava/lang/Object;")] - _ (compile ?idx) - :let [_ (doto *writer* - &&/unwrap-long - (.visitInsn Opcodes/L2I))] - :let [_ (.visitInsn *writer* Opcodes/AALOAD)] - :let [$is-null (new Label) - $end (new Label) - _ (doto *writer* - (.visitInsn Opcodes/DUP) - (.visitJumpInsn Opcodes/IFNULL $is-null) - (.visitLdcInsn (int 1)) - (.visitLdcInsn "") - (.visitInsn Opcodes/DUP2_X1) ;; I?2I? - (.visitInsn Opcodes/POP2) ;; I?2 - (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "sum_make" "(ILjava/lang/Object;Ljava/lang/Object;)[Ljava/lang/Object;") - (.visitJumpInsn Opcodes/GOTO $end) - (.visitLabel $is-null) - (.visitInsn Opcodes/POP) - (.visitLdcInsn (int 0)) - (.visitInsn Opcodes/ACONST_NULL) - (.visitLdcInsn &/unit-tag) - (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "sum_make" "(ILjava/lang/Object;Ljava/lang/Object;)[Ljava/lang/Object;") - (.visitLabel $end))]] - (return nil))) - -(defn ^:private compile-array-put [compile ?values special-args] - (|do [:let [(&/$Cons ?array (&/$Cons ?idx (&/$Cons ?elem (&/$Nil)))) ?values - ;; (&/$Nil) special-args - ] - ^MethodVisitor *writer* &/get-writer - _ (compile ?array) - :let [_ (doto *writer* - (.visitTypeInsn Opcodes/CHECKCAST "[Ljava/lang/Object;") - (.visitInsn Opcodes/DUP))] - _ (compile ?idx) - :let [_ (doto *writer* - &&/unwrap-long - (.visitInsn Opcodes/L2I))] - _ (compile ?elem) - :let [_ (.visitInsn *writer* Opcodes/AASTORE)]] - (return nil))) - -(defn ^:private compile-array-remove [compile ?values special-args] - (|do [:let [(&/$Cons ?array (&/$Cons ?idx (&/$Nil))) ?values - ;; (&/$Nil) special-args - ] - ^MethodVisitor *writer* &/get-writer - _ (compile ?array) - :let [_ (doto *writer* - (.visitTypeInsn Opcodes/CHECKCAST "[Ljava/lang/Object;") - (.visitInsn Opcodes/DUP))] - _ (compile ?idx) - :let [_ (doto *writer* - &&/unwrap-long - (.visitInsn Opcodes/L2I))] - :let [_ (doto *writer* - (.visitInsn Opcodes/ACONST_NULL) - (.visitInsn Opcodes/AASTORE))]] - (return nil))) - -(defn ^:private compile-array-size [compile ?values special-args] - (|do [:let [(&/$Cons ?array (&/$Nil)) ?values - ;; (&/$Nil) special-args - ] - ^MethodVisitor *writer* &/get-writer - _ (compile ?array) - :let [_ (.visitTypeInsn *writer* Opcodes/CHECKCAST "[Ljava/lang/Object;")] - :let [_ (doto *writer* - (.visitInsn Opcodes/ARRAYLENGTH) - (.visitInsn Opcodes/I2L) - &&/wrap-long)]] - (return nil))) - (do-template [ ] (defn [compile ?values special-args] (|do [:let [(&/$Cons ?input (&/$Cons ?mask (&/$Nil))) ?values] @@ -543,14 +453,6 @@ "+" (compile-i64-add compile ?values special-args) "-" (compile-i64-sub compile ?values special-args)) - "array" - (case proc - "new" (compile-array-new compile ?values special-args) - "get" (compile-array-get compile ?values special-args) - "put" (compile-array-put compile ?values special-args) - "remove" (compile-array-remove compile ?values special-args) - "size" (compile-array-size compile ?values special-args)) - "int" (case proc "*" (compile-int-mul compile ?values special-args) diff --git a/new-luxc/source/luxc/lang/translation/common-lisp/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/common-lisp/procedure/common.jvm.lux index 54a4336fb..91a95d2f9 100644 --- a/new-luxc/source/luxc/lang/translation/common-lisp/procedure/common.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/common-lisp/procedure/common.jvm.lux @@ -177,34 +177,6 @@ (install "arithmetic-right-shift" (binary bit//arithmetic-right-shift)) ))) -## [[Arrays]] -(def: (array//new size0) - Unary - (_.make-array/init size0 _.nil)) - -(def: (array//get [arrayO idxO]) - Binary - (runtimeT.array//get arrayO idxO)) - -(def: (array//put [arrayO idxO elemO]) - Trinary - (runtimeT.array//put arrayO idxO elemO)) - -(def: (array//remove [arrayO idxO]) - Binary - (runtimeT.array//put arrayO idxO _.nil)) - -(def: array-procs - Bundle - (<| (prefix "array") - (|> (dict.new text.Hash) - (install "new" (unary array//new)) - (install "get" (binary array//get)) - (install "put" (trinary array//put)) - (install "remove" (binary array//remove)) - (install "size" (unary _.length)) - ))) - ## [[Numbers]] (host.import: java/lang/Double (#static MIN_VALUE Double) @@ -359,7 +331,6 @@ (dict.merge int-procs) (dict.merge frac-procs) (dict.merge text-procs) - (dict.merge array-procs) (dict.merge io-procs) (dict.merge box-procs) ))) diff --git a/new-luxc/source/luxc/lang/translation/js/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/js/procedure/common.jvm.lux index df1be8508..0efdedd4c 100644 --- a/new-luxc/source/luxc/lang/translation/js/procedure/common.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/js/procedure/common.jvm.lux @@ -164,27 +164,6 @@ [bit//logical-right-shift runtimeT.bit//logical-right-shift] ) -## [[Arrays]] -(def: (array//new sizeJS) - Unary - (self-contained (format "new Array(" runtimeT.int//to-number "(" sizeJS ")" ")"))) - -(def: (array//get [arrayJS idxJS]) - Binary - (format runtimeT.array//get "(" arrayJS "," idxJS ")")) - -(def: (array//put [arrayJS idxJS elemJS]) - Trinary - (format runtimeT.array//put "(" arrayJS "," idxJS "," elemJS ")")) - -(def: (array//remove [arrayJS idxJS]) - Binary - (format runtimeT.array//remove "(" arrayJS "," idxJS ")")) - -(def: (array//size arrayJS) - Unary - (format arrayJS ".length")) - ## [[Numbers]] (host.import: java/lang/Double (#static MIN_VALUE Double) @@ -388,17 +367,6 @@ (install "clip" (trinary text//clip)) ))) -(def: array-procs - Bundle - (<| (prefix "array") - (|> (dict.new text.Hash) - (install "new" (unary array//new)) - (install "get" (binary array//get)) - (install "put" (trinary array//put)) - (install "remove" (binary array//remove)) - (install "size" (unary array//size)) - ))) - (def: io-procs Bundle (<| (prefix "io") @@ -424,7 +392,6 @@ (dict.merge int-procs) (dict.merge frac-procs) (dict.merge text-procs) - (dict.merge array-procs) (dict.merge io-procs) (dict.merge box-procs) ))) diff --git a/new-luxc/source/luxc/lang/translation/js/runtime.jvm.lux b/new-luxc/source/luxc/lang/translation/js/runtime.jvm.lux index d5abbc150..af47bffce 100644 --- a/new-luxc/source/luxc/lang/translation/js/runtime.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/js/runtime.jvm.lux @@ -597,35 +597,6 @@ __text//clip __text//char)) -(runtime: array//get "arrayGet" - (format "(function " @ "(arr,idx) {" - "var temp = arr[" int//to-number "(idx)];" - (format "if(temp !== undefined) {" - (format "return " (some "temp") ";") - "}" - "else {" - (format "return " none ";") - "}") - "})")) - -(runtime: array//put "arrayPut" - (format "(function " @ "(arr,idx,val) {" - "arr[" int//to-number "(idx)] = val;" - "return arr;" - "})")) - -(runtime: array//remove "arrayRemove" - (format "(function " @ "(arr,idx) {" - "delete arr[" int//to-number "(idx)];" - "return arr;" - "})")) - -(def: runtime//array - Runtime - (format __array//get - __array//put - __array//remove)) - (runtime: io//log "log" (format "(function " @ "(message) {" "if(typeof console !== \"undefined\" && console.log) { console.log(message); }" @@ -685,7 +656,6 @@ runtime//bit runtime//int runtime//text - runtime//array runtime//io runtime//js)) diff --git a/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux index 49b1971f1..2c470c44c 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux @@ -113,15 +113,6 @@ (def: lux-intI $.Inst (|>> _.I2L (_.wrap #$.Long))) (def: jvm-intI $.Inst (|>> (_.unwrap #$.Long) _.L2I)) -(def: (array-writeI arrayI idxI elemI) - (-> $.Inst $.Inst $.Inst - $.Inst) - (|>> arrayI (_.CHECKCAST ($t.descriptor $Object-Array)) - _.DUP - idxI jvm-intI - elemI - _.AASTORE)) - (def: (predicateI tester) (-> (-> $.Label $.Inst) $.Inst) @@ -209,41 +200,6 @@ [bit//logical-right-shift _.LUSHR] ) -## [[Arrays]] -(def: (array//new lengthI) - Unary - (|>> lengthI jvm-intI (_.ANEWARRAY ($t.binary-name "java.lang.Object")))) - -(def: (array//get [arrayI idxI]) - Binary - (<| _.with-label (function (_ @is-null)) - _.with-label (function (_ @end)) - (|>> arrayI (_.CHECKCAST ($t.descriptor $Object-Array)) - idxI jvm-intI - _.AALOAD - _.DUP - (_.IFNULL @is-null) - runtimeT.someI - (_.GOTO @end) - (_.label @is-null) - _.POP - runtimeT.noneI - (_.label @end)))) - -(def: (array//put [arrayI idxI elemI]) - Trinary - (array-writeI arrayI idxI elemI)) - -(def: (array//remove [arrayI idxI]) - Binary - (array-writeI arrayI idxI _.NULL)) - -(def: (array//size arrayI) - Unary - (|>> arrayI (_.CHECKCAST ($t.descriptor $Object-Array)) - _.ARRAYLENGTH - lux-intI)) - ## [[Numbers]] (def: nat-method $.Method @@ -501,17 +457,6 @@ (install "clip" (trinary text//clip)) ))) -(def: array-procs - Bundle - (<| (prefix "array") - (|> (dict.new text.Hash) - (install "new" (unary array//new)) - (install "get" (binary array//get)) - (install "put" (trinary array//put)) - (install "remove" (binary array//remove)) - (install "size" (unary array//size)) - ))) - (def: io-procs Bundle (<| (prefix "io") @@ -537,7 +482,6 @@ (dict.merge int-procs) (dict.merge frac-procs) (dict.merge text-procs) - (dict.merge array-procs) (dict.merge io-procs) (dict.merge box-procs) ))) diff --git a/new-luxc/source/luxc/lang/translation/lua/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/lua/procedure/common.jvm.lux index 4b128f946..394dd3d34 100644 --- a/new-luxc/source/luxc/lang/translation/lua/procedure/common.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/lua/procedure/common.jvm.lux @@ -155,27 +155,6 @@ [bit//logical-right-shift runtimeT.bit//logical-right-shift] ) -## [[Arrays]] -(def: (array//new sizeO) - Unary - (runtimeT.array//new sizeO)) - -(def: (array//get [arrayO idxO]) - Binary - (runtimeT.array//get arrayO idxO)) - -(def: (array//put [arrayO idxO elemO]) - Trinary - (runtimeT.array//put arrayO idxO elemO)) - -(def: (array//remove [arrayO idxO]) - Binary - (runtimeT.array//put arrayO idxO runtimeT.unit)) - -(def: array//size - Unary - lua.length) - ## [[Numbers]] (host.import: java/lang/Double (#static MIN_VALUE Double) @@ -387,17 +366,6 @@ (install "clip" (trinary text//clip)) ))) -(def: array-procs - Bundle - (<| (prefix "array") - (|> (dict.new text.Hash) - (install "new" (unary array//new)) - (install "get" (binary array//get)) - (install "put" (trinary array//put)) - (install "remove" (binary array//remove)) - (install "size" (unary array//size)) - ))) - (def: io-procs Bundle (<| (prefix "io") @@ -423,7 +391,6 @@ (dict.merge int-procs) (dict.merge frac-procs) (dict.merge text-procs) - (dict.merge array-procs) (dict.merge io-procs) (dict.merge box-procs) ))) diff --git a/new-luxc/source/luxc/lang/translation/php/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/php/procedure/common.jvm.lux index 774c28acf..f77a35292 100644 --- a/new-luxc/source/luxc/lang/translation/php/procedure/common.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/php/procedure/common.jvm.lux @@ -182,36 +182,6 @@ ## (install "arithmetic-right-shift" (binary bit//arithmetic-right-shift)) ## ))) -## ## [[Arrays]] -## (def: (array//new sizeO) -## Unary -## (|> _.none -## list _.list -## (_.* sizeO))) - -## (def: (array//get [arrayO idxO]) -## Binary -## (runtimeT.array//get arrayO idxO)) - -## (def: (array//put [arrayO idxO elemO]) -## Trinary -## (runtimeT.array//put arrayO idxO elemO)) - -## (def: (array//remove [arrayO idxO]) -## Binary -## (runtimeT.array//put arrayO idxO _.none)) - -## (def: array-procs -## Bundle -## (<| (prefix "array") -## (|> (dict.new text.Hash) -## (install "new" (unary array//new)) -## (install "get" (binary array//get)) -## (install "put" (trinary array//put)) -## (install "remove" (binary array//remove)) -## (install "size" (unary _.length)) -## ))) - ## ## [[Numbers]] ## (host.import: java/lang/Double ## (#static MIN_VALUE Double) @@ -348,6 +318,5 @@ (dict.merge int-procs) ## (dict.merge frac-procs) ## (dict.merge text-procs) - ## (dict.merge array-procs) ## (dict.merge io-procs) ))) diff --git a/new-luxc/source/luxc/lang/translation/python/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/python/procedure/common.jvm.lux index a760dc3a2..430d4b5e7 100644 --- a/new-luxc/source/luxc/lang/translation/python/procedure/common.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/python/procedure/common.jvm.lux @@ -182,36 +182,6 @@ (install "arithmetic-right-shift" (binary bit//arithmetic-right-shift)) ))) -## [[Arrays]] -(def: (array//new sizeO) - Unary - (|> python.none - list python.list - (python.* sizeO))) - -(def: (array//get [arrayO idxO]) - Binary - (runtimeT.array//get arrayO idxO)) - -(def: (array//put [arrayO idxO elemO]) - Trinary - (runtimeT.array//put arrayO idxO elemO)) - -(def: (array//remove [arrayO idxO]) - Binary - (runtimeT.array//put arrayO idxO python.none)) - -(def: array-procs - Bundle - (<| (prefix "array") - (|> (dict.new text.Hash) - (install "new" (unary array//new)) - (install "get" (binary array//get)) - (install "put" (trinary array//put)) - (install "remove" (binary array//remove)) - (install "size" (unary python.length)) - ))) - ## [[Numbers]] (host.import: java/lang/Double (#static MIN_VALUE Double) @@ -388,7 +358,6 @@ (dict.merge int-procs) (dict.merge frac-procs) (dict.merge text-procs) - (dict.merge array-procs) (dict.merge io-procs) (dict.merge box-procs) ))) diff --git a/new-luxc/source/luxc/lang/translation/r/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/r/procedure/common.jvm.lux index d8b383ff2..421618890 100644 --- a/new-luxc/source/luxc/lang/translation/r/procedure/common.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/r/procedure/common.jvm.lux @@ -179,30 +179,6 @@ (install "arithmetic-right-shift" (binary bit//arithmetic-right-shift)) ))) -## [[Arrays]] -(def: (array//get [arrayO idxO]) - Binary - (runtimeT.array//get arrayO idxO)) - -(def: (array//put [arrayO idxO elemO]) - Trinary - (runtimeT.array//put arrayO idxO elemO)) - -(def: (array//remove [arrayO idxO]) - Binary - (runtimeT.array//put arrayO idxO r.null)) - -(def: array-procs - Bundle - (<| (prefix "array") - (|> (dict.new text.Hash) - (install "new" (unary runtimeT.array//new)) - (install "get" (binary array//get)) - (install "put" (trinary array//put)) - (install "remove" (binary array//remove)) - (install "size" (unary r.length)) - ))) - ## [[Numbers]] (host.import: java/lang/Double (#static MIN_VALUE Double) @@ -380,7 +356,6 @@ (dict.merge int-procs) (dict.merge frac-procs) (dict.merge text-procs) - (dict.merge array-procs) (dict.merge io-procs) (dict.merge box-procs) ))) diff --git a/new-luxc/source/luxc/lang/translation/ruby/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/ruby/procedure/common.jvm.lux index 1f995b44b..e40f49b80 100644 --- a/new-luxc/source/luxc/lang/translation/ruby/procedure/common.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/ruby/procedure/common.jvm.lux @@ -181,38 +181,6 @@ (install "arithmetic-right-shift" (binary bit//arithmetic-right-shift)) ))) -## [[Arrays]] -(def: (array//new sizeO) - Unary - (ruby.apply "Array.new" (list sizeO))) - -(def: (array//get [arrayO idxO]) - Binary - (runtimeT.array//get arrayO idxO)) - -(def: (array//put [arrayO idxO elemO]) - Trinary - (runtimeT.array//put arrayO idxO elemO)) - -(def: (array//remove [arrayO idxO]) - Binary - (runtimeT.array//put arrayO idxO ruby.nil)) - -(def: array//size - Unary - ruby.length) - -(def: array-procs - Bundle - (<| (prefix "array") - (|> (dict.new text.Hash) - (install "new" (unary array//new)) - (install "get" (binary array//get)) - (install "put" (trinary array//put)) - (install "remove" (binary array//remove)) - (install "size" (unary array//size)) - ))) - ## [[Numbers]] (host.import: java/lang/Double (#static MIN_VALUE Double) @@ -421,7 +389,6 @@ (dict.merge int-procs) (dict.merge frac-procs) (dict.merge text-procs) - (dict.merge array-procs) (dict.merge io-procs) (dict.merge box-procs) ))) diff --git a/new-luxc/test/test/luxc/lang/translation/common.lux b/new-luxc/test/test/luxc/lang/translation/common.lux index 7fe49fae2..03e56fa18 100644 --- a/new-luxc/test/test/luxc/lang/translation/common.lux +++ b/new-luxc/test/test/luxc/lang/translation/common.lux @@ -274,59 +274,6 @@ #0))) ))) -(def: (array-spec run) - (-> Runner Test) - (do r.Monad - [size (|> r.nat (:: @ map (|>> (n/% 10) (n/max 1)))) - idx (|> r.nat (:: @ map (n/% size))) - value r.nat - #let [array0S (#synthesis.Extension "lux array new" - (list (synthesis.i64 size))) - array1S (#synthesis.Extension "lux array put" - (list array0S - (synthesis.i64 idx) - (synthesis.i64 value)))]] - ($_ seq - (test "Can get size of array." - (|> (run (#synthesis.Extension "lux array size" - (list array0S))) - (case> (#e.Success valueV) - (n/= size (:coerce Nat valueV)) - - (#e.Error error) - (exec (log! error) - #0)))) - (test "Can get element from array (if it exists)." - (and (|> (run (#synthesis.Extension "lux array get" - (list array0S (synthesis.i64 idx)))) - (case> (^multi (#e.Success valueV) - [(:coerce (Maybe Nat) valueV) #.None]) - #1 - - _ - #0)) - (|> (run (#synthesis.Extension "lux array get" - (list array1S (synthesis.i64 idx)))) - (case> (^multi (#e.Success valueV) - [(:coerce (Maybe Nat) valueV) (#.Some valueV)]) - (n/= value valueV) - - _ - #0)))) - (test "Can remove element from array." - (|> (run (#synthesis.Extension "lux array get" - (list (#synthesis.Extension "lux array remove" - (list array1S - (synthesis.i64 idx))) - (synthesis.i64 idx)))) - (case> (^multi (#e.Success valueV) - [(:coerce (Maybe Nat) valueV) #.None]) - #1 - - _ - #0))) - ))) - (def: (io-spec run) (-> Runner Test) (do r.Monad @@ -421,7 +368,6 @@ (i64-spec run) (f64-spec run) (text-spec run) - (array-spec run) (io-spec run) (box-spec run) )) diff --git a/stdlib/source/lux/compiler/default/phase/extension/analysis/common.lux b/stdlib/source/lux/compiler/default/phase/extension/analysis/common.lux index 3272f8a29..24f22df3c 100644 --- a/stdlib/source/lux/compiler/default/phase/extension/analysis/common.lux +++ b/stdlib/source/lux/compiler/default/phase/extension/analysis/common.lux @@ -9,7 +9,6 @@ format] [collection ["." list ("list/." Functor)] - ["." array] ["dict" dictionary (#+ Dictionary)]]] [type ["." check]] @@ -203,41 +202,6 @@ (bundle.install "clip" (trinary Text Nat Nat (type (Maybe Text)))) ))) -(def: array::get - Handler - (function (_ extension-name analyse args) - (do ////.Monad - [[var-id varT] (typeA.with-env check.var)] - ((binary (type (Array varT)) Nat (type (Maybe varT)) extension-name) - analyse args)))) - -(def: array::put - Handler - (function (_ extension-name analyse args) - (do ////.Monad - [[var-id varT] (typeA.with-env check.var)] - ((trinary (type (Array varT)) Nat varT (type (Array varT)) extension-name) - analyse args)))) - -(def: array::remove - Handler - (function (_ extension-name analyse args) - (do ////.Monad - [[var-id varT] (typeA.with-env check.var)] - ((binary (type (Array varT)) Nat (type (Array varT)) extension-name) - analyse args)))) - -(def: bundle::array - Bundle - (<| (bundle.prefix "array") - (|> bundle.empty - (bundle.install "new" (unary Nat Array)) - (bundle.install "get" array::get) - (bundle.install "put" array::put) - (bundle.install "remove" array::remove) - (bundle.install "size" (unary (type (Ex [a] (Array a))) Nat)) - ))) - (def: box::new Handler (function (_ extension-name analyse args) @@ -289,7 +253,6 @@ (dict.merge bundle::int) (dict.merge bundle::frac) (dict.merge bundle::text) - (dict.merge bundle::array) (dict.merge bundle::box) (dict.merge bundle::io) ))) diff --git a/stdlib/source/lux/compiler/default/phase/translation/scheme/extension/common.jvm.lux b/stdlib/source/lux/compiler/default/phase/translation/scheme/extension/common.jvm.lux index d1576248d..c46a5e82e 100644 --- a/stdlib/source/lux/compiler/default/phase/translation/scheme/extension/common.jvm.lux +++ b/stdlib/source/lux/compiler/default/phase/translation/scheme/extension/common.jvm.lux @@ -115,34 +115,6 @@ (bundle.install "arithmetic-right-shift" (binary bit::arithmetic-right-shift)) ))) -## [[Arrays]] -(def: (array::new size0) - Unary - (_.make-vector/2 size0 _.nil)) - -(def: (array::get [arrayO idxO]) - Binary - (runtime.array//get arrayO idxO)) - -(def: (array::put [arrayO idxO elemO]) - Trinary - (runtime.array//put arrayO idxO elemO)) - -(def: (array::remove [arrayO idxO]) - Binary - (runtime.array//put arrayO idxO _.nil)) - -(def: bundle::array - Bundle - (<| (bundle.prefix "array") - (|> bundle.empty - (bundle.install "new" (unary array::new)) - (bundle.install "get" (binary array::get)) - (bundle.install "put" (trinary array::put)) - (bundle.install "remove" (binary array::remove)) - (bundle.install "size" (unary _.vector-length/1)) - ))) - ## [[Numbers]] (import: java/lang/Double (#static MIN_VALUE Double) @@ -299,7 +271,6 @@ (dict.merge bundle::int) (dict.merge bundle::frac) (dict.merge bundle::text) - (dict.merge bundle::array) (dict.merge bundle::io) (dict.merge bundle::box) ))) diff --git a/stdlib/source/lux/data/collection/array.lux b/stdlib/source/lux/data/collection/array.lux index 1d64511a9..09fe50412 100644 --- a/stdlib/source/lux/data/collection/array.lux +++ b/stdlib/source/lux/data/collection/array.lux @@ -7,32 +7,46 @@ fold [predicate (#+ Predicate)]] [data + ["." product] [collection - ["." list ("list/." Fold)]] - ["." product]]]) + ["." list ("list/." Fold)]]] + [compiler + ["." host]]]) (def: #export (new size) (All [a] (-> Nat (Array a))) - ("lux array new" size)) + (`` (for {(~~ (static host.jvm)) + (:assume ("jvm anewarray" "(java.lang.Object )" size))}))) (def: #export (size xs) (All [a] (-> (Array a) Nat)) - ("lux array size" xs)) + (`` (for {(~~ (static host.jvm)) + ("jvm arraylength" xs)}))) (def: #export (read i xs) (All [a] (-> Nat (Array a) (Maybe a))) - ("lux array get" xs i)) + (if (n/< (size xs) i) + (`` (for {(~~ (static host.jvm)) + (let [value ("jvm aaload" xs i)] + (if ("jvm object null?" value) + #.None + (#.Some value)))})) + #.None)) (def: #export (write i x xs) (All [a] (-> Nat a (Array a) (Array a))) - ("lux array put" xs i x)) + (`` (for {(~~ (static host.jvm)) + ("jvm aastore" xs i x)}))) (def: #export (delete i xs) (All [a] (-> Nat (Array a) (Array a))) - ("lux array remove" xs i)) + (if (n/< (size xs) i) + (`` (for {(~~ (static host.jvm)) + (write i (:assume ("jvm object null")) xs)})) + xs)) (def: #export (copy length src-start src-array dest-start dest-array) (All [a] diff --git a/stdlib/source/lux/data/number.lux b/stdlib/source/lux/data/number.lux index 583a03b1f..2fc52ae41 100644 --- a/stdlib/source/lux/data/number.lux +++ b/stdlib/source/lux/data/number.lux @@ -12,7 +12,9 @@ [data ["." error (#+ Error)] ["." maybe] - ["." text]] + ["." text] + [collection + ["." array]]] ["." math]] [/ ["." i64]]) @@ -750,15 +752,15 @@ (def: (make-digits _) (-> Any Digits) - ("lux array new" i64.width)) + (array.new i64.width)) (def: (digits-get idx digits) (-> Nat Digits Nat) - (maybe.default 0 ("lux array get" digits idx))) + (|> digits (array.read idx) (maybe.default 0))) -(def: (digits-put idx digit digits) +(def: digits-put (-> Nat Nat Digits Digits) - ("lux array put" digits idx digit)) + array.write) (def: (prepend left right) (-> Text Text Text) diff --git a/stdlib/test/test/lux/compiler/default/phase/analysis/procedure/common.lux b/stdlib/test/test/lux/compiler/default/phase/analysis/procedure/common.lux index 9d733912e..20eeaf2eb 100644 --- a/stdlib/test/test/lux/compiler/default/phase/analysis/procedure/common.lux +++ b/stdlib/test/test/lux/compiler/default/phase/analysis/procedure/common.lux @@ -170,81 +170,6 @@ (check-success+ "lux text clip" (list subjectC fromC toC) (type (Maybe Text)))) )))) -(context: "Array procedures" - (<| (times 100) - (do @ - [[elemT elemC] _primitive.primitive - sizeC (|> r.nat (:: @ map code.nat)) - idxC (|> r.nat (:: @ map code.nat)) - var-name (r.unicode 5) - #let [arrayT (type (Array elemT)) - g!array (code.local-identifier var-name) - array-operation (function (_ output-type code) - (|> (scope.with-scope "" - (scope.with-local [var-name arrayT] - (typeA.with-type output-type - (_primitive.analyse code)))) - (phase.run [analysisE.bundle (init.compiler [])]) - (case> (#e.Success _) - #1 - - (#e.Error error) - #0)))]] - ($_ seq - (test "Can create arrays." - (check-success+ "lux array new" (list sizeC) arrayT)) - (test "Can get a value inside an array." - (array-operation (type (Maybe elemT)) - (` ("lux array get" (~ g!array) (~ idxC))))) - (test "Can put a value inside an array." - (array-operation arrayT - (` ("lux array put" (~ g!array) (~ idxC) (~ elemC))))) - (test "Can remove a value from an array." - (array-operation arrayT - (` ("lux array remove" (~ g!array) (~ idxC))))) - (test "Can query the size of an array." - (array-operation Nat - (` ("lux array size" (~ g!array))))) - )))) - -(context: "Atom procedures" - (<| (times 100) - (do @ - [[elemT elemC] _primitive.primitive - sizeC (|> r.nat (:: @ map code.nat)) - idxC (|> r.nat (:: @ map code.nat)) - var-name (r.unicode 5) - #let [atomT (type (atom.Atom elemT))]] - ($_ seq - (test "Can create atomic reference." - (check-success+ "lux atom new" (list elemC) atomT)) - (test "Can read the value of an atomic reference." - (|> (scope.with-scope "" - (scope.with-local [var-name atomT] - (typeA.with-type elemT - (_primitive.analyse (` ("lux atom read" (~ (code.identifier ["" var-name])))))))) - (phase.run [analysisE.bundle (init.compiler [])]) - (case> (#e.Success _) - #1 - - (#e.Error _) - #0))) - (test "Can swap the value of an atomic reference." - (|> (scope.with-scope "" - (scope.with-local [var-name atomT] - (typeA.with-type Bit - (_primitive.analyse (` ("lux atom compare-and-swap" - (~ (code.identifier ["" var-name])) - (~ elemC) - (~ elemC))))))) - (phase.run [analysisE.bundle (init.compiler [])]) - (case> (#e.Success _) - #1 - - (#e.Error _) - #0))) - )))) - (context: "IO procedures" (<| (times 100) (do @ -- cgit v1.2.3