diff options
author | Eduardo Julian | 2017-02-16 20:09:52 -0400 |
---|---|---|
committer | Eduardo Julian | 2017-02-16 20:09:52 -0400 |
commit | b0114f4871a6a2654fa2edc667a635a97ae76b19 (patch) | |
tree | 9e501a76cfb77a1b523384660e0020a2a15ffe44 /stdlib/source | |
parent | 47ddcadd07234f32d6d4f1411548ccf9665e60c3 (diff) |
- Implemented several new procedures.
- Improved Lux-to-JS interactions.
- Parallel compilation works for the JS backend.
- Added more primitive functionality to the JS runtime.
- More common procedures.
Diffstat (limited to 'stdlib/source')
-rw-r--r-- | stdlib/source/lux.lux | 162 | ||||
-rw-r--r-- | stdlib/source/lux/data/number.lux | 105 | ||||
-rw-r--r-- | stdlib/source/lux/data/text.lux | 8 | ||||
-rw-r--r-- | stdlib/source/lux/math/complex.lux | 8 |
4 files changed, 136 insertions, 147 deletions
diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux index 06c0fd2fd..c6018398b 100644 --- a/stdlib/source/lux.lux +++ b/stdlib/source/lux.lux @@ -1666,6 +1666,13 @@ (#Cons [[k' v] dict']) (#Cons [[k' v'] (put k v dict')])))) +(def:''' #export (log! message) + (list [["lux" "doc"] (#TextA "Logs message to standard output. + + Useful for debugging.")]) + (-> Text Unit) + (_lux_proc ["io" "log"] [message])) + (def:''' (Text/append x y) #Nil (-> Text Text Text) @@ -2241,13 +2248,6 @@ (-> Bool Bool) (if x false true)) -(def:''' #export (log! message) - (list [["lux" "doc"] (#TextA "Logs message to standard output. - - Useful for debugging.")]) - (-> Text Unit) - (_lux_proc ["io" "log!"] [message])) - (def:''' (find-macro' modules current-module module name) #Nil (-> ($' List (& Text Module)) @@ -2568,7 +2568,7 @@ (macro:' #export (Rec tokens) (list [["lux" "doc"] (#TextA "## Parameter-less recursive types. - ## A name has to be given to the whole type, to use it within it's body. + ## A name has to be given to the whole type, to use it within its body. (Rec Self [Int (List Self)])")]) (_lux_case tokens @@ -3223,42 +3223,81 @@ (#Some y)))) (def: (last-index-of part text) - (-> Text Text Int) - (_lux_proc ["jvm" "i2l"] [(_lux_proc ["jvm" "invokevirtual:java.lang.String:lastIndexOf:java.lang.String"] [text part])])) + (-> Text Text (Maybe Nat)) + (_lux_proc ["text" "last-index"] [text part])) (def: (index-of part text) - (-> Text Text Int) - (_lux_proc ["jvm" "i2l"] [(_lux_proc ["jvm" "invokevirtual:java.lang.String:indexOf:java.lang.String"] [text part])])) + (-> Text Text (Maybe Nat)) + (_lux_proc ["text" "index"] [text part])) + +(def: (clip1 from text) + (-> Nat Text (Maybe Text)) + (_lux_proc ["text" "clip"] [text from (_lux_proc ["text" "size"] [text])])) + +(def: (clip2 from to text) + (-> Nat Nat Text (Maybe Text)) + (_lux_proc ["text" "clip"] [text from to])) + +(def: #export (error! message) + {#;doc "## Causes an error, with the given error message. + (error! \"OH NO!\")"} + (-> Text Bottom) + (_lux_proc ["io" "error"] [message])) -(def: (substring1 idx text) - (-> Int Text Text) - (_lux_proc ["jvm" "invokevirtual:java.lang.String:substring:int"] [text (_lux_proc ["jvm" "l2i"] [idx])])) +(macro: #export (default tokens state) + {#;doc "## Allows you to provide a default value that will be used + ## if a (Maybe x) value turns out to be #;None. + (default 20 (#;Some 10)) => 10 -(def: (substring2 idx1 idx2 text) - (-> Int Int Text Text) - (_lux_proc ["jvm" "invokevirtual:java.lang.String:substring:int,int"] [text (_lux_proc ["jvm" "l2i"] [idx1]) (_lux_proc ["jvm" "l2i"] [idx2])])) + (default 20 #;None) => 20"} + (case tokens + (^ (list else maybe)) + (let [g!temp (: AST [_cursor (#;SymbolS ["" ""])]) + code (` (case (~ maybe) + (#;Some (~ g!temp)) + (~ g!temp) + + #;None + (~ else)))] + (#;Right [state (list code)])) + + _ + (#;Left "Wrong syntax for ?"))) (def: (split-text splitter input) (-> Text Text (List Text)) - (let [idx (index-of splitter input)] - (if (i.< 0 idx) - (#Cons input #Nil) - (#Cons (substring2 0 idx input) - (split-text splitter (substring1 (i.+ 1 idx) input)))))) + (case (index-of splitter input) + #;None + (#Cons input #Nil) + + (#;Some idx) + (#Cons (default (error! "UNDEFINED") + (clip2 +0 idx input)) + (split-text splitter + (default (error! "UNDEFINED") + (clip1 (n.+ +1 idx) input)))))) (def: (split-module-contexts module) (-> Text (List Text)) - (#Cons module (let [idx (last-index-of "/" module)] - (if (i.< 0 idx) - #Nil - (split-module-contexts (substring2 0 idx module)))))) + (#Cons module (case (last-index-of "/" module) + #;None + #Nil + + (#;Some idx) + (split-module-contexts (default (error! "UNDEFINED") + (clip2 +0 idx module)))))) (def: (split-module module) (-> Text (List Text)) - (let [idx (index-of "/" module)] - (if (i.< 0 idx) - (list module) - (list& (substring2 0 idx module) (split-module (substring1 (i.+ 1 idx) module)))))) + (case (index-of "/" module) + #;None + (list module) + + (#;Some idx) + (list& (default (error! "UNDEFINED") + (clip2 +0 idx module)) + (split-module (default (error! "UNDEFINED") + (clip1 (n.+ +1 idx) module)))))) (def: (nth idx xs) (All [a] @@ -3881,22 +3920,22 @@ (def: (replace pattern value template) (-> Text Text Text Text) - (_lux_proc ["jvm" "invokevirtual:java.lang.String:replace:java.lang.CharSequence,java.lang.CharSequence"] [template pattern value])) + (_lux_proc ["text" "replace-all"] [template pattern value])) (def: (clean-module module) (-> Text (Lux Text)) (do Monad<Lux> - [module-name current-module-name] + [current-module current-module-name] (case (split-module module) (^ (list& "." parts)) - (return (|> (list& module-name parts) (interpose "/") reverse (fold Text/append ""))) + (return (|> (list& current-module parts) (interpose "/") reverse (fold Text/append ""))) parts (let [[ups parts'] (split-with (Text/= "..") parts) num-ups (length ups)] (if (i.= num-ups 0) (return module) - (case (nth num-ups (split-module-contexts module-name)) + (case (nth num-ups (split-module-contexts current-module)) #None (fail (Text/append "Can't clean module: " module)) @@ -4378,26 +4417,6 @@ #let [{#module-hash _ #module-aliases _ #defs _ #imports imports #tags _ #types _ #module-anns _ #module-state _} module]] (wrap (is-member? imports import-name)))) -(macro: #export (default tokens state) - {#;doc "## Allows you to provide a default value that will be used - ## if a (Maybe x) value turns out to be #;None. - (default 20 (#;Some 10)) => 10 - - (default 20 #;None) => 20"} - (case tokens - (^ (list else maybe)) - (let [g!temp (: AST [_cursor (#;SymbolS ["" ""])]) - code (` (case (~ maybe) - (#;Some (~ g!temp)) - (~ g!temp) - - #;None - (~ else)))] - (#;Right [state (list code)])) - - _ - (#;Left "Wrong syntax for ?"))) - (def: (read-refer module-name options) (-> Text (List AST) (Lux Refer)) (do Monad<Lux> @@ -4790,13 +4809,13 @@ _ (fail "Wrong syntax for ^template"))) -(do-template [<name> <from> <to> <converter>] +(do-template [<name> <from> <to> <proc>] [(def: #export (<name> n) (-> <from> <to>) - (_lux_proc ["jvm" <converter>] [n]))] + (_lux_proc <proc> [n]))] - [real-to-int Real Int "d2l"] - [int-to-real Int Real "l2d"] + [real-to-int Real Int ["real" "to-int"]] + [int-to-real Int Real ["int" "to-real"]] ) (def: (find-baseline-column ast) @@ -4874,11 +4893,10 @@ (-> <from> <to>) (_lux_proc <op> [input]))] - [int-to-nat ["int" "to-nat"] Int Nat] - [nat-to-int ["nat" "to-int"] Nat Int] - + [int-to-nat ["int" "to-nat"] Int Nat] + [nat-to-int ["nat" "to-int"] Nat Int] [real-to-deg ["real" "to-deg"] Real Deg] - [deg-to-real ["deg" "to-real"] Deg Real] + [deg-to-real ["deg" "to-real"] Deg Real] ) (def: (repeat n x) @@ -4897,13 +4915,11 @@ (def: (Text/size x) (-> Text Nat) - (:! Nat - (_lux_proc ["jvm" "i2l"] - [(_lux_proc ["jvm" "invokevirtual:java.lang.String:length:"] [x])]))) + (_lux_proc ["text" "size"] [x])) (def: (Text/trim x) (-> Text Text) - (_lux_proc ["jvm" "invokevirtual:java.lang.String:trim:"] [x])) + (_lux_proc ["text" "trim"] [x])) (def: (update-cursor [file line column] ast-text) (-> Cursor Text Cursor) @@ -5468,7 +5484,7 @@ "This one should fail:" (is 5 (i.+ 2 3)))} (All [a] (-> a a Bool)) - (_lux_proc ["lux" "=="] [left right])) + (_lux_proc ["lux" "is"] [left right])) (macro: #export (^@ tokens) {#;doc (doc "Allows you to simultaneously bind and de-structure a value." @@ -5514,12 +5530,6 @@ _ (fail "Wrong syntax for :!!"))) -(def: #export (error! message) - {#;doc (doc "Causes an error, with the given error message." - (error! "OH NO!"))} - (-> Text Bottom) - (_lux_proc ["jvm" "throw"] [(_lux_proc ["jvm" "new:java.lang.Error:java.lang.String"] [message])])) - (def: #hidden hack_Text/append (-> Text Text Text) Text/append) @@ -5735,3 +5745,7 @@ (type: #export (<.> f g) (All [a] (f (g a)))) + +(def: #export (assume mx) + (All [a] (-> (Maybe a) a)) + (default (undefined) mx)) diff --git a/stdlib/source/lux/data/number.lux b/stdlib/source/lux/data/number.lux index 998b42ea8..ce0d5f887 100644 --- a/stdlib/source/lux/data/number.lux +++ b/stdlib/source/lux/data/number.lux @@ -17,7 +17,7 @@ [ Nat n.=] [ Int i.=] - [Deg d.=] + [ Deg d.=] [Real r.=] ) @@ -29,9 +29,9 @@ (def: > <gt>) (def: >= <gte>))] - [ Nat Eq<Nat> n.< n.<= n.> n.>=] - [ Int Eq<Int> i.< i.<= i.> i.>=] - [Deg Eq<Deg> d.< d.<= d.> d.>=] + [ Nat Eq<Nat> n.< n.<= n.> n.>=] + [ Int Eq<Int> i.< i.<= i.> i.>=] + [Deg Eq<Deg> d.< d.<= d.> d.>=] [Real Eq<Real> r.< r.<= r.> r.>=] ) @@ -100,38 +100,34 @@ (def: top <top>) (def: bottom <bottom>))] - [ Nat Ord<Nat> (_lux_proc ["nat" "max-value"] []) (_lux_proc ["nat" "min-value"] [])] - [ Int Ord<Int> (_lux_proc ["jvm" "getstatic:java.lang.Long:MAX_VALUE"] []) (_lux_proc ["jvm" "getstatic:java.lang.Long:MIN_VALUE"] [])] - [Real Ord<Real> (_lux_proc ["jvm" "getstatic:java.lang.Double:MAX_VALUE"] []) (_lux_proc ["jvm" "getstatic:java.lang.Double:MIN_VALUE"] [])] - [Deg Ord<Deg> (_lux_proc ["deg" "max-value"] []) (_lux_proc ["deg" "min-value"] [])]) + [ Nat Ord<Nat> (_lux_proc [ "nat" "max-value"] []) (_lux_proc [ "nat" "min-value"] [])] + [ Int Ord<Int> (_lux_proc [ "int" "max-value"] []) (_lux_proc [ "int" "min-value"] [])] + [Real Ord<Real> (_lux_proc ["real" "max-value"] []) (_lux_proc ["real" "min-value"] [])] + [ Deg Ord<Deg> (_lux_proc [ "deg" "max-value"] []) (_lux_proc [ "deg" "min-value"] [])]) (do-template [<name> <type> <unit> <append>] [(struct: #export <name> (Monoid <type>) (def: unit <unit>) (def: (append x y) (<append> x y)))] - [ Add@Monoid<Nat> Nat +0 n.+] - [ Mul@Monoid<Nat> Nat +1 n.*] + [ Add@Monoid<Nat> Nat +0 n.+] + [ Mul@Monoid<Nat> Nat +1 n.*] [ Max@Monoid<Nat> Nat (:: Interval<Nat> bottom) n.max] [ Min@Monoid<Nat> Nat (:: Interval<Nat> top) n.min] - [ Add@Monoid<Int> Int 0 i.+] - [ Mul@Monoid<Int> Int 1 i.*] + [ Add@Monoid<Int> Int 0 i.+] + [ Mul@Monoid<Int> Int 1 i.*] [ Max@Monoid<Int> Int (:: Interval<Int> bottom) i.max] [ Min@Monoid<Int> Int (:: Interval<Int> top) i.min] - [Add@Monoid<Real> Real 0.0 r.+] - [Mul@Monoid<Real> Real 1.0 r.*] + [Add@Monoid<Real> Real 0.0 r.+] + [Mul@Monoid<Real> Real 1.0 r.*] [Max@Monoid<Real> Real (:: Interval<Real> bottom) r.max] [Min@Monoid<Real> Real (:: Interval<Real> top) r.min] - [Add@Monoid<Deg> Deg (:: Interval<Deg> bottom) d.+] - [Mul@Monoid<Deg> Deg (:: Interval<Deg> top) d.*] - [Max@Monoid<Deg> Deg (:: Interval<Deg> bottom) d.max] - [Min@Monoid<Deg> Deg (:: Interval<Deg> top) d.min] + [ Add@Monoid<Deg> Deg (:: Interval<Deg> bottom) d.+] + [ Mul@Monoid<Deg> Deg (:: Interval<Deg> top) d.*] + [ Max@Monoid<Deg> Deg (:: Interval<Deg> bottom) d.max] + [ Min@Monoid<Deg> Deg (:: Interval<Deg> top) d.min] ) -(def: (text.replace pattern value template) - (-> Text Text Text Text) - (_lux_proc ["jvm" "invokevirtual:java.lang.String:replace:java.lang.CharSequence,java.lang.CharSequence"] [template pattern value])) - (do-template [<type> <encoder> <decoder> <error>] [(struct: #export _ (Codec Text <type>) (def: (encode x) @@ -145,26 +141,10 @@ #;None (#;Left <error>))))] - [Nat ["nat" "encode"] ["nat" "decode"] "Couldn't decode Nat"] - [Deg ["deg" "encode"] ["deg" "decode"] "Couldn't decode Deg"] - ) - -(def: clean-number - (-> Text Text) - (text.replace "_" "")) - -(do-template [<type> <encode> <decode> <error>] - [(struct: #export _ (Codec Text <type>) - (def: (encode x) - (_lux_proc ["jvm" <encode>] [x])) - - (def: (decode input) - (_lux_proc ["jvm" "try"] - [(#;Right (_lux_proc ["jvm" <decode>] [(clean-number input)])) - (lambda [e] (#;Left <error>))])))] - - [ Int "invokevirtual:java.lang.Object:toString:" "invokestatic:java.lang.Long:parseLong:java.lang.String" "Couldn't parse Int"] - [Real "invokevirtual:java.lang.Object:toString:" "invokestatic:java.lang.Double:parseDouble:java.lang.String" "Couldn't parse Real"] + [ Nat [ "nat" "encode"] [ "nat" "decode"] "Couldn't decode Nat"] + [ Int [ "int" "encode"] [ "int" "decode"] "Couldn't decode Int"] + [ Deg [ "deg" "encode"] [ "deg" "decode"] "Couldn't decode Deg"] + [Real ["real" "encode"] ["real" "decode"] "Couldn't decode Real"] ) (struct: #export _ (Hash Nat) @@ -178,13 +158,24 @@ (struct: #export _ (Hash Real) (def: eq Eq<Real>) - (def: hash - (|>. (:: Codec<Text,Real> encode) - [] - (_lux_proc ["jvm" "invokevirtual:java.lang.Object:hashCode:"]) - [] - (_lux_proc ["jvm" "i2l"]) - int-to-nat))) + (def: (hash value) + (_lux_proc ["real" "hash"] [value]))) + +(do-template [<name> <const> <doc>] + [(def: #export <name> + {#;doc <doc>} + Real + (_lux_proc ["real" <const>] []))] + + [not-a-number "not-a-number" "Not-a-number."] + [positive-infinity "positive-infinity" "Positive infinity."] + [negative-infinity "negative-infinity" "Negative infinity."] + ) + +(def: #export (not-a-number? number) + {#;doc "Tests whether a real is actually not-a-number."} + (-> Real Bool) + (not (r.= number number))) ## [Values & Syntax] (do-template [<struct> <to-proc> <radix> <macro> <error> <doc>] @@ -221,19 +212,3 @@ (doc "Given syntax for a hexadecimal number, generates a Nat." (hex "deadBEEF"))] ) - -(do-template [<name> <field> <doc>] - [(def: #export <name> - {#;doc <doc>} - Real - (_lux_proc ["jvm" <field>] []))] - - [nan "getstatic:java.lang.Double:NaN" "Not-a-number."] - [+inf "getstatic:java.lang.Double:POSITIVE_INFINITY" "Positive infinity."] - [-inf "getstatic:java.lang.Double:NEGATIVE_INFINITY" "Negative infinity."] - ) - -(def: #export (nan? number) - {#;doc "Tests whether a real is actually not-a-number."} - (-> Real Bool) - (not (r.= number number))) diff --git a/stdlib/source/lux/data/text.lux b/stdlib/source/lux/data/text.lux index bec6d7d2b..9375d6876 100644 --- a/stdlib/source/lux/data/text.lux +++ b/stdlib/source/lux/data/text.lux @@ -33,7 +33,7 @@ [trim "invokevirtual:java.lang.String:trim:"] ) -(def: #export (sub from to x) +(def: #export (clip from to x) (-> Nat Nat Text (Maybe Text)) (if (and (n.< to from) (n.<= (size x) to)) @@ -43,9 +43,9 @@ (_lux_proc ["jvm" "l2i"] [(nat-to-int to)])])) #;None)) -(def: #export (sub' from x) +(def: #export (clip' from x) (-> Nat Text (Maybe Text)) - (sub from (size x) x)) + (clip from (size x) x)) (def: #export (replace pattern value template) (-> Text Text Text Text) @@ -158,7 +158,7 @@ (def: (decode input) (if (and (starts-with? "\"" input) (ends-with? "\"" input)) - (case (sub +1 (n.dec (size input)) input) + (case (clip +1 (n.dec (size input)) input) (#;Some input') (|> input' (replace "\\\\" "\\") diff --git a/stdlib/source/lux/math/complex.lux b/stdlib/source/lux/math/complex.lux index eae4fbe55..87b1a7d18 100644 --- a/stdlib/source/lux/math/complex.lux +++ b/stdlib/source/lux/math/complex.lux @@ -38,9 +38,9 @@ (def: #export zero Complex (complex 0.0 0.0)) -(def: #export (nan? complex) - (or (number;nan? (get@ #real complex)) - (number;nan? (get@ #imaginary complex)))) +(def: #export (not-a-number? complex) + (or (number;not-a-number? (get@ #real complex)) + (number;not-a-number? (get@ #imaginary complex)))) (def: #export (c.= param input) (-> Complex Complex Bool) @@ -317,7 +317,7 @@ (def: (decode input) (case (do Monad<Maybe> - [input' (text;sub +1 (n.- +1 (text;size input)) input)] + [input' (text;clip +1 (n.- +1 (text;size input)) input)] (text;split-with "," input')) #;None (#;Left (Text/append "Wrong syntax for complex numbers: " input)) |