From b0114f4871a6a2654fa2edc667a635a97ae76b19 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Thu, 16 Feb 2017 20:09:52 -0400 Subject: - 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. --- stdlib/source/lux.lux | 162 ++++++++++++++++++++----------------- stdlib/source/lux/data/number.lux | 105 +++++++++--------------- stdlib/source/lux/data/text.lux | 8 +- stdlib/source/lux/math/complex.lux | 8 +- 4 files changed, 136 insertions(+), 147 deletions(-) (limited to 'stdlib/source') 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 - [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 @@ -4790,13 +4809,13 @@ _ (fail "Wrong syntax for ^template"))) -(do-template [ ] +(do-template [ ] [(def: #export ( n) (-> ) - (_lux_proc ["jvm" ] [n]))] + (_lux_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 @@ (-> ) (_lux_proc [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: > ) (def: >= ))] - [ Nat Eq n.< n.<= n.> n.>=] - [ Int Eq i.< i.<= i.> i.>=] - [Deg Eq d.< d.<= d.> d.>=] + [ Nat Eq n.< n.<= n.> n.>=] + [ Int Eq i.< i.<= i.> i.>=] + [Deg Eq d.< d.<= d.> d.>=] [Real Eq r.< r.<= r.> r.>=] ) @@ -100,38 +100,34 @@ (def: top ) (def: bottom ))] - [ Nat Ord (_lux_proc ["nat" "max-value"] []) (_lux_proc ["nat" "min-value"] [])] - [ Int Ord (_lux_proc ["jvm" "getstatic:java.lang.Long:MAX_VALUE"] []) (_lux_proc ["jvm" "getstatic:java.lang.Long:MIN_VALUE"] [])] - [Real Ord (_lux_proc ["jvm" "getstatic:java.lang.Double:MAX_VALUE"] []) (_lux_proc ["jvm" "getstatic:java.lang.Double:MIN_VALUE"] [])] - [Deg Ord (_lux_proc ["deg" "max-value"] []) (_lux_proc ["deg" "min-value"] [])]) + [ Nat Ord (_lux_proc [ "nat" "max-value"] []) (_lux_proc [ "nat" "min-value"] [])] + [ Int Ord (_lux_proc [ "int" "max-value"] []) (_lux_proc [ "int" "min-value"] [])] + [Real Ord (_lux_proc ["real" "max-value"] []) (_lux_proc ["real" "min-value"] [])] + [ Deg Ord (_lux_proc [ "deg" "max-value"] []) (_lux_proc [ "deg" "min-value"] [])]) (do-template [ ] [(struct: #export (Monoid ) (def: unit ) (def: (append x y) ( x y)))] - [ Add@Monoid Nat +0 n.+] - [ Mul@Monoid Nat +1 n.*] + [ Add@Monoid Nat +0 n.+] + [ Mul@Monoid Nat +1 n.*] [ Max@Monoid Nat (:: Interval bottom) n.max] [ Min@Monoid Nat (:: Interval top) n.min] - [ Add@Monoid Int 0 i.+] - [ Mul@Monoid Int 1 i.*] + [ Add@Monoid Int 0 i.+] + [ Mul@Monoid Int 1 i.*] [ Max@Monoid Int (:: Interval bottom) i.max] [ Min@Monoid Int (:: Interval top) i.min] - [Add@Monoid Real 0.0 r.+] - [Mul@Monoid Real 1.0 r.*] + [Add@Monoid Real 0.0 r.+] + [Mul@Monoid Real 1.0 r.*] [Max@Monoid Real (:: Interval bottom) r.max] [Min@Monoid Real (:: Interval top) r.min] - [Add@Monoid Deg (:: Interval bottom) d.+] - [Mul@Monoid Deg (:: Interval top) d.*] - [Max@Monoid Deg (:: Interval bottom) d.max] - [Min@Monoid Deg (:: Interval top) d.min] + [ Add@Monoid Deg (:: Interval bottom) d.+] + [ Mul@Monoid Deg (:: Interval top) d.*] + [ Max@Monoid Deg (:: Interval bottom) d.max] + [ Min@Monoid Deg (:: Interval 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 [ ] [(struct: #export _ (Codec Text ) (def: (encode x) @@ -145,26 +141,10 @@ #;None (#;Left ))))] - [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 [ ] - [(struct: #export _ (Codec Text ) - (def: (encode x) - (_lux_proc ["jvm" ] [x])) - - (def: (decode input) - (_lux_proc ["jvm" "try"] - [(#;Right (_lux_proc ["jvm" ] [(clean-number input)])) - (lambda [e] (#;Left ))])))] - - [ 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) - (def: hash - (|>. (:: Codec 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 [ ] + [(def: #export + {#;doc } + Real + (_lux_proc ["real" ] []))] + + [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 [ ] @@ -221,19 +212,3 @@ (doc "Given syntax for a hexadecimal number, generates a Nat." (hex "deadBEEF"))] ) - -(do-template [ ] - [(def: #export - {#;doc } - Real - (_lux_proc ["jvm" ] []))] - - [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 - [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)) -- cgit v1.2.3