aboutsummaryrefslogtreecommitdiff
path: root/stdlib
diff options
context:
space:
mode:
authorEduardo Julian2017-11-20 21:46:49 -0400
committerEduardo Julian2017-11-20 21:46:49 -0400
commit3eabc421e559e7e2f903e06eb6b47a2ee0cd25b9 (patch)
treee66ef551837cb895786bb532fe19e621132e81db /stdlib
parent4abfd5413b5a7aa540d7c06b387e3426ff5c532c (diff)
- Added parallel compilation.
- Added aliasing. - Several bug fixes. - Some minor refactoring.
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux/concurrency/actor.lux3
-rw-r--r--stdlib/source/lux/concurrency/atom.lux4
-rw-r--r--stdlib/source/lux/concurrency/promise.lux6
-rw-r--r--stdlib/source/lux/concurrency/stm.lux81
-rw-r--r--stdlib/source/lux/control/eq.lux4
-rw-r--r--stdlib/source/lux/data/lazy.lux18
-rw-r--r--stdlib/source/lux/host.jvm.lux2
-rw-r--r--stdlib/source/lux/lang/syntax.lux2
-rw-r--r--stdlib/source/lux/lang/type/check.lux10
-rw-r--r--stdlib/source/lux/macro.lux232
-rw-r--r--stdlib/source/lux/test.lux6
-rw-r--r--stdlib/source/lux/type/object.lux3
-rw-r--r--stdlib/test/test/lux/concurrency/atom.lux10
-rw-r--r--stdlib/test/test/lux/data/coll/dict.lux6
-rw-r--r--stdlib/test/test/lux/host.jvm.lux10
-rw-r--r--stdlib/test/test/lux/lang/syntax.lux48
16 files changed, 246 insertions, 199 deletions
diff --git a/stdlib/source/lux/concurrency/actor.lux b/stdlib/source/lux/concurrency/actor.lux
index bdf0758c3..848350499 100644
--- a/stdlib/source/lux/concurrency/actor.lux
+++ b/stdlib/source/lux/concurrency/actor.lux
@@ -152,8 +152,7 @@
(def: #hidden (<resolve> name)
(-> Ident (Meta Ident))
(do Monad<Meta>
- [name (macro;normalize name)
- [_ annotations _] (macro;find-def name)]
+ [[_ annotations _] (macro;find-def name)]
(case (macro;get-tag-ann (ident-for <tag>) annotations)
(#;Some actor-name)
(wrap actor-name)
diff --git a/stdlib/source/lux/concurrency/atom.lux b/stdlib/source/lux/concurrency/atom.lux
index 1260c758f..2837d6177 100644
--- a/stdlib/source/lux/concurrency/atom.lux
+++ b/stdlib/source/lux/concurrency/atom.lux
@@ -11,7 +11,7 @@
(All [a] (-> a (Atom a)))
("lux atom new" value))
-(def: #export (get atom)
+(def: #export (read atom)
(All [a] (-> (Atom a) (IO a)))
(io ("lux atom get" atom)))
@@ -34,6 +34,6 @@
[]
(io;run (update f atom))))))
-(def: #export (set value atom)
+(def: #export (write value atom)
(All [a] (-> a (Atom a) (IO Unit)))
(update (function;const value) atom))
diff --git a/stdlib/source/lux/concurrency/promise.lux b/stdlib/source/lux/concurrency/promise.lux
index 115f60dc1..78cdbecce 100644
--- a/stdlib/source/lux/concurrency/promise.lux
+++ b/stdlib/source/lux/concurrency/promise.lux
@@ -40,7 +40,7 @@
(def: #export (poll promise)
{#;doc "Polls a Promise's value."}
(All [a] (-> (Promise a) (Maybe a)))
- (|> (atom;get promise)
+ (|> (atom;read promise)
io;run
(get@ #value)))
@@ -58,7 +58,7 @@
{#;doc "Sets an Promise's value if it has not been done yet."}
(All [a] (-> a (Promise a) (IO Bool)))
(do Monad<IO>
- [old (atom;get promise)]
+ [old (atom;read promise)]
(case (get@ #value old)
(#;Some _)
(wrap false)
@@ -76,7 +76,7 @@
(def: (await f promise)
(All [a] (-> (-> a (IO Unit)) (Promise a) Unit))
- (let [old (io;run (atom;get promise))]
+ (let [old (io;run (atom;read promise))]
(case (get@ #value old)
(#;Some value)
(io;run (f value))
diff --git a/stdlib/source/lux/concurrency/stm.lux b/stdlib/source/lux/concurrency/stm.lux
index 7886dda36..1fee00b7e 100644
--- a/stdlib/source/lux/concurrency/stm.lux
+++ b/stdlib/source/lux/concurrency/stm.lux
@@ -1,23 +1,22 @@
(;module:
lux
- (lux (control ["F" functor]
- ["A" applicative]
- ["M" monad #+ do Monad])
+ (lux (control [functor #+ Functor]
+ [applicative #+ Applicative]
+ [monad #+ do Monad])
[io #- run]
- (data (coll [list "L/" Functor<List> Fold<List>]
- [dict #+ Dict]
- ["Q" queue])
+ (data (coll [list "list/" Functor<List> Fold<List>]
+ [dict #+ Dict])
[product]
[text]
maybe
- [number "Nat/" Codec<Text,Nat>]
+ [number "nat/" Codec<Text,Nat>]
text/format)
[macro]
(macro [code]
["s" syntax #+ syntax: Syntax])
(concurrency [atom #+ Atom atom]
["P" promise]
- [frp])
+ [frp "frp/" Functor<Channel>])
))
(type: (Var-State a)
@@ -48,7 +47,7 @@
(def: raw-read
(All [a] (-> (Var a) a))
- (|>. atom;get io;run (get@ #value)))
+ (|>. atom;read io;run (get@ #value)))
(def: (find-var-value var tx)
(All [a] (-> (Var a) Tx (Maybe a)))
@@ -76,7 +75,7 @@
{#;doc "Reads var immediately, without going through a transaction."}
(All [a] (-> (Var a) (IO a)))
(|> var
- atom;get
+ atom;read
(:: Functor<IO> map (get@ #value))))
(def: (update-tx-value var value tx)
@@ -112,7 +111,7 @@
{#;doc "Writes value to var immediately, without going through a transaction."}
(All [a] (-> a (Var a) (IO Unit)))
(do Monad<IO>
- [old (atom;get var)
+ [old (atom;read var)
#let [old-value (get@ #value old)
new (set@ #value new-value old)]
succeeded? (atom;compare-and-swap old new var)]
@@ -121,7 +120,7 @@
[_ (|> old
(get@ #observers)
dict;values
- (M;map @ (function [f] (f new-value))))]
+ (monad;map @ (function [f] (f new-value))))]
(wrap []))
(write! new-value var))))
@@ -143,26 +142,26 @@
(write! tail' channel-var)))]
(do Monad<IO>
[_ (atom;update (function [[value observers]]
- (let [label (Nat/encode (L/fold (function [key base]
- (case (Nat/decode key)
- (#;Left _)
- base
-
- (#;Right key-num)
- (n.max key-num base)))
- +0
- (dict;keys observers)))]
+ (let [label (nat/encode (list/fold (function [key base]
+ (case (nat/decode key)
+ (#;Left _)
+ base
+
+ (#;Right key-num)
+ (n.max key-num base)))
+ +0
+ (dict;keys observers)))]
[value (dict;put label (observer label) observers)]))
target)]
(wrap head))))
-(struct: #export _ (F;Functor STM)
+(struct: #export _ (Functor STM)
(def: (map f fa)
(function [tx]
(let [[tx' a] (fa tx)]
[tx' (f a)]))))
-(struct: #export _ (A;Applicative STM)
+(struct: #export _ (Applicative STM)
(def: functor Functor<STM>)
(def: (wrap a)
@@ -186,7 +185,7 @@
{#;doc "Will update a Var's value, and return a tuple with the old and the new values."}
(All [a] (-> (-> a a) (Var a) (IO [a a])))
(io (loop [_ []]
- (let [(^@ state [value observers]) (io;run (atom;get var))
+ (let [(^@ state [value observers]) (io;run (atom;read var))
value' (f value)]
(if (io;run (atom;compare-and-swap state
[value' observers]
@@ -225,31 +224,18 @@
(Atom Bool)
(atom false))
-(def: (process-commit commits)
- (-> (frp;Channel [(STM Unit) (P;Promise Unit)])
- (P;Promise Unit))
- (do P;Monad<Promise>
- [?head+tail commits]
- (case ?head+tail
- (#;Cons [stm-proc output] tail)
- (do @
- [#let [[finished-tx value] (stm-proc fresh-tx)]]
- (exec (if (can-commit? finished-tx)
- (exec (L/map commit-var finished-tx)
- (io;run (P;resolve value output))
- [])
- (exec (io;run (write! [stm-proc output] pending-commits))
- []))
- (process-commit tail)))
-
- #;Nil
- (undefined)
- )))
+(def: (process-commit [stm-proc output])
+ (-> [(STM Unit) (P;Promise Unit)] Top)
+ (let [[finished-tx value] (stm-proc fresh-tx)]
+ (if (can-commit? finished-tx)
+ (exec (list/map commit-var finished-tx)
+ (io;run (P;resolve value output)))
+ (io;run (write! [stm-proc output] pending-commits)))))
(def: init-processor!
(IO Unit)
(do Monad<IO>
- [flag (atom;get commit-processor-flag)]
+ [flag (atom;read commit-processor-flag)]
(if flag
(wrap [])
(do @
@@ -257,8 +243,9 @@
(if was-first?
(do Monad<IO>
[inputs (follow pending-commits)]
- (exec (process-commit (:! (frp;Channel [(STM Unit) (P;Promise Unit)])
- inputs))
+ (exec (|> inputs
+ (:! (frp;Channel [(STM Unit) (P;Promise Unit)]))
+ (frp/map process-commit))
(wrap [])))
(wrap [])))
)))
diff --git a/stdlib/source/lux/control/eq.lux b/stdlib/source/lux/control/eq.lux
index b69292daa..9e372bd58 100644
--- a/stdlib/source/lux/control/eq.lux
+++ b/stdlib/source/lux/control/eq.lux
@@ -5,13 +5,13 @@
(: (-> a a Bool)
=))
-(def: #export (seq left right)
+(def: #export (pair left right)
(All [l r] (-> (Eq l) (Eq r) (Eq [l r])))
(struct (def: (= [a b] [x y])
(and (:: left = a x)
(:: right = b y)))))
-(def: #export (alt left right)
+(def: #export (either left right)
(All [l r] (-> (Eq l) (Eq r) (Eq (| l r))))
(struct (def: (= a|b x|y)
(case [a|b x|y]
diff --git a/stdlib/source/lux/data/lazy.lux b/stdlib/source/lux/data/lazy.lux
index e344c6a0a..86fdde4a4 100644
--- a/stdlib/source/lux/data/lazy.lux
+++ b/stdlib/source/lux/data/lazy.lux
@@ -1,10 +1,10 @@
(;module:
lux
(lux [io]
- (control ["F" functor]
- ["A" applicative]
- monad)
- (concurrency ["a" atom])
+ (control [functor #+ Functor]
+ [applicative #+ Applicative]
+ [monad #+ Monad do])
+ (concurrency [atom])
[macro]
(macro ["s" syntax #+ syntax:])
(type opaque)))
@@ -14,15 +14,15 @@
(def: #hidden (freeze' generator)
(All [a] (-> (-> [] a) (Lazy a)))
- (let [cache (a;atom (: (Maybe ($ +0)) #;None))]
+ (let [cache (atom;atom (: (Maybe ($ +0)) #;None))]
(@opaque (function [_]
- (case (io;run (a;get cache))
+ (case (io;run (atom;read cache))
(#;Some value)
value
_
(let [value (generator [])]
- (exec (io;run (a;compare-and-swap _ (#;Some value) cache))
+ (exec (io;run (atom;compare-and-swap _ (#;Some value) cache))
value)))))))
(def: #export (thaw l-value)
@@ -34,11 +34,11 @@
[g!_ (macro;gensym "_")]
(wrap (list (` (freeze' (function [(~ g!_)] (~ expr))))))))
-(struct: #export _ (F;Functor Lazy)
+(struct: #export _ (Functor Lazy)
(def: (map f fa)
(freeze (f (thaw fa)))))
-(struct: #export _ (A;Applicative Lazy)
+(struct: #export _ (Applicative Lazy)
(def: functor Functor<Lazy>)
(def: (wrap a)
diff --git a/stdlib/source/lux/host.jvm.lux b/stdlib/source/lux/host.jvm.lux
index 1298a56d1..12f6d7abf 100644
--- a/stdlib/source/lux/host.jvm.lux
+++ b/stdlib/source/lux/host.jvm.lux
@@ -1344,7 +1344,7 @@
))
(syntax: #export (object [#let [imports (class-imports *compiler*)]]
- [#let [class-vars (list)]]
+ [class-vars (s;tuple (p;some (type-param^ imports)))]
[super (p;default object-super-class
(super-class-decl^ imports class-vars))]
[interfaces (p;default (list)
diff --git a/stdlib/source/lux/lang/syntax.lux b/stdlib/source/lux/lang/syntax.lux
index 9fe4939a2..7bc8e8cca 100644
--- a/stdlib/source/lux/lang/syntax.lux
+++ b/stdlib/source/lux/lang/syntax.lux
@@ -613,7 +613,7 @@
(p;fail (Unrecognized-Input current-module))))
)))))
-(def: #export (parse current-module [where offset source])
+(def: #export (read current-module [where offset source])
(-> Text Source (e;Error [Source Code]))
(case (p;run [offset source] (ast current-module where))
(#e;Error error)
diff --git a/stdlib/source/lux/lang/type/check.lux b/stdlib/source/lux/lang/type/check.lux
index cbf31ac08..086866ddf 100644
--- a/stdlib/source/lux/lang/type/check.lux
+++ b/stdlib/source/lux/lang/type/check.lux
@@ -458,6 +458,16 @@
[Type Type] [Type Type]
(Check (List Assumption)))
(case [eFT aFT]
+ (^or [(#;UnivQ _ _) (#;Ex _)] [(#;UnivQ _ _) (#;Var _)])
+ (do Monad<Check>
+ [eFT' (apply-type! eFT eAT)]
+ (check' eFT' (#;Apply aAT aFT) assumptions))
+
+ (^or [(#;Ex _) (#;UnivQ _ _)] [(#;Var _) (#;UnivQ _ _)])
+ (do Monad<Check>
+ [aFT' (apply-type! aFT aAT)]
+ (check' (#;Apply eAT eFT) aFT' assumptions))
+
(^or [(#;Ex _) _] [_ (#;Ex _)])
(do Monad<Check>
[assumptions (check' eFT aFT assumptions)]
diff --git a/stdlib/source/lux/macro.lux b/stdlib/source/lux/macro.lux
index e65e09b58..e3cba7a31 100644
--- a/stdlib/source/lux/macro.lux
+++ b/stdlib/source/lux/macro.lux
@@ -1,8 +1,8 @@
(;module: {#;doc "Functions for extracting information from the state of the compiler."}
lux
- (lux (control ["F" functor]
- ["A" applicative]
- ["M" monad #+ do Monad])
+ (lux (control [functor #+ Functor]
+ [applicative #+ Applicative]
+ [monad #+ do Monad])
(data [number]
[product]
[ident "ident/" Codec<Text,Ident> Eq<Ident>]
@@ -15,30 +15,30 @@
## (type: (Meta a)
## (-> Compiler (e;Error [Compiler a])))
-(struct: #export _ (F;Functor Meta)
+(struct: #export _ (Functor Meta)
(def: (map f fa)
- (function [state]
- (case (fa state)
+ (function [compiler]
+ (case (fa compiler)
(#e;Error msg)
(#e;Error msg)
- (#e;Success [state' a])
- (#e;Success [state' (f a)])))))
+ (#e;Success [compiler' a])
+ (#e;Success [compiler' (f a)])))))
-(struct: #export _ (A;Applicative Meta)
+(struct: #export _ (Applicative Meta)
(def: functor Functor<Meta>)
(def: (wrap x)
- (function [state]
- (#e;Success [state x])))
+ (function [compiler]
+ (#e;Success [compiler x])))
(def: (apply ff fa)
- (function [state]
- (case (ff state)
- (#e;Success [state' f])
- (case (fa state')
- (#e;Success [state'' a])
- (#e;Success [state'' (f a)])
+ (function [compiler]
+ (case (ff compiler)
+ (#e;Success [compiler' f])
+ (case (fa compiler')
+ (#e;Success [compiler'' a])
+ (#e;Success [compiler'' (f a)])
(#e;Error msg)
(#e;Error msg))
@@ -50,13 +50,13 @@
(def: applicative Applicative<Meta>)
(def: (join mma)
- (function [state]
- (case (mma state)
+ (function [compiler]
+ (case (mma compiler)
(#e;Error msg)
(#e;Error msg)
- (#e;Success [state' ma])
- (ma state')))))
+ (#e;Success [compiler' ma])
+ (ma compiler')))))
(def: (get k plist)
(All [a]
@@ -111,20 +111,20 @@
(def: #export (find-module name)
(-> Text (Meta Module))
- (function [state]
- (case (get name (get@ #;modules state))
+ (function [compiler]
+ (case (get name (get@ #;modules compiler))
(#;Some module)
- (#e;Success [state module])
+ (#e;Success [compiler module])
_
(#e;Error ($_ text/compose "Unknown module: " name)))))
(def: #export current-module-name
(Meta Text)
- (function [state]
- (case (get@ #;current-module state)
+ (function [compiler]
+ (case (get@ #;current-module compiler)
(#;Some current-module)
- (#e;Success [state current-module])
+ (#e;Success [compiler current-module])
_
(#e;Error "No current module.")
@@ -183,7 +183,7 @@
(def: #export (get-doc anns)
{#;doc "Looks-up a definition's documentation."}
(-> Code (Maybe Text))
- (get-text-ann ["lux" "doc"] anns))
+ (get-text-ann (ident-for #;doc) anns))
(def: #export (flag-set? flag-name anns)
{#;doc "Finds out whether an annotation-as-a-flag is set (has value 'true')."}
@@ -205,6 +205,15 @@
[sig? #;sig? "a signature"]
)
+(def: #export (aliased? annotations)
+ (-> Code Bool)
+ (case (get-symbol-ann (ident-for #;alias) annotations)
+ (#;Some _)
+ true
+
+ #;None
+ false))
+
(do-template [<name> <tag> <type>]
[(def: (<name> input)
(-> Code (Maybe <type>))
@@ -227,7 +236,7 @@
(do maybe;Monad<Maybe>
[_args (get-ann (ident-for <tag>) anns)
args (parse-tuple _args)]
- (M;map @ parse-text args))))]
+ (monad;map @ parse-text args))))]
[func-args #;func-args "Looks up the arguments of a function."]
[type-args #;type-args "Looks up the arguments of a parameterized type."]
@@ -243,22 +252,13 @@
(if (and (macro? def-anns)
(or (export? def-anns) (text/= module this-module)))
(#;Some (:! Macro def-value))
- (case (get-symbol-ann ["lux" "alias"] def-anns)
+ (case (get-symbol-ann (ident-for #;alias) def-anns)
(#;Some [r-module r-name])
(find-macro' modules this-module r-module r-name)
_
#;None))))
-(def: #export (find-macro ident)
- (-> Ident (Meta (Maybe Macro)))
- (do Monad<Meta>
- [this-module current-module-name]
- (let [[module name] ident]
- (: (Meta (Maybe Macro))
- (function [state]
- (#e;Success [state (find-macro' (get@ #;modules state) this-module module name)]))))))
-
(def: #export (normalize ident)
{#;doc "If given an identifier without a module prefix, gives it the current module's name as prefix.
@@ -273,6 +273,16 @@
_
(:: Monad<Meta> wrap ident)))
+(def: #export (find-macro ident)
+ (-> Ident (Meta (Maybe Macro)))
+ (do Monad<Meta>
+ [ident (normalize ident)
+ this-module current-module-name]
+ (let [[module name] ident]
+ (: (Meta (Maybe Macro))
+ (function [compiler]
+ (#e;Success [compiler (find-macro' (get@ #;modules compiler) this-module module name)]))))))
+
(def: #export (expand-once syntax)
{#;doc "Given code that requires applying a macro, does it once and returns the result.
@@ -281,8 +291,7 @@
(case syntax
[_ (#;Form (#;Cons [[_ (#;Symbol name)] args]))]
(do Monad<Meta>
- [name' (normalize name)
- ?macro (find-macro name')]
+ [?macro (find-macro name)]
(case ?macro
(#;Some macro)
(macro args)
@@ -301,13 +310,12 @@
(case syntax
[_ (#;Form (#;Cons [[_ (#;Symbol name)] args]))]
(do Monad<Meta>
- [name' (normalize name)
- ?macro (find-macro name')]
+ [?macro (find-macro name)]
(case ?macro
(#;Some macro)
(do Monad<Meta>
[expansion (macro args)
- expansion' (M;map Monad<Meta> expand expansion)]
+ expansion' (monad;map Monad<Meta> expand expansion)]
(wrap (list/join expansion')))
#;None
@@ -322,29 +330,28 @@
(case syntax
[_ (#;Form (#;Cons [[_ (#;Symbol name)] args]))]
(do Monad<Meta>
- [name' (normalize name)
- ?macro (find-macro name')]
+ [?macro (find-macro name)]
(case ?macro
(#;Some macro)
(do Monad<Meta>
[expansion (macro args)
- expansion' (M;map Monad<Meta> expand-all expansion)]
+ expansion' (monad;map Monad<Meta> expand-all expansion)]
(wrap (list/join expansion')))
#;None
(do Monad<Meta>
- [parts' (M;map Monad<Meta> expand-all (list& (code;symbol name) args))]
+ [parts' (monad;map Monad<Meta> expand-all (list& (code;symbol name) args))]
(wrap (list (code;form (list/join parts')))))))
[_ (#;Form (#;Cons [harg targs]))]
(do Monad<Meta>
[harg+ (expand-all harg)
- targs+ (M;map Monad<Meta> expand-all targs)]
+ targs+ (monad;map Monad<Meta> expand-all targs)]
(wrap (list (code;form (list/compose harg+ (list/join (: (List (List Code)) targs+)))))))
[_ (#;Tuple members)]
(do Monad<Meta>
- [members' (M;map Monad<Meta> expand-all members)]
+ [members' (monad;map Monad<Meta> expand-all members)]
(wrap (list (code;tuple (list/join members')))))
_
@@ -355,9 +362,9 @@
A prefix can be given (or just be empty text \"\") to better identify the code for debugging purposes."}
(-> Text (Meta Code))
- (function [state]
- (#e;Success [(update@ #;seed n.inc state)
- (code;symbol ["" ($_ text/compose "__gensym__" prefix (:: number;Codec<Text,Nat> encode (get@ #;seed state)))])])))
+ (function [compiler]
+ (#e;Success [(update@ #;seed n.inc compiler)
+ (code;symbol ["" ($_ text/compose "__gensym__" prefix (:: number;Codec<Text,Nat> encode (get@ #;seed compiler)))])])))
(def: (get-local-symbol ast)
(-> Code (Meta Text))
@@ -381,7 +388,7 @@
(case tokens
(^ (list [_ (#;Tuple symbols)] body))
(do Monad<Meta>
- [symbol-names (M;map @ get-local-symbol symbols)
+ [symbol-names (monad;map @ get-local-symbol symbols)
#let [symbol-defs (list/join (list/map (: (-> Text (List Code))
(function [name] (list (code;symbol ["" name]) (` (gensym (~ (code;text name)))))))
symbol-names))]]
@@ -406,13 +413,13 @@
(def: #export (module-exists? module)
(-> Text (Meta Bool))
- (function [state]
- (#e;Success [state (case (get module (get@ #;modules state))
- (#;Some _)
- true
-
- #;None
- false)])))
+ (function [compiler]
+ (#e;Success [compiler (case (get module (get@ #;modules compiler))
+ (#;Some _)
+ true
+
+ #;None
+ false)])))
(def: (try-both f x1 x2)
(All [a b]
@@ -424,7 +431,7 @@
(def: #export (find-var-type name)
{#;doc "Looks-up the type of a local variable somewhere in the environment."}
(-> Text (Meta Type))
- (function [state]
+ (function [compiler]
(let [test (: (-> [Text [Type Top]] Bool)
(|>. product;left (text/= name)))]
(case (do maybe;Monad<Maybe>
@@ -433,7 +440,7 @@
(get@ [#;locals #;mappings] env)))
(list;any? test (: (List [Text [Type Top]])
(get@ [#;captured #;mappings] env)))))
- (get@ #;scopes state))
+ (get@ #;scopes compiler))
[_ [type _]] (try-both (list;find test)
(: (List [Text [Type Top]])
(get@ [#;locals #;mappings] scope))
@@ -441,25 +448,60 @@
(get@ [#;captured #;mappings] scope)))]
(wrap type))
(#;Some var-type)
- (#e;Success [state var-type])
+ (#e;Success [compiler var-type])
#;None
(#e;Error ($_ text/compose "Unknown variable: " name))))))
+(def: #export (canonical name)
+ (-> Ident (Meta Ident))
+ (case name
+ ["" _name]
+ (do Monad<Meta>
+ [this-module current-module-name]
+ (wrap [this-module _name]))
+
+ [_module _name]
+ (do Monad<Meta>
+ [this-module-name current-module-name
+ this-module (find-module this-module-name)]
+ (case (list;find (|>. product;left (text/= _module))
+ (get@ #;module-aliases this-module))
+ (#;Some [alias real])
+ (wrap [real _name])
+
+ _
+ (wrap name)))
+ ))
+
(def: #export (find-def name)
{#;doc "Looks-up a definition's whole data in the available modules (including the current one)."}
(-> Ident (Meta Def))
- (function [state]
- (case (: (Maybe Def)
- (do maybe;Monad<Maybe>
- [#let [[v-prefix v-name] name]
- (^slots [#;defs]) (get v-prefix (get@ #;modules state))]
- (get v-name defs)))
- (#;Some _anns)
- (#e;Success [state _anns])
+ (do Monad<Meta>
+ [name (canonical name)]
+ (function [compiler]
+ (case (: (Maybe Def)
+ (do maybe;Monad<Maybe>
+ [#let [[v-prefix v-name] name]
+ (^slots [#;defs]) (get v-prefix (get@ #;modules compiler))]
+ (get v-name defs)))
+ (#;Some definition)
+ (#e;Success [compiler definition])
- _
- (#e;Error ($_ text/compose "Unknown definition: " (ident/encode name))))))
+ _
+ (let [current-module (|> compiler (get@ #;current-module) (maybe;default "???"))]
+ (#e;Error ($_ text/compose
+ "Unknown definition: " (ident/encode name) "\n"
+ " Current module: " current-module "\n"
+ (case (get current-module (get@ #;modules compiler))
+ (#;Some this-module)
+ ($_ text/compose
+ " Imports: " (|> this-module (get@ #;imports) (text;join-with ", ")) "\n"
+ " Aliases: " (|> this-module (get@ #;module-aliases) (list/map (function [[alias real]] ($_ text/compose alias " => " real))) (text;join-with ", ")) "\n")
+
+ _
+ "")
+ " All Known modules: " (|> compiler (get@ #;modules) (list/map product;left) (text;join-with ", ")) "\n")))))))
(def: #export (find-def-type name)
{#;doc "Looks-up a definition's type in the available modules (including the current one)."}
@@ -473,10 +515,13 @@
(-> Ident (Meta Type))
(do Monad<Meta>
[#let [[_ _name] name]]
- (either (find-var-type _name)
- (do @
- [name (normalize name)]
- (find-def-type name)))))
+ (case name
+ ["" _name]
+ (either (find-var-type _name)
+ (find-def-type name))
+
+ _
+ (find-def-type name))))
(def: #export (find-type-def name)
{#;doc "Finds the value of a type definition (such as Int, Top or Compiler)."}
@@ -488,10 +533,10 @@
(def: #export (defs module-name)
{#;doc "The entire list of definitions in a module (including the unexported/private ones)."}
(-> Text (Meta (List [Text Def])))
- (function [state]
- (case (get module-name (get@ #;modules state))
+ (function [compiler]
+ (case (get module-name (get@ #;modules compiler))
#;None (#e;Error ($_ text/compose "Unknown module: " module-name))
- (#;Some module) (#e;Success [state (get@ #;defs module)])
+ (#;Some module) (#e;Success [compiler (get@ #;defs module)])
)))
(def: #export (exports module-name)
@@ -507,10 +552,10 @@
(def: #export modules
{#;doc "All the available modules (including the current one)."}
(Meta (List [Text Module]))
- (function [state]
- (|> state
+ (function [compiler]
+ (|> compiler
(get@ #;modules)
- [state]
+ [compiler]
#e;Success)))
(def: #export (tags-of type-name)
@@ -529,16 +574,16 @@
(def: #export cursor
{#;doc "The cursor of the current expression being analyzed."}
(Meta Cursor)
- (function [state]
- (#e;Success [state (get@ #;cursor state)])))
+ (function [compiler]
+ (#e;Success [compiler (get@ #;cursor compiler)])))
(def: #export expected-type
{#;doc "The expected type of the current expression being analyzed."}
(Meta Type)
- (function [state]
- (case (get@ #;expected state)
+ (function [compiler]
+ (case (get@ #;expected compiler)
(#;Some type)
- (#e;Success [state type])
+ (#e;Success [compiler type])
#;None
(#e;Error "Not expecting any type."))))
@@ -583,13 +628,13 @@
(def: #export locals
{#;doc "All the local variables currently in scope, separated in different scopes."}
(Meta (List (List [Text Type])))
- (function [state]
- (case (list;inits (get@ #;scopes state))
+ (function [compiler]
+ (case (list;inits (get@ #;scopes compiler))
#;None
(#e;Error "No local environment")
(#;Some scopes)
- (#e;Success [state
+ (#e;Success [compiler
(list/map (|>. (get@ [#;locals #;mappings])
(list/map (function [[name [type _]]]
[name type])))
@@ -599,8 +644,7 @@
{#;doc "Given an aliased definition's name, returns the original definition being referenced."}
(-> Ident (Meta Ident))
(do Monad<Meta>
- [def-name (normalize def-name)
- [_ def-anns _] (find-def def-name)]
+ [[_ def-anns _] (find-def def-name)]
(case (get-symbol-ann (ident-for #;alias) def-anns)
(#;Some real-def-name)
(wrap real-def-name)
diff --git a/stdlib/source/lux/test.lux b/stdlib/source/lux/test.lux
index d296a9a2e..f8cfa9871 100644
--- a/stdlib/source/lux/test.lux
+++ b/stdlib/source/lux/test.lux
@@ -1,6 +1,6 @@
(;module: {#;doc "Tools for unit & property-based/generative testing."}
lux
- (lux [macro #+ Monad<Meta> with-gensyms]
+ (lux [macro #+ with-gensyms]
(macro ["s" syntax #+ syntax: Syntax]
[code])
(control [monad #+ do Monad]
@@ -12,7 +12,7 @@
[text]
text/format
["e" error])
- [io #- run]
+ [io #+ IO io]
(time [instant]
[duration])
["r" math/random]))
@@ -199,7 +199,7 @@
(def: (exported-tests module-name)
(-> Text (Meta (List [Text Text Text])))
- (do Monad<Meta>
+ (do macro;Monad<Meta>
[defs (macro;exports module-name)]
(wrap (|> defs
(list/map (function [[def-name [_ def-anns _]]]
diff --git a/stdlib/source/lux/type/object.lux b/stdlib/source/lux/type/object.lux
index fc68dcdae..a7945b41a 100644
--- a/stdlib/source/lux/type/object.lux
+++ b/stdlib/source/lux/type/object.lux
@@ -143,8 +143,7 @@
[(def: (<name> name)
(-> Ident (Meta [Ident (List Ident)]))
(do Monad<Meta>
- [name (macro;normalize name)
- [_ annotations _] (macro;find-def name)]
+ [[_ annotations _] (macro;find-def name)]
(case [(macro;get-tag-ann (ident-for <name-tag>) annotations)
(macro;get-tag-ann (ident-for <parent-tag>) annotations)]
[(#;Some real-name) (#;Some parent)]
diff --git a/stdlib/test/test/lux/concurrency/atom.lux b/stdlib/test/test/lux/concurrency/atom.lux
index 90c1c07d2..039546436 100644
--- a/stdlib/test/test/lux/concurrency/atom.lux
+++ b/stdlib/test/test/lux/concurrency/atom.lux
@@ -18,17 +18,17 @@
#let [box (&;atom value)]]
($_ seq
(test "Can obtain the value of an atom."
- (n.= value (io;run (&;get box))))
+ (n.= value (io;run (&;read box))))
(test "Can swap the value of an atom."
(and (io;run (&;compare-and-swap value swap-value box))
- (n.= swap-value (io;run (&;get box)))))
+ (n.= swap-value (io;run (&;read box)))))
(test "Can update the value of an atom."
(exec (io;run (&;update n.inc box))
- (n.= (n.inc swap-value) (io;run (&;get box)))))
+ (n.= (n.inc swap-value) (io;run (&;read box)))))
(test "Can immediately set the value of an atom."
- (exec (io;run (&;set set-value box))
- (n.= set-value (io;run (&;get box)))))
+ (exec (io;run (&;write set-value box))
+ (n.= set-value (io;run (&;read box)))))
))))
diff --git a/stdlib/test/test/lux/data/coll/dict.lux b/stdlib/test/test/lux/data/coll/dict.lux
index f2e47615a..536ad8450 100644
--- a/stdlib/test/test/lux/data/coll/dict.lux
+++ b/stdlib/test/test/lux/data/coll/dict.lux
@@ -8,7 +8,7 @@
[number]
[maybe]
(coll ["&" dict]
- [list "L/" Fold<List> Functor<List>]))
+ [list "list/" Fold<List> Functor<List>]))
["r" math/random])
lux/test)
@@ -30,7 +30,7 @@
(not (&;empty? dict))))
(test "The functions 'entries', 'keys' and 'values' should be synchronized."
- (:: (list;Eq<List> (eq;seq number;Eq<Nat> number;Eq<Nat>)) =
+ (:: (list;Eq<List> (eq;pair number;Eq<Nat> number;Eq<Nat>)) =
(&;entries dict)
(list;zip2 (&;keys dict)
(&;values dict))))
@@ -99,7 +99,7 @@
(test "If you merge, and the second dict has overlapping keys, it should overwrite yours."
(let [dict' (|> dict &;entries
- (L/map (function [[k v]] [k (n.inc v)]))
+ (list/map (function [[k v]] [k (n.inc v)]))
(&;from-list number;Hash<Nat>))
(^open) (&;Eq<Dict> number;Eq<Nat>)]
(= dict' (&;merge dict' dict))))
diff --git a/stdlib/test/test/lux/host.jvm.lux b/stdlib/test/test/lux/host.jvm.lux
index d41c587c8..070457799 100644
--- a/stdlib/test/test/lux/host.jvm.lux
+++ b/stdlib/test/test/lux/host.jvm.lux
@@ -11,6 +11,8 @@
["r" math/random])
lux/test)
+(&;import (java.util.concurrent.Callable a))
+
(&;import java.lang.Exception
(new [String]))
@@ -44,11 +46,17 @@
)
(def: test-runnable
- (object [Runnable]
+ (object [] [Runnable]
[]
(Runnable [] (run) void
[])))
+(def: test-callable
+ (object [a] [(Callable a)]
+ []
+ (Callable [] (call) a
+ (undefined))))
+
(interface: TestInterface
([] foo [boolean String] void #throws [Exception]))
diff --git a/stdlib/test/test/lux/lang/syntax.lux b/stdlib/test/test/lux/lang/syntax.lux
index 154e18a91..3eb9bfc02 100644
--- a/stdlib/test/test/lux/lang/syntax.lux
+++ b/stdlib/test/test/lux/lang/syntax.lux
@@ -80,20 +80,20 @@
other code^]
($_ seq
(test "Can parse Lux code."
- (case (&;parse "" [default-cursor +0 (code;to-text sample)])
+ (case (&;read "" [default-cursor +0 (code;to-text sample)])
(#e;Error error)
false
(#e;Success [_ parsed])
(:: code;Eq<Code> = parsed sample)))
(test "Can parse Lux multiple code nodes."
- (case (&;parse "" [default-cursor +0 (format (code;to-text sample) " "
- (code;to-text other))])
+ (case (&;read "" [default-cursor +0 (format (code;to-text sample) " "
+ (code;to-text other))])
(#e;Error error)
false
(#e;Success [remaining =sample])
- (case (&;parse "" remaining)
+ (case (&;read "" remaining)
(#e;Error error)
false
@@ -114,11 +114,11 @@
signed? r;bool
#let [expected (|> numerator (f./ denominator) (f.* (if signed? -1.0 1.0)))]]
(test "Can parse frac ratio syntax."
- (case (&;parse "" [default-cursor +0
- (format (if signed? "-" "")
- (%i (frac-to-int numerator))
- "/"
- (%i (frac-to-int denominator)))])
+ (case (&;read "" [default-cursor +0
+ (format (if signed? "-" "")
+ (%i (frac-to-int numerator))
+ "/"
+ (%i (frac-to-int denominator)))])
(#e;Success [_ [_ (#;Frac actual)]])
(f.= expected actual)
@@ -131,8 +131,8 @@
(do @
[expected (|> r;nat (:: @ map (n.% +1_000)))]
(test "Can parse nat char syntax."
- (case (&;parse "" [default-cursor +0
- (format "#" (%t (text;from-code expected)) "")])
+ (case (&;read "" [default-cursor +0
+ (format "#" (%t (text;from-code expected)) "")])
(#e;Success [_ [_ (#;Nat actual)]])
(n.= expected actual)
@@ -181,8 +181,8 @@
(let [bad-match (format (text;from-code x) "\n"
(text;from-code y) "\n"
(text;from-code z))]
- (case (&;parse "" [default-cursor +0
- (format "\"" bad-match "\"")])
+ (case (&;read "" [default-cursor +0
+ (format "\"" bad-match "\"")])
(#e;Error error)
true
@@ -195,9 +195,9 @@
good-output (format (text;from-code x) "\n"
(text;from-code y) "\n"
(text;from-code z))]
- (case (&;parse "" [(|> default-cursor (update@ #;column (n.+ (n.dec offset-size))))
- +0
- (format "\"" good-input "\"")])
+ (case (&;read "" [(|> default-cursor (update@ #;column (n.+ (n.dec offset-size))))
+ +0
+ (format "\"" good-input "\"")])
(#e;Error error)
false
@@ -206,25 +206,25 @@
parsed
(code;text good-output)))))
(test "Can handle comments."
- (case (&;parse "" [default-cursor +0
- (format comment (code;to-text sample))])
+ (case (&;read "" [default-cursor +0
+ (format comment (code;to-text sample))])
(#e;Error error)
false
(#e;Success [_ parsed])
(:: code;Eq<Code> = parsed sample)))
(test "Will reject unbalanced multi-line comments."
- (and (case (&;parse "" [default-cursor +0
- (format "#(" "#(" unbalanced-comment ")#"
- (code;to-text sample))])
+ (and (case (&;read "" [default-cursor +0
+ (format "#(" "#(" unbalanced-comment ")#"
+ (code;to-text sample))])
(#e;Error error)
true
(#e;Success [_ parsed])
false)
- (case (&;parse "" [default-cursor +0
- (format "#(" unbalanced-comment ")#" ")#"
- (code;to-text sample))])
+ (case (&;read "" [default-cursor +0
+ (format "#(" unbalanced-comment ")#" ")#"
+ (code;to-text sample))])
(#e;Error error)
true