diff options
Diffstat (limited to 'stdlib/source/lux.lux')
| -rw-r--r-- | stdlib/source/lux.lux | 324 |
1 files changed, 136 insertions, 188 deletions
diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux index 2b66cdbe1..e2782012b 100644 --- a/stdlib/source/lux.lux +++ b/stdlib/source/lux.lux @@ -2006,11 +2006,6 @@ (-> Int Int Bool) (_lux_proc ["jvm" "leq"] [x y])) -(def:''' (n= x y) - #Nil - (-> Nat Nat Bool) - (_lux_proc ["nat" "="] [x y])) - (def:''' (->Text x) #Nil (-> (host java.lang.Object) Text) @@ -2021,10 +2016,10 @@ (do-template [<name> <diff>] [(def: #export <name> (-> Int Int) - (+ <diff>))] + (i.+ <diff>))] - [inc 1] - [dec -1])")]) + [i.inc 1] + [i.dec -1])")]) (_lux_case tokens (#Cons [[_ (#TupleS bindings)] (#Cons [[_ (#TupleS templates)] data])]) (_lux_case [(mapM Monad<Maybe> get-name bindings) @@ -2045,53 +2040,106 @@ _ (fail "Wrong syntax for do-template"))) +(do-template [<type> <category> <=-name> <=> <lt-name> <lte-name> <lt> <gt-name> <gte-name> + <eq-doc> <<-doc> <<=-doc> <>-doc> <>=-doc>] + [(def:''' #export (<=-name> test subject) + (list [["lux" "doc"] (#TextM <eq-doc>)]) + (-> <type> <type> Bool) + (_lux_proc [<category> <=>] [subject test])) + + (def:''' #export (<lt-name> test subject) + (list [["lux" "doc"] (#TextM <<-doc>)]) + (-> <type> <type> Bool) + (_lux_proc [<category> <lt>] [subject test])) -(do-template [<name> <cmp> <type>] - [(def:''' (<name> x y) - #Nil + (def:''' #export (<lte-name> test subject) + (list [["lux" "doc"] (#TextM <<=-doc>)]) + (-> <type> <type> Bool) + (if (_lux_proc [<category> <lt>] [subject test]) + true + (_lux_proc [<category> <=>] [subject test]))) + + (def:''' #export (<gt-name> test subject) + (list [["lux" "doc"] (#TextM <>-doc>)]) + (-> <type> <type> Bool) + (_lux_proc [<category> <lt>] [test subject])) + + (def:''' #export (<gte-name> test subject) + (list [["lux" "doc"] (#TextM <>=-doc>)]) (-> <type> <type> Bool) - (_lux_proc ["jvm" <cmp>] [x y]))] + (if (_lux_proc [<category> <lt>] [test subject]) + true + (_lux_proc [<category> <=>] [subject test])))] - ## [i= "leq" Int] - [i> "lgt" Int] - [i< "llt" Int] + [ Nat "nat" n.= "=" n.< n.<= "<" n.> n.>= + "Natural equality." "Natural less-than." "Natural less-than-equal." "Natural greater-than." "Natural greater-than-equal."] + + [ Int "jvm" i.= "leq" i.< i.<= "llt" i.> i.>= + "Integer equality." "Integer less-than." "Integer less-than-equal." "Integer greater-than." "Integer greater-than-equal."] + + [Frac "frac" f.= "=" f.< f.<= "<" f.> f.>= + "Fractional equality." "Fractional less-than." "Fractional less-than-equal." "Fractional greater-than." "Fractional greater-than-equal."] + + [Real "jvm" r.= "deq" r.< r.<= "dlt" r.> r.>= + "Real equality." "Real less-than." "Real less-than-equal." "Real greater-than." "Real greater-than-equal."] ) -(do-template [<name> <cmp> <eq> <type>] - [(def:''' (<name> x y) - #Nil - (-> <type> <type> Bool) - (if (<cmp> x y) - true - (<eq> x y)))] +(do-template [<type> <name> <op> <doc>] + [(def:''' #export (<name> param subject) + (list [["lux" "doc"] (#TextM <doc>)]) + (-> <type> <type> <type>) + (_lux_proc <op> [subject param]))] - [i>= i> i= Int] - [i<= i< i= Int] + [ Nat n.+ ["nat" "+"] "Nat(ural) addition."] + [ Nat n.- ["nat" "-"] "Nat(ural) substraction."] + [ Nat n.* ["nat" "*"] "Nat(ural) multiplication."] + [ Nat n./ ["nat" "/"] "Nat(ural) division."] + [ Nat n.% ["nat" "%"] "Nat(ural) remainder."] + + [ Int i.+ ["jvm" "ladd"] "Int(eger) addition."] + [ Int i.- ["jvm" "lsub"] "Int(eger) substraction."] + [ Int i.* ["jvm" "lmul"] "Int(eger) multiplication."] + [ Int i./ ["jvm" "ldiv"] "Int(eger) division."] + [ Int i.% ["jvm" "lrem"] "Int(eger) remainder."] + + [Frac f.+ ["frac" "+"] "Frac(tional) addition."] + [Frac f.- ["frac" "-"] "Frac(tional) substraction."] + [Frac f.* ["frac" "*"] "Frac(tional) multiplication."] + [Frac f./ ["frac" "/"] "Frac(tional) division."] + [Frac f.% ["frac" "%"] "Frac(tional) remainder."] + + [Real r.+ ["jvm" "dadd"] "Real addition."] + [Real r.- ["jvm" "dsub"] "Real substraction."] + [Real r.* ["jvm" "dmul"] "Real multiplication."] + [Real r./ ["jvm" "ddiv"] "Real division."] + [Real r.% ["jvm" "drem"] "Real remainder."] ) -(do-template [<name> <op> <type>] - [(def:''' (<name> x y) - #Nil +(do-template [<name> <type> <test> <doc>] + [(def:''' #export (<name> left right) + (list [["lux" "doc"] (#TextM <doc>)]) (-> <type> <type> <type>) - (_lux_proc <op> [x y]))] - - [i+ ["jvm" "ladd"] Int] - [i- ["jvm" "lsub"] Int] - [i* ["jvm" "lmul"] Int] - [i/ ["jvm" "ldiv"] Int] - [i% ["jvm" "lrem"] Int] - - [n+ ["nat" "+"] Nat] - [n- ["nat" "-"] Nat] - [n* ["nat" "*"] Nat] - [n/ ["nat" "/"] Nat] - [n% ["nat" "%"] Nat] + (if (<test> right left) + left + right))] + + [n.min Nat n.< "Nat(ural) minimum."] + [n.max Nat n.> "Nat(ural) maximum."] + + [i.min Int i.< "Int(eger) minimum."] + [i.max Int i.> "Int(eger) maximum."] + + [f.min Frac f.< "Frac(tional) minimum."] + [f.max Frac f.> "Frac(tional) maximum."] + + [r.min Real r.< "Real minimum."] + [r.max Real r.> "Real minimum."] ) (def:''' (multiple? div n) #Nil (-> Int Int Bool) - (i= 0 (i% n div))) + (i.= 0 (i.% div n))) (def:''' #export (not x) #Nil @@ -2411,7 +2459,7 @@ #scope-type-vars scope-type-vars} (#Right {#info info #source source #modules modules #scopes scopes #type-vars types #host host - #seed (n+ +1 seed) #expected expected + #seed (n.+ +1 seed) #expected expected #cursor cursor #scope-type-vars scope-type-vars} (symbol$ ["" ($_ Text/append "__gensym__" prefix (->Text seed))])))) @@ -2601,7 +2649,7 @@ ## Allows the usage of macros within the patterns to provide custom syntax. (case (: (List Int) (list 1 2 3)) (#Cons x (#Cons y (#Cons z #Nil))) - (#Some ($_ * x y z)) + (#Some ($_ i.* x y z)) _ #None)")]) @@ -2619,7 +2667,7 @@ ## It's a special macro meant to be used with case. (case (: (List Int) (list 1 2 3)) (^ (list x y z)) - (#Some ($_ * x y z)) + (#Some ($_ i.* x y z)) _ #None)")]) @@ -3098,24 +3146,24 @@ (def: (split-text splitter input) (-> Text Text (List Text)) (let [idx (index-of splitter input)] - (if (i< idx 0) + (if (i.< 0 idx) (#Cons input #Nil) (#Cons (substring2 0 idx input) - (split-text splitter (substring1 (i+ 1 idx) input)))))) + (split-text splitter (substring1 (i.+ 1 idx) input)))))) (def: (split-module-contexts module) (-> Text (List Text)) (#Cons module (let [idx (last-index-of "/" module)] - (if (i< idx 0) + (if (i.< 0 idx) #Nil (split-module-contexts (substring2 0 idx module)))))) (def: (split-module module) (-> Text (List Text)) (let [idx (index-of "/" module)] - (if (i< idx 0) + (if (i.< 0 idx) (list module) - (list& (substring2 0 idx module) (split-module (substring1 (i+ 1 idx) module)))))) + (list& (substring2 0 idx module) (split-module (substring1 (i.+ 1 idx) module)))))) (def: (at idx xs) (All [a] @@ -3125,9 +3173,9 @@ #None (#Cons x xs') - (if (i= idx 0) + (if (i.= idx 0) (#Some x) - (at (i- idx 1) xs') + (at (i.- 1 idx) xs') ))) (def: (beta-reduce env type) @@ -3749,7 +3797,7 @@ parts (let [[ups parts'] (split-with (Text/= "..") parts) num-ups (length ups)] - (if (i= num-ups 0) + (if (i.= num-ups 0) (return module) (case (at num-ups (split-module-contexts module-name)) #None @@ -4086,7 +4134,7 @@ (odd? num) \"odd\" ## else-branch \"???\")"} - (if (i= 0 (i% (length tokens) 2)) + (if (i.= 0 (i.% 2 (length tokens))) (fail "cond requires an even number of arguments.") (case (reverse tokens) (^ (list& else branches')) @@ -4104,7 +4152,7 @@ (All [a] (-> Nat (List a) (List [Nat a]))) (case xs (#Cons x xs') - (#Cons [idx x] (enumerate' (n+ +1 idx) xs')) + (#Cons [idx x] (enumerate' (n.+ +1 idx) xs')) #Nil #Nil)) @@ -4136,7 +4184,7 @@ (#Some members) (let [pattern (record$ (map (: (-> [Ident [Nat Type]] [AST AST]) (lambda [[[r-prefix r-name] [r-idx r-type]]] - [(tag$ [r-prefix r-name]) (if (n= idx r-idx) + [(tag$ [r-prefix r-name]) (if (n.= idx r-idx) g!output g!_)])) (zip2 tags (enumerate members))))] @@ -4459,7 +4507,7 @@ pattern')) output (record$ (map (: (-> [Ident Nat AST] [AST AST]) (lambda [[r-slot-name r-idx r-var]] - [(tag$ r-slot-name) (if (n= idx r-idx) + [(tag$ r-slot-name) (if (n.= idx r-idx) value r-var)])) pattern'))] @@ -4511,7 +4559,7 @@ (macro: #export (update@ tokens) {#;doc "## Modifies the value of a record at a given tag, based on some function. - (update@ #age inc person) + (update@ #age i.inc person) ## Can also work with multiple levels of nesting: (update@ [#foo #bar #baz] func my-record) @@ -4545,7 +4593,7 @@ pattern')) output (record$ (map (: (-> [Ident Nat AST] [AST AST]) (lambda [[r-slot-name r-idx r-var]] - [(tag$ r-slot-name) (if (n= idx r-idx) + [(tag$ r-slot-name) (if (n.= idx r-idx) (` ((~ fun) (~ r-var))) r-var)])) pattern'))] @@ -4628,7 +4676,7 @@ (do Monad<Maybe> [bindings' (mapM Monad<Maybe> get-name bindings) data' (mapM Monad<Maybe> tuple->list data)] - (if (every? (i= (length bindings')) (map length data')) + (if (every? (i.= (length bindings')) (map length data')) (let [apply (: (-> RepEnv (List AST)) (lambda [env] (map (apply-template env) templates)))] (|> data' @@ -4653,100 +4701,6 @@ [int-to-real Int Real "l2d"] ) -(do-template [<type> <category> <=-name> <=> <lt-name> <lte-name> <lt> <gt-name> <gte-name> - <eq-doc> <<-doc> <<=-doc> <>-doc> <>=-doc>] - [(def: #export (<=-name> test subject) - {#;doc <eq-doc>} - (-> <type> <type> Bool) - (_lux_proc [<category> <=>] [subject test])) - - (def: #export (<lt-name> test subject) - {#;doc <<-doc>} - (-> <type> <type> Bool) - (_lux_proc [<category> <lt>] [subject test])) - - (def: #export (<lte-name> test subject) - {#;doc <<=-doc>} - (-> <type> <type> Bool) - (or (_lux_proc [<category> <lt>] [subject test]) - (_lux_proc [<category> <=>] [subject test]))) - - (def: #export (<gt-name> test subject) - {#;doc <>-doc>} - (-> <type> <type> Bool) - (_lux_proc [<category> <lt>] [test subject])) - - (def: #export (<gte-name> test subject) - {#;doc <>=-doc>} - (-> <type> <type> Bool) - (or (_lux_proc [<category> <lt>] [test subject]) - (_lux_proc [<category> <=>] [subject test])))] - - [ Nat "nat" =+ "=" <+ <=+ "<" >+ >=+ - "Natural equality." "Natural less-than." "Natural less-than-equal." "Natural greater-than." "Natural greater-than-equal."] - - [ Int "jvm" = "leq" < <= "llt" > >= - "Integer equality." "Integer less-than." "Integer less-than-equal." "Integer greater-than." "Integer greater-than-equal."] - - [Frac "frac" =.. "=" <.. <=.. "<" >.. >=.. - "Fractional equality." "Fractional less-than." "Fractional less-than-equal." "Fractional greater-than." "Fractional greater-than-equal."] - - [Real "jvm" =. "deq" <. <=. "dlt" >. >=. - "Real equality." "Real less-than." "Real less-than-equal." "Real greater-than." "Real greater-than-equal."] - ) - -(do-template [<type> <name> <op> <doc>] - [(def: #export (<name> param subject) - {#;doc <doc>} - (-> <type> <type> <type>) - (_lux_proc <op> [subject param]))] - - [ Nat ++ ["nat" "+"] "Nat(ural) addition."] - [ Nat -+ ["nat" "-"] "Nat(ural) substraction."] - [ Nat *+ ["nat" "*"] "Nat(ural) multiplication."] - [ Nat /+ ["nat" "/"] "Nat(ural) division."] - [ Nat %+ ["nat" "%"] "Nat(ural) remainder."] - - [ Int + ["jvm" "ladd"] "Int(eger) addition."] - [ Int - ["jvm" "lsub"] "Int(eger) substraction."] - [ Int * ["jvm" "lmul"] "Int(eger) multiplication."] - [ Int / ["jvm" "ldiv"] "Int(eger) division."] - [ Int % ["jvm" "lrem"] "Int(eger) remainder."] - - [Frac +.. ["frac" "+"] "Frac(tional) addition."] - [Frac -.. ["frac" "-"] "Frac(tional) substraction."] - [Frac *.. ["frac" "*"] "Frac(tional) multiplication."] - [Frac /.. ["frac" "/"] "Frac(tional) division."] - [Frac %.. ["frac" "%"] "Frac(tional) remainder."] - - [Real +. ["jvm" "dadd"] "Real addition."] - [Real -. ["jvm" "dsub"] "Real substraction."] - [Real *. ["jvm" "dmul"] "Real multiplication."] - [Real /. ["jvm" "ddiv"] "Real division."] - [Real %. ["jvm" "drem"] "Real remainder."] - ) - -(do-template [<name> <type> <test> <doc>] - [(def: #export (<name> left right) - {#;doc <doc>} - (-> <type> <type> <type>) - (if (<test> right left) - left - right))] - - [min+ Nat <+ "Nat(ural) minimum."] - [max+ Nat >+ "Nat(ural) maximum."] - - [min Int < "Int(eger) minimum."] - [max Int > "Int(eger) maximum."] - - [min.. Frac <.. "Frac(tional) minimum."] - [max.. Frac >.. "Frac(tional) maximum."] - - [min. Real <. "Real minimum."] - [max. Real >. "Real minimum."] - ) - (def: (find-baseline-column ast) (-> AST Int) (case ast @@ -4765,12 +4719,12 @@ (^template [<tag>] [[_ _ column] (<tag> parts)] - (fold min column (map find-baseline-column parts))) + (fold i.min column (map find-baseline-column parts))) ([#FormS] [#TupleS]) [[_ _ column] (#RecordS pairs)] - (fold min column + (fold i.min column (List/append (map (. find-baseline-column first) pairs) (map (. find-baseline-column second) pairs))) )) @@ -4814,13 +4768,15 @@ )] ($_ Text/append "\"" escaped "\""))) -(do-template [<name> <diff>] - [(def: #export <name> - (-> Int Int) - (i+ <diff>))] +(do-template [<name> <op> <one> <type>] + [(def: #export (<name> value) + (-> <type> <type>) + (<op> <one> value))] - [inc 1] - [dec -1]) + [i.inc i.+ 1 Int] + [i.dec i.- 1 Int] + [n.inc n.+ +1 Nat] + [n.dec n.- +1 Nat]) (def: tag->Text (-> Ident Text) @@ -4828,16 +4784,16 @@ (def: (repeat n x) (All [a] (-> Int a (List a))) - (if (i> n 0) - (#;Cons x (repeat (i+ -1 n) x)) + (if (i.> 0 n) + (#;Cons x (repeat (i.+ -1 n) x)) #;Nil)) (def: (cursor-padding baseline [_ old-line old-column] [_ new-line new-column]) (-> Int Cursor Cursor Text) - (if (i= old-line new-line) - (Text/join (repeat (i- new-column old-column) " ")) - (let [extra-lines (Text/join (repeat (i- new-line old-line) "\n")) - space-padding (Text/join (repeat (i- new-column baseline) " "))] + (if (i.= old-line new-line) + (Text/join (repeat (i.- old-column new-column) " ")) + (let [extra-lines (Text/join (repeat (i.- old-line new-line) "\n")) + space-padding (Text/join (repeat (i.- baseline new-column) " "))] (Text/append extra-lines space-padding)))) (def: (Text/size x) @@ -4851,11 +4807,11 @@ (def: (update-cursor [file line column] ast-text) (-> Cursor Text Cursor) - [file line (i+ column (Text/size ast-text))]) + [file line (i.+ column (Text/size ast-text))]) (def: (delim-update-cursor [file line column]) (-> Cursor Cursor) - [file line (inc column)]) + [file line (i.inc column)]) (def: rejoin-all-pairs (-> (List [AST AST]) (List AST)) @@ -4926,7 +4882,7 @@ (loop [count 0 x init] (if (< 10 count) - (recur (inc count) (f x)) + (recur (i.inc count) (f x)) x)))"} (return (list (` (#;TextM (~ (|> tokens (map (. doc-fragment->Text identify-doc-fragment)) @@ -4998,7 +4954,7 @@ (loop [count 0 x init] (if (< 10 count) - (recur (inc count) (f x)) + (recur (i.inc count) (f x)) x)))} (case tokens (^ (list [_ (#TupleS bindings)] body)) @@ -5351,14 +5307,14 @@ (do-template [<type> <even> <odd> <%> <=> <0> <2>] [(def: #export (<even> n) (-> <type> Bool) - (<=> <0> (<%> n <2>))) + (<=> <0> (<%> <2> n))) (def: #export (<odd> n) (-> <type> Bool) (not (<even> n)))] - [Nat even?+ odd?+ n% n= +0 +2] - [Int even? odd? i% i= 0 2]) + [Nat n.even? n.odd? n.% n.= +0 +2] + [Int i.even? i.odd? i.% i.= 0 2]) (def: (get-scope-type-vars state) (Lux (List Nat)) @@ -5371,19 +5327,19 @@ )) (def: (list-at idx xs) - (All [a] (-> Int (List a) (Maybe a))) + (All [a] (-> Nat (List a) (Maybe a))) (case xs #;Nil #;None (#;Cons x xs') - (if (i= 0 idx) + (if (n.= +0 idx) (#;Some x) - (list-at (dec idx) xs')))) + (list-at (n.dec idx) xs')))) (macro: #export ($ tokens) (case tokens - (^ (list [_ (#IntS idx)])) + (^ (list [_ (#NatS idx)])) (do Monad<Lux> [stvs get-scope-type-vars] (case (list-at idx (reverse stvs)) @@ -5403,14 +5359,14 @@ (== 5 5)) "This one should fail:" - (== 5 (+ 2 3)))} + (== 5 (i.+ 2 3)))} (All [a] (-> a a Bool)) (_lux_proc ["lux" "=="] [left right])) (macro: #export (^@ tokens) {#;doc (doc "Allows you to simultaneously bind and de-structure a value." (def: (hash (^@ set [a/Hash _])) - (List/fold (lambda [elem acc] (+ (:: a/Hash hash elem) acc)) + (List/fold (lambda [elem acc] (i.+ (:: a/Hash hash elem) acc)) 0 (->List set))))} (case tokens @@ -5531,11 +5487,3 @@ [real-to-frac ["real" "to-frac"] Real Frac] [frac-to-real ["frac" "to-real"] Frac Real] ) - -(do-template [<name> <op>] - [(def: #export <name> - (-> Nat Nat) - (<op> +1))] - - [inc+ ++] - [dec+ -+]) |