From 693466dec80764358acea002f0ccfd5f0de17300 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Mon, 10 Apr 2017 22:53:51 -0400 Subject: - Renamed "lambda" to "function". --- stdlib/test/test/lux/concurrency/actor.lux | 4 +-- stdlib/test/test/lux/concurrency/frp.lux | 4 +-- stdlib/test/test/lux/concurrency/stm.lux | 4 +-- stdlib/test/test/lux/data/coll/array.lux | 4 +-- stdlib/test/test/lux/data/coll/dict.lux | 16 ++++++------ stdlib/test/test/lux/data/coll/list.lux | 2 +- stdlib/test/test/lux/data/coll/priority-queue.lux | 2 +- stdlib/test/test/lux/data/coll/stream.lux | 2 +- stdlib/test/test/lux/data/coll/tree/zipper.lux | 2 +- stdlib/test/test/lux/data/error/exception.lux | 6 ++--- stdlib/test/test/lux/data/format/json.lux | 4 +-- stdlib/test/test/lux/data/format/xml.lux | 2 +- stdlib/test/test/lux/data/number.lux | 30 +++++++++++------------ stdlib/test/test/lux/data/sum.lux | 8 ++++-- stdlib/test/test/lux/data/text/lexer.lux | 4 +-- stdlib/test/test/lux/function/cont.lux | 6 ++--- stdlib/test/test/lux/type.lux | 8 +++--- stdlib/test/test/lux/type/check.lux | 14 +++++------ stdlib/test/tests.lux | 9 ++++--- 19 files changed, 68 insertions(+), 63 deletions(-) (limited to 'stdlib/test') diff --git a/stdlib/test/test/lux/concurrency/actor.lux b/stdlib/test/test/lux/concurrency/actor.lux index 49100ef01..a4c69a880 100644 --- a/stdlib/test/test/lux/concurrency/actor.lux +++ b/stdlib/test/test/lux/concurrency/actor.lux @@ -22,11 +22,11 @@ (test: "Actors" (let [counter-proc (: (&;Behavior Int (Promise Int)) - [(lambda [self output state] + [(function [self output state] (let [state' (i.inc state)] (exec (io;run (promise;resolve state' output)) (Promise/wrap (#;Right state'))))) - (lambda [?error state] (Promise/wrap []))])] + (function [?error state] (Promise/wrap []))])] ($_ seq (assert "Can check where an actor is alive." (let [counter (: (&;Actor Int (Promise Int)) diff --git a/stdlib/test/test/lux/concurrency/frp.lux b/stdlib/test/test/lux/concurrency/frp.lux index 6c2e9af99..a141753a8 100644 --- a/stdlib/test/test/lux/concurrency/frp.lux +++ b/stdlib/test/test/lux/concurrency/frp.lux @@ -13,7 +13,7 @@ (-> (List Int) (&;Chan Int)) (let [_chan (: (&;Chan Int) (&;chan))] (io;run (do Monad - [_ (mapM @ (lambda [value] (&;write value _chan)) + [_ (mapM @ (function [value] (&;write value _chan)) values) _ (&;close _chan)] (wrap _chan))))) @@ -65,7 +65,7 @@ false))) (do Monad - [output (&;fold (lambda [base input] (Promise/wrap (i.+ input base))) 0 (List->Chan (list 0 1 2 3 4 5)))] + [output (&;fold (function [base input] (Promise/wrap (i.+ input base))) 0 (List->Chan (list 0 1 2 3 4 5)))] (assert "Can fold over a channel." (i.= 15 output))) diff --git a/stdlib/test/test/lux/concurrency/stm.lux b/stdlib/test/test/lux/concurrency/stm.lux index d6b6c1d43..c1c8144ae 100644 --- a/stdlib/test/test/lux/concurrency/stm.lux +++ b/stdlib/test/test/lux/concurrency/stm.lux @@ -44,8 +44,8 @@ (let [_concurrency-var (&;var 0)] (do promise;Monad [_ (seqM @ - (map (lambda [_] - (mapM @ (lambda [_] (&;commit (&;update i.inc _concurrency-var))) + (map (function [_] + (mapM @ (function [_] (&;commit (&;update i.inc _concurrency-var))) (list;i.range 1 iterations/processes))) (list;i.range 1 (nat-to-int promise;concurrency-level)))) last-val (&;commit (&;read _concurrency-var))] diff --git a/stdlib/test/test/lux/data/coll/array.lux b/stdlib/test/test/lux/data/coll/array.lux index f7d09ae9a..6006cf021 100644 --- a/stdlib/test/test/lux/data/coll/array.lux +++ b/stdlib/test/test/lux/data/coll/array.lux @@ -34,7 +34,7 @@ (not (is original copy))))) (assert "Array folding should go over all values." (exec (:: &;Fold fold - (lambda [x idx] + (function [x idx] (exec (&;put idx x manual-copy) (n.inc idx))) +0 @@ -83,7 +83,7 @@ (case> (#;Some _) true #;None false))) (assert "Can find values inside arrays (with access to indices)." - (|> (&;find+ (lambda [idx n] + (|> (&;find+ (function [idx n] (and (n.even? n) (n.< size idx))) array) diff --git a/stdlib/test/test/lux/data/coll/dict.lux b/stdlib/test/test/lux/data/coll/dict.lux index 34e99cf58..ee54f9204 100644 --- a/stdlib/test/test/lux/data/coll/dict.lux +++ b/stdlib/test/test/lux/data/coll/dict.lux @@ -17,9 +17,9 @@ size capped-nat dict (R;dict char;Hash size R;char capped-nat) non-key (|> R;char - (R;filter (lambda [key] (not (&;contains? key dict))))) + (R;filter (function [key] (not (&;contains? key dict))))) test-val (|> R;nat - (R;filter (lambda [val] (not (list;member? number;Eq (&;values dict) val)))))] + (R;filter (function [val] (not (list;member? number;Eq (&;values dict) val)))))] ($_ seq (assert "Size function should correctly represent Dict size." (n.= size (&;size dict))) @@ -36,13 +36,13 @@ (&;values dict)))) (assert "Dict should be able to recognize it's own keys." - (list;every? (lambda [key] (&;contains? key dict)) + (list;every? (function [key] (&;contains? key dict)) (&;keys dict))) (assert "Should be able to get every key." - (list;every? (lambda [key] (case (&;get key dict) - (#;Some _) true - _ false)) + (list;every? (function [key] (case (&;get key dict) + (#;Some _) true + _ false)) (&;keys dict))) (assert "Shouldn't be able to access non-existant keys." @@ -99,13 +99,13 @@ (assert "If you merge, and the second dict has overlapping keys, it should overwrite yours." (let [dict' (|> dict &;entries - (List/map (lambda [[k v]] [k (n.inc v)])) + (List/map (function [[k v]] [k (n.inc v)])) (&;from-list char;Hash)) (^open) (&;Eq number;Eq)] (= dict' (&;merge dict' dict)))) (assert "Can merge values in such a way that they become combined." - (list;every? (lambda [[x x*2]] (n.= (n.* +2 x) x*2)) + (list;every? (function [[x x*2]] (n.= (n.* +2 x) x*2)) (list;zip2 (&;values dict) (&;values (&;merge-with n.+ dict dict))))) diff --git a/stdlib/test/test/lux/data/coll/list.lux b/stdlib/test/test/lux/data/coll/list.lux index bd6f78015..0840b11e3 100644 --- a/stdlib/test/test/lux/data/coll/list.lux +++ b/stdlib/test/test/lux/data/coll/list.lux @@ -197,7 +197,7 @@ (assert "You can iteratively construct a list, generating values until you're done." (= (&;n.range +0 (n.dec size)) - (&;iterate (lambda [n] (if (n.< size n) (#;Some (n.inc n)) #;None)) + (&;iterate (function [n] (if (n.< size n) (#;Some (n.inc n)) #;None)) +0))) (assert "Can enumerate all elements in a list." diff --git a/stdlib/test/test/lux/data/coll/priority-queue.lux b/stdlib/test/test/lux/data/coll/priority-queue.lux index 3e28334db..f82216f54 100644 --- a/stdlib/test/test/lux/data/coll/priority-queue.lux +++ b/stdlib/test/test/lux/data/coll/priority-queue.lux @@ -11,7 +11,7 @@ (-> Nat (R;Random (&;Queue Nat))) (do R;Monad [inputs (R;list size R;nat)] - (foldM @ (lambda [head tail] + (foldM @ (function [head tail] (do @ [priority R;nat] (wrap (&;push priority head tail)))) diff --git a/stdlib/test/test/lux/data/coll/stream.lux b/stdlib/test/test/lux/data/coll/stream.lux index 2ee3013e2..edc7d52dc 100644 --- a/stdlib/test/test/lux/data/coll/stream.lux +++ b/stdlib/test/test/lux/data/coll/stream.lux @@ -86,7 +86,7 @@ (List/= (&;take size (&/map Nat/encode (&;iterate n.inc offset))) (&;take size - (&;unfold (lambda [n] [(n.inc n) (Nat/encode n)]) + (&;unfold (function [n] [(n.inc n) (Nat/encode n)]) offset))))) (assert "Can cycle over the same elements as an infinite stream." diff --git a/stdlib/test/test/lux/data/coll/tree/zipper.lux b/stdlib/test/test/lux/data/coll/tree/zipper.lux index 143229dc5..a6799d302 100644 --- a/stdlib/test/test/lux/data/coll/tree/zipper.lux +++ b/stdlib/test/test/lux/data/coll/tree/zipper.lux @@ -14,7 +14,7 @@ (def: gen-tree (R;Random (rose;Tree Nat)) - (R;rec (lambda [gen-tree] + (R;rec (function [gen-tree] (do R;Monad ## Each branch can have, at most, 1 child. [size (|> R;nat (:: @ map (n.% +2)))] diff --git a/stdlib/test/test/lux/data/error/exception.lux b/stdlib/test/test/lux/data/error/exception.lux index bc84df7f5..2a297a587 100644 --- a/stdlib/test/test/lux/data/error/exception.lux +++ b/stdlib/test/test/lux/data/error/exception.lux @@ -40,8 +40,8 @@ (if should-throw? (&;throw this-ex "Uh-oh...") (&;return default-val))) - (&;catch Some-Exception (lambda [ex] some-val)) - (&;catch Another-Exception (lambda [ex] another-val)) - (&;otherwise (lambda [ex] otherwise-val)))]] + (&;catch Some-Exception (function [ex] some-val)) + (&;catch Another-Exception (function [ex] another-val)) + (&;otherwise (function [ex] otherwise-val)))]] (assert "Catch and otherwhise handlers can properly handle the flow of exception-handling." (n.= expected actual))) diff --git a/stdlib/test/test/lux/data/format/json.lux b/stdlib/test/test/lux/data/format/json.lux index 37fe49786..6328533bc 100644 --- a/stdlib/test/test/lux/data/format/json.lux +++ b/stdlib/test/test/lux/data/format/json.lux @@ -27,7 +27,7 @@ (def: gen-json (R;Random &;JSON) - (R;rec (lambda [gen-json] + (R;rec (function [gen-json] (do R;Monad [size (:: @ map (n.% +2) R;nat)] ($_ R;alt @@ -95,7 +95,7 @@ (struct: _ (Eq Record) (def: (= recL recR) - (let [variant/= (lambda [left right] + (let [variant/= (function [left right] (case [left right] [(#Case0 left') (#Case0 right')] (:: bool;Eq = left' right') diff --git a/stdlib/test/test/lux/data/format/xml.lux b/stdlib/test/test/lux/data/format/xml.lux index 0479cb561..16c586d63 100644 --- a/stdlib/test/test/lux/data/format/xml.lux +++ b/stdlib/test/test/lux/data/format/xml.lux @@ -39,7 +39,7 @@ (def: gen-xml (R;Random &;XML) - (R;rec (lambda [gen-xml] + (R;rec (function [gen-xml] (R;alt (xml-text^ +1 +10) (do R;Monad [size (size^ +0 +2)] diff --git a/stdlib/test/test/lux/data/number.lux b/stdlib/test/test/lux/data/number.lux index 131db1441..dbae41674 100644 --- a/stdlib/test/test/lux/data/number.lux +++ b/stdlib/test/test/lux/data/number.lux @@ -73,11 +73,11 @@ (assert "" (and (<= x (:: bottom)) (>= x (:: top)))))] - ["Nat" R;nat Number Order Interval (lambda [_] true)] - ["Int" R;int Number Order Interval (lambda [_] true)] + ["Nat" R;nat Number Order Interval (function [_] true)] + ["Int" R;int Number Order Interval (function [_] true)] ## Both min and max values will be positive (thus, greater than zero) ["Real" R;real Number Order Interval (r.> 0.0)] - ["Deg" R;deg Number Order Interval (lambda [_] true)] + ["Deg" R;deg Number Order Interval (function [_] true)] ) (do-template [category rand-gen ] @@ -91,22 +91,22 @@ (= x (append x unit)) (= unit (append unit unit)))))] - ["Nat/Add" R;nat Number Order Add@Monoid (n.% +1000) (lambda [_] true)] - ["Nat/Mul" R;nat Number Order Mul@Monoid (n.% +1000) (lambda [_] true)] - ["Nat/Min" R;nat Number Order Min@Monoid (n.% +1000) (lambda [_] true)] - ["Nat/Max" R;nat Number Order Max@Monoid (n.% +1000) (lambda [_] true)] - ["Int/Add" R;int Number Order Add@Monoid (i.% 1000) (lambda [_] true)] - ["Int/Mul" R;int Number Order Mul@Monoid (i.% 1000) (lambda [_] true)] - ["Int/Min" R;int Number Order Min@Monoid (i.% 1000) (lambda [_] true)] - ["Int/Max" R;int Number Order Max@Monoid (i.% 1000) (lambda [_] true)] + ["Nat/Add" R;nat Number Order Add@Monoid (n.% +1000) (function [_] true)] + ["Nat/Mul" R;nat Number Order Mul@Monoid (n.% +1000) (function [_] true)] + ["Nat/Min" R;nat Number Order Min@Monoid (n.% +1000) (function [_] true)] + ["Nat/Max" R;nat Number Order Max@Monoid (n.% +1000) (function [_] true)] + ["Int/Add" R;int Number Order Add@Monoid (i.% 1000) (function [_] true)] + ["Int/Mul" R;int Number Order Mul@Monoid (i.% 1000) (function [_] true)] + ["Int/Min" R;int Number Order Min@Monoid (i.% 1000) (function [_] true)] + ["Int/Max" R;int Number Order Max@Monoid (i.% 1000) (function [_] true)] ["Real/Add" R;real Number Order Add@Monoid (r.% 1000.0) (r.> 0.0)] ["Real/Mul" R;real Number Order Mul@Monoid (r.% 1000.0) (r.> 0.0)] ["Real/Min" R;real Number Order Min@Monoid (r.% 1000.0) (r.> 0.0)] ["Real/Max" R;real Number Order Max@Monoid (r.% 1000.0) (r.> 0.0)] - ["Deg/Add" R;deg Number Order Add@Monoid (d.% .125) (lambda [_] true)] - ## ["Deg/Mul" R;deg Number Order Mul@Monoid (d.% .125) (lambda [_] true)] - ["Deg/Min" R;deg Number Order Min@Monoid (d.% .125) (lambda [_] true)] - ["Deg/Max" R;deg Number Order Max@Monoid (d.% .125) (lambda [_] true)] + ["Deg/Add" R;deg Number Order Add@Monoid (d.% .125) (function [_] true)] + ## ["Deg/Mul" R;deg Number Order Mul@Monoid (d.% .125) (function [_] true)] + ["Deg/Min" R;deg Number Order Min@Monoid (d.% .125) (function [_] true)] + ["Deg/Max" R;deg Number Order Max@Monoid (d.% .125) (function [_] true)] ) (do-template [ ] diff --git a/stdlib/test/test/lux/data/sum.lux b/stdlib/test/test/lux/data/sum.lux index 389ff1b9e..6e88e6b07 100644 --- a/stdlib/test/test/lux/data/sum.lux +++ b/stdlib/test/test/lux/data/sum.lux @@ -28,6 +28,10 @@ (list (+0 "0") (+1 "1") (+0 "2")))))))) (assert "Can apply a function to an Either value depending on the case." - (and (i.= 10 (either (lambda [_] 10) (lambda [_] 20) (: (| Text Text) (+0 "")))) - (i.= 20 (either (lambda [_] 10) (lambda [_] 20) (: (| Text Text) (+1 "")))))) + (and (i.= 10 (either (function [_] 10) + (function [_] 20) + (: (| Text Text) (+0 "")))) + (i.= 20 (either (function [_] 10) + (function [_] 20) + (: (| Text Text) (+1 "")))))) ))) diff --git a/stdlib/test/test/lux/data/text/lexer.lux b/stdlib/test/test/lux/data/text/lexer.lux index 92aeca0d8..8a63cf573 100644 --- a/stdlib/test/test/lux/data/text/lexer.lux +++ b/stdlib/test/test/lux/data/text/lexer.lux @@ -221,9 +221,9 @@ (assert "Can lex using arbitrary predicates." (and (should-passC #"D" (&;run "D" - (&;satisfies (lambda [c] true)))) + (&;satisfies (function [c] true)))) (should-fail (&;run "C" - (&;satisfies (lambda [c] false)))))) + (&;satisfies (function [c] false)))))) (assert "Can apply a lexer multiple times." (and (should-passT "0123456789ABCDEF" (&;run "0123456789ABCDEF yolo" diff --git a/stdlib/test/test/lux/function/cont.lux b/stdlib/test/test/lux/function/cont.lux index eda75833e..4362f5a75 100644 --- a/stdlib/test/test/lux/function/cont.lux +++ b/stdlib/test/test/lux/function/cont.lux @@ -35,7 +35,7 @@ (n.= (n.* +2 sample) (&;run (do &;Monad [value (&;call/cc - (lambda [k] + (function [k] (do @ [temp (k sample)] ## If this code where to run, @@ -57,14 +57,14 @@ (^open "L/") (list;Eq number;Eq) visit (: (-> (List Nat) (&;Cont (List Nat) (List Nat))) - (lambda visit [xs] + (function visit [xs] (case xs #;Nil (&/wrap #;Nil) (#;Cons x xs') (do &;Monad - [output (&;shift (lambda [k] + [output (&;shift (function [k] (do @ [tail (k xs')] (wrap (#;Cons x tail)))))] diff --git a/stdlib/test/test/lux/type.lux b/stdlib/test/test/lux/type.lux index d1098b960..0ebc23489 100644 --- a/stdlib/test/test/lux/type.lux +++ b/stdlib/test/test/lux/type.lux @@ -26,7 +26,7 @@ (def: gen-type (R;Random Type) (let [(^open "R/") R;Monad] - (R;rec (lambda [gen-type] + (R;rec (function [gen-type] ($_ R;alt (R;seq gen-name (R/wrap (list))) (R/wrap []) @@ -81,7 +81,7 @@ (test: "Type construction [structs]" [size (|> R;nat (:: @ map (n.% +3))) members (|> gen-type - (R;filter (lambda [type] + (R;filter (function [type] (case type (^or (#;SumT _) (#;ProdT _)) false @@ -110,7 +110,7 @@ [size (|> R;nat (:: @ map (n.% +3))) members (seqM @ (list;repeat size gen-type)) extra (|> gen-type - (R;filter (lambda [type] + (R;filter (function [type] (case type (^or (#;LambdaT _) (#;AppT _)) false @@ -133,7 +133,7 @@ (test: "Type construction [higher order]" [size (|> R;nat (:: @ map (n.% +3))) extra (|> gen-type - (R;filter (lambda [type] + (R;filter (function [type] (case type (^or (#;UnivQ _) (#;ExQ _)) false diff --git a/stdlib/test/test/lux/type/check.lux b/stdlib/test/test/lux/type/check.lux index d76a53622..8235ff808 100644 --- a/stdlib/test/test/lux/type/check.lux +++ b/stdlib/test/test/lux/type/check.lux @@ -26,7 +26,7 @@ (def: gen-type (R;Random Type) (let [(^open "R/") R;Monad] - (R;rec (lambda [gen-type] + (R;rec (function [gen-type] ($_ R;alt (R;seq gen-name (R/wrap (list))) (R/wrap []) @@ -150,26 +150,26 @@ (test: "Type-vars" ($_ seq (assert "Type-vars check against themselves." - (type-checks? (&;with-var (lambda [[id var]] (&;check var var))))) + (type-checks? (&;with-var (function [[id var]] (&;check var var))))) (assert "Can bind unbound type-vars by type-checking against them." - (and (type-checks? (&;with-var (lambda [[id var]] (&;check var #;UnitT)))) - (type-checks? (&;with-var (lambda [[id var]] (&;check #;UnitT var)))))) + (and (type-checks? (&;with-var (function [[id var]] (&;check var #;UnitT)))) + (type-checks? (&;with-var (function [[id var]] (&;check #;UnitT var)))))) (assert "Can't rebind already bound type-vars." - (not (type-checks? (&;with-var (lambda [[id var]] + (not (type-checks? (&;with-var (function [[id var]] (do &;Monad [_ (&;check var #;UnitT)] (&;check var #;VoidT))))))) (assert "If the type bound to a var is a super-type to another, then the var is also a super-type." - (type-checks? (&;with-var (lambda [[id var]] + (type-checks? (&;with-var (function [[id var]] (do &;Monad [_ (&;check var Top)] (&;check var #;UnitT)))))) (assert "If the type bound to a var is a sub-type of another, then the var is also a sub-type." - (type-checks? (&;with-var (lambda [[id var]] + (type-checks? (&;with-var (function [[id var]] (do &;Monad [_ (&;check var Bottom)] (&;check #;UnitT var)))))) diff --git a/stdlib/test/tests.lux b/stdlib/test/tests.lux index 08d73a430..931a89e28 100644 --- a/stdlib/test/tests.lux +++ b/stdlib/test/tests.lux @@ -10,9 +10,9 @@ ["_;" host] ["_;" io] (function ["_;" cont] - ["_;" reader] - ["_;" state] - ["_;" thunk]) + ["_;" reader] + ["_;" state] + ["_;" thunk]) (concurrency ["_;" actor] ["_;" atom] ["_;" frp] @@ -72,7 +72,8 @@ [trace] [store]) [macro] - (math [random]))) + (math [random])) + ) ## [Program] (program: args -- cgit v1.2.3