From 3eabc421e559e7e2f903e06eb6b47a2ee0cd25b9 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Mon, 20 Nov 2017 21:46:49 -0400 Subject: - Added parallel compilation. - Added aliasing. - Several bug fixes. - Some minor refactoring. --- stdlib/source/lux/concurrency/actor.lux | 3 +- stdlib/source/lux/concurrency/atom.lux | 4 +- stdlib/source/lux/concurrency/promise.lux | 6 +- stdlib/source/lux/concurrency/stm.lux | 81 +++++------ stdlib/source/lux/control/eq.lux | 4 +- stdlib/source/lux/data/lazy.lux | 18 +-- stdlib/source/lux/host.jvm.lux | 2 +- stdlib/source/lux/lang/syntax.lux | 2 +- stdlib/source/lux/lang/type/check.lux | 10 ++ stdlib/source/lux/macro.lux | 232 ++++++++++++++++++------------ stdlib/source/lux/test.lux | 6 +- stdlib/source/lux/type/object.lux | 3 +- stdlib/test/test/lux/concurrency/atom.lux | 10 +- stdlib/test/test/lux/data/coll/dict.lux | 6 +- stdlib/test/test/lux/host.jvm.lux | 10 +- stdlib/test/test/lux/lang/syntax.lux | 48 +++---- 16 files changed, 246 insertions(+), 199 deletions(-) (limited to 'stdlib') 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 ( name) (-> Ident (Meta Ident)) (do Monad - [name (macro;normalize name) - [_ annotations _] (macro;find-def name)] + [[_ annotations _] (macro;find-def name)] (case (macro;get-tag-ann (ident-for ) 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 - [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 Fold] - [dict #+ Dict] - ["Q" queue]) + (data (coll [list "list/" Functor Fold] + [dict #+ Dict]) [product] [text] maybe - [number "Nat/" Codec] + [number "nat/" Codec] text/format) [macro] (macro [code] ["s" syntax #+ syntax: Syntax]) (concurrency [atom #+ Atom atom] ["P" promise] - [frp]) + [frp "frp/" Functor]) )) (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 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 - [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 [_ (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) (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 - [?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 - [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 [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) (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 + [eFT' (apply-type! eFT eAT)] + (check' eFT' (#;Apply aAT aFT) assumptions)) + + (^or [(#;Ex _) (#;UnivQ _ _)] [(#;Var _) (#;UnivQ _ _)]) + (do Monad + [aFT' (apply-type! aFT aAT)] + (check' (#;Apply eAT eFT) aFT' assumptions)) + (^or [(#;Ex _) _] [_ (#;Ex _)]) (do Monad [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 Eq] @@ -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) (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) (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 [ ] [(def: ( input) (-> Code (Maybe )) @@ -227,7 +236,7 @@ (do maybe;Monad [_args (get-ann (ident-for ) 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 - [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 wrap ident))) +(def: #export (find-macro ident) + (-> Ident (Meta (Maybe Macro))) + (do Monad + [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 - [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 - [name' (normalize name) - ?macro (find-macro name')] + [?macro (find-macro name)] (case ?macro (#;Some macro) (do Monad [expansion (macro args) - expansion' (M;map Monad expand expansion)] + expansion' (monad;map Monad expand expansion)] (wrap (list/join expansion'))) #;None @@ -322,29 +330,28 @@ (case syntax [_ (#;Form (#;Cons [[_ (#;Symbol name)] args]))] (do Monad - [name' (normalize name) - ?macro (find-macro name')] + [?macro (find-macro name)] (case ?macro (#;Some macro) (do Monad [expansion (macro args) - expansion' (M;map Monad expand-all expansion)] + expansion' (monad;map Monad expand-all expansion)] (wrap (list/join expansion'))) #;None (do Monad - [parts' (M;map Monad expand-all (list& (code;symbol name) args))] + [parts' (monad;map Monad expand-all (list& (code;symbol name) args))] (wrap (list (code;form (list/join parts'))))))) [_ (#;Form (#;Cons [harg targs]))] (do Monad [harg+ (expand-all harg) - targs+ (M;map Monad expand-all targs)] + targs+ (monad;map Monad expand-all targs)] (wrap (list (code;form (list/compose harg+ (list/join (: (List (List Code)) targs+))))))) [_ (#;Tuple members)] (do Monad - [members' (M;map Monad expand-all members)] + [members' (monad;map Monad 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 encode (get@ #;seed state)))])]))) + (function [compiler] + (#e;Success [(update@ #;seed n.inc compiler) + (code;symbol ["" ($_ text/compose "__gensym__" prefix (:: number;Codec encode (get@ #;seed compiler)))])]))) (def: (get-local-symbol ast) (-> Code (Meta Text)) @@ -381,7 +388,7 @@ (case tokens (^ (list [_ (#;Tuple symbols)] body)) (do Monad - [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 @@ -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 + [this-module current-module-name] + (wrap [this-module _name])) + + [_module _name] + (do Monad + [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 - [#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 + [name (canonical name)] + (function [compiler] + (case (: (Maybe Def) + (do maybe;Monad + [#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 [#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 - [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 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 + (do macro;Monad [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) (-> Ident (Meta [Ident (List Ident)])) (do Monad - [name (macro;normalize name) - [_ annotations _] (macro;find-def name)] + [[_ annotations _] (macro;find-def name)] (case [(macro;get-tag-ann (ident-for ) annotations) (macro;get-tag-ann (ident-for ) 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 Functor])) + [list "list/" Fold Functor])) ["r" math/random]) lux/test) @@ -30,7 +30,7 @@ (not (&;empty? dict)))) (test "The functions 'entries', 'keys' and 'values' should be synchronized." - (:: (list;Eq (eq;seq number;Eq number;Eq)) = + (:: (list;Eq (eq;pair number;Eq number;Eq)) = (&;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)) (^open) (&;Eq number;Eq)] (= 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 = 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 = 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 -- cgit v1.2.3