aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source
diff options
context:
space:
mode:
authorLuxLang2017-03-24 17:02:05 -0400
committerGitHub2017-03-24 17:02:05 -0400
commit67835905186803efa763b2c107ecadc835ebe0a6 (patch)
tree626b3240bf1c5131d630358efa57951f157daa2d /stdlib/source
parent7886f9da86c2b6d3da6ab801d07005d21686c275 (diff)
parent3ad92cceba0ebd2fa4b6ced5302d4a9290229e43 (diff)
Merge pull request #29 from LuxLang/js_port
Js port
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux.lux567
-rw-r--r--stdlib/source/lux/concurrency/atom.lux20
-rw-r--r--stdlib/source/lux/concurrency/promise.lux47
-rw-r--r--stdlib/source/lux/concurrency/stm.lux1
-rw-r--r--stdlib/source/lux/control/comonad.lux11
-rw-r--r--stdlib/source/lux/control/monad.lux13
-rw-r--r--stdlib/source/lux/data/char.lux50
-rw-r--r--stdlib/source/lux/data/coll/list.lux2
-rw-r--r--stdlib/source/lux/data/number.lux148
-rw-r--r--stdlib/source/lux/data/text.lux112
-rw-r--r--stdlib/source/lux/host.js.lux83
-rw-r--r--stdlib/source/lux/host.jvm.lux (renamed from stdlib/source/lux/host.lux)0
-rw-r--r--stdlib/source/lux/io.lux2
-rw-r--r--stdlib/source/lux/macro/ast.lux2
-rw-r--r--stdlib/source/lux/math.lux61
-rw-r--r--stdlib/source/lux/math/complex.lux8
-rw-r--r--stdlib/source/lux/test.lux20
17 files changed, 601 insertions, 546 deletions
diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux
index 520e55434..7ae8c2847 100644
--- a/stdlib/source/lux.lux
+++ b/stdlib/source/lux.lux
@@ -1,7 +1,7 @@
## Basic types
(_lux_def Bool
(+12 ["lux" "Bool"]
- (+0 "java.lang.Boolean" (+0)))
+ (+0 "#Bool" (+0)))
(+1 [["lux" "type?"] (+0 true)]
(+1 [["lux" "export?"] (+0 true)]
(+1 [["lux" "doc"] (+6 "Your standard, run-of-the-mill boolean values.")]
@@ -19,7 +19,7 @@
(_lux_def Int
(+12 ["lux" "Int"]
- (+0 "java.lang.Long" (+0)))
+ (+0 "#Int" (+0)))
(+1 [["lux" "type?"] (+0 true)]
(+1 [["lux" "export?"] (+0 true)]
(+1 [["lux" "doc"] (+6 "Your standard, run-of-the-mill integer numbers.")]
@@ -27,7 +27,7 @@
(_lux_def Real
(+12 ["lux" "Real"]
- (+0 "java.lang.Double" (+0)))
+ (+0 "#Real" (+0)))
(+1 [["lux" "type?"] (+0 true)]
(+1 [["lux" "export?"] (+0 true)]
(+1 [["lux" "doc"] (+6 "Your standard, run-of-the-mill floating-point numbers.")]
@@ -45,7 +45,7 @@
(_lux_def Char
(+12 ["lux" "Char"]
- (+0 "java.lang.Character" (+0)))
+ (+0 "#Char" (+0)))
(+1 [["lux" "type?"] (+0 true)]
(+1 [["lux" "export?"] (+0 true)]
(+1 [["lux" "doc"] (+6 "Your standard, run-of-the-mill character values.")]
@@ -53,7 +53,7 @@
(_lux_def Text
(+12 ["lux" "Text"]
- (+0 "java.lang.String" (+0)))
+ (+0 "#Text" (+0)))
(+1 [["lux" "type?"] (+0 true)]
(+1 [["lux" "export?"] (+0 true)]
(+1 [["lux" "doc"] (+6 "Your standard, run-of-the-mill string values.")]
@@ -323,11 +323,11 @@
## (type: Cursor
## {#module Text
-## #line Int
-## #column Int})
+## #line Nat
+## #column Nat})
(_lux_def Cursor
(#NamedT ["lux" "Cursor"]
- (#ProdT Text (#ProdT Int Int)))
+ (#ProdT Text (#ProdT Nat Nat)))
(#Cons [["lux" "tags"] (#ListA (#Cons (#TextA "module")
(#Cons (#TextA "line")
(#Cons (#TextA "column")
@@ -485,6 +485,26 @@
Text])]))
default-def-meta-exported)
+## (type: Module-State
+## #Active
+## #Compiled
+## #Cached)
+(_lux_def Module-State
+ (#NamedT ["lux" "Module-State"]
+ (#SumT
+ ## #Active
+ Unit
+ (#SumT
+ ## #Compiled
+ Unit
+ ## #Cached
+ Unit)))
+ (#Cons [["lux" "tags"] (#ListA (#Cons (#TextA "Active")
+ (#Cons (#TextA "Compiled")
+ (#Cons (#TextA "Cached")
+ #Nil))))]
+ default-def-meta-exported))
+
## (type: Module
## {#module-hash Int
## #module-aliases (List [Text Text])
@@ -493,6 +513,7 @@
## #tags (List [Text [Nat (List Ident) Bool Type]])
## #types (List [Text [(List Ident) Bool Type]])}
## #module-anns Anns
+## #module-state Module-State
## )
(_lux_def Module
(#NamedT ["lux" "Module"]
@@ -518,8 +539,9 @@
(#ProdT (#AppT List Ident)
(#ProdT Bool
Type))))
- ## "lux;module-anns"
- Anns)
+ (#ProdT ## "lux;module-anns"
+ Anns
+ Module-State))
))))))
(#Cons [["lux" "tags"] (#ListA (#Cons (#TextA "module-hash")
(#Cons (#TextA "module-aliases")
@@ -528,7 +550,8 @@
(#Cons (#TextA "tags")
(#Cons (#TextA "types")
(#Cons (#TextA "module-anns")
- #Nil))))))))]
+ (#Cons (#TextA "module-state")
+ #Nil)))))))))]
(#Cons [["lux" "doc"] (#TextA "All the information contained within a Lux module.")]
default-def-meta-exported)))
@@ -556,21 +579,17 @@
default-def-meta-exported)))
## (type: Compiler-Info
-## {#compiler-name Text
-## #compiler-version Text
+## {#compiler-version Text
## #compiler-mode Compiler-Mode})
(_lux_def Compiler-Info
(#NamedT ["lux" "Compiler-Info"]
- (#ProdT ## "lux;compiler-name"
+ (#ProdT ## "lux;compiler-version"
Text
- (#ProdT ## "lux;compiler-version"
- Text
- ## "lux;compiler-mode"
- Compiler-Mode)))
- (#Cons [["lux" "tags"] (#ListA (#Cons (#TextA "compiler-name")
- (#Cons (#TextA "compiler-version")
- (#Cons (#TextA "compiler-mode")
- #Nil))))]
+ ## "lux;compiler-mode"
+ Compiler-Mode))
+ (#Cons [["lux" "tags"] (#ListA (#Cons (#TextA "compiler-version")
+ (#Cons (#TextA "compiler-mode")
+ #Nil)))]
(#Cons [["lux" "doc"] (#TextA "Information about the current version and type of compiler that is running.")]
default-def-meta-exported)))
@@ -584,6 +603,7 @@
## #expected (Maybe Type)
## #seed Nat
## #scope-type-vars (List Nat)
+## #catching (List Text)
## #host Void})
(_lux_def Compiler
(#NamedT ["lux" "Compiler"]
@@ -604,10 +624,13 @@
(#AppT Maybe Type)
(#ProdT ## "lux;seed"
Nat
- (#ProdT ## "lux;scope-type-vars"
+ (#ProdT ## scope-type-vars
(#AppT List Nat)
## "lux;host"
- Void))))))))))
+ (#ProdT ## catching
+ (#AppT List Text)
+ ## "lux;host"
+ Void)))))))))))
(#Cons [["lux" "tags"] (#ListA (#Cons (#TextA "info")
(#Cons (#TextA "source")
(#Cons (#TextA "cursor")
@@ -617,8 +640,9 @@
(#Cons (#TextA "expected")
(#Cons (#TextA "seed")
(#Cons (#TextA "scope-type-vars")
- (#Cons (#TextA "host")
- #Nil)))))))))))]
+ (#Cons (#TextA "catching")
+ (#Cons (#TextA "host")
+ #Nil))))))))))))]
(#Cons [["lux" "doc"] (#TextA "Represents the state of the Lux compiler during a run.
It is provided to macros during their invocation, so they can access compiler data.
@@ -649,16 +673,10 @@
default-def-meta-exported))
## Base functions & macros
-## (def: _cursor
-## Cursor
-## ["" -1 -1])
(_lux_def _cursor
- (_lux_: Cursor ["" -1 -1])
+ (_lux_: Cursor ["" +0 +0])
#Nil)
-## (def: (_meta data)
-## (-> (AST' (Meta Cursor)) AST)
-## [["" -1 -1] data])
(_lux_def _meta
(_lux_: (#LambdaT (#AppT AST'
(#AppT Meta Cursor))
@@ -667,11 +685,6 @@
[_cursor data]))
#Nil)
-## (def: (return x)
-## (All [a]
-## (-> a Compiler
-## (Either Text [Compiler a])))
-## ...)
(_lux_def return
(_lux_: (#UnivQ #Nil
(#LambdaT (#BoundT +1)
@@ -684,11 +697,6 @@
(#Right state val))))
#Nil)
-## (def: (fail msg)
-## (All [a]
-## (-> Text Compiler
-## (Either Text [Compiler a])))
-## ...)
(_lux_def fail
(_lux_: (#UnivQ #Nil
(#LambdaT Text
@@ -1020,7 +1028,7 @@
(def:'' (Text/= x y)
#Nil
(#LambdaT Text (#LambdaT Text Bool))
- (_lux_proc ["jvm" "invokevirtual:java.lang.Object:equals:java.lang.Object"] [x y]))
+ (_lux_proc ["text" "="] [x y]))
(def:'' (get-rep key env)
#Nil
@@ -1133,7 +1141,7 @@
#Nil
(#UnivQ #Nil
(#LambdaT ($' List (#BoundT +1)) Int))
- (fold (lambda'' [_ acc] (_lux_proc ["jvm" "ladd"] [1 acc])) 0 list))
+ (fold (lambda'' [_ acc] (_lux_proc ["int" "+"] [1 acc])) 0 list))
(macro:' #export (All tokens)
(#Cons [["lux" "doc"] (#TextA "## Universal quantification.
@@ -1445,7 +1453,7 @@
(def:''' (wrap-meta content)
#Nil
(-> AST AST)
- (tuple$ (list (tuple$ (list (text$ "") (int$ -1) (int$ -1)))
+ (tuple$ (list (tuple$ (list (text$ "") (nat$ +0) (nat$ +0)))
content)))
(def:''' (untemplate-list tokens)
@@ -1658,10 +1666,17 @@
(#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)
- (_lux_proc ["jvm" "invokevirtual:java.lang.String:concat:java.lang.String"] [x y]))
+ (_lux_proc ["text" "append"] [x y]))
(def:''' (Ident/encode ident)
#Nil
@@ -1695,9 +1710,9 @@
{#info info #source source #modules modules
#scopes scopes #type-vars types #host host
#seed seed #expected expected #cursor cursor
- #scope-type-vars scope-type-vars} state]
+ #scope-type-vars scope-type-vars #catching _} state]
(_lux_case (get module modules)
- (#Some {#module-hash _ #module-aliases _ #defs defs #imports _ #tags tags #types types #module-anns _})
+ (#Some {#module-hash _ #module-aliases _ #defs defs #imports _ #tags tags #types types #module-anns _ #module-state _})
(_lux_case (get name defs)
(#Some [def-type def-meta def-value])
(_lux_case (get-meta ["lux" "alias"] def-meta)
@@ -1854,7 +1869,7 @@
{#info info #source source #modules modules
#scopes scopes #type-vars types #host host
#seed seed #expected expected #cursor cursor
- #scope-type-vars scope-type-vars}
+ #scope-type-vars scope-type-vars #catching _}
(_lux_case (reverse scopes)
(#Cons {#name (#;Cons module-name #Nil) #inner-closures _ #locals _ #closure _} _)
(#Right [state module-name])
@@ -1907,12 +1922,12 @@
(macro:' #export (|> tokens)
(list [["lux" "doc"] (#TextA "## Piping macro.
- (|> elems (map ->Text) (interpose \" \") (fold Text/append \"\"))
+ (|> elems (map Int/encode) (interpose \" \") (fold Text/append \"\"))
## =>
(fold Text/append \"\"
(interpose \" \"
- (map ->Text elems)))")])
+ (map Int/encode elems)))")])
(_lux_case tokens
(#Cons [init apps])
(return (list (fold (_lux_: (-> AST AST AST)
@@ -1934,12 +1949,12 @@
(macro:' #export (<| tokens)
(list [["lux" "doc"] (#TextA "## Reverse piping macro.
- (<| (fold Text/append \"\") (interpose \" \") (map ->Text) elems)
+ (<| (fold Text/append \"\") (interpose \" \") (map Int/encode) elems)
## =>
(fold Text/append \"\"
(interpose \" \"
- (map ->Text elems)))")])
+ (map Int/encode elems)))")])
(_lux_case (reverse tokens)
(#Cons [init apps])
(return (list (fold (_lux_: (-> AST AST AST)
@@ -2053,12 +2068,47 @@
(def:''' (i= x y)
#Nil
(-> Int Int Bool)
- (_lux_proc ["jvm" "leq"] [x y]))
+ (_lux_proc ["int" "="] [x y]))
+
+(def:''' (Bool/encode x)
+ #Nil
+ (-> Bool Text)
+ (if x "true" "false"))
+
+(def:''' (Nat/encode x)
+ #Nil
+ (-> Nat Text)
+ (_lux_proc ["nat" "encode"] [x]))
+
+(def:''' (Int/encode x)
+ #Nil
+ (-> Int Text)
+ (_lux_proc ["int" "encode"] [x]))
+
+(def:''' (Deg/encode x)
+ #Nil
+ (-> Deg Text)
+ (_lux_proc ["deg" "encode"] [x]))
-(def:''' (->Text x)
+(def:''' (Real/encode x)
#Nil
- (-> (host java.lang.Object) Text)
- (_lux_proc ["jvm" "invokevirtual:java.lang.Object:toString:"] [x]))
+ (-> Real Text)
+ (_lux_proc ["real" "encode"] [x]))
+
+(def:''' (Char/encode x)
+ #Nil
+ (-> Char Text)
+ (let' [as-text (_lux_case x
+ #"\t" "\\t"
+ #"\v" "\\v"
+ #"\b" "\\b"
+ #"\n" "\\n"
+ #"\r" "\\r"
+ #"\f" "\\f"
+ #"\"" "\\\""
+ #"\\" "\\\\"
+ _ (_lux_proc ["char" "to-text"] [x]))]
+ ($_ Text/append "#\"" as-text "\"")))
(macro:' #export (do-template tokens)
(list [["lux" "doc"] (#TextA "## By specifying a pattern (with holes), and the input data to fill those holes, repeats the pattern as many times as necessary.
@@ -2081,7 +2131,7 @@
(|> data'
(join-map (. apply (make-env bindings')))
return)
- (fail (Text/append "Irregular arguments vectors for do-template. Expected size " (->Text num-bindings)))))
+ (fail (Text/append "Irregular arguments vectors for do-template. Expected size " (Int/encode num-bindings)))))
_
(fail "Wrong syntax for do-template"))
@@ -2089,47 +2139,47 @@
_
(fail "Wrong syntax for do-template")))
-(do-template [<type> <category> <=-name> <=> <lt-name> <lte-name> <lt> <gt-name> <gte-name>
+(do-template [<type> <category> <=-name> <lt-name> <lte-name> <gt-name> <gte-name>
<eq-doc> <<-doc> <<=-doc> <>-doc> <>=-doc>]
[(def:''' #export (<=-name> test subject)
(list [["lux" "doc"] (#TextA <eq-doc>)])
(-> <type> <type> Bool)
- (_lux_proc [<category> <=>] [subject test]))
+ (_lux_proc [<category> "="] [subject test]))
(def:''' #export (<lt-name> test subject)
(list [["lux" "doc"] (#TextA <<-doc>)])
(-> <type> <type> Bool)
- (_lux_proc [<category> <lt>] [subject test]))
+ (_lux_proc [<category> "<"] [subject test]))
(def:''' #export (<lte-name> test subject)
(list [["lux" "doc"] (#TextA <<=-doc>)])
(-> <type> <type> Bool)
- (if (_lux_proc [<category> <lt>] [subject test])
+ (if (_lux_proc [<category> "<"] [subject test])
true
- (_lux_proc [<category> <=>] [subject test])))
+ (_lux_proc [<category> "="] [subject test])))
(def:''' #export (<gt-name> test subject)
(list [["lux" "doc"] (#TextA <>-doc>)])
(-> <type> <type> Bool)
- (_lux_proc [<category> <lt>] [test subject]))
+ (_lux_proc [<category> "<"] [test subject]))
(def:''' #export (<gte-name> test subject)
(list [["lux" "doc"] (#TextA <>=-doc>)])
(-> <type> <type> Bool)
- (if (_lux_proc [<category> <lt>] [test subject])
+ (if (_lux_proc [<category> "<"] [test subject])
true
- (_lux_proc [<category> <=>] [subject test])))]
+ (_lux_proc [<category> "="] [subject test])))]
- [ Nat "nat" n.= "=" n.< n.<= "<" n.> n.>=
+ [ 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.>=
+ [ Int "int" i.= i.< i.<= i.> i.>=
"Integer equality." "Integer less-than." "Integer less-than-equal." "Integer greater-than." "Integer greater-than-equal."]
- [Deg "deg" d.= "=" d.< d.<= "<" d.> d.>=
+ [ Deg "deg" d.= d.< d.<= d.> d.>=
"Degree equality." "Degree less-than." "Degree less-than-equal." "Degree greater-than." "Degree greater-than-equal."]
- [Real "jvm" r.= "deq" r.< r.<= "dlt" r.> r.>=
+ [Real "real" r.= r.< r.<= r.> r.>=
"Real equality." "Real less-than." "Real less-than-equal." "Real greater-than." "Real greater-than-equal."]
)
@@ -2139,29 +2189,29 @@
(-> <type> <type> <type>)
(_lux_proc <op> [subject param]))]
- [ 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."]
+ [ 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."]
-
- [Deg d.+ ["deg" "+"] "Deg(ree) addition."]
- [Deg d.- ["deg" "-"] "Deg(ree) substraction."]
- [Deg d.* ["deg" "*"] "Deg(ree) multiplication."]
- [Deg d./ ["deg" "/"] "Deg(ree) division."]
- [Deg d.% ["deg" "%"] "Deg(ree) remainder."]
+ [ Int i.+ [ "int" "+"] "Int(eger) addition."]
+ [ Int i.- [ "int" "-"] "Int(eger) substraction."]
+ [ Int i.* [ "int" "*"] "Int(eger) multiplication."]
+ [ Int i./ [ "int" "/"] "Int(eger) division."]
+ [ Int i.% [ "int" "%"] "Int(eger) remainder."]
+
+ [ Deg d.+ [ "deg" "+"] "Deg(ree) addition."]
+ [ Deg d.- [ "deg" "-"] "Deg(ree) substraction."]
+ [ Deg d.* [ "deg" "*"] "Deg(ree) multiplication."]
+ [ Deg d./ [ "deg" "/"] "Deg(ree) division."]
+ [ Deg d.% [ "deg" "%"] "Deg(ree) 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."]
+ [Real r.+ ["real" "+"] "Real addition."]
+ [Real r.- ["real" "-"] "Real substraction."]
+ [Real r.* ["real" "*"] "Real multiplication."]
+ [Real r./ ["real" "/"] "Real division."]
+ [Real r.% ["real" "%"] "Real remainder."]
)
(do-template [<name> <type> <test> <doc>]
@@ -2172,14 +2222,14 @@
left
right))]
- [n.min Nat n.< "Nat(ural) minimum."]
- [n.max Nat n.> "Nat(ural) maximum."]
+ [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."]
+ [i.min Int i.< "Int(eger) minimum."]
+ [i.max Int i.> "Int(eger) maximum."]
- [d.min Deg d.< "Deg(ree) minimum."]
- [d.max Deg d.> "Deg(ree) maximum."]
+ [d.min Deg d.< "Deg(ree) minimum."]
+ [d.max Deg d.> "Deg(ree) maximum."]
[r.min Real r.< "Real minimum."]
[r.max Real r.> "Real minimum."]
@@ -2206,7 +2256,7 @@
($' Maybe Macro))
(do Monad<Maybe>
[$module (get module modules)
- gdef (let' [{#module-hash _ #module-aliases _ #defs bindings #imports _ #tags tags #types types #module-anns _} (_lux_: Module $module)]
+ gdef (let' [{#module-hash _ #module-aliases _ #defs bindings #imports _ #tags tags #types types #module-anns _ #module-state _} (_lux_: Module $module)]
(get name bindings))]
(let' [[def-type def-meta def-value] (_lux_: Def gdef)]
(_lux_case (get-meta ["lux" "macro?"] def-meta)
@@ -2254,7 +2304,7 @@
#scopes scopes #type-vars types #host host
#seed seed #expected expected
#cursor cursor
- #scope-type-vars scope-type-vars}
+ #scope-type-vars scope-type-vars #catching _}
(#Right state (find-macro' modules current-module module name)))))))
(def:''' (macro? ident)
@@ -2506,20 +2556,20 @@
(-> Text ($' Lux AST))
(_lux_case state
{#info info #source source #modules modules
- #scopes scopes #type-vars types #host host
+ #scopes scopes #type-vars types #host host
#seed seed #expected expected
#cursor cursor
- #scope-type-vars scope-type-vars}
+ #scope-type-vars scope-type-vars #catching catching}
(#Right {#info info #source source #modules modules
- #scopes scopes #type-vars types #host host
+ #scopes scopes #type-vars types #host host
#seed (n.+ +1 seed) #expected expected
#cursor cursor
- #scope-type-vars scope-type-vars}
- (symbol$ ["" ($_ Text/append "__gensym__" prefix (->Text seed))]))))
+ #scope-type-vars scope-type-vars #catching catching}
+ (symbol$ ["" ($_ Text/append "__gensym__" prefix (Nat/encode seed))]))))
(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
@@ -2598,36 +2648,26 @@
(let' [[left right] pair]
(list left right)))
-(def:''' (Nat->Text x)
- #Nil
- (-> Nat Text)
- (_lux_proc ["nat" "encode"] [x]))
-
-(def:''' (Deg->Text x)
- #Nil
- (-> Deg Text)
- (_lux_proc ["deg" "encode"] [x]))
-
(def:' (ast-to-text ast)
(-> AST Text)
(_lux_case ast
[_ (#BoolS value)]
- (->Text value)
+ (Bool/encode value)
[_ (#NatS value)]
- (Nat->Text value)
+ (Nat/encode value)
[_ (#IntS value)]
- (->Text value)
+ (Int/encode value)
[_ (#DegS value)]
- (Deg->Text value)
+ (Deg/encode value)
[_ (#RealS value)]
- (->Text value)
+ (Real/encode value)
[_ (#CharS value)]
- ($_ Text/append "#" "\"" (->Text value) "\"")
+ ($_ Text/append "#" "\"" (Char/encode value) "\"")
[_ (#TextS value)]
($_ Text/append "\"" value "\"")
@@ -2966,14 +3006,6 @@
(#;Some (#;Right []))
(list (' #hidden))))
-(def:''' #export (log! message)
- (list [["lux" "doc"] (#TextA "Logs message to standard output.
-
- Useful for debugging.")])
- (-> Text Unit)
- (_lux_proc ["jvm" "invokevirtual:java.io.PrintStream:println:java.lang.String"]
- [(_lux_proc ["jvm" "getstatic:java.lang.System:out"] []) message]))
-
(macro:' #export (def: tokens)
(list [["lux" "doc"] (#TextA "## Defines global constants/functions.
(def: (rejoin-pair pair)
@@ -3191,43 +3223,83 @@
(#Some y)
(#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])]))
+(do-template [<name> <proc> <start>]
+ [(def: (<name> part text)
+ (-> Text Text (Maybe Nat))
+ (_lux_proc ["text" <proc>] [text part <start>]))]
+
+ [index-of "index" +0]
+ [last-index-of "last-index" (_lux_proc ["text" "size"] [text])]
+ )
+
+(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]))
+
+(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: (index-of part text)
- (-> Text Text Int)
- (_lux_proc ["jvm" "i2l"] [(_lux_proc ["jvm" "invokevirtual:java.lang.String:indexOf:java.lang.String"] [text part])]))
+ (default 20 #;None) => 20"}
+ (case tokens
+ (^ (list else maybe))
+ (let [g!temp (: AST [_cursor (#;SymbolS ["" ""])])
+ code (` (case (~ maybe)
+ (#;Some (~ g!temp))
+ (~ g!temp)
-(def: (substring1 idx text)
- (-> Int Text Text)
- (_lux_proc ["jvm" "invokevirtual:java.lang.String:substring:int"] [text (_lux_proc ["jvm" "l2i"] [idx])]))
+ #;None
+ (~ else)))]
+ (#;Right [state (list code)]))
-(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])]))
+ _
+ (#;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]
@@ -3356,7 +3428,7 @@
(let [{#info info #source source #modules modules
#scopes scopes #type-vars types #host host
#seed seed #expected expected #cursor cursor
- #scope-type-vars scope-type-vars} state]
+ #scope-type-vars scope-type-vars #catching _} state]
(case (get name modules)
(#Some module)
(#Right state module)
@@ -3374,7 +3446,7 @@
(-> Ident (Lux [Nat (List Ident) Bool Type]))
(do Monad<Lux>
[=module (find-module module)
- #let [{#module-hash _ #module-aliases _ #defs bindings #imports _ #tags tags-table #types types #module-anns _} =module]]
+ #let [{#module-hash _ #module-aliases _ #defs bindings #imports _ #tags tags-table #types types #module-anns _ #module-state _} =module]]
(case (get name tags-table)
(#Some output)
(return output)
@@ -3397,7 +3469,7 @@
(#NamedT [module name] _)
(do Monad<Lux>
[=module (find-module module)
- #let [{#module-hash _ #module-aliases _ #defs bindings #imports _ #tags tags #types types #module-anns _} =module]]
+ #let [{#module-hash _ #module-aliases _ #defs bindings #imports _ #tags tags #types types #module-anns _ #module-state _} =module]]
(case (get name types)
(#Some [tags exported? (#NamedT _ _type)])
(case (resolve-struct-type _type)
@@ -3419,7 +3491,7 @@
(let [{#info info #source source #modules modules
#scopes scopes #type-vars types #host host
#seed seed #expected expected #cursor cursor
- #scope-type-vars scope-type-vars} state]
+ #scope-type-vars scope-type-vars #catching _} state]
(case expected
(#Some type)
(#Right state type)
@@ -3850,22 +3922,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))
@@ -3884,7 +3956,8 @@
[_ (#SymbolS "" m-name)]
(do Monad<Lux>
[m-name (clean-module m-name)]
- (wrap (list [m-name #None {#refer-defs #All #refer-open (list)}])))
+ (wrap (list [m-name #None {#refer-defs #All
+ #refer-open (list)}])))
(^ [_ (#FormS (list& [_ (#SymbolS "" m-name)] extra))])
(do Monad<Lux>
@@ -3942,7 +4015,7 @@
{#info info #source source #modules modules
#scopes scopes #type-vars types #host host
#seed seed #expected expected #cursor cursor
- #scope-type-vars scope-type-vars}
+ #scope-type-vars scope-type-vars #catching _}
modules)]
(case (get module modules)
(#Some =module)
@@ -3956,7 +4029,7 @@
_
(list))))
- (let [{#module-hash _ #module-aliases _ #defs defs #imports _ #tags tags #types types #module-anns _} =module]
+ (let [{#module-hash _ #module-aliases _ #defs defs #imports _ #tags tags #types types #module-anns _ #module-state _} =module]
defs))]
(#Right state (List/join to-alias)))
@@ -3997,7 +4070,7 @@
{#info info #source source #modules modules
#scopes scopes #type-vars types #host host
#seed seed #expected expected #cursor cursor
- #scope-type-vars scope-type-vars}
+ #scope-type-vars scope-type-vars #catching _}
(find (: (-> Scope (Maybe Type))
(lambda [env]
(case env
@@ -4017,12 +4090,12 @@
{#info info #source source #modules modules
#scopes scopes #type-vars types #host host
#seed seed #expected expected #cursor cursor
- #scope-type-vars scope-type-vars} state]
+ #scope-type-vars scope-type-vars #catching _} state]
(case (get v-prefix modules)
#None
#None
- (#Some {#defs defs #module-hash _ #module-aliases _ #imports _ #tags tags #types types #module-anns _})
+ (#Some {#defs defs #module-hash _ #module-aliases _ #imports _ #tags tags #types types #module-anns _ #module-state _})
(case (get v-name defs)
#None
#None
@@ -4036,12 +4109,12 @@
{#info info #source source #modules modules
#scopes scopes #type-vars types #host host
#seed seed #expected expected #cursor cursor
- #scope-type-vars scope-type-vars} state]
+ #scope-type-vars scope-type-vars #catching _} state]
(case (get v-prefix modules)
#None
(#Left (Text/append "Unknown definition: " (Ident/encode name)))
- (#Some {#defs defs #module-hash _ #module-aliases _ #imports _ #tags tags #types types #module-anns _})
+ (#Some {#defs defs #module-hash _ #module-aliases _ #imports _ #tags tags #types types #module-anns _ #module-state _})
(case (get v-name defs)
#None
(#Left (Text/append "Unknown definition: " (Ident/encode name)))
@@ -4134,13 +4207,13 @@
($_ Text/append "(-> " (|> (flatten-lambda type) (map Type/show) (interpose " ") reverse (fold Text/append "")) ")")
(#BoundT id)
- (Nat->Text id)
+ (Nat/encode id)
(#VarT id)
- ($_ Text/append "⌈v:" (->Text id) "⌋")
+ ($_ Text/append "⌈v:" (Nat/encode id) "⌋")
(#ExT id)
- ($_ Text/append "⟨e:" (->Text id) "⟩")
+ ($_ Text/append "⟨e:" (Nat/encode id) "⟩")
(#UnivQ env body)
($_ Text/append "(All " (Type/show body) ")")
@@ -4330,12 +4403,12 @@
(macro: #export (|>. tokens)
{#;doc "## Similar to the piping macro, but rather than taking an initial object to work on, creates a function for taking it.
- (|> (map ->Text) (interpose \" \") (fold Text/append \"\"))
+ (|> (map Int/encode) (interpose \" \") (fold Text/append \"\"))
## =>
(lambda [<something>]
(fold Text/append \"\"
(interpose \" \"
- (map ->Text <something>))))"}
+ (map Int/encode <something>))))"}
(do Monad<Lux>
[g!arg (gensym "arg")]
(return (list (` (lambda [(~ g!arg)] (|> (~ g!arg) (~@ tokens))))))))
@@ -4344,29 +4417,9 @@
(-> Text Text (Lux Bool))
(do Monad<Lux>
[module (find-module module-name)
- #let [{#module-hash _ #module-aliases _ #defs _ #imports imports #tags _ #types _ #module-anns _} module]]
+ #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 [["" -1 -1] (#;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>
@@ -4759,17 +4812,17 @@
_
(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)
- (-> AST Int)
+ (-> AST Nat)
(case ast
(^template [<tag>]
[[_ _ column] (<tag> _)]
@@ -4786,12 +4839,12 @@
(^template [<tag>]
[[_ _ column] (<tag> parts)]
- (fold i.min column (map find-baseline-column parts)))
+ (fold n.min column (map find-baseline-column parts)))
([#FormS]
[#TupleS])
[[_ _ column] (#RecordS pairs)]
- (fold i.min column
+ (fold n.min column
(List/append (map (. find-baseline-column first) pairs)
(map (. find-baseline-column second) pairs)))
))
@@ -4809,23 +4862,11 @@
_
(#Doc-Example ast)))
-(def: (Char/encode x)
- (-> Char Text)
- (let [as-text (case x
- #"\t" "\\t"
- #"\b" "\\b"
- #"\n" "\\n"
- #"\r" "\\r"
- #"\f" "\\f"
- #"\"" "\\\""
- #"\\" "\\\\"
- _ (_lux_proc ["jvm" "invokevirtual:java.lang.Object:toString:"] [x]))]
- ($_ Text/append "#\"" as-text "\"")))
-
(def: (Text/encode original)
(-> Text Text)
(let [escaped (|> original
(replace "\t" "\\t")
+ (replace "\v" "\\v")
(replace "\b" "\\b")
(replace "\n" "\\n")
(replace "\r" "\\r")
@@ -4841,16 +4882,27 @@
(-> <type> <type>)
(<op> <one> value))]
- [i.inc i.+ 1 Int "Increment function."]
- [i.dec i.- 1 Int "Decrement function."]
- [n.inc n.+ +1 Nat "Increment function."]
- [n.dec n.- +1 Nat "Decrement function."]
+ [i.inc i.+ 1 Int "[Int] Increment function."]
+ [i.dec i.- 1 Int "[Int] Decrement function."]
+ [n.inc n.+ +1 Nat "[Nat] Increment function."]
+ [n.dec n.- +1 Nat "[Nat] Decrement function."]
)
-(def: tag->Text
+(def: Tag/encode
(-> Ident Text)
(. (Text/append "#") Ident/encode))
+(do-template [<name> <op> <from> <to>]
+ [(def: #export (<name> input)
+ (-> <from> <to>)
+ (_lux_proc <op> [input]))]
+
+ [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]
+ )
+
(def: (repeat n x)
(All [a] (-> Int a (List a)))
(if (i.> 0 n)
@@ -4858,36 +4910,35 @@
#;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.- 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) " "))]
+ (-> Nat Cursor Cursor Text)
+ (if (n.= old-line new-line)
+ (Text/join (repeat (nat-to-int (n.- old-column new-column)) " "))
+ (let [extra-lines (Text/join (repeat (nat-to-int (n.- old-line new-line)) "\n"))
+ space-padding (Text/join (repeat (nat-to-int (n.- baseline new-column)) " "))]
(Text/append extra-lines space-padding))))
(def: (Text/size x)
- (-> Text Int)
- (_lux_proc ["jvm" "i2l"]
- [(_lux_proc ["jvm" "invokevirtual:java.lang.String:length:"] [x])]))
+ (-> Text Nat)
+ (_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)
- [file line (i.+ column (Text/size ast-text))])
+ [file line (n.+ column (Text/size ast-text))])
(def: (delim-update-cursor [file line column])
(-> Cursor Cursor)
- [file line (i.inc column)])
+ [file line (n.inc column)])
(def: rejoin-all-pairs
(-> (List [AST AST]) (List AST))
(. List/join (map rejoin-pair)))
(def: (doc-example->Text prev-cursor baseline example)
- (-> Cursor Int AST [Cursor Text])
+ (-> Cursor Nat AST [Cursor Text])
(case example
(^template [<tag> <show>]
[new-cursor (<tag> value)]
@@ -4895,15 +4946,15 @@
[(update-cursor new-cursor as-text)
(Text/append (cursor-padding baseline prev-cursor new-cursor)
as-text)]))
- ([#BoolS ->Text]
- [#NatS Nat->Text]
- [#IntS ->Text]
- [#DegS Deg->Text]
- [#RealS ->Text]
+ ([#BoolS Bool/encode]
+ [#NatS Nat/encode]
+ [#IntS Int/encode]
+ [#DegS Deg/encode]
+ [#RealS Real/encode]
[#CharS Char/encode]
[#TextS Text/encode]
[#SymbolS Ident/encode]
- [#TagS tag->Text])
+ [#TagS Tag/encode])
(^template [<tag> <open> <close> <prep>]
[group-cursor (<tag> parts)]
@@ -4923,7 +4974,7 @@
))
(def: (with-baseline baseline [file line column])
- (-> Int Cursor Cursor)
+ (-> Nat Cursor Cursor)
[file line baseline])
(def: (doc-fragment->Text fragment)
@@ -5142,7 +5193,7 @@
(compare <text> (:: AST/encode show <expr>))
(compare true (:: Eq<AST> = <expr> <expr>))]
- [(bool true) "true" [["" -1 -1] (#;BoolS true)]]
+ [(bool true) "true" [_ (#;BoolS true)]]
[(bool false) "false" [_ (#;BoolS false)]]
[(int 123) "123" [_ (#;IntS 123)]]
[(real 123.0) "123.0" [_ (#;RealS 123.0)]]
@@ -5390,7 +5441,7 @@
{#info info #source source #modules modules
#scopes scopes #type-vars types #host host
#seed seed #expected expected #cursor cursor
- #scope-type-vars scope-type-vars}
+ #scope-type-vars scope-type-vars #catching _}
(#Right state scope-type-vars)
))
@@ -5423,7 +5474,7 @@
(wrap (list (` (#ExT (~ (nat$ var-id))))))
#;None
- (fail (Text/append "Indexed-type doesn't exist: " (->Text idx)))))
+ (fail (Text/append "Indexed-type doesn't exist: " (Nat/encode idx)))))
_
(fail "Wrong syntax for $")))
@@ -5437,7 +5488,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."
@@ -5483,12 +5534,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)
@@ -5499,7 +5544,7 @@
(let [{#;info info #;source source #;modules modules #;scopes scopes
#;type-vars types #;host host #;seed seed
#;expected expected #;cursor cursor
- #;scope-type-vars scope-type-vars} state]
+ #;scope-type-vars scope-type-vars #catching _} state]
(#;Right [state cursor]))))
(macro: #export (with-cursor tokens)
@@ -5513,7 +5558,7 @@
(do Monad<Lux>
[cursor get-cursor]
(let [[module line column] cursor
- cursor-prefix ($_ hack_Text/append "[" module "," (->Text line) "," (->Text column) "] ")]
+ cursor-prefix ($_ hack_Text/append "[" module "," (Nat/encode line) "," (Nat/encode column) "] ")]
(wrap (list (` (hack_Text/append (~ (text$ cursor-prefix)) (~ message)))))))
_
@@ -5567,18 +5612,6 @@
_
(fail "Wrong syntax for @post")))
-(do-template [<name> <op> <from> <to>]
- [(def: #export (<name> input)
- (-> <from> <to>)
- (_lux_proc <op> [input]))]
-
- [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]
- )
-
(macro: #export (type-of tokens)
{#;doc (doc "Generates the type corresponding to a given definition or variable."
(let [my-num (: Int 123)]
@@ -5716,3 +5749,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/concurrency/atom.lux b/stdlib/source/lux/concurrency/atom.lux
index 09dd642ed..f2ec8b46c 100644
--- a/stdlib/source/lux/concurrency/atom.lux
+++ b/stdlib/source/lux/concurrency/atom.lux
@@ -1,31 +1,25 @@
(;module:
lux
- (lux [io #- run]
- host))
-
-(jvm-import (java.util.concurrent.atomic.AtomicReference V)
- (new [V])
- (compareAndSet [V V] boolean)
- (get [] V))
+ (lux [io #- run]))
(type: #export (Atom a)
{#;doc "Atomic references that are safe to mutate concurrently."}
- (AtomicReference a))
+ (#;HostT "#Atom" (#;Cons a #;Nil)))
(def: #export (atom value)
(All [a] (-> a (Atom a)))
- (AtomicReference.new [value]))
+ (_lux_proc ["atom" "new"] [value]))
(def: #export (get atom)
(All [a] (-> (Atom a) (IO a)))
- (io (AtomicReference.get [] atom)))
+ (io (_lux_proc ["atom" "get"] [atom])))
(def: #export (compare-and-swap current new atom)
{#;doc "Only mutates an atom if you can present it's current value.
That guarantees that atom wasn't updated since you last read from it."}
(All [a] (-> a a (Atom a) (IO Bool)))
- (io (AtomicReference.compareAndSet [current new] atom)))
+ (io (_lux_proc ["atom" "compare-and-swap"] [atom current new])))
(def: #export (update f atom)
{#;doc "Updates an atom by applying a function to its current value.
@@ -34,8 +28,8 @@
The retries will be done with the new values of the atom, as they show up."}
(All [a] (-> (-> a a) (Atom a) (IO Unit)))
- (io (let [old (AtomicReference.get [] atom)]
- (if (AtomicReference.compareAndSet [old (f old)] atom)
+ (io (let [old (_lux_proc ["atom" "get"] [atom])]
+ (if (_lux_proc ["atom" "compare-and-swap"] [atom old (f old)])
[]
(io;run (update f atom))))))
diff --git a/stdlib/source/lux/concurrency/promise.lux b/stdlib/source/lux/concurrency/promise.lux
index 3c10e785d..ef7efd923 100644
--- a/stdlib/source/lux/concurrency/promise.lux
+++ b/stdlib/source/lux/concurrency/promise.lux
@@ -12,47 +12,11 @@
[compiler]
(macro ["s" syntax #+ syntax: Syntax])
(concurrency [atom #+ Atom atom])
- host
))
-(jvm-import java.lang.Runtime
- (#static getRuntime [] Runtime)
- (availableProcessors [] int))
-
-(jvm-import java.lang.Runnable)
-
-(jvm-import java.lang.Thread
- (new [Runnable])
- (start [] void))
-
-(jvm-import java.util.concurrent.Executor
- (execute [Runnable] void))
-
-(jvm-import java.util.concurrent.TimeUnit
- (#enum MILLISECONDS))
-
-(jvm-import (java.util.concurrent.ScheduledFuture a))
-
-(jvm-import java.util.concurrent.ScheduledThreadPoolExecutor
- (new [int])
- (schedule [Runnable long TimeUnit] (ScheduledFuture Object)))
-
(def: #export concurrency-level
Nat
- (|> (Runtime.getRuntime [])
- (Runtime.availableProcessors [])
- int-to-nat))
-
-(def: executor
- ScheduledThreadPoolExecutor
- (ScheduledThreadPoolExecutor.new [(nat-to-int concurrency-level)]))
-
-(syntax: (runnable expr)
- (wrap (list (`' (object [java.lang.Runnable]
- []
- (java.lang.Runnable (run) void
- (exec (~ expr)
- [])))))))
+ (_lux_proc ["process" "concurrency-level"] []))
(type: (Promise-State a)
{#value (Maybe a)
@@ -218,18 +182,15 @@
{#;doc "Runs an I/O computation on its own process and returns an Promise that will eventually host its result."}
(All [a] (-> (IO a) (Promise a)))
(let [!out (promise ($ +0))]
- (exec (Thread.start [] (Thread.new [(runnable (io;run (resolve (io;run computation)
- !out)))]))
+ (exec (_lux_proc ["process" "future"] [(io (io;run (resolve (io;run computation)
+ !out)))])
!out)))
(def: #export (wait time)
{#;doc "Returns a Promise that will be resolved after the specified amount of milliseconds."}
(-> Nat (Promise Unit))
(let [!out (promise Unit)]
- (exec (ScheduledThreadPoolExecutor.schedule [(runnable (io;run (resolve [] !out)))
- (nat-to-int time)
- TimeUnit.MILLISECONDS]
- executor)
+ (exec (_lux_proc ["process" "schedule"] [time (resolve [] !out)])
!out)))
(def: #export (time-out time promise)
diff --git a/stdlib/source/lux/concurrency/stm.lux b/stdlib/source/lux/concurrency/stm.lux
index 36eb6854e..c1c3153dd 100644
--- a/stdlib/source/lux/concurrency/stm.lux
+++ b/stdlib/source/lux/concurrency/stm.lux
@@ -12,7 +12,6 @@
maybe
[number "Nat/" Codec<Text,Nat>]
text/format)
- host
[compiler]
(macro [ast]
["s" syntax #+ syntax: Syntax])
diff --git a/stdlib/source/lux/control/comonad.lux b/stdlib/source/lux/control/comonad.lux
index f78ffea17..5ed443040 100644
--- a/stdlib/source/lux/control/comonad.lux
+++ b/stdlib/source/lux/control/comonad.lux
@@ -18,6 +18,8 @@
split))
## [Syntax]
+(def: _cursor Cursor ["" +0 +0])
+
(macro: #export (be tokens state)
{#;doc (doc "A co-monadic parallel to the \"do\" macro."
(let [square (lambda [n] (i.* n n))]
@@ -26,9 +28,8 @@
(square (head inputs)))))}
(case tokens
(#;Cons comonad (#;Cons [_ (#;TupleS bindings)] (#;Cons body #;Nil)))
- (let [g!@ (: AST [["" -1 -1] (#;SymbolS ["" "@"])])
- g!map (: AST [["" -1 -1] (#;SymbolS ["" " map "])])
- g!split (: AST [["" -1 -1] (#;SymbolS ["" " split "])])
+ (let [g!map (: AST [_cursor (#;SymbolS ["" " map "])])
+ g!split (: AST [_cursor (#;SymbolS ["" " split "])])
body' (fold (: (-> [AST AST] AST AST)
(lambda [binding body']
(let [[var value] binding]
@@ -42,8 +43,8 @@
body
(reverse (as-pairs bindings)))]
(#;Right [state (#;Cons (` (;_lux_case (~ comonad)
- (~ g!@)
- (;_lux_case (~ g!@)
+ (~' @)
+ (;_lux_case (~' @)
{#functor {#F;map (~ g!map)} #unwrap (~' unwrap) #split (~ g!split)}
(~ body'))))
#;Nil)]))
diff --git a/stdlib/source/lux/control/monad.lux b/stdlib/source/lux/control/monad.lux
index 5c540791a..a6d0d5988 100644
--- a/stdlib/source/lux/control/monad.lux
+++ b/stdlib/source/lux/control/monad.lux
@@ -49,6 +49,8 @@
join))
## [Syntax]
+(def: _cursor Cursor ["" +0 +0])
+
(macro: #export (do tokens state)
{#;doc (doc "Macro for easy concatenation of monadic operations."
(do Monad<Maybe>
@@ -57,10 +59,9 @@
(wrap (f3 z))))}
(case tokens
(#;Cons monad (#;Cons [_ (#;TupleS bindings)] (#;Cons body #;Nil)))
- (let [g!@ (: AST [["" -1 -1] (#;SymbolS ["" "@"])])
- g!map (: AST [["" -1 -1] (#;SymbolS ["" " map "])])
- g!join (: AST [["" -1 -1] (#;SymbolS ["" " join "])])
- g!apply (: AST [["" -1 -1] (#;SymbolS ["" " apply "])])
+ (let [g!map (: AST [_cursor (#;SymbolS ["" " map "])])
+ g!join (: AST [_cursor (#;SymbolS ["" " join "])])
+ g!apply (: AST [_cursor (#;SymbolS ["" " apply "])])
body' (fold (: (-> [AST AST] AST AST)
(lambda [binding body']
(let [[var value] binding]
@@ -74,8 +75,8 @@
body
(reverse (as-pairs bindings)))]
(#;Right [state (#;Cons (` (;_lux_case (~ monad)
- (~ g!@)
- (;_lux_case (~ g!@)
+ (~' @)
+ (;_lux_case (~' @)
{#applicative {#A;functor {#F;map (~ g!map)}
#A;wrap (~' wrap)
#A;apply (~ g!apply)}
diff --git a/stdlib/source/lux/data/char.lux b/stdlib/source/lux/data/char.lux
index 28877ae34..0db90898e 100644
--- a/stdlib/source/lux/data/char.lux
+++ b/stdlib/source/lux/data/char.lux
@@ -9,48 +9,43 @@
## [Structures]
(struct: #export _ (Eq Char)
(def: (= x y)
- (_lux_proc ["jvm" "ceq"] [x y])))
+ (_lux_proc ["char" "="] [x y])))
(struct: #export _ (Hash Char)
(def: eq Eq<Char>)
- (def: hash
- (|>. []
- (_lux_proc ["jvm" "c2i"])
- []
- (_lux_proc ["jvm" "i2l"])
- int-to-nat)))
+ (def: (hash input)
+ (_lux_proc ["char" "to-nat"] [input])))
(struct: #export _ (ord;Ord Char)
(def: eq Eq<Char>)
- (do-template [<name> <op>]
- [(def: (<name> test subject)
- (_lux_proc ["jvm" <op>] [subject test]))]
+ (def: (< test subject)
+ (_lux_proc ["char" "<"] [subject test]))
- [< "clt"]
- [> "cgt"]
- )
+ (def: (<= test subject)
+ (or (_lux_proc ["char" "="] [subject test])
+ (_lux_proc ["char" "<"] [subject test])))
- (do-template [<name> <op>]
- [(def: (<name> test subject)
- (or (_lux_proc ["jvm" "ceq"] [subject test])
- (_lux_proc ["jvm" <op>] [subject test])))]
+ (def: (> test subject)
+ (_lux_proc ["char" "<"] [test subject]))
- [<= "clt"]
- [>= "cgt"]
- ))
+ (def: (>= test subject)
+ (or (_lux_proc ["char" "="] [test subject])
+ (_lux_proc ["char" "<"] [test subject])))
+ )
(struct: #export _ (Codec Text Char)
(def: (encode x)
(let [as-text (case x
#"\t" "\\t"
+ #"\v" "\\v"
#"\b" "\\b"
#"\n" "\\n"
#"\r" "\\r"
#"\f" "\\f"
#"\"" "\\\""
#"\\" "\\\\"
- _ (_lux_proc ["jvm" "invokevirtual:java.lang.Object:toString:"] [x]))]
+ _ (_lux_proc ["char" "to-text"] [x]))]
($_ Text/append "#\"" as-text "\"")))
(def: (decode y)
@@ -70,13 +65,13 @@
[(#;Some #"\\") (#;Some char)]
(case char
#"t" (#;Right #"\t")
+ #"v" (#;Right #"\v")
#"b" (#;Right #"\b")
#"n" (#;Right #"\n")
#"r" (#;Right #"\r")
#"f" (#;Right #"\f")
#"\"" (#;Right #"\"")
#"\\" (#;Right #"\\")
- #"t" (#;Right #"\t")
_ (#;Left (Text/append "Wrong syntax for Char: " y)))
_
@@ -84,14 +79,19 @@
(#;Left (Text/append "Wrong syntax for Char: " y))))))
## [Values]
-(def: #export (space? x)
+(def: #export (space? char)
{#;doc "Checks whether the character is white-space."}
(-> Char Bool)
- (_lux_proc ["jvm" "invokestatic:java.lang.Character:isWhitespace:char"] [x]))
+ (case char
+ (^or #"\t" #"\v" #" " #"\n" #"\r" #"\f")
+ true
+
+ _
+ false))
(def: #export (as-text x)
(-> Char Text)
- (_lux_proc ["jvm" "invokevirtual:java.lang.Object:toString:"] [x]))
+ (_lux_proc ["char" "to-text"] [x]))
(def: #export (char x)
(-> Nat Char)
diff --git a/stdlib/source/lux/data/coll/list.lux b/stdlib/source/lux/data/coll/list.lux
index 4d9d9c270..5f2ef3984 100644
--- a/stdlib/source/lux/data/coll/list.lux
+++ b/stdlib/source/lux/data/coll/list.lux
@@ -335,7 +335,7 @@
## [Syntax]
(def: (symbol$ name)
(-> Text AST)
- [["" -1 -1] (#;SymbolS "" name)])
+ [["" +0 +0] (#;SymbolS "" name)])
(macro: #export (zip tokens state)
{#;doc (doc "Create list zippers with the specified number of input lists."
diff --git a/stdlib/source/lux/data/number.lux b/stdlib/source/lux/data/number.lux
index 998b42ea8..1a29fc5b6 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,24 +158,59 @@
(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>]
+(do-template [<struct> <base> <macro> <error> <char-set> <doc>]
[(struct: #export <struct> (Codec Text Nat)
(def: (encode value)
- (_lux_proc ["jvm" <to-proc>] [(nat-to-int value)]))
+ (loop [input value
+ output ""]
+ (let [digit (assume (_lux_proc ["text" "char"] [<char-set> (n.% <base> input)]))
+ output' (_lux_proc ["text" "append"] [(_lux_proc ["char" "to-text"] [digit])
+ output])
+ input' (n./ <base> input)]
+ (if (n.= +0 input')
+ output'
+ (recur input' output')))))
(def: (decode repr)
- (_lux_proc ["jvm" "try"]
- [(#;Right (int-to-nat (_lux_proc ["jvm" "invokestatic:java.lang.Long:parseUnsignedLong:java.lang.String,int"] [repr (_lux_proc ["jvm" "l2i"] [<radix>])])))
- (lambda [ex] (#;Left <error>))])))
+ (let [input-size (_lux_proc ["text" "size"] [repr])]
+ (if (n.= +0 input-size)
+ (#;Left "Empty input.")
+ (let [input (_lux_proc ["text" "upper-case"] [repr])]
+ (loop [idx +0
+ output +0]
+ (if (n.< input-size idx)
+ (let [digit (assume (_lux_proc ["text" "char"] [input idx]))]
+ (case (_lux_proc ["text" "index"]
+ [<char-set>
+ (_lux_proc ["char" "to-text"] [digit])
+ +0])
+ #;None
+ (#;Left <error>)
+
+ (#;Some index)
+ (recur (n.inc idx)
+ (|> output (n.* <base>) (n.+ index)))))
+ (#;Right output))))))))
(macro: #export (<macro> tokens state)
{#;doc <doc>}
@@ -211,29 +226,16 @@
_
(#;Left <error>)))]
- [Binary@Codec<Text,Nat> "invokestatic:java.lang.Long:toBinaryString:long" 2 bin "Invalid binary syntax."
+ [Binary@Codec<Text,Nat> +2 bin "Invalid binary syntax."
+ "01"
(doc "Given syntax for a binary number, generates a Nat."
(bin "11001001"))]
- [Octal@Codec<Text,Nat> "invokestatic:java.lang.Long:toOctalString:long" 8 oct "Invalid octal syntax."
+ [Octal@Codec<Text,Nat> +8 oct "Invalid octal syntax."
+ "01234567"
(doc "Given syntax for an octal number, generates a Nat."
(oct "615243"))]
- [Hex@Codec<Text,Nat> "invokestatic:java.lang.Long:toHexString:long" 16 hex "Invalid hexadecimal syntax."
+ [Hex@Codec<Text,Nat> +16 hex "Invalid hexadecimal syntax."
+ "0123456789ABCDEF"
(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..4869d9e82 100644
--- a/stdlib/source/lux/data/text.lux
+++ b/stdlib/source/lux/data/text.lux
@@ -12,67 +12,53 @@
## [Functions]
(def: #export (size x)
(-> Text Nat)
- (int-to-nat (_lux_proc ["jvm" "i2l"] [(_lux_proc ["jvm" "invokevirtual:java.lang.String:length:"] [x])])))
+ [(_lux_proc ["text" "size"] [x])])
-(def: #export (nth idx x)
+(def: #export (nth idx input)
(-> Nat Text (Maybe Char))
- (if (n.< (size x) idx)
- (#;Some (_lux_proc ["jvm" "invokevirtual:java.lang.String:charAt:int"] [x (_lux_proc ["jvm" "l2i"] [(nat-to-int idx)])]))
- #;None))
+ (_lux_proc ["text" "char"] [input idx]))
(def: #export (contains? sub text)
(-> Text Text Bool)
- (_lux_proc ["jvm" "invokevirtual:java.lang.String:contains:java.lang.CharSequence"] [text sub]))
+ (_lux_proc ["text" "contains?"] [text sub]))
(do-template [<name> <proc>]
- [(def: #export (<name> x)
+ [(def: #export (<name> input)
(-> Text Text)
- (_lux_proc ["jvm" <proc>] [x]))]
- [lower-case "invokevirtual:java.lang.String:toLowerCase:"]
- [upper-case "invokevirtual:java.lang.String:toUpperCase:"]
- [trim "invokevirtual:java.lang.String:trim:"]
+ (_lux_proc ["text" <proc>] [input]))]
+ [lower-case "lower-case"]
+ [upper-case "upper-case"]
+ [trim "trim"]
)
-(def: #export (sub from to x)
+(def: #export (clip from to input)
(-> Nat Nat Text (Maybe Text))
- (if (and (n.< to from)
- (n.<= (size x) to))
- (#;Some (_lux_proc ["jvm" "invokevirtual:java.lang.String:substring:int,int"]
- [x
- (_lux_proc ["jvm" "l2i"] [(nat-to-int from)])
- (_lux_proc ["jvm" "l2i"] [(nat-to-int to)])]))
- #;None))
+ (_lux_proc ["text" "clip"] [input from to]))
-(def: #export (sub' from x)
+(def: #export (clip' from input)
(-> Nat Text (Maybe Text))
- (sub from (size x) x))
+ (clip from (size input) input))
(def: #export (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]))
-(do-template [<common> <common-proc> <general> <general-proc>]
- [(def: #export (<common> pattern x)
+(do-template [<general> <common> <proc> <start>]
+ [(def: #export (<common> pattern input)
(-> Text Text (Maybe Nat))
- (case (_lux_proc ["jvm" "i2l"] [(_lux_proc ["jvm" <common-proc>] [x pattern])])
- -1 #;None
- idx (#;Some (int-to-nat idx))))
+ (_lux_proc ["text" <proc>] [input pattern <start>]))
- (def: #export (<general> pattern from x)
+ (def: #export (<general> pattern from input)
(-> Text Nat Text (Maybe Nat))
- (if (n.< (size x) from)
- (case (_lux_proc ["jvm" "i2l"] [(_lux_proc ["jvm" <general-proc>] [x pattern (_lux_proc ["jvm" "l2i"] [(nat-to-int from)])])])
- -1 #;None
- idx (#;Some (int-to-nat idx)))
- #;None))]
-
- [index-of "invokevirtual:java.lang.String:indexOf:java.lang.String" index-of' "invokevirtual:java.lang.String:indexOf:java.lang.String,int"]
- [last-index-of "invokevirtual:java.lang.String:lastIndexOf:java.lang.String" last-index-of' "invokevirtual:java.lang.String:lastIndexOf:java.lang.String,int"]
+ (_lux_proc ["text" <proc>] [input pattern from]))]
+
+ [index-of index-of' "index" +0]
+ [last-index-of last-index-of' "last-index" (size input)]
)
(def: #export (starts-with? prefix x)
(-> Text Text Bool)
- (case (index-of prefix x)
+ (case (index-of' prefix x)
(#;Some +0)
true
@@ -81,7 +67,7 @@
(def: #export (ends-with? postfix x)
(-> Text Text Bool)
- (case (last-index-of postfix x)
+ (case (last-index-of' postfix x)
(#;Some n)
(n.= (size x)
(n.+ (size postfix) n))
@@ -91,16 +77,17 @@
(def: #export (split at x)
(-> Nat Text (Maybe [Text Text]))
- (if (n.<= (size x) at)
- (let [pre (_lux_proc ["jvm" "invokevirtual:java.lang.String:substring:int,int"] [x (_lux_proc ["jvm" "l2i"] [0]) (_lux_proc ["jvm" "l2i"] [(nat-to-int at)])])
- post (_lux_proc ["jvm" "invokevirtual:java.lang.String:substring:int"] [x (_lux_proc ["jvm" "l2i"] [(nat-to-int at)])])]
- (#;Some [pre post]))
+ (case [(clip +0 at x) (clip' at x)]
+ [(#;Some pre) (#;Some post)]
+ (#;Some [pre post])
+
+ _
#;None))
(def: #export (split-with token sample)
(-> Text Text (Maybe [Text Text]))
(do Monad<Maybe>
- [index (index-of token sample)
+ [index (index-of' token sample)
[pre post'] (split index sample)
[_ post] (split (size token) post')]
(wrap [pre post])))
@@ -120,25 +107,30 @@
## [Structures]
(struct: #export _ (Eq Text)
(def: (= test subject)
- (_lux_proc ["jvm" "invokevirtual:java.lang.Object:equals:java.lang.Object"] [subject test])))
+ (_lux_proc ["text" "="] [subject test])))
(struct: #export _ (ord;Ord Text)
(def: eq Eq<Text>)
- (do-template [<name> <op>]
- [(def: (<name> test subject)
- (<op> 0
- (_lux_proc ["jvm" "i2l"] [(_lux_proc ["jvm" "invokevirtual:java.lang.String:compareTo:java.lang.String"] [subject test])])))]
+ (def: (< test subject)
+ (_lux_proc ["text" "<"] [subject test]))
+
+ (def: (<= test subject)
+ (or (_lux_proc ["text" "<"] [subject test])
+ (_lux_proc ["text" "="] [subject test])))
- [< i.<]
- [<= i.<=]
- [> i.>]
- [>= i.>=]))
+ (def: (> test subject)
+ (_lux_proc ["text" "<"] [test subject]))
+
+ (def: (>= test subject)
+ (or (_lux_proc ["text" "<"] [test subject])
+ (_lux_proc ["text" "="] [test subject])))
+ )
(struct: #export _ (Monoid Text)
(def: unit "")
- (def: (append x y)
- (_lux_proc ["jvm" "invokevirtual:java.lang.String:concat:java.lang.String"] [x y])))
+ (def: (append left right)
+ (_lux_proc ["text" "append"] [left right])))
(open Monoid<Text>)
@@ -147,6 +139,7 @@
(let [escaped (|> original
(replace "\\" "\\\\")
(replace "\t" "\\t")
+ (replace "\v" "\\v")
(replace "\b" "\\b")
(replace "\n" "\\n")
(replace "\r" "\\r")
@@ -158,11 +151,12 @@
(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 "\\\\" "\\")
(replace "\\t" "\t")
+ (replace "\\v" "\v")
(replace "\\b" "\b")
(replace "\\n" "\n")
(replace "\\r" "\r")
@@ -177,12 +171,8 @@
(struct: #export _ (Hash Text)
(def: eq Eq<Text>)
- (def: hash
- (|>. []
- (_lux_proc ["jvm" "invokevirtual:java.lang.Object:hashCode:"])
- []
- (_lux_proc ["jvm" "i2l"])
- int-to-nat)))
+ (def: (hash input)
+ (_lux_proc ["text" "hash"] [input])))
(def: #export concat
(-> (List Text) Text)
diff --git a/stdlib/source/lux/host.js.lux b/stdlib/source/lux/host.js.lux
new file mode 100644
index 000000000..f935dc8d6
--- /dev/null
+++ b/stdlib/source/lux/host.js.lux
@@ -0,0 +1,83 @@
+(;module:
+ lux
+ (lux (control monad)
+ (data (coll [list #* "L/" Fold<List>]))
+ [compiler #+ with-gensyms]
+ (macro [ast]
+ ["s" syntax #+ syntax: Syntax])
+ ))
+
+(do-template [<name> <type>]
+ [(type: #export <name> (#;HostT <type> #;Nil))]
+
+ [Object "object"]
+ [Function "function"]
+ [Symbol "symbol"]
+ [Undefined "undefined"]
+ )
+
+(do-template [<name> <type>]
+ [(type: #export <name> <type>)]
+
+ [String Text]
+ [Number Real]
+ [Boolean Bool]
+ )
+
+## [Syntax]
+(syntax: #export (set! field-name field-value object)
+ {#;doc (doc "A way to set fields from objects."
+ (set! "foo" 1234 some-object))}
+ (wrap (list (` (;_lux_proc ["js" "set-field"] [(~ object) (~ field-name) (~ field-value)])))))
+
+(syntax: #export (delete! field-name object)
+ {#;doc (doc "A way to delete fields from objects."
+ (delete! "foo" some-object))}
+ (wrap (list (` (;_lux_proc ["js" "delete-field"] [(~ object) (~ field-name)])))))
+
+(syntax: #export (get field-name type object)
+ {#;doc (doc "A way to get fields from objects."
+ (get "ceil" (ref "Math"))
+ (get "ceil" (-> Real Real) (ref "Math")))}
+ (wrap (list (` (:! (~ type)
+ (;_lux_proc ["js" "get-field"] [(~ object) (~ field-name)]))))))
+
+(syntax: #export (object [kvs (s;some (s;seq s;any s;any))])
+ {#;doc (doc "A way to create JavaScript objects."
+ (object)
+ (object "foo" foo "bar" (inc bar)))}
+ (wrap (list (L/fold (lambda [[k v] object]
+ (` (set! (~ k) (~ v) (~ object))))
+ (` (;_lux_proc ["js" "object"] []))
+ kvs))))
+
+(syntax: #export (ref [name s;text] [type (s;opt s;any)])
+ {#;doc (doc "A way to refer to JavaScript variables."
+ (ref "document")
+ (ref "Math.ceil" (-> Real Real)))}
+ (wrap (list (` (:! (~ (default (' ;;Object) type))
+ (;_lux_proc ["js" "ref"] [(~ (ast;text name))]))))))
+
+(do-template [<name> <proc> <doc>]
+ [(syntax: #export (<name>)
+ {#;doc (doc <doc>
+ (<name>))}
+ (wrap (list (` (;_lux_proc ["js" <proc>] [])))))]
+
+ [null "null" "Null object reference."]
+ [undef "undefined" "Undefined."]
+ )
+
+(syntax: #export (call! [shape (s;alt ($_ s;seq s;any (s;tuple (s;some s;any)) (s;opt s;any))
+ ($_ s;seq s;any s;text (s;tuple (s;some s;any)) (s;opt s;any)))])
+ {#;doc (doc "A way to call JavaScript functions and methods."
+ (call! (ref "Math.ceil") [123.45])
+ (call! (ref "Math") "ceil" [123.45]))}
+ (case shape
+ (#;Left [function args ?type])
+ (wrap (list (` (:! (~ (default (' ;;Object) ?type))
+ (;_lux_proc ["js" "call"] [(~ function) (~@ args)])))))
+
+ (#;Right [object field args ?type])
+ (wrap (list (` (:! (~ (default (' ;;Object) ?type))
+ (;_lux_proc ["js" "object-call"] [(~ object) (~ (ast;text field)) (~@ args)])))))))
diff --git a/stdlib/source/lux/host.lux b/stdlib/source/lux/host.jvm.lux
index 41d567165..41d567165 100644
--- a/stdlib/source/lux/host.lux
+++ b/stdlib/source/lux/host.jvm.lux
diff --git a/stdlib/source/lux/io.lux b/stdlib/source/lux/io.lux
index 93c01ee85..8a9e6bb9e 100644
--- a/stdlib/source/lux/io.lux
+++ b/stdlib/source/lux/io.lux
@@ -19,7 +19,7 @@
"Some value...")))}
(case tokens
(^ (list value))
- (let [blank (: AST [["" -1 -1] (#;SymbolS ["" ""])])]
+ (let [blank (: AST [["" +0 +0] (#;SymbolS ["" ""])])]
(#;Right [state (list (` (;_lux_lambda (~ blank) (~ blank) (~ value))))]))
_
diff --git a/stdlib/source/lux/macro/ast.lux b/stdlib/source/lux/macro/ast.lux
index 49d68b5c3..6647307dd 100644
--- a/stdlib/source/lux/macro/ast.lux
+++ b/stdlib/source/lux/macro/ast.lux
@@ -27,7 +27,7 @@
## (Meta Cursor (AST' (Meta Cursor))))
## [Utils]
-(def: _cursor Cursor ["" -1 -1])
+(def: _cursor Cursor ["" +0 +0])
## [Functions]
(do-template [<name> <type> <tag>]
diff --git a/stdlib/source/lux/math.lux b/stdlib/source/lux/math.lux
index e87bb1b1b..c49e82969 100644
--- a/stdlib/source/lux/math.lux
+++ b/stdlib/source/lux/math.lux
@@ -5,7 +5,6 @@
[number "Int/" Number<Int>]
[product]
text/format)
- host
[compiler]
(macro ["s" syntax #+ syntax: Syntax "s/" Functor<Syntax>]
[ast])))
@@ -14,10 +13,10 @@
(do-template [<name> <value>]
[(def: #export <name>
Real
- (_lux_proc ["jvm" <value>] []))]
+ (_lux_proc ["math" <value>] []))]
- [e "getstatic:java.lang.Math:E"]
- [pi "getstatic:java.lang.Math:PI"]
+ [e "e"]
+ [pi "pi"]
)
(def: #export tau
@@ -26,52 +25,40 @@
6.28318530717958647692)
(do-template [<name> <method>]
- [(def: #export (<name> n)
+ [(def: #export (<name> input)
(-> Real Real)
- (_lux_proc ["jvm" <method>] [n]))]
+ (_lux_proc ["math" <method>] [input]))]
- [cos "invokestatic:java.lang.Math:cos:double"]
- [sin "invokestatic:java.lang.Math:sin:double"]
- [tan "invokestatic:java.lang.Math:tan:double"]
+ [cos "cos"]
+ [sin "sin"]
+ [tan "tan"]
- [acos "invokestatic:java.lang.Math:acos:double"]
- [asin "invokestatic:java.lang.Math:asin:double"]
- [atan "invokestatic:java.lang.Math:atan:double"]
+ [acos "acos"]
+ [asin "asin"]
+ [atan "atan"]
- [cosh "invokestatic:java.lang.Math:cosh:double"]
- [sinh "invokestatic:java.lang.Math:sinh:double"]
- [tanh "invokestatic:java.lang.Math:tanh:double"]
+ [cosh "cosh"]
+ [sinh "sinh"]
+ [tanh "tanh"]
- [exp "invokestatic:java.lang.Math:exp:double"]
- [log "invokestatic:java.lang.Math:log:double"]
+ [exp "exp"]
+ [log "log"]
- [root2 "invokestatic:java.lang.Math:sqrt:double"]
- [root3 "invokestatic:java.lang.Math:cbrt:double"]
+ [root2 "root2"]
+ [root3 "root3"]
- [degrees "invokestatic:java.lang.Math:toDegrees:double"]
- [radians "invokestatic:java.lang.Math:toRadians:double"]
+ [ceil "ceil"]
+ [floor "floor"]
+ [round "round"]
)
(do-template [<name> <method>]
- [(def: #export (<name> n)
- (-> Real Real)
- (_lux_proc ["jvm" <method>] [n]))]
-
- [ceil "invokestatic:java.lang.Math:ceil:double"]
- [floor "invokestatic:java.lang.Math:floor:double"]
- )
-
-(def: #export (round n)
- (-> Real Real)
- (int-to-real (_lux_proc ["jvm" "invokestatic:java.lang.Math:round:double"] [n])))
-
-(do-template [<name> <method>]
[(def: #export (<name> param subject)
(-> Real Real Real)
- (_lux_proc ["jvm" <method>] [subject param]))]
+ (_lux_proc ["math" <method>] [subject param]))]
- [atan2 "invokestatic:java.lang.Math:atan2:double,double"]
- [pow "invokestatic:java.lang.Math:pow:double,double"]
+ [atan2 "atan2"]
+ [pow "pow"]
)
(def: #export (log' base input)
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))
diff --git a/stdlib/source/lux/test.lux b/stdlib/source/lux/test.lux
index 82fcabed9..d953b7d65 100644
--- a/stdlib/source/lux/test.lux
+++ b/stdlib/source/lux/test.lux
@@ -13,16 +13,16 @@
text/format
[error #- fail "Error/" Monad<Error>])
[io #- run]
- ["R" random]
- [host #- try]))
+ ["R" random]))
## [Host]
-(jvm-import java.lang.System
- (#static exit [int] #io void)
- (#static currentTimeMillis [] #io long))
+(def: now
+ (IO Int)
+ (io (_lux_proc ["io" "current-time"] [])))
(do-template [<name> <signal>]
- [(def: #hidden <name> (IO Unit) (System.exit <signal>))]
+ [(def: #hidden <name> (IO Bottom)
+ (io (_lux_proc ["io" "exit"] [<signal>])))]
[exit 0]
[die 1]
@@ -51,9 +51,9 @@
[#let [test-runs (List/map (: (-> [Text (IO Test) Text] (Promise Nat))
(lambda [[module test description]]
(do @
- [#let [pre (io;run (System.currentTimeMillis []))]
+ [#let [pre (io;run now)]
outcome (io;run test)
- #let [post (io;run (System.currentTimeMillis []))
+ #let [post (io;run now)
description+ (:: text;Codec<Text,Text> encode description)]]
(case outcome
(#;Left error)
@@ -107,7 +107,7 @@
(def: #hidden (repeat ?seed times random-test)
(-> (Maybe Nat) Nat (R;Random Test) Test)
- (repeat' (default (int-to-nat (io;run (System.currentTimeMillis [])))
+ (repeat' (default (int-to-nat (io;run now))
?seed)
(case ?seed
#;None times
@@ -155,7 +155,7 @@
(def: #hidden (try-body lazy-body)
(-> (IO Test) Test)
- (case (host;try (io;run lazy-body))
+ (case (_lux_proc ["lux" "try"] [lazy-body])
(#;Right output)
output