From cc16e4ba982a9a2b228c7b40d927f539c9e1a5c8 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Thu, 4 Apr 2019 18:30:46 -0400 Subject: Changed the order of the inputs to the common extensions. --- luxc/src/lux/analyser/proc/common.clj | 75 ++++---- stdlib/source/lux.lux | 194 ++++++++++----------- stdlib/source/lux/data/number.lux | 2 +- stdlib/source/lux/data/number/frac.lux | 28 ++- stdlib/source/lux/data/number/i64.lux | 31 ++-- stdlib/source/lux/data/number/rev.lux | 6 +- stdlib/source/lux/data/text.lux | 44 ++--- stdlib/source/lux/tool/compiler/default/syntax.lux | 14 +- stdlib/source/lux/type/check.lux | 50 +++--- .../default/phase/analysis/procedure/common.lux | 36 ++-- 10 files changed, 229 insertions(+), 251 deletions(-) diff --git a/luxc/src/lux/analyser/proc/common.clj b/luxc/src/lux/analyser/proc/common.clj index fbdf05546..8f51521d8 100644 --- a/luxc/src/lux/analyser/proc/common.clj +++ b/luxc/src/lux/analyser/proc/common.clj @@ -9,13 +9,13 @@ (defn- analyse-lux-is [analyse exo-type ?values] (&type/with-var (fn [$var] - (|do [:let [(&/$Cons left (&/$Cons right (&/$Nil))) ?values] - =left (&&/analyse-1 analyse $var left) - =right (&&/analyse-1 analyse $var right) + (|do [:let [(&/$Cons reference (&/$Cons sample (&/$Nil))) ?values] + =reference (&&/analyse-1 analyse $var reference) + =sample (&&/analyse-1 analyse $var sample) _ (&type/check exo-type &type/Bit) _cursor &/cursor] (return (&/|list (&&/|meta exo-type _cursor - (&&/$proc (&/T ["lux" "is"]) (&/|list =left =right) (&/|list))))))))) + (&&/$proc (&/T ["lux" "is"]) (&/|list =sample =reference) (&/|list))))))))) (defn- analyse-lux-try [analyse exo-type ?values] (&type/with-var @@ -31,40 +31,44 @@ (do-template [ ] (defn- [analyse exo-type ?values] - (|do [:let [(&/$Cons x (&/$Cons y (&/$Nil))) ?values] - =x (&&/analyse-1 analyse x) - =y (&&/analyse-1 analyse y) + (|do [:let [(&/$Cons reference (&/$Cons sample (&/$Nil))) ?values] + =reference (&&/analyse-1 analyse reference) + =sample (&&/analyse-1 analyse sample) _ (&type/check exo-type ) _cursor &/cursor] (return (&/|list (&&/|meta exo-type _cursor - (&&/$proc (&/T ) (&/|list =x =y) (&/|list))))))) + (&&/$proc (&/T ) (&/|list =sample =reference) (&/|list))))))) analyse-text-eq ["text" "="] &type/Text &type/Bit analyse-text-lt ["text" "<"] &type/Text &type/Bit - analyse-text-concat ["text" "concat"] &type/Text &type/Text ) -(do-template [ ] - (defn- [analyse exo-type ?values] - (|do [:let [(&/$Cons text (&/$Cons part (&/$Cons start (&/$Nil)))) ?values] - =text (&&/analyse-1 analyse &type/Text text) - =part (&&/analyse-1 analyse &type/Text part) - =start (&&/analyse-1 analyse &type/Nat start) - _ (&type/check exo-type ) - _cursor &/cursor] - (return (&/|list (&&/|meta exo-type _cursor - (&&/$proc (&/T ["text" ]) - (&/|list =text =part =start) - (&/|list))))))) +(defn- analyse-text-concat [analyse exo-type ?values] + (|do [:let [(&/$Cons parameter (&/$Cons subject (&/$Nil))) ?values] + =parameter (&&/analyse-1 analyse &type/Text parameter) + =subject (&&/analyse-1 analyse &type/Text subject) + _ (&type/check exo-type &type/Text) + _cursor &/cursor] + (return (&/|list (&&/|meta exo-type _cursor + (&&/$proc (&/T ["text" "concat"]) (&/|list =parameter =subject) (&/|list))))))) - analyse-text-index "index" (&/$Apply &type/Nat &type/Maybe) - ) +(defn- analyse-text-index [analyse exo-type ?values] + (|do [:let [(&/$Cons start (&/$Cons part (&/$Cons text (&/$Nil)))) ?values] + =start (&&/analyse-1 analyse &type/Nat start) + =part (&&/analyse-1 analyse &type/Text part) + =text (&&/analyse-1 analyse &type/Text text) + _ (&type/check exo-type (&/$Apply &type/Nat &type/Maybe)) + _cursor &/cursor] + (return (&/|list (&&/|meta exo-type _cursor + (&&/$proc (&/T ["text" "index"]) + (&/|list =text =part =start) + (&/|list))))))) (defn- analyse-text-clip [analyse exo-type ?values] - (|do [:let [(&/$Cons text (&/$Cons from (&/$Cons to (&/$Nil)))) ?values] - =text (&&/analyse-1 analyse &type/Text text) + (|do [:let [(&/$Cons from (&/$Cons to (&/$Cons text (&/$Nil)))) ?values] =from (&&/analyse-1 analyse &type/Nat from) =to (&&/analyse-1 analyse &type/Nat to) + =text (&&/analyse-1 analyse &type/Text text) _ (&type/check exo-type &type/Text) _cursor &/cursor] (return (&/|list (&&/|meta exo-type _cursor @@ -135,31 +139,18 @@ (let [inputT outputT ] (defn- [analyse exo-type ?values] - (|do [:let [(&/$Cons subjectC (&/$Cons paramC (&/$Nil))) ?values] + (|do [:let [(&/$Cons parameterC (&/$Cons subjectC (&/$Nil))) ?values] + parameterA (&&/analyse-1 analyse parameterC) subjectA (&&/analyse-1 analyse subjectC) - paramA (&&/analyse-1 analyse paramC) _ (&type/check exo-type ) _cursor &/cursor] (return (&/|list (&&/|meta exo-type _cursor - (&&/$proc (&/T ) (&/|list subjectA paramA) (&/|list)))))))) + (&&/$proc (&/T ) (&/|list subjectA parameterA) (&/|list)))))))) analyse-i64-eq ["i64" "="] (&/$Apply &type/Any &type/I64) &type/Bit analyse-i64-add ["i64" "+"] (&/$Apply &type/Any &type/I64) &type/I64 analyse-i64-sub ["i64" "-"] (&/$Apply &type/Any &type/I64) &type/I64 - ) - -(do-template [ ] - (let [inputT - outputT ] - (defn- [analyse exo-type ?values] - (|do [:let [(&/$Cons x (&/$Cons y (&/$Nil))) ?values] - =x (&&/analyse-1 analyse x) - =y (&&/analyse-1 analyse y) - _ (&type/check exo-type ) - _cursor &/cursor] - (return (&/|list (&&/|meta exo-type _cursor - (&&/$proc (&/T ) (&/|list =x =y) (&/|list)))))))) - + analyse-int-mul ["int" "*"] &type/Int &type/Int analyse-int-div ["int" "/"] &type/Int &type/Int analyse-int-rem ["int" "%"] &type/Int &type/Int diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux index 2c550ebd9..412169967 100644 --- a/stdlib/source/lux.lux +++ b/stdlib/source/lux.lux @@ -1086,10 +1086,10 @@ #Nil} [xs ys])) -(def:'' (text@= x y) +(def:'' (text@= reference sample) #Nil (#Function Text (#Function Text Bit)) - ("lux text =" x y)) + ("lux text =" reference sample)) (def:'' (get-rep key env) #Nil @@ -1140,14 +1140,14 @@ (#.Cons export-meta #.Nil)) (#Function Nat (#Function Nat Nat)) - ("lux i64 +" param subject)) + ("lux i64 +" subject param)) (def:'' (n/- param subject) (#.Cons (doc-meta "Nat(ural) substraction.") (#.Cons export-meta #.Nil)) (#Function Nat (#Function Nat Nat)) - ("lux i64 -" subject param)) + ("lux i64 -" param subject)) (def:'' (n/* param subject) (#.Cons (doc-meta "Nat(ural) multiplication.") @@ -1156,8 +1156,8 @@ (#Function Nat (#Function Nat Nat)) ("lux coerce" Nat ("lux int *" - ("lux coerce" Int subject) - ("lux coerce" Int param)))) + ("lux coerce" Int param) + ("lux coerce" Int subject)))) (def:'' (update-parameters code) #Nil @@ -2206,11 +2206,11 @@ (-> (-> a Bit) ($' List a) Bit)) (list@fold (function' [_2 _1] (if _1 (p _2) #0)) #1 xs)) -(def:''' #export (n/= test subject) +(def:''' #export (n/= reference sample) (list [(tag$ ["lux" "doc"]) (text$ "Nat(ural) equivalence.")]) (-> Nat Nat Bit) - ("lux i64 =" test subject)) + ("lux i64 =" reference sample)) (def:''' (high-bits value) (list) @@ -2220,48 +2220,48 @@ (def:''' low-mask (list) I64 - ("lux i64 -" ("lux i64 left-shift" 32 1) 1)) + (|> 1 ("lux i64 left-shift" 32) ("lux i64 -" 1))) (def:''' (low-bits value) (list) (-> ($' I64 Any) I64) ("lux i64 and" low-mask value)) -(def:''' #export (n/< test subject) +(def:''' #export (n/< reference sample) (list [(tag$ ["lux" "doc"]) (text$ "Nat(ural) less-than.")]) (-> Nat Nat Bit) - (let' [testH (high-bits test) - subjectH (high-bits subject)] - (if ("lux int <" subjectH testH) + (let' [referenceH (high-bits reference) + sampleH (high-bits sample)] + (if ("lux int <" referenceH sampleH) #1 - (if ("lux i64 =" subjectH testH) + (if ("lux i64 =" referenceH sampleH) ("lux int <" - (low-bits subject) - (low-bits test)) + (low-bits reference) + (low-bits sample)) #0)))) -(def:''' #export (n/<= test subject) +(def:''' #export (n/<= reference sample) (list [(tag$ ["lux" "doc"]) (text$ "Nat(ural) less-than-equal.")]) (-> Nat Nat Bit) - (if (n/< test subject) + (if (n/< reference sample) #1 - ("lux i64 =" test subject))) + ("lux i64 =" reference sample))) -(def:''' #export (n/> test subject) +(def:''' #export (n/> reference sample) (list [(tag$ ["lux" "doc"]) (text$ "Nat(ural) greater-than.")]) (-> Nat Nat Bit) - (n/< subject test)) + (n/< sample reference)) -(def:''' #export (n/>= test subject) +(def:''' #export (n/>= reference sample) (list [(tag$ ["lux" "doc"]) (text$ "Nat(ural) greater-than-equal.")]) (-> Nat Nat Bit) - (if (n/< subject test) + (if (n/< sample reference) #1 - ("lux i64 =" test subject))) + ("lux i64 =" reference sample))) (macro:' #export (template tokens) (list [(tag$ ["lux" "doc"]) @@ -2292,78 +2292,78 @@ (fail "Wrong syntax for template")} tokens)) -(def:''' #export (r/= test subject) +(def:''' #export (r/= reference sample) (list [(tag$ ["lux" "doc"]) (text$ "Rev(olution) equivalence.")]) (-> Rev Rev Bit) - ("lux i64 =" test subject)) + ("lux i64 =" reference sample)) -(def:''' #export (r/< test subject) +(def:''' #export (r/< reference sample) (list [(tag$ ["lux" "doc"]) (text$ "Rev(olution) less-than.")]) (-> Rev Rev Bit) - (n/< ("lux coerce" Nat test) - ("lux coerce" Nat subject))) + (n/< ("lux coerce" Nat reference) + ("lux coerce" Nat sample))) -(def:''' #export (r/<= test subject) +(def:''' #export (r/<= reference sample) (list [(tag$ ["lux" "doc"]) (text$ "Rev(olution) less-than-equal.")]) (-> Rev Rev Bit) - (if (n/< ("lux coerce" Nat test) - ("lux coerce" Nat subject)) + (if (n/< ("lux coerce" Nat reference) + ("lux coerce" Nat sample)) #1 - ("lux i64 =" test subject))) + ("lux i64 =" reference sample))) -(def:''' #export (r/> test subject) +(def:''' #export (r/> reference sample) (list [(tag$ ["lux" "doc"]) (text$ "Rev(olution) greater-than.")]) (-> Rev Rev Bit) - (r/< subject test)) + (r/< sample reference)) -(def:''' #export (r/>= test subject) +(def:''' #export (r/>= reference sample) (list [(tag$ ["lux" "doc"]) (text$ "Rev(olution) greater-than-equal.")]) (-> Rev Rev Bit) - (if (r/< subject test) + (if (r/< sample reference) #1 - ("lux i64 =" test subject))) + ("lux i64 =" reference sample))) (template [ - - <<-doc> <<=-doc> <>-doc> <>=-doc>] - [(def:''' #export ( test subject) + + <<-doc> <<=-doc> <>-doc> <>=-doc>] + [(def:''' #export ( reference sample) (list [(tag$ ["lux" "doc"]) (text$ )]) (-> Bit) - ( subject test)) + ( reference sample)) - (def:''' #export ( test subject) + (def:''' #export ( reference sample) (list [(tag$ ["lux" "doc"]) (text$ <<-doc>)]) (-> Bit) - ( subject test)) + ( reference sample)) - (def:''' #export ( test subject) + (def:''' #export ( reference sample) (list [(tag$ ["lux" "doc"]) (text$ <<=-doc>)]) (-> Bit) - (if ( subject test) + (if ( reference sample) #1 - ( subject test))) + ( reference sample))) - (def:''' #export ( test subject) + (def:''' #export ( reference sample) (list [(tag$ ["lux" "doc"]) (text$ <>-doc>)]) (-> Bit) - ( test subject)) + ( sample reference)) - (def:''' #export ( test subject) + (def:''' #export ( reference sample) (list [(tag$ ["lux" "doc"]) (text$ <>=-doc>)]) (-> Bit) - (if ( test subject) + (if ( sample reference) #1 - ( subject test)))] + ( reference sample)))] [ Int "lux i64 =" "lux int <" i/= i/< i/<= i/> i/>= "Int(eger) equivalence." "Int(eger) less-than." "Int(eger) less-than-equal." "Int(eger) greater-than." "Int(eger) greater-than-equal."] @@ -2376,19 +2376,18 @@ (list [(tag$ ["lux" "doc"]) (text$ "Nat(ural) division.")]) (-> Nat Nat Nat) - (if ("lux int <" ("lux coerce" Int param) +0) + (if ("lux int <" +0 ("lux coerce" Int param)) (if (n/< param subject) 0 1) - (let' [quotient ("lux i64 left-shift" - 1 - ("lux int /" - ("lux i64 logical-right-shift" 1 subject) - ("lux coerce" Int param))) + (let' [quotient (|> subject + ("lux i64 logical-right-shift" 1) + ("lux int /" ("lux coerce" Int param)) + ("lux i64 left-shift" 1)) flat ("lux int *" - ("lux coerce" Int quotient) - ("lux coerce" Int param)) - remainder ("lux i64 -" subject flat)] + ("lux coerce" Int param) + ("lux coerce" Int quotient)) + remainder ("lux i64 -" flat subject)] (if (n/< param remainder) quotient ("lux i64 +" 1 quotient))))) @@ -2399,25 +2398,25 @@ (-> Nat Nat (#Product Nat Nat)) (let' [div (n// param subject) flat ("lux int *" - ("lux coerce" Int div) - ("lux coerce" Int param))] - [div ("lux i64 -" subject flat)])) + ("lux coerce" Int param) + ("lux coerce" Int div))] + [div ("lux i64 -" flat subject)])) (def:''' #export (n/% param subject) (list [(tag$ ["lux" "doc"]) (text$ "Nat(ural) remainder.")]) (-> Nat Nat Nat) (let' [flat ("lux int *" - ("lux coerce" Int (n// param subject)) - ("lux coerce" Int param))] - ("lux i64 -" subject flat))) + ("lux coerce" Int param) + ("lux coerce" Int (n// param subject)))] + ("lux i64 -" flat subject))) (template [ ] [(def:''' #export ( param subject) (list [(tag$ ["lux" "doc"]) (text$ )]) (-> ) - ( subject param))] + ( param subject))] [ Int i/+ "lux i64 +" "Int(eger) addition."] [ Int i/- "lux i64 -" "Int(eger) substraction."] @@ -2431,7 +2430,7 @@ (list [(tag$ ["lux" "doc"]) (text$ )]) (-> ) - ( subject param))] + ( param subject))] [ Int i/* "lux int *" "Int(eger) multiplication."] [ Int i// "lux int /" "Int(eger) division."] @@ -2456,8 +2455,8 @@ ("lux int *" paramL) ("lux i64 logical-right-shift" 32)) middle ("lux i64 +" - ("lux int *" subjectH paramL) - ("lux int *" subjectL paramH)) + ("lux int *" paramL subjectH) + ("lux int *" paramH subjectL)) top ("lux int *" subjectH paramH)] (|> bottom ("lux i64 +" middle) @@ -2488,31 +2487,28 @@ (if ("lux i64 =" +0 trailing-zeroes) [1 ("lux i64 logical-right-shift" 1 remaining)] [trailing-zeroes remaining])) - shift ("lux i64 -" 64 trailing-zeroes) + shift ("lux i64 -" trailing-zeroes 64) numerator ("lux i64 left-shift" shift 1)] - ("lux coerce" Rev - ("lux int *" - ("lux coerce" Int subject) - ("lux int /" - ("lux coerce" Int numerator) - ("lux coerce" Int denominator))))))) + (|> ("lux coerce" Int numerator) + ("lux int /" ("lux coerce" Int denominator)) + ("lux int *" ("lux coerce" Int subject)) + ("lux coerce" Rev))))) (def:''' #export (r/% param subject) (list [(tag$ ["lux" "doc"]) (text$ "Rev(olution) remainder.")]) (-> Rev Rev Rev) - ("lux coerce" Rev - (n/% ("lux coerce" Nat param) - ("lux coerce" Nat subject)))) + (|> ("lux coerce" Nat subject) + (n/% ("lux coerce" Nat param)) + ("lux coerce" Rev))) (def:''' #export (r/scale param subject) (list [(tag$ ["lux" "doc"]) (text$ "Rev(olution) scale.")]) (-> Nat Rev Rev) - ("lux coerce" Rev - ("lux int *" - ("lux coerce" Int subject) - ("lux coerce" Int param)))) + (|> ("lux coerce" Int subject) + ("lux int *" ("lux coerce" Int param)) + ("lux coerce" Rev))) (def:''' #export (r/reciprocal numerator) (list [(tag$ ["lux" "doc"]) @@ -3587,11 +3583,11 @@ (def: (index-of part text) (-> Text Text (Maybe Nat)) - ("lux text index" text part 0)) + ("lux text index" 0 part text)) (def: (last-index-of' part part-size since text) (-> Text Nat Nat Text (Maybe Nat)) - (case ("lux text index" text part (n/+ part-size since)) + (case ("lux text index" (n/+ part-size since) part text) #None (#Some since) @@ -3600,7 +3596,7 @@ (def: (last-index-of part text) (-> Text Text (Maybe Nat)) - (case ("lux text index" text part 0) + (case ("lux text index" 0 part text) (#Some since) (last-index-of' part ("lux text size" part) since text) @@ -3611,14 +3607,14 @@ (-> Nat Text (Maybe Text)) (let [size ("lux text size" text)] (if (n/<= size from) - (#.Some ("lux text clip" text from size)) + (#.Some ("lux text clip" from size text)) #.None))) (def: (clip/2 from to text) (-> Nat Nat Text (Maybe Text)) (if (and (n/<= to from) (n/<= ("lux text size" text) to)) - (#.Some ("lux text clip" text from to)) + (#.Some ("lux text clip" from to text)) #.None)) (def: #export (error! message) @@ -3657,9 +3653,9 @@ (list input) (#Some idx) - (list& ("lux text clip" input 0 idx) + (list& ("lux text clip" 0 idx input) (text@split-all-with splitter - ("lux text clip" input (n/+ 1 idx) ("lux text size" input)))))) + ("lux text clip" (n/+ 1 idx) ("lux text size" input) input))))) (def: (nth idx xs) (All [a] @@ -4142,8 +4138,8 @@ (def: (split! at x) (-> Nat Text [Text Text]) - [("lux text clip" x 0 at) - ("lux text clip" x at ("lux text size" x))]) + [("lux text clip" 0 at x) + ("lux text clip" at ("lux text size" x) x)]) (def: (split-with token sample) (-> Text Text (Maybe [Text Text])) @@ -4175,7 +4171,7 @@ (def: (count-relatives relatives input) (-> Nat Text Nat) - (case ("lux text index" input ..module-separator relatives) + (case ("lux text index" relatives ..module-separator input) #None relatives @@ -4220,7 +4216,7 @@ list@reverse (interpose ..module-separator) (text@join-with "")) - clean ("lux text clip" module relatives ("lux text size" module)) + clean ("lux text clip" relatives ("lux text size" module) module) output (case ("lux text size" clean) 0 prefix _ ($_ text@compose prefix ..module-separator clean))] @@ -5170,7 +5166,7 @@ (template [ ] [(def: #export ( n) (-> ) - ( [n]))] + ( n))] [frac-to-int Frac Int "lux frac int"] [int-to-frac Int Frac "lux int frac"] @@ -5221,10 +5217,10 @@ ($_ text@compose ..double-quote original ..double-quote)) (template [ ] - [(def: #export ( value) + [(def: #export {#.doc } (All [s] (-> (I64 s) (I64 s))) - ( value 1))] + (|>> ( 1)))] [inc "lux i64 +" "Increment function."] [dec "lux i64 -" "Decrement function."] diff --git a/stdlib/source/lux/data/number.lux b/stdlib/source/lux/data/number.lux index b4408518e..e6b169fc4 100644 --- a/stdlib/source/lux/data/number.lux +++ b/stdlib/source/lux/data/number.lux @@ -29,7 +29,7 @@ (def: (comma-prefixed? number) (-> Text Bit) - (case ("lux text index" number "," 0) + (case ("lux text index" 0 "," number) (#.Some 0) #1 diff --git a/stdlib/source/lux/data/number/frac.lux b/stdlib/source/lux/data/number/frac.lux index 924831dcf..f49f73039 100644 --- a/stdlib/source/lux/data/number/frac.lux +++ b/stdlib/source/lux/data/number/frac.lux @@ -107,14 +107,14 @@ (let [shifted (f/* dec-left) digit-idx (|> shifted (f/% ) frac-to-int .nat)] (recur (f/% +1.0 shifted) - ("lux text concat" output ("lux text clip" digit-idx (inc digit-idx))))))))] + ("lux text concat" output ("lux text clip" digit-idx (inc digit-idx) )))))))] ("lux text concat" whole-part decimal-part))) (def: (decode repr) - (case ("lux text index" repr "." 0) + (case ("lux text index" 0 "." repr) (#.Some split-index) - (let [whole-part ("lux text clip" repr 0 split-index) - decimal-part ("lux text clip" repr (inc split-index) ("lux text size" repr))] + (let [whole-part ("lux text clip" 0 split-index repr) + decimal-part ("lux text clip" (inc split-index) ("lux text size" repr) repr)] (case [(:: decode whole-part) (:: decode ("lux text concat" "+" decimal-part))] (^multi [(#error.Success whole) (#error.Success decimal)] @@ -158,8 +158,8 @@ (if (n/<= chunk-size num-digits) (list digits) (let [boundary (n/- chunk-size num-digits) - chunk ("lux text clip" digits boundary num-digits) - remaining ("lux text clip" digits 0 boundary)] + chunk ("lux text clip" boundary num-digits digits) + remaining ("lux text clip" 0 boundary digits)] (list& chunk (segment-digits chunk-size remaining))))))) (def: (bin-segment-to-hex input) @@ -286,11 +286,9 @@ (def: (encode value) (let [sign (:: ..number signum value) raw-bin (:: ..binary encode value) - dot-idx (maybe.assume ("lux text index" raw-bin "." 0)) - whole-part ("lux text clip" raw-bin - (if (f/= -1.0 sign) 1 0) - dot-idx) - decimal-part ("lux text clip" raw-bin (inc dot-idx) ("lux text size" raw-bin)) + dot-idx (maybe.assume ("lux text index" 0 "." raw-bin)) + whole-part ("lux text clip" (if (f/= -1.0 sign) 1 0) dot-idx raw-bin) + decimal-part ("lux text clip" (inc dot-idx) ("lux text size" raw-bin) raw-bin) hex-output (|> ( #0 decimal-part) ("lux text concat" ".") ("lux text concat" ( #1 whole-part)) @@ -298,16 +296,16 @@ hex-output)) (def: (decode repr) - (let [sign (case ("lux text index" repr "-" 0) + (let [sign (case ("lux text index" 0 "-" repr) (#.Some 0) -1.0 _ +1.0)] - (case ("lux text index" repr "." 0) + (case ("lux text index" 0 "." repr) (#.Some split-index) - (let [whole-part ("lux text clip" repr 1 split-index) - decimal-part ("lux text clip" repr (inc split-index) ("lux text size" repr)) + (let [whole-part ("lux text clip" 1 split-index repr) + decimal-part ("lux text clip" (inc split-index) ("lux text size" repr) repr) as-binary (|> ( decimal-part) ("lux text concat" ".") ("lux text concat" ( whole-part)) diff --git a/stdlib/source/lux/data/number/i64.lux b/stdlib/source/lux/data/number/i64.lux index 321c628e9..ffce20b4c 100644 --- a/stdlib/source/lux/data/number/i64.lux +++ b/stdlib/source/lux/data/number/i64.lux @@ -12,15 +12,19 @@ (n/* bits-per-byte bytes-per-i64)) -(template [ ] - [(def: #export ( param subject) +(template [ ] + [(def: #export ( parameter subject) {#.doc } - (All [s] (-> (I64 Any) (I64 s) (I64 s))) - ( param subject))] - - [and "lux i64 and" "Bitwise and."] - [or "lux i64 or" "Bitwise or."] - [xor "lux i64 xor" "Bitwise xor."] + (All [s] (-> (I64 s) (I64 s))) + ( parameter subject))] + + [(I64 Any) and "lux i64 and" "Bitwise and."] + [(I64 Any) or "lux i64 or" "Bitwise or."] + [(I64 Any) xor "lux i64 xor" "Bitwise xor."] + + [Nat left-shift "lux i64 left-shift" "Bitwise left-shift."] + [Nat logic-right-shift "lux i64 logical-right-shift" "Unsigned bitwise logic-right-shift."] + [Nat arithmetic-right-shift "lux i64 arithmetic-right-shift" "Signed bitwise arithmetic-right-shift."] ) (def: #export not @@ -42,17 +46,6 @@ (def: compose ..and) ) -(template [ ] - [(def: #export ( param subject) - {#.doc } - (All [s] (-> Nat (I64 s) (I64 s))) - ( param subject))] - - [left-shift "lux i64 left-shift" "Bitwise left-shift."] - [logic-right-shift "lux i64 logical-right-shift" "Unsigned bitwise logic-right-shift."] - [arithmetic-right-shift "lux i64 arithmetic-right-shift" "Signed bitwise arithmetic-right-shift."] - ) - (def: #export (mask bits) (-> Nat (I64 Any)) (|> 1 (..left-shift (n/% ..width bits)) .dec)) diff --git a/stdlib/source/lux/data/number/rev.lux b/stdlib/source/lux/data/number/rev.lux index fa79f597d..cb95efff4 100644 --- a/stdlib/source/lux/data/number/rev.lux +++ b/stdlib/source/lux/data/number/rev.lux @@ -52,7 +52,7 @@ (def: (de-prefix input) (-> Text Text) - ("lux text clip" input 1 ("lux text size" input))) + ("lux text clip" 1 ("lux text size" input) input)) (template [ ] [(with-expansions [ (as-is (#error.Failure ("lux text concat" repr)))] @@ -188,7 +188,7 @@ (loop [idx 0 output (make-digits [])] (if (n/< length idx) - (case ("lux text index" "0123456789" ("lux text clip" input idx (inc idx)) 0) + (case ("lux text index" 0 ("lux text clip" idx (inc idx) input) "0123456789") #.None #.None @@ -251,7 +251,7 @@ ))))) (def: (decode input) - (let [dotted? (case ("lux text index" input "." 0) + (let [dotted? (case ("lux text index" 0 "." input) (#.Some 0) #1 diff --git a/stdlib/source/lux/data/text.lux b/stdlib/source/lux/data/text.lux index 110afd81d..cf13fd182 100644 --- a/stdlib/source/lux/data/text.lux +++ b/stdlib/source/lux/data/text.lux @@ -12,7 +12,7 @@ [number ["." i64]] [collection - ["." list ("#;." fold)]]] + ["." list ("#@." fold)]]] [tool [compiler ["." host]]]]) @@ -51,15 +51,15 @@ (def: #export (index-of' pattern from input) (-> Text Nat Text (Maybe Nat)) - ("lux text index" input pattern from)) + ("lux text index" from pattern input)) (def: #export (index-of pattern input) (-> Text Text (Maybe Nat)) - ("lux text index" input pattern 0)) + ("lux text index" 0 pattern input)) (def: (last-index-of'' part since text) (-> Text Nat Text (Maybe Nat)) - (case ("lux text index" text part (inc since)) + (case ("lux text index" (inc since) part text) #.None (#.Some since) @@ -68,7 +68,7 @@ (def: #export (last-index-of' part from text) (-> Text Nat Text (Maybe Nat)) - (case ("lux text index" text part from) + (case ("lux text index" from part text) (#.Some since) (last-index-of'' part since text) @@ -77,7 +77,7 @@ (def: #export (last-index-of part text) (-> Text Text (Maybe Nat)) - (case ("lux text index" text part 0) + (case ("lux text index" 0 part text) (#.Some since) (last-index-of'' part since text) @@ -105,7 +105,7 @@ (def: #export (contains? sub text) (-> Text Text Bit) - (case ("lux text index" text sub 0) + (case ("lux text index" 0 sub text) (#.Some _) #1 @@ -116,14 +116,14 @@ (-> Nat Nat Text (Maybe Text)) (if (and (n/<= to from) (n/<= ("lux text size" input) to)) - (#.Some ("lux text clip" input from to)) + (#.Some ("lux text clip" from to input)) #.None)) (def: #export (clip' from input) (-> Nat Text (Maybe Text)) (let [size ("lux text size" input)] (if (n/<= size from) - (#.Some ("lux text clip" input from size)) + (#.Some ("lux text clip" from size input)) #.None))) (def: #export (split at x) @@ -169,25 +169,25 @@ template)) (structure: #export equivalence (Equivalence Text) - (def: (= test subject) - ("lux text =" subject test))) + (def: (= reference sample) + ("lux text =" reference sample))) (structure: #export order (Order Text) (def: &equivalence ..equivalence) - (def: (< test subject) - ("lux text <" subject test)) + (def: (< reference sample) + ("lux text <" reference sample)) - (def: (<= test subject) - (or ("lux text <" subject test) - ("lux text =" subject test))) + (def: (<= reference sample) + (or ("lux text <" reference sample) + ("lux text =" reference sample))) - (def: (> test subject) - ("lux text <" test subject)) + (def: (> reference sample) + ("lux text <" sample reference)) - (def: (>= test subject) - (or ("lux text <" test subject) - ("lux text =" test subject))) + (def: (>= reference sample) + (or ("lux text <" sample reference) + ("lux text =" reference sample))) ) (structure: #export monoid (Monoid Text) @@ -221,7 +221,7 @@ (def: #export concat (-> (List Text) Text) (let [(^open ".") ..monoid] - (|>> list.reverse (list;fold compose identity)))) + (|>> list.reverse (list@fold compose identity)))) (def: #export (join-with sep texts) (-> Text (List Text) Text) diff --git a/stdlib/source/lux/tool/compiler/default/syntax.lux b/stdlib/source/lux/tool/compiler/default/syntax.lux index 5f894622b..8be32d7f2 100644 --- a/stdlib/source/lux/tool/compiler/default/syntax.lux +++ b/stdlib/source/lux/tool/compiler/default/syntax.lux @@ -59,7 +59,7 @@ (template [ ] [(template: ( value) - ( value ))] + ( value))] [!inc "lux i64 +" 1] [!inc/2 "lux i64 +" 2] @@ -67,11 +67,11 @@ ) (template: (!clip from to text) - ("lux text clip" text from to)) + ("lux text clip" from to text)) (template [ ] [(template: ( reference subject) - ( subject reference))] + ( reference subject))] [!n/= "lux i64 ="] [!i/< "lux int <"] @@ -79,7 +79,7 @@ (template [ ] [(template: ( param subject) - ( subject param))] + ( param subject))] [!n/+ "lux i64 +"] [!n/- "lux i64 -"] @@ -235,7 +235,7 @@ (#error.Failure error)))))))) (template: (!guarantee-no-new-lines content body) - (case ("lux text index" content (static text.new-line) 0) + (case ("lux text index" 0 (static text.new-line) content) #.None body @@ -243,7 +243,7 @@ (ex.throw ..text-cannot-contain-new-lines content))) (template: (!read-text where offset source-code) - (case ("lux text index" source-code (static ..text-delimiter) offset) + (case ("lux text index" offset (static ..text-delimiter) source-code) (#.Some g!end) (let [g!content (!clip offset g!end source-code)] (<| (!guarantee-no-new-lines g!content) @@ -505,7 +505,7 @@ ## Single-line comment [(~~ (static ..sigil))] - (case ("lux text index" source-code (static text.new-line) (!inc offset/1)) + (case ("lux text index" (!inc offset/1) (static text.new-line) source-code) (#.Some end) (recur [(!new-line where) (!inc end) source-code]) diff --git a/stdlib/source/lux/type/check.lux b/stdlib/source/lux/type/check.lux index 7f5fc1f36..636a1722e 100644 --- a/stdlib/source/lux/type/check.lux +++ b/stdlib/source/lux/type/check.lux @@ -10,31 +10,31 @@ ["." product] ["." error (#+ Error)] [number - ["." nat ("#;." decimal)]] - ["." text ("#;." monoid equivalence)] + ["." nat ("#@." decimal)]] + ["." text ("#@." monoid equivalence)] [collection ["." list] ["." set (#+ Set)]]]] - ["." // ("#;." equivalence)]) + ["." // ("#@." equivalence)]) (template: (!n/= reference subject) - ("lux i64 =" subject reference)) + ("lux i64 =" reference subject)) -(template: (!text;= reference subject) - ("lux text =" subject reference)) +(template: (!text@= reference subject) + ("lux text =" reference subject)) (exception: #export (unknown-type-var {id Nat}) - (ex.report ["ID" (nat;encode id)])) + (ex.report ["ID" (nat@encode id)])) (exception: #export (unbound-type-var {id Nat}) - (ex.report ["ID" (nat;encode id)])) + (ex.report ["ID" (nat@encode id)])) (exception: #export (invalid-type-application {funcT Type} {argT Type}) (ex.report ["Type function" (//.to-text funcT)] ["Type argument" (//.to-text argT)])) (exception: #export (cannot-rebind-var {id Nat} {type Type} {bound Type}) - (ex.report ["Var" (nat;encode id)] + (ex.report ["Var" (nat@encode id)] ["Wanted Type" (//.to-text type)] ["Current Type" (//.to-text bound)])) @@ -104,7 +104,7 @@ ))) ) -(open: "check;." ..monad) +(open: "check@." ..monad) (def: (var::get id plist) (-> Var Type-Vars (Maybe (Maybe Type))) @@ -253,7 +253,7 @@ _ (case (//.apply (list argT) funcT) (#.Some output) - (check;wrap output) + (check@wrap output) _ (throw invalid-type-application [funcT argT])))) @@ -327,8 +327,8 @@ (def: (assumed? [e a] assumptions) (-> Assumption (List Assumption) Bit) (list.any? (function (_ [e' a']) - (and (//;= e e') - (//;= a a'))) + (and (//@= e e') + (//@= a a'))) assumptions)) (def: (assume! assumption assumptions) @@ -374,7 +374,7 @@ Var Var (Check (List Assumption))) (if (!n/= idE idA) - (check;wrap assumptions) + (check@wrap assumptions) (do ..monad [ebound (attempt (peek idE)) abound (attempt (peek idA))] @@ -447,7 +447,7 @@ (on-error []) _ - ($_ text;compose + ($_ text@compose (on-error []) text.new-line text.new-line "-----------------------------------------" @@ -514,7 +514,7 @@ {#.doc "Type-check to ensure that the 'expected' type subsumes the 'actual' type."} (-> (List Assumption) Type Type (Check (List Assumption))) (if (is? expected actual) - (check;wrap assumptions) + (check@wrap assumptions) (with-error-stack (function (_ _) (ex.construct type-check-failed [expected actual])) (case [expected actual] @@ -523,13 +523,13 @@ [(#.Var id) _] (if-bind id actual - (check;wrap assumptions) + (check@wrap assumptions) (function (_ bound) (check' assumptions bound actual))) [_ (#.Var id)] (if-bind id expected - (check;wrap assumptions) + (check@wrap assumptions) (function (_ bound) (check' assumptions expected bound))) @@ -544,7 +544,7 @@ [(#.Apply A F) _] (let [new-assumption [expected actual]] (if (assumed? new-assumption assumptions) - (check;wrap assumptions) + (check@wrap assumptions) (do ..monad [expected' (apply-type! F A)] (check' (assume! new-assumption assumptions) expected' actual)))) @@ -575,13 +575,13 @@ [#.ExQ ..existential]) [(#.Primitive e-name e-params) (#.Primitive a-name a-params)] - (if (!text;= e-name a-name) + (if (!text@= e-name a-name) (loop [assumptions assumptions e-params e-params a-params a-params] (case [e-params a-params] [#.Nil #.Nil] - (check;wrap assumptions) + (check@wrap assumptions) [(#.Cons e-head e-tail) (#.Cons a-head a-tail)] (do ..monad @@ -607,7 +607,7 @@ [(#.Ex e!id) (#.Ex a!id)] (if (!n/= e!id a!id) - (check;wrap assumptions) + (check@wrap assumptions) (fail "")) [(#.Named _ ?etype) _] @@ -645,17 +645,17 @@ (#.Primitive name paramsT+) (|> paramsT+ (monad.map ..monad clean) - (check;map (|>> (#.Primitive name)))) + (check@map (|>> (#.Primitive name)))) (^or (#.Parameter _) (#.Ex _) (#.Named _)) - (check;wrap inputT) + (check@wrap inputT) (^template [] ( leftT rightT) (do ..monad [leftT' (clean leftT)] (|> (clean rightT) - (check;map (|>> ( leftT')))))) + (check@map (|>> ( leftT')))))) ([#.Sum] [#.Product] [#.Function] [#.Apply]) (#.Var id) diff --git a/stdlib/source/test/lux/compiler/default/phase/analysis/procedure/common.lux b/stdlib/source/test/lux/compiler/default/phase/analysis/procedure/common.lux index 8b5308a5d..a4c4421d2 100644 --- a/stdlib/source/test/lux/compiler/default/phase/analysis/procedure/common.lux +++ b/stdlib/source/test/lux/compiler/default/phase/analysis/procedure/common.lux @@ -91,19 +91,19 @@ paramC (|> r.int (:: @ map code.int))] ($_ seq (test "Can add integers." - (check-success+ "lux int +" (list subjectC paramC) Int)) + (check-success+ "lux int +" (list paramC subjectC) Int)) (test "Can subtract integers." - (check-success+ "lux int -" (list subjectC paramC) Int)) + (check-success+ "lux int -" (list paramC subjectC) Int)) (test "Can multiply integers." - (check-success+ "lux int *" (list subjectC paramC) Int)) + (check-success+ "lux int *" (list paramC subjectC) Int)) (test "Can divide integers." - (check-success+ "lux int /" (list subjectC paramC) Int)) + (check-success+ "lux int /" (list paramC subjectC) Int)) (test "Can calculate remainder of integers." - (check-success+ "lux int %" (list subjectC paramC) Int)) + (check-success+ "lux int %" (list paramC subjectC) Int)) (test "Can test equivalence of integers." - (check-success+ "lux int =" (list subjectC paramC) Bit)) + (check-success+ "lux int =" (list paramC subjectC) Bit)) (test "Can compare integers." - (check-success+ "lux int <" (list subjectC paramC) Bit)) + (check-success+ "lux int <" (list paramC subjectC) Bit)) (test "Can convert integer to fraction." (check-success+ "lux int to-frac" (list subjectC) Frac)) (test "Can convert integer to text." @@ -118,19 +118,19 @@ encodedC (|> (r.unicode 5) (:: @ map code.text))] ($_ seq (test "Can add frac numbers." - (check-success+ "lux frac +" (list subjectC paramC) Frac)) + (check-success+ "lux frac +" (list paramC subjectC) Frac)) (test "Can subtract frac numbers." - (check-success+ "lux frac -" (list subjectC paramC) Frac)) + (check-success+ "lux frac -" (list paramC subjectC) Frac)) (test "Can multiply frac numbers." - (check-success+ "lux frac *" (list subjectC paramC) Frac)) + (check-success+ "lux frac *" (list paramC subjectC) Frac)) (test "Can divide frac numbers." - (check-success+ "lux frac /" (list subjectC paramC) Frac)) + (check-success+ "lux frac /" (list paramC subjectC) Frac)) (test "Can calculate remainder of frac numbers." - (check-success+ "lux frac %" (list subjectC paramC) Frac)) + (check-success+ "lux frac %" (list paramC subjectC) Frac)) (test "Can test equivalence of frac numbers." - (check-success+ "lux frac =" (list subjectC paramC) Bit)) + (check-success+ "lux frac =" (list paramC subjectC) Bit)) (test "Can compare frac numbers." - (check-success+ "lux frac <" (list subjectC paramC) Bit)) + (check-success+ "lux frac <" (list paramC subjectC) Bit)) (test "Can obtain minimum frac number." (check-success+ "lux frac min" (list) Frac)) (test "Can obtain maximum frac number." @@ -155,19 +155,19 @@ toC (|> r.nat (:: @ map code.nat))] ($_ seq (test "Can test text equivalence." - (check-success+ "lux text =" (list subjectC paramC) Bit)) + (check-success+ "lux text =" (list paramC subjectC) Bit)) (test "Compare texts in lexicographical order." - (check-success+ "lux text <" (list subjectC paramC) Bit)) + (check-success+ "lux text <" (list paramC subjectC) Bit)) (test "Can concatenate one text to another." (check-success+ "lux text concat" (list subjectC paramC) Text)) (test "Can find the index of a piece of text inside a larger one that (may) contain it." - (check-success+ "lux text index" (list subjectC paramC fromC) (type (Maybe Nat)))) + (check-success+ "lux text index" (list fromC paramC subjectC) (type (Maybe Nat)))) (test "Can query the size/length of a text." (check-success+ "lux text size" (list subjectC) Nat)) (test "Can obtain the character code of a text at a given index." (check-success+ "lux text char" (list subjectC fromC) Nat)) (test "Can clip a piece of text between 2 indices." - (check-success+ "lux text clip" (list subjectC fromC toC) Text)) + (check-success+ "lux text clip" (list fromC toC subjectC) Text)) )))) (context: "IO procedures" -- cgit v1.2.3 From 2914f38f7c3795a63f555409361bc1b317e871a9 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Thu, 4 Apr 2019 20:40:50 -0400 Subject: Forgot "lux text char". --- luxc/src/lux/analyser/proc/common.clj | 4 ++-- stdlib/source/lux.lux | 2 +- stdlib/source/lux/data/number/int.lux | 4 ++-- stdlib/source/lux/data/number/nat.lux | 2 +- stdlib/source/lux/data/number/rev.lux | 2 +- stdlib/source/lux/data/text.lux | 4 ++-- stdlib/source/lux/tool/compiler/default/syntax.lux | 2 +- stdlib/source/lux/tool/compiler/name.lux | 2 +- .../test/lux/compiler/default/phase/analysis/procedure/common.lux | 2 +- 9 files changed, 12 insertions(+), 12 deletions(-) diff --git a/luxc/src/lux/analyser/proc/common.clj b/luxc/src/lux/analyser/proc/common.clj index 8f51521d8..cbe741a34 100644 --- a/luxc/src/lux/analyser/proc/common.clj +++ b/luxc/src/lux/analyser/proc/common.clj @@ -91,9 +91,9 @@ ) (defn- analyse-text-char [analyse exo-type ?values] - (|do [:let [(&/$Cons text (&/$Cons idx (&/$Nil))) ?values] - =text (&&/analyse-1 analyse &type/Text text) + (|do [:let [(&/$Cons idx (&/$Cons text (&/$Nil))) ?values] =idx (&&/analyse-1 analyse &type/Nat idx) + =text (&&/analyse-1 analyse &type/Text text) _ (&type/check exo-type &type/Nat) _cursor &/cursor] (return (&/|list (&&/|meta exo-type _cursor diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux index 412169967..45b190c82 100644 --- a/stdlib/source/lux.lux +++ b/stdlib/source/lux.lux @@ -5999,7 +5999,7 @@ (case tokens (^multi (^ (list [_ (#Text input)])) (n/= 1 ("lux text size" input))) - (|> ("lux text char" input 0) + (|> input ("lux text char" 0) nat$ list [compiler] #Right) diff --git a/stdlib/source/lux/data/number/int.lux b/stdlib/source/lux/data/number/int.lux index 9a2ce2b9b..f94049296 100644 --- a/stdlib/source/lux/data/number/int.lux +++ b/stdlib/source/lux/data/number/int.lux @@ -73,7 +73,7 @@ (def: (int;sign?? representation) (-> Text (Maybe Int)) - (case ("lux text char" representation 0) + (case ("lux text char" 0 representation) (^ (char "-")) (#.Some -1) @@ -88,7 +88,7 @@ (loop [idx 1 output +0] (if (n/< input-size idx) - (case ( ("lux text char" repr idx)) + (case ( ("lux text char" idx repr)) #.None (#error.Failure ) diff --git a/stdlib/source/lux/data/number/nat.lux b/stdlib/source/lux/data/number/nat.lux index fb47d2460..c1f0ca420 100644 --- a/stdlib/source/lux/data/number/nat.lux +++ b/stdlib/source/lux/data/number/nat.lux @@ -191,7 +191,7 @@ (loop [idx 0 output 0] (if (n/< input-size idx) - (case ( ("lux text char" repr idx)) + (case ( ("lux text char" idx repr)) #.None (#error.Failure ("lux text concat" repr)) diff --git a/stdlib/source/lux/data/number/rev.lux b/stdlib/source/lux/data/number/rev.lux index cb95efff4..bbb34c570 100644 --- a/stdlib/source/lux/data/number/rev.lux +++ b/stdlib/source/lux/data/number/rev.lux @@ -77,7 +77,7 @@ (def: (decode repr) (let [repr-size ("lux text size" repr)] (if (n/> 1 repr-size) - (case ("lux text char" repr 0) + (case ("lux text char" 0 repr) (^ (char ".")) (case (:: decode (de-prefix repr)) (#error.Success output) diff --git a/stdlib/source/lux/data/text.lux b/stdlib/source/lux/data/text.lux index cf13fd182..384d4e860 100644 --- a/stdlib/source/lux/data/text.lux +++ b/stdlib/source/lux/data/text.lux @@ -46,7 +46,7 @@ (def: #export (nth idx input) (-> Nat Text (Maybe Char)) (if (n/< ("lux text size" input) idx) - (#.Some ("lux text char" input idx)) + (#.Some ("lux text char" idx input)) #.None)) (def: #export (index-of' pattern from input) @@ -215,7 +215,7 @@ (|> hash (i64.left-shift 5) (n/- hash) - (n/+ ("lux text char" input idx)))) + (n/+ ("lux text char" idx input)))) hash))))))) (def: #export concat diff --git a/stdlib/source/lux/tool/compiler/default/syntax.lux b/stdlib/source/lux/tool/compiler/default/syntax.lux index 8be32d7f2..512c19246 100644 --- a/stdlib/source/lux/tool/compiler/default/syntax.lux +++ b/stdlib/source/lux/tool/compiler/default/syntax.lux @@ -155,7 +155,7 @@ (template: (!with-char+ @source-code-size @source-code @offset @char @else @body) (if (!i/< (:coerce Int @source-code-size) (:coerce Int @offset)) - (let [@char ("lux text char" @source-code @offset)] + (let [@char ("lux text char" @offset @source-code)] @body) @else)) diff --git a/stdlib/source/lux/tool/compiler/name.lux b/stdlib/source/lux/tool/compiler/name.lux index f65113d38..d2841d849 100644 --- a/stdlib/source/lux/tool/compiler/name.lux +++ b/stdlib/source/lux/tool/compiler/name.lux @@ -40,7 +40,7 @@ output ""] (if (n/< name/size idx) (recur (inc idx) - (|> ("lux text char" name idx) !sanitize (format output))) + (|> name ("lux text char" idx) !sanitize (format output))) output)))) (def: #export (definition [module short]) diff --git a/stdlib/source/test/lux/compiler/default/phase/analysis/procedure/common.lux b/stdlib/source/test/lux/compiler/default/phase/analysis/procedure/common.lux index a4c4421d2..bf7de5cec 100644 --- a/stdlib/source/test/lux/compiler/default/phase/analysis/procedure/common.lux +++ b/stdlib/source/test/lux/compiler/default/phase/analysis/procedure/common.lux @@ -165,7 +165,7 @@ (test "Can query the size/length of a text." (check-success+ "lux text size" (list subjectC) Nat)) (test "Can obtain the character code of a text at a given index." - (check-success+ "lux text char" (list subjectC fromC) Nat)) + (check-success+ "lux text char" (list fromC subjectC) Nat)) (test "Can clip a piece of text between 2 indices." (check-success+ "lux text clip" (list fromC toC subjectC) Text)) )))) -- cgit v1.2.3 From 72956a4d2259192148bd3cc95f6fdda0a42e91f1 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Thu, 4 Apr 2019 20:41:40 -0400 Subject: - Updated analysis phase. - Updated Python compiler. --- .../compiler/phase/extension/analysis/common.lux | 6 +-- .../phase/generation/python/extension/common.lux | 44 +++++++++++----------- .../compiler/phase/generation/python/runtime.lux | 2 +- 3 files changed, 26 insertions(+), 26 deletions(-) diff --git a/stdlib/source/lux/tool/compiler/phase/extension/analysis/common.lux b/stdlib/source/lux/tool/compiler/phase/extension/analysis/common.lux index 18ac68d99..9940273cc 100644 --- a/stdlib/source/lux/tool/compiler/phase/extension/analysis/common.lux +++ b/stdlib/source/lux/tool/compiler/phase/extension/analysis/common.lux @@ -201,10 +201,10 @@ (///bundle.install "=" (binary Text Text Bit)) (///bundle.install "<" (binary Text Text Bit)) (///bundle.install "concat" (binary Text Text Text)) - (///bundle.install "index" (trinary Text Text Nat (type (Maybe Nat)))) + (///bundle.install "index" (trinary Nat Text Text (type (Maybe Nat)))) (///bundle.install "size" (unary Text Nat)) - (///bundle.install "char" (binary Text Nat Nat)) - (///bundle.install "clip" (trinary Text Nat Nat Text)) + (///bundle.install "char" (binary Nat Text Nat)) + (///bundle.install "clip" (trinary Nat Nat Text Text)) ))) (def: #export (bundle eval) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/python/extension/common.lux b/stdlib/source/lux/tool/compiler/phase/generation/python/extension/common.lux index 43ebd105f..7ff70b393 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/python/extension/common.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/python/extension/common.lux @@ -29,15 +29,15 @@ Bundle (<| (bundle.prefix "i64") (|> bundle.empty - (bundle.install "and" (binary (product.uncurry (function.flip _.bit-and)))) - (bundle.install "or" (binary (product.uncurry (function.flip _.bit-or)))) - (bundle.install "xor" (binary (product.uncurry (function.flip _.bit-xor)))) + (bundle.install "and" (binary (product.uncurry _.bit-and))) + (bundle.install "or" (binary (product.uncurry _.bit-or))) + (bundle.install "xor" (binary (product.uncurry _.bit-xor))) (bundle.install "left-shift" (binary (function.compose ///runtime.i64//64 (product.uncurry _.bit-shl)))) (bundle.install "logical-right-shift" (binary (product.uncurry ///runtime.i64//logic-right-shift))) (bundle.install "arithmetic-right-shift" (binary (product.uncurry _.bit-shr))) - (bundle.install "=" (binary (product.uncurry (function.flip _.=)))) - (bundle.install "+" (binary (product.uncurry (function.flip _.+)))) - (bundle.install "-" (binary (product.uncurry (function.flip _.-)))) + (bundle.install "=" (binary (product.uncurry _.=))) + (bundle.install "+" (binary (product.uncurry _.+))) + (bundle.install "-" (binary (product.uncurry _.-))) ))) (import: #long java/lang/Double @@ -58,10 +58,10 @@ Bundle (<| (bundle.prefix "int") (|> bundle.empty - (bundle.install "<" (binary (product.uncurry (function.flip _.<)))) - (bundle.install "*" (binary (product.uncurry (function.flip _.*)))) - (bundle.install "/" (binary (product.uncurry (function.flip _./)))) - (bundle.install "%" (binary (product.uncurry (function.flip _.%)))) + (bundle.install "<" (binary (product.uncurry _.<))) + (bundle.install "*" (binary (product.uncurry _.*))) + (bundle.install "/" (binary (product.uncurry _./))) + (bundle.install "%" (binary (product.uncurry _.%))) (bundle.install "frac" (unary _.float/1)) (bundle.install "char" (unary _.chr/1))))) @@ -69,13 +69,13 @@ Bundle (<| (bundle.prefix "frac") (|> bundle.empty - (bundle.install "+" (binary (product.uncurry (function.flip _.+)))) - (bundle.install "-" (binary (product.uncurry (function.flip _.-)))) - (bundle.install "*" (binary (product.uncurry (function.flip _.*)))) - (bundle.install "/" (binary (product.uncurry (function.flip _./)))) - (bundle.install "%" (binary (product.uncurry (function.flip _.%)))) - (bundle.install "=" (binary (product.uncurry (function.flip _.=)))) - (bundle.install "<" (binary (product.uncurry (function.flip _.<)))) + (bundle.install "+" (binary (product.uncurry _.+))) + (bundle.install "-" (binary (product.uncurry _.-))) + (bundle.install "*" (binary (product.uncurry _.*))) + (bundle.install "/" (binary (product.uncurry _./))) + (bundle.install "%" (binary (product.uncurry _.%))) + (bundle.install "=" (binary (product.uncurry _.=))) + (bundle.install "<" (binary (product.uncurry _.<))) (bundle.install "smallest" (nullary frac//smallest)) (bundle.install "min" (nullary frac//min)) (bundle.install "max" (nullary frac//max)) @@ -87,11 +87,11 @@ (Binary (Expression Any)) (///runtime.text//char subjectO paramO)) -(def: (text//clip [subjectO paramO extraO]) +(def: (text//clip [paramO extraO subjectO]) (Trinary (Expression Any)) (///runtime.text//clip subjectO paramO extraO)) -(def: (text//index [textO partO startO]) +(def: (text//index [startO partO textO]) (Trinary (Expression Any)) (///runtime.text//index textO partO startO)) @@ -99,9 +99,9 @@ Bundle (<| (bundle.prefix "text") (|> bundle.empty - (bundle.install "=" (binary (product.uncurry (function.flip _.=)))) - (bundle.install "<" (binary (product.uncurry (function.flip _.<)))) - (bundle.install "concat" (binary (product.uncurry (function.flip _.+)))) + (bundle.install "=" (binary (product.uncurry _.=))) + (bundle.install "<" (binary (product.uncurry _.<))) + (bundle.install "concat" (binary (product.uncurry _.+))) (bundle.install "index" (trinary text//index)) (bundle.install "size" (unary _.len/1)) (bundle.install "char" (binary (product.uncurry ///runtime.text//char))) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/python/runtime.lux b/stdlib/source/lux/tool/compiler/phase/generation/python/runtime.lux index a8f601922..36184e21c 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/python/runtime.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/python/runtime.lux @@ -308,7 +308,7 @@ (runtime: (text//clip @text @from @to) (_.return (|> @text (_.slice @from (inc @to))))) -(runtime: (text//char text idx) +(runtime: (text//char idx text) (_.if (|> idx (within? (_.len/1 text))) (_.return (..some (_.ord/1 (|> text (_.slice idx (inc idx)))))) (_.return ..none))) -- cgit v1.2.3 From e45c856bad7f0dd2dfdd32d4d99b951715e3b267 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Thu, 4 Apr 2019 21:02:58 -0400 Subject: Updated JavaScript compiler. --- .../phase/generation/js/extension/common.lux | 17 ++-- .../tool/compiler/phase/generation/js/runtime.lux | 97 +++++++++++----------- 2 files changed, 57 insertions(+), 57 deletions(-) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/js/extension/common.lux b/stdlib/source/lux/tool/compiler/phase/generation/js/extension/common.lux index 9a065a73e..2ee78f394 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/js/extension/common.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/js/extension/common.lux @@ -60,18 +60,17 @@ (_.apply/* (_.var "String.fromCharCode")))) ## [[Text]] -(def: (text//concat [subjectG paramG]) +(def: (text//concat [leftG rightG]) (Binary Expression) - (|> subjectG (_.do "concat" (list paramG)))) + (|> leftG (_.do "concat" (list rightG)))) -(template [ ] - [(def: ( [subjectG paramG extraG]) - (Trinary Expression) - ( subjectG paramG extraG))] +(def: (text//clip [startG endG subjectG]) + (Trinary Expression) + (///runtime.text//clip startG endG subjectG)) - [text//clip ///runtime.text//clip] - [text//index ///runtime.text//index] - ) +(def: (text//index [startG partG subjectG]) + (Trinary Expression) + (///runtime.text//index startG partG subjectG)) ## [[IO]] (def: (io//log messageG) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/js/runtime.lux b/stdlib/source/lux/tool/compiler/phase/generation/js/runtime.lux index 8dcdb866a..821633e50 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/js/runtime.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/js/runtime.lux @@ -278,13 +278,13 @@ (runtime: i64//one (i64//new (_.i32 +0) (_.i32 +1))) -(runtime: (i64//= left right) - (_.return (_.and (_.= (_.the ..i64-high-field left) - (_.the ..i64-high-field right)) - (_.= (_.the ..i64-low-field left) - (_.the ..i64-low-field right))))) +(runtime: (i64//= reference sample) + (_.return (_.and (_.= (_.the ..i64-high-field reference) + (_.the ..i64-high-field sample)) + (_.= (_.the ..i64-low-field reference) + (_.the ..i64-low-field sample))))) -(runtime: (i64//+ subject parameter) +(runtime: (i64//+ parameter subject) (let [up-16 (_.left-shift (_.i32 +16)) high-16 (_.logic-right-shift (_.i32 +16)) low-16 (_.bit-and (_.i32 (hex "+FFFF"))) @@ -339,7 +339,7 @@ (runtime: (i64//negate value) (_.if (i64//= i64//min value) (_.return i64//min) - (_.return (i64//+ (i64//not value) i64//one)))) + (_.return (i64//+ i64//one (i64//not value))))) (runtime: i64//-one (i64//negate i64//one)) @@ -422,20 +422,20 @@ @i64//logic-right-shift )) -(runtime: (i64//- subject parameter) - (_.return (i64//+ subject (i64//negate parameter)))) +(runtime: (i64//- parameter subject) + (_.return (i64//+ (i64//negate parameter) subject))) -(runtime: (i64//* subject parameter) +(runtime: (i64//* parameter subject) (let [negative? (|>> (_.the ..i64-high-field) (_.< (_.i32 +0)))] (_.cond (list [(negative? subject) (_.if (negative? parameter) ## Both are negative - (_.return (i64//* (i64//negate subject) (i64//negate parameter))) + (_.return (i64//* (i64//negate parameter) (i64//negate subject))) ## Subject is negative - (_.return (i64//negate (i64//* (i64//negate subject) parameter))))] + (_.return (i64//negate (i64//* parameter (i64//negate subject)))))] [(negative? parameter) ## Parameter is negative - (_.return (i64//negate (i64//* subject (i64//negate parameter))))]) + (_.return (i64//negate (i64//* (i64//negate parameter) subject)))]) ## Both are positive (let [up-16 (_.left-shift (_.i32 +16)) high-16 (_.logic-right-shift (_.i32 +16)) @@ -485,7 +485,7 @@ (_.bit-or (up-16 x16) x00))) )))))) -(runtime: (i64//< subject parameter) +(runtime: (i64//< parameter subject) (let [negative? (|>> (_.the ..i64-high-field) (_.< (_.i32 +0)))] (with-vars [-subject? -parameter?] ($_ _.then @@ -495,16 +495,16 @@ (_.return _.true)] [(_.and (_.not -subject?) -parameter?) (_.return _.false)]) - (_.return (negative? (i64//- subject parameter)))))))) + (_.return (negative? (i64//- parameter subject)))))))) -(def: (i64//<= subject param) +(def: (i64//<= param subject) (-> Expression Expression Expression) - (_.or (i64//< subject param) - (i64//= subject param))) + (_.or (i64//< param subject) + (i64//= param subject))) -(runtime: (i64/// subject parameter) +(runtime: (i64/// parameter subject) (let [negative? (function (_ value) - (i64//< value i64//zero)) + (i64//< i64//zero value)) valid-division-check [(i64//= i64//zero parameter) (_.throw (_.string "Cannot divide by zero!"))] short-circuit-check [(i64//= i64//zero subject) @@ -521,39 +521,39 @@ (with-vars [approximation] (let [subject/2 (i64//arithmetic-right-shift subject (_.i32 +1))] ($_ _.then - (_.define approximation (i64//left-shift (i64/// subject/2 - parameter) + (_.define approximation (i64//left-shift (i64/// parameter + subject/2) (_.i32 +1))) (_.if (i64//= i64//zero approximation) (_.return (_.? (negative? parameter) i64//one i64//-one)) - (let [remainder (i64//- subject - (i64//* parameter - approximation))] - (_.return (i64//+ approximation - (i64/// remainder - parameter)))))))))] + (let [remainder (i64//- (i64//* approximation + parameter) + subject)] + (_.return (i64//+ (i64/// parameter + remainder) + approximation))))))))] [(i64//= i64//min parameter) (_.return i64//zero)] [(negative? subject) (_.return (_.? (negative? parameter) - (i64/// (i64//negate subject) - (i64//negate parameter)) - (i64//negate (i64/// (i64//negate subject) - parameter))))] + (i64/// (i64//negate parameter) + (i64//negate subject)) + (i64//negate (i64/// parameter + (i64//negate subject)))))] [(negative? parameter) - (_.return (i64//negate (i64/// subject (i64//negate parameter))))]) + (_.return (i64//negate (i64/// (i64//negate parameter) subject)))]) (with-vars [result remainder] ($_ _.then (_.define result i64//zero) (_.define remainder subject) - (_.while (i64//<= parameter remainder) + (_.while (i64//<= remainder parameter) (with-vars [approximate approximate-result approximate-remainder log2 delta] (let [approximate-result' (i64//from-number approximate) - approx-remainder (i64//* approximate-result parameter)] + approx-remainder (i64//* parameter approximate-result)] ($_ _.then (_.define approximate (|> (i64//to-number remainder) (_./ (i64//to-number parameter)) @@ -572,24 +572,25 @@ (_.define approximate-result approximate-result') (_.define approximate-remainder approx-remainder) (_.while (_.or (negative? approximate-remainder) - (i64//< remainder - approximate-remainder)) + (i64//< approximate-remainder + remainder)) ($_ _.then (_.set approximate (_.- delta approximate)) (_.set approximate-result approximate-result') (_.set approximate-remainder approx-remainder))) - (_.set result (i64//+ result - (_.? (i64//= i64//zero approximate-result) + (_.set result (i64//+ (_.? (i64//= i64//zero approximate-result) i64//one - approximate-result))) - (_.set remainder (i64//- remainder approximate-remainder)))))) + approximate-result) + result)) + (_.set remainder (i64//- approximate-remainder remainder)))))) (_.return result))) ))) -(runtime: (i64//% subject parameter) - (let [flat (i64//* (i64/// subject parameter) - parameter)] - (_.return (i64//- subject flat)))) +(runtime: (i64//% parameter subject) + (let [flat (|> subject + (i64/// parameter) + (i64//* parameter))] + (_.return (i64//- flat subject)))) (def: runtime//i64 Statement @@ -617,7 +618,7 @@ runtime//bit )) -(runtime: (text//index text part start) +(runtime: (text//index start part text) (with-vars [idx] ($_ _.then (_.define idx (|> text (_.do "indexOf" (list part (i64//to-number start))))) @@ -625,11 +626,11 @@ (_.return ..none) (_.return (..some (i64//from-number idx))))))) -(runtime: (text//clip text start end) +(runtime: (text//clip start end text) (_.return (|> text (_.do "substring" (list (_.the ..i64-low-field start) (_.the ..i64-low-field end)))))) -(runtime: (text//char text idx) +(runtime: (text//char idx text) (with-vars [result] ($_ _.then (_.define result (|> text (_.do "charCodeAt" (list (_.the ..i64-low-field idx))))) -- cgit v1.2.3 From 721e791b9273bb77b762a4dd48b085efc7bedd9b Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Thu, 4 Apr 2019 21:09:12 -0400 Subject: Updated JVM compiler. --- .gitignore | 1 + .../lang/translation/jvm/procedure/common.jvm.lux | 38 ++++++++++------------ 2 files changed, 19 insertions(+), 20 deletions(-) diff --git a/.gitignore b/.gitignore index d55202a8b..9fa81e94a 100644 --- a/.gitignore +++ b/.gitignore @@ -18,6 +18,7 @@ pom.xml.asc /new-luxc/target /new-luxc/source/lux.lux /new-luxc/source/lux +/new-luxc/source/program /lux-js/target /lux-js/source/lux.lux 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 faec813e9..6f5fccf4e 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 @@ -103,10 +103,10 @@ ## Extensions ### Lux -(def: (lux::is [leftI rightI]) +(def: (lux::is [referenceI sampleI]) Binary - (|>> leftI - rightI + (|>> referenceI + sampleI (predicateI _.IF_ACMPEQ))) (def: (lux::try riskyI) @@ -155,7 +155,7 @@ ) (template [ ] - [(def: ( [subjectI paramI]) + [(def: ( [paramI subjectI]) Binary (|>> subjectI (_.unwrap ) paramI (_.unwrap ) @@ -177,7 +177,7 @@ (template [ ] [(template [ ] - [(def: ( [subjectI paramI]) + [(def: ( [paramI subjectI]) Binary (|>> subjectI paramI @@ -217,7 +217,7 @@ lux-intI)) (template [ ] - [(def: ( [subjectI paramI]) + [(def: ( [paramI subjectI]) Binary (|>> subjectI paramI @@ -229,28 +229,26 @@ [text::< ..check-stringI ..check-stringI (_.INVOKEVIRTUAL "java.lang.String" "compareTo" (_t.method (list $String) (#.Some _t.int) (list)) #0) (predicateI _.IFLT)] - [text::concat ..check-stringI ..check-stringI - (_.INVOKEVIRTUAL "java.lang.String" "concat" (_t.method (list $String) (#.Some $String) (list)) #0) - (<|)] [text::char ..check-stringI jvm-intI (_.INVOKEVIRTUAL "java.lang.String" "charAt" (_t.method (list _t.int) (#.Some _t.char) (list)) #0) lux-intI] ) -(template [ ] - [(def: ( [subjectI paramI extraI]) - Trinary - (|>> subjectI - paramI - extraI - ))] +(def: (text::concat [leftI rightI]) + Binary + (|>> leftI ..check-stringI + rightI ..check-stringI + (_.INVOKEVIRTUAL "java.lang.String" "concat" (_t.method (list $String) (#.Some $String) (list)) #0))) - [text::clip ..check-stringI jvm-intI jvm-intI - (_.INVOKEVIRTUAL "java.lang.String" "substring" (_t.method (list _t.int _t.int) (#.Some $String) (list)) #0)] - ) +(def: (text::clip [startI endI subjectI]) + Trinary + (|>> subjectI ..check-stringI + startI jvm-intI + endI jvm-intI + (_.INVOKEVIRTUAL "java.lang.String" "substring" (_t.method (list _t.int _t.int) (#.Some $String) (list)) #0))) (def: index-method Method (_t.method (list $String _t.int) (#.Some _t.int) (list))) -(def: (text::index [textI partI startI]) +(def: (text::index [startI partI textI]) Trinary (<| _.with-label (function (_ @not-found)) _.with-label (function (_ @end)) -- cgit v1.2.3