diff options
| -rw-r--r-- | luxc/src/lux/analyser/proc/common.clj | 75 | ||||
| -rw-r--r-- | stdlib/source/lux.lux | 194 | ||||
| -rw-r--r-- | stdlib/source/lux/data/number.lux | 2 | ||||
| -rw-r--r-- | stdlib/source/lux/data/number/frac.lux | 28 | ||||
| -rw-r--r-- | stdlib/source/lux/data/number/i64.lux | 31 | ||||
| -rw-r--r-- | stdlib/source/lux/data/number/rev.lux | 6 | ||||
| -rw-r--r-- | stdlib/source/lux/data/text.lux | 44 | ||||
| -rw-r--r-- | stdlib/source/lux/tool/compiler/default/syntax.lux | 14 | ||||
| -rw-r--r-- | stdlib/source/lux/type/check.lux | 50 | ||||
| -rw-r--r-- | stdlib/source/test/lux/compiler/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 [<name> <proc> <input-type> <output-type>] (defn- <name> [analyse exo-type ?values] - (|do [:let [(&/$Cons x (&/$Cons y (&/$Nil))) ?values] - =x (&&/analyse-1 analyse <input-type> x) - =y (&&/analyse-1 analyse <input-type> y) + (|do [:let [(&/$Cons reference (&/$Cons sample (&/$Nil))) ?values] + =reference (&&/analyse-1 analyse <input-type> reference) + =sample (&&/analyse-1 analyse <input-type> sample) _ (&type/check exo-type <output-type>) _cursor &/cursor] (return (&/|list (&&/|meta exo-type _cursor - (&&/$proc (&/T <proc>) (&/|list =x =y) (&/|list))))))) + (&&/$proc (&/T <proc>) (&/|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 [<name> <proc-name> <output-type>] - (defn- <name> [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 <output-type>) - _cursor &/cursor] - (return (&/|list (&&/|meta exo-type _cursor - (&&/$proc (&/T ["text" <proc-name>]) - (&/|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 <input-type> outputT <output-type>] (defn- <name> [analyse exo-type ?values] - (|do [:let [(&/$Cons subjectC (&/$Cons paramC (&/$Nil))) ?values] + (|do [:let [(&/$Cons parameterC (&/$Cons subjectC (&/$Nil))) ?values] + parameterA (&&/analyse-1 analyse <input-type> parameterC) subjectA (&&/analyse-1 analyse <input-type> subjectC) - paramA (&&/analyse-1 analyse <input-type> paramC) _ (&type/check exo-type <output-type>) _cursor &/cursor] (return (&/|list (&&/|meta exo-type _cursor - (&&/$proc (&/T <proc>) (&/|list subjectA paramA) (&/|list)))))))) + (&&/$proc (&/T <proc>) (&/|list subjectA parameterA) (&/|list)))))))) analyse-i64-eq ["i64" "="] (&/$Apply &type/Any &type/I64) &type/Bit analyse-i64-add ["i64" "+"] (&/$Apply &type/Any &type/I64) &type/I64 analyse-i64-sub ["i64" "-"] (&/$Apply &type/Any &type/I64) &type/I64 - ) - -(do-template [<name> <proc> <input-type> <output-type>] - (let [inputT <input-type> - outputT <output-type>] - (defn- <name> [analyse exo-type ?values] - (|do [:let [(&/$Cons x (&/$Cons y (&/$Nil))) ?values] - =x (&&/analyse-1 analyse <input-type> x) - =y (&&/analyse-1 analyse <input-type> y) - _ (&type/check exo-type <output-type>) - _cursor &/cursor] - (return (&/|list (&&/|meta exo-type _cursor - (&&/$proc (&/T <proc>) (&/|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 [<type> - <eq-proc> <lt-proc> <eq-name> <lt-name> <lte-name> <gt-name> <gte-name> - <eq-doc> <<-doc> <<=-doc> <>-doc> <>=-doc>] - [(def:''' #export (<eq-name> test subject) + <eq-proc> <lt-proc> <eq-name> <lt-name> <lte-name> <gt-name> <gte-name> + <eq-doc> <<-doc> <<=-doc> <>-doc> <>=-doc>] + [(def:''' #export (<eq-name> reference sample) (list [(tag$ ["lux" "doc"]) (text$ <eq-doc>)]) (-> <type> <type> Bit) - (<eq-proc> subject test)) + (<eq-proc> reference sample)) - (def:''' #export (<lt-name> test subject) + (def:''' #export (<lt-name> reference sample) (list [(tag$ ["lux" "doc"]) (text$ <<-doc>)]) (-> <type> <type> Bit) - (<lt-proc> subject test)) + (<lt-proc> reference sample)) - (def:''' #export (<lte-name> test subject) + (def:''' #export (<lte-name> reference sample) (list [(tag$ ["lux" "doc"]) (text$ <<=-doc>)]) (-> <type> <type> Bit) - (if (<lt-proc> subject test) + (if (<lt-proc> reference sample) #1 - (<eq-proc> subject test))) + (<eq-proc> reference sample))) - (def:''' #export (<gt-name> test subject) + (def:''' #export (<gt-name> reference sample) (list [(tag$ ["lux" "doc"]) (text$ <>-doc>)]) (-> <type> <type> Bit) - (<lt-proc> test subject)) + (<lt-proc> sample reference)) - (def:''' #export (<gte-name> test subject) + (def:''' #export (<gte-name> reference sample) (list [(tag$ ["lux" "doc"]) (text$ <>=-doc>)]) (-> <type> <type> Bit) - (if (<lt-proc> test subject) + (if (<lt-proc> sample reference) #1 - (<eq-proc> subject test)))] + (<eq-proc> 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 [<type> <name> <op> <doc>] [(def:''' #export (<name> param subject) (list [(tag$ ["lux" "doc"]) (text$ <doc>)]) (-> <type> <type> <type>) - (<op> subject param))] + (<op> 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$ <doc>)]) (-> <type> <type> <type>) - (<op> subject param))] + (<op> 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 [<name> <from> <to> <proc>] [(def: #export (<name> n) (-> <from> <to>) - (<proc> [n]))] + (<proc> 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 [<name> <extension> <doc>] - [(def: #export (<name> value) + [(def: #export <name> {#.doc <doc>} (All [s] (-> (I64 s) (I64 s))) - (<extension> value 1))] + (|>> (<extension> 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/* <base> dec-left) digit-idx (|> shifted (f/% <base>) frac-to-int .nat)] (recur (f/% +1.0 shifted) - ("lux text concat" output ("lux text clip" <char-set> digit-idx (inc digit-idx))))))))] + ("lux text concat" output ("lux text clip" digit-idx (inc digit-idx) <char-set>)))))))] ("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 [(:: <int> decode whole-part) (:: <int> 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 (|> (<from> #0 decimal-part) ("lux text concat" ".") ("lux text concat" (<from> #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 (|> (<to> decimal-part) ("lux text concat" ".") ("lux text concat" (<to> 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 [<name> <op> <doc>] - [(def: #export (<name> param subject) +(template [<parameter-type> <name> <op> <doc>] + [(def: #export (<name> parameter subject) {#.doc <doc>} - (All [s] (-> (I64 Any) (I64 s) (I64 s))) - (<op> param subject))] - - [and "lux i64 and" "Bitwise and."] - [or "lux i64 or" "Bitwise or."] - [xor "lux i64 xor" "Bitwise xor."] + (All [s] (-> <parameter-type> (I64 s) (I64 s))) + (<op> 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 [<name> <op> <doc>] - [(def: #export (<name> param subject) - {#.doc <doc>} - (All [s] (-> Nat (I64 s) (I64 s))) - (<op> 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 [<struct> <codec> <char-bit-size> <error>] [(with-expansions [<error-output> (as-is (#error.Failure ("lux text concat" <error> 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 [<name> <extension> <diff>] [(template: (<name> value) - (<extension> value <diff>))] + (<extension> <diff> 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 [<name> <extension>] [(template: (<name> reference subject) - (<extension> subject reference))] + (<extension> reference subject))] [!n/= "lux i64 ="] [!i/< "lux int <"] @@ -79,7 +79,7 @@ (template [<name> <extension>] [(template: (<name> param subject) - (<extension> subject param))] + (<extension> 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 [<tag>] (<tag> leftT rightT) (do ..monad [leftT' (clean leftT)] (|> (clean rightT) - (check;map (|>> (<tag> leftT')))))) + (check@map (|>> (<tag> 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" |