From 9f839b97e95f56e228d78e5d29f7d31d0d3f8eb1 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sat, 1 Jul 2017 15:44:15 -0400 Subject: - Remove the suffixes of "lift" functions for monad transformers. --- stdlib/source/lux/concurrency/stm.lux | 46 +++--- stdlib/source/lux/control/reader.lux | 2 +- stdlib/source/lux/control/state.lux | 2 +- stdlib/source/lux/data/coll/list.lux | 2 +- stdlib/source/lux/data/log.lux | 2 +- stdlib/source/lux/data/maybe.lux | 2 +- stdlib/source/lux/data/result.lux | 2 +- stdlib/source/lux/host.jvm.lux | 280 ++++++++++++++++---------------- stdlib/source/lux/macro.lux | 98 +++++------ stdlib/test/test/lux/control/reader.lux | 2 +- stdlib/test/test/lux/control/state.lux | 5 +- stdlib/test/test/lux/data/coll/list.lux | 2 +- stdlib/test/test/lux/data/log.lux | 2 +- stdlib/test/test/lux/data/maybe.lux | 2 +- stdlib/test/test/lux/data/result.lux | 2 +- 15 files changed, 225 insertions(+), 226 deletions(-) diff --git a/stdlib/source/lux/concurrency/stm.lux b/stdlib/source/lux/concurrency/stm.lux index 066384e11..ed9f28038 100644 --- a/stdlib/source/lux/concurrency/stm.lux +++ b/stdlib/source/lux/concurrency/stm.lux @@ -4,7 +4,7 @@ applicative monad) [io #- run] - (data (coll [list #* "List/" Functor Fold] + (data (coll [list "L/" Functor Fold] [dict #+ Dict] ["Q" queue]) [product] @@ -16,7 +16,7 @@ (macro [code] ["s" syntax #+ syntax: Syntax]) (concurrency [atom #+ Atom atom] - ["P" promise #+ Promise "Promise/" Monad] + ["P" promise] [frp]) )) @@ -53,9 +53,9 @@ (def: (find-var-value var tx) (All [a] (-> (Var a) Tx (Maybe a))) (|> tx - (find (function [[_var _original _current]] - (is (:! (Var Unit) var) - (:! (Var Unit) _var)))) + (list;find (function [[_var _original _current]] + (is (:! (Var Unit) var) + (:! (Var Unit) _var)))) (:: Monad map (function [[_var _original _current]] _current)) (:! (Maybe ($ +0))))) @@ -143,15 +143,15 @@ (write! tail' chan-var)))] (do Monad [_ (atom;update (function [[value 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)))] + (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)))] [value (dict;put label (observer label) observers)])) target)] (wrap head)))) @@ -205,9 +205,9 @@ (def: (can-commit? tx) (-> Tx Bool) - (every? (function [[_var _original _current]] - (is _original (raw-read _var))) - tx)) + (list;every? (function [[_var _original _current]] + (is _original (raw-read _var))) + tx)) (def: (commit-var [_var _original _current]) (-> (Ex [a] (Tx-Frame a)) Unit) @@ -218,7 +218,7 @@ (def: fresh-tx Tx (list)) (def: pending-commits - (Var (Ex [a] [(STM a) (Promise a)])) + (Var (Ex [a] [(STM a) (P;Promise a)])) (var (:!! []))) (def: commit-processor-flag @@ -226,8 +226,8 @@ (atom false)) (def: (process-commit commits) - (-> (frp;Chan [(STM Unit) (Promise Unit)]) - (Promise Unit)) + (-> (frp;Chan [(STM Unit) (P;Promise Unit)]) + (P;Promise Unit)) (do P;Monad [?head+tail commits] (case ?head+tail @@ -235,7 +235,7 @@ (do @ [#let [[finished-tx value] (stm-proc fresh-tx)]] (exec (if (can-commit? finished-tx) - (exec (List/map commit-var finished-tx) + (exec (L/map commit-var finished-tx) (io;run (P;resolve value output)) []) (exec (io;run (write! [stm-proc output] pending-commits)) @@ -257,7 +257,7 @@ (if was-first? (do Monad [inputs (follow pending-commits)] - (exec (process-commit (:! (frp;Chan [(STM Unit) (Promise Unit)]) + (exec (process-commit (:! (frp;Chan [(STM Unit) (P;Promise Unit)]) inputs)) (wrap []))) (wrap []))) @@ -269,7 +269,7 @@ Note that a transaction may be re-run an indeterminate number of times if other transactions involving the same variables successfully commit first. For this reason, it's important to note that transactions must be free from side-effects, such as I/O."} - (All [a] (-> (STM a) (Promise a))) + (All [a] (-> (STM a) (P;Promise a))) (let [output (P;promise ($ +0))] (exec (io;run init-processor!) (io;run (write! [stm-proc output] pending-commits)) diff --git a/stdlib/source/lux/control/reader.lux b/stdlib/source/lux/control/reader.lux index 598bfc670..b63504294 100644 --- a/stdlib/source/lux/control/reader.lux +++ b/stdlib/source/lux/control/reader.lux @@ -57,7 +57,7 @@ [eMa (run env eMeMa)] (run env eMa))))) -(def: #export lift-reader +(def: #export lift {#;doc "Lift monadic values to the Reader wrapper."} (All [M e a] (-> (M a) (Reader e (M a)))) (:: Monad wrap)) diff --git a/stdlib/source/lux/control/state.lux b/stdlib/source/lux/control/state.lux index 37135ac06..9c6dd2922 100644 --- a/stdlib/source/lux/control/state.lux +++ b/stdlib/source/lux/control/state.lux @@ -115,7 +115,7 @@ [[state' sMa] (sMsMa state)] (sMa state'))))) -(def: #export (lift-state Monad ma) +(def: #export (lift Monad ma) {#;doc "Lift monadic values to the State' wrapper."} (All [M s a] (-> (Monad M) (M a) (State' M s a))) (function [state] diff --git a/stdlib/source/lux/data/coll/list.lux b/stdlib/source/lux/data/coll/list.lux index 568aded11..5d21585a4 100644 --- a/stdlib/source/lux/data/coll/list.lux +++ b/stdlib/source/lux/data/coll/list.lux @@ -486,7 +486,7 @@ (seqM @ lMla))] (wrap (concat lla))))) -(def: #export (lift-list Monad) +(def: #export (lift Monad) (All [M a] (-> (Monad M) (-> (M a) (M (List a))))) (liftM Monad (:: Monad wrap))) diff --git a/stdlib/source/lux/data/log.lux b/stdlib/source/lux/data/log.lux index ae644c94f..896f19e94 100644 --- a/stdlib/source/lux/data/log.lux +++ b/stdlib/source/lux/data/log.lux @@ -51,7 +51,7 @@ [l2 a] Mla] (wrap [(:: Monoid append l1 l2) a])))) -(def: #export (lift-log Monoid Monad) +(def: #export (lift Monoid Monad) (All [l M a] (-> (Monoid l) (Monad M) (-> (M a) (M (Log l a))))) (function [ma] (do Monad diff --git a/stdlib/source/lux/data/maybe.lux b/stdlib/source/lux/data/maybe.lux index 6286e7d5e..d0c2c8441 100644 --- a/stdlib/source/lux/data/maybe.lux +++ b/stdlib/source/lux/data/maybe.lux @@ -72,6 +72,6 @@ (#;Some Mma) Mma)))) -(def: #export (lift-maybe Monad) +(def: #export (lift Monad) (All [M a] (-> (Monad M) (-> (M a) (M (Maybe a))))) (liftM Monad (:: Monad wrap))) diff --git a/stdlib/source/lux/data/result.lux b/stdlib/source/lux/data/result.lux index 3a713a174..77fd144f9 100644 --- a/stdlib/source/lux/data/result.lux +++ b/stdlib/source/lux/data/result.lux @@ -57,7 +57,7 @@ (#Success Mea) Mea)))) -(def: #export (lift-result Monad) +(def: #export (lift Monad) (All [M a] (-> (Monad M) (-> (M a) (M (Result a))))) (liftM Monad (:: Monad wrap))) diff --git a/stdlib/source/lux/host.jvm.lux b/stdlib/source/lux/host.jvm.lux index 17f89e7ba..22245f302 100644 --- a/stdlib/source/lux/host.jvm.lux +++ b/stdlib/source/lux/host.jvm.lux @@ -4,7 +4,7 @@ [enum] ["p" parser]) [io #+ IO Monad io] - (data (coll [list #* "" Functor Fold "List/" Monad Monoid] + (data (coll [list "L/" Monad Fold Monoid] [array #+ Array]) number maybe @@ -239,7 +239,7 @@ ## Utils (def: (short-class-name name) (-> Text Text) - (case (reverse (text;split-all-with "." name)) + (case (list;reverse (text;split-all-with "." name)) (#;Cons short-name _) short-name @@ -299,17 +299,17 @@ output [[name params] _ _] - (let [=params (map (class->type' mode type-params in-array?) params)] + (let [=params (L/map (class->type' mode type-params in-array?) params)] (` (host (~ (code;symbol ["" name])) [(~@ =params)]))))) (def: (class->type' mode type-params in-array? class) (-> Primitive-Mode (List TypeParam) Bool GenericType Code) (case class (#GenericTypeVar name) - (case (find (function [[pname pbounds]] - (and (Text/= name pname) - (not (list;empty? pbounds)))) - type-params) + (case (list;find (function [[pname pbounds]] + (and (Text/= name pname) + (not (list;empty? pbounds)))) + type-params) #;None (code;symbol ["" name]) @@ -341,15 +341,15 @@ (def: (class-decl-type$ (^slots [#class-name #class-params])) (-> ClassDecl Code) - (let [=params (map (: (-> TypeParam Code) - (function [[pname pbounds]] - (case pbounds - #;Nil - (code;symbol ["" pname]) - - (#;Cons bound1 _) - (class->type #ManualPrM class-params bound1)))) - class-params)] + (let [=params (L/map (: (-> TypeParam Code) + (function [[pname pbounds]] + (case pbounds + #;Nil + (code;symbol ["" pname]) + + (#;Cons bound1 _) + (class->type #ManualPrM class-params bound1)))) + class-params)] (` (host (~ (code;symbol ["" class-name])) [(~@ =params)])))) (def: empty-imports @@ -359,8 +359,8 @@ (def: (get-import name imports) (-> Text ClassImports (Maybe Text)) (:: Functor map product;right - (find (|>. product;left (Text/= name)) - imports))) + (list;find (|>. product;left (Text/= name)) + imports))) (def: (add-import short+full imports) (-> [Text Text] ClassImports ClassImports) @@ -373,16 +373,16 @@ (do Monad [current-module macro;current-module-name defs (macro;defs current-module)] - (wrap (fold (: (-> [Text Def] ClassImports ClassImports) - (function [[short-name [_ meta _]] imports] - (case (macro;get-text-ann (ident-for #;;jvm-class) meta) - (#;Some full-class-name) - (add-import [short-name full-class-name] imports) - - _ - imports))) - empty-imports - defs))))) + (wrap (L/fold (: (-> [Text Def] ClassImports ClassImports) + (function [[short-name [_ meta _]] imports] + (case (macro;get-text-ann (ident-for #;;jvm-class) meta) + (#;Some full-class-name) + (add-import [short-name full-class-name] imports) + + _ + imports))) + empty-imports + defs))))) (#;Left _) (list) (#;Right imports) imports)) @@ -478,7 +478,7 @@ (cond (fully-qualified-class-name? name) name - (member? text;Eq java.lang-classes name) + (list;member? text;Eq java.lang-classes name) (format "java.lang." name) ## else @@ -490,10 +490,10 @@ (-> (List TypeParam) GenericType Text) (case class (#GenericTypeVar name) - (case (find (function [[pname pbounds]] - (and (Text/= name pname) - (not (list;empty? pbounds)))) - params) + (case (list;find (function [[pname pbounds]] + (and (Text/= name pname) + (not (list;empty? pbounds)))) + params) #;None type-var-class @@ -557,15 +557,15 @@ (case (f input) (^template [] [meta ( parts)] - [meta ( (map (pre-walk-replace f) parts))]) + [meta ( (L/map (pre-walk-replace f) parts))]) ([#;Form] [#;Tuple]) [meta (#;Record pairs)] - [meta (#;Record (map (: (-> [Code Code] [Code Code]) - (function [[key val]] - [(pre-walk-replace f key) (pre-walk-replace f val)])) - pairs))] + [meta (#;Record (L/map (: (-> [Code Code] [Code Code]) + (function [[key val]] + [(pre-walk-replace f key) (pre-walk-replace f val)])) + pairs))] ast' ast')) @@ -595,7 +595,7 @@ (do p;Monad [[_ args] (: (Syntax [Unit (List Code)]) (s;form ($_ p;seq (s;this (' .new!)) (s;tuple (p;exactly (list;size arg-decls) s;any))))) - #let [arg-decls' (: (List Text) (map (. (simple-class$ params) product;right) arg-decls))]] + #let [arg-decls' (: (List Text) (L/map (. (simple-class$ params) product;right) arg-decls))]] (wrap (` (;_lux_proc ["jvm" (~ (code;text (format "new" ":" class-name ":" (text;join-with "," arg-decls'))))] [(~@ args)]))))) @@ -605,7 +605,7 @@ [#let [dotted-name (format "." method-name "!")] [_ args] (: (Syntax [Unit (List Code)]) (s;form ($_ p;seq (s;this (code;symbol ["" dotted-name])) (s;tuple (p;exactly (list;size arg-decls) s;any))))) - #let [arg-decls' (: (List Text) (map (. (simple-class$ params) product;right) arg-decls))]] + #let [arg-decls' (: (List Text) (L/map (. (simple-class$ params) product;right) arg-decls))]] (wrap (`' (;_lux_proc ["jvm" (~ (code;text (format "invokestatic" ":" class-name ":" method-name ":" (text;join-with "," arg-decls'))))] [(~@ args)]))))) @@ -616,7 +616,7 @@ [#let [dotted-name (format "." method-name "!")] [_ args] (: (Syntax [Unit (List Code)]) (s;form ($_ p;seq (s;this (code;symbol ["" dotted-name])) (s;tuple (p;exactly (list;size arg-decls) s;any))))) - #let [arg-decls' (: (List Text) (map (. (simple-class$ params) product;right) arg-decls))]] + #let [arg-decls' (: (List Text) (L/map (. (simple-class$ params) product;right) arg-decls))]] (wrap (`' (;_lux_proc ["jvm" (~ (code;text (format ":" class-name ":" method-name ":" (text;join-with "," arg-decls'))))] [(~' _jvm_this) (~@ args)])))))] @@ -697,7 +697,7 @@ ["[F" "Float-Array"] ["[D" "Double-Array"] ["[C" "Char-Array"])] - (cond (member? text;Eq (map product;left type-vars) name) + (cond (list;member? text;Eq (L/map product;left type-vars) name) (wrap (#GenericTypeVar name)) @@ -726,7 +726,7 @@ [name (full-class-name^ imports) params (p;some (generic-type^ imports type-vars)) _ (p;assert (format name " cannot be a type-parameter!") - (not (member? text;Eq (map product;left type-vars) name)))] + (not (list;member? text;Eq (L/map product;left type-vars) name)))] (wrap (#GenericClass name params)))) )) @@ -863,7 +863,7 @@ [pm privacy-modifier^ strict-fp? (s;this? (' #strict)) method-vars (p;default (list) (type-params^ imports)) - #let [total-vars (List/append class-vars method-vars)] + #let [total-vars (L/append class-vars method-vars)] [_ arg-decls] (s;form (p;seq (s;this (' new)) (arg-decls^ imports total-vars))) constructor-args (constructor-args^ imports total-vars) @@ -882,7 +882,7 @@ strict-fp? (s;this? (' #strict)) final? (s;this? (' #final)) method-vars (p;default (list) (type-params^ imports)) - #let [total-vars (List/append class-vars method-vars)] + #let [total-vars (L/append class-vars method-vars)] [name arg-decls] (s;form (p;seq s;local-symbol (arg-decls^ imports total-vars))) return-type (generic-type^ imports total-vars) @@ -900,7 +900,7 @@ [strict-fp? (s;this? (' #strict)) owner-class (class-decl^ imports) method-vars (p;default (list) (type-params^ imports)) - #let [total-vars (List/append (product;right owner-class) method-vars)] + #let [total-vars (L/append (product;right owner-class) method-vars)] [name arg-decls] (s;form (p;seq s;local-symbol (arg-decls^ imports total-vars))) return-type (generic-type^ imports total-vars) @@ -1019,7 +1019,7 @@ [tvars (p;default (list) (type-params^ imports)) _ (s;this (' new)) ?alias import-member-alias^ - #let [total-vars (List/append owner-vars tvars)] + #let [total-vars (L/append owner-vars tvars)] ?prim-mode (p;opt primitive-mode^) args (import-member-args^ imports total-vars) [io? try? maybe?] import-member-return-flags^] @@ -1040,7 +1040,7 @@ tvars (p;default (list) (type-params^ imports)) name s;local-symbol ?alias import-member-alias^ - #let [total-vars (List/append owner-vars tvars)] + #let [total-vars (L/append owner-vars tvars)] ?prim-mode (p;opt primitive-mode^) args (import-member-args^ imports total-vars) [io? try? maybe?] import-member-return-flags^ @@ -1105,7 +1105,7 @@ (def: (annotation$ [name params]) (-> Annotation JVM-Code) - (format "(" name " " "{" (text;join-with "\t" (map annotation-param$ params)) "}" ")")) + (format "(" name " " "{" (text;join-with "\t" (L/map annotation-param$ params)) "}" ")")) (def: (bound-kind$ kind) (-> BoundKind JVM-Code) @@ -1120,7 +1120,7 @@ name (#GenericClass name params) - (format "(" name " " (spaced (map generic-type$ params)) ")") + (format "(" name " " (spaced (L/map generic-type$ params)) ")") (#GenericArray param) (format "(" array-type-name " " (generic-type$ param) ")") @@ -1133,25 +1133,25 @@ (def: (type-param$ [name bounds]) (-> TypeParam JVM-Code) - (format "(" name " " (spaced (map generic-type$ bounds)) ")")) + (format "(" name " " (spaced (L/map generic-type$ bounds)) ")")) (def: (class-decl$ (^open)) (-> ClassDecl JVM-Code) - (format "(" class-name " " (spaced (map type-param$ class-params)) ")")) + (format "(" class-name " " (spaced (L/map type-param$ class-params)) ")")) (def: (super-class-decl$ (^slots [#super-class-name #super-class-params])) (-> SuperClassDecl JVM-Code) - (format "(" super-class-name " " (spaced (map generic-type$ super-class-params)) ")")) + (format "(" super-class-name " " (spaced (L/map generic-type$ super-class-params)) ")")) (def: (method-decl$ [[name pm anns] method-decl]) (-> [MemberDecl MethodDecl] JVM-Code) (let [(^slots [#method-tvars #method-inputs #method-output #method-exs]) method-decl] (with-parens (spaced (list name - (with-brackets (spaced (map annotation$ anns))) - (with-brackets (spaced (map type-param$ method-tvars))) - (with-brackets (spaced (map generic-type$ method-exs))) - (with-brackets (spaced (map generic-type$ method-inputs))) + (with-brackets (spaced (L/map annotation$ anns))) + (with-brackets (spaced (L/map type-param$ method-tvars))) + (with-brackets (spaced (L/map generic-type$ method-exs))) + (with-brackets (spaced (L/map generic-type$ method-inputs))) (generic-type$ method-output)) )))) @@ -1168,7 +1168,7 @@ (#ConstantField class value) (with-parens (spaced (list "constant" name - (with-brackets (spaced (map annotation$ anns))) + (with-brackets (spaced (L/map annotation$ anns))) (generic-type$ class) (code;to-text value)) )) @@ -1178,7 +1178,7 @@ (spaced (list "variable" name (privacy-modifier$ pm) (state-modifier$ sm) - (with-brackets (spaced (map annotation$ anns))) + (with-brackets (spaced (L/map annotation$ anns))) (generic-type$ class)) )) )) @@ -1201,11 +1201,11 @@ (spaced (list "init" (privacy-modifier$ pm) (Bool/encode strict-fp?) - (with-brackets (spaced (map annotation$ anns))) - (with-brackets (spaced (map type-param$ type-vars))) - (with-brackets (spaced (map generic-type$ exs))) - (with-brackets (spaced (map arg-decl$ arg-decls))) - (with-brackets (spaced (map constructor-arg$ constructor-args))) + (with-brackets (spaced (L/map annotation$ anns))) + (with-brackets (spaced (L/map type-param$ type-vars))) + (with-brackets (spaced (L/map generic-type$ exs))) + (with-brackets (spaced (L/map arg-decl$ arg-decls))) + (with-brackets (spaced (L/map constructor-arg$ constructor-args))) (code;to-text (pre-walk-replace replacer body)) ))) @@ -1216,10 +1216,10 @@ (privacy-modifier$ pm) (Bool/encode final?) (Bool/encode strict-fp?) - (with-brackets (spaced (map annotation$ anns))) - (with-brackets (spaced (map type-param$ type-vars))) - (with-brackets (spaced (map generic-type$ exs))) - (with-brackets (spaced (map arg-decl$ arg-decls))) + (with-brackets (spaced (L/map annotation$ anns))) + (with-brackets (spaced (L/map type-param$ type-vars))) + (with-brackets (spaced (L/map generic-type$ exs))) + (with-brackets (spaced (L/map arg-decl$ arg-decls))) (generic-type$ return-type) (code;to-text (pre-walk-replace replacer body))))) @@ -1227,8 +1227,8 @@ (let [super-replacer (parser->replacer (s;form (do p;Monad [_ (s;this (' .super!)) args (s;tuple (p;exactly (list;size arg-decls) s;any)) - #let [arg-decls' (: (List Text) (map (. (simple-class$ (list)) product;right) - arg-decls))]] + #let [arg-decls' (: (List Text) (L/map (. (simple-class$ (list)) product;right) + arg-decls))]] (wrap (`' (;_lux_proc ["jvm" (~ (code;text (format "invokespecial" ":" (get@ #super-class-name super-class) ":" name ":" (text;join-with "," arg-decls'))))] [(~' _jvm_this) (~@ args)]))))))] (with-parens @@ -1236,10 +1236,10 @@ (class-decl$ class-decl) name (Bool/encode strict-fp?) - (with-brackets (spaced (map annotation$ anns))) - (with-brackets (spaced (map type-param$ type-vars))) - (with-brackets (spaced (map generic-type$ exs))) - (with-brackets (spaced (map arg-decl$ arg-decls))) + (with-brackets (spaced (L/map annotation$ anns))) + (with-brackets (spaced (L/map type-param$ type-vars))) + (with-brackets (spaced (L/map generic-type$ exs))) + (with-brackets (spaced (L/map arg-decl$ arg-decls))) (generic-type$ return-type) (|> body (pre-walk-replace replacer) @@ -1253,10 +1253,10 @@ name (privacy-modifier$ pm) (Bool/encode strict-fp?) - (with-brackets (spaced (map annotation$ anns))) - (with-brackets (spaced (map type-param$ type-vars))) - (with-brackets (spaced (map generic-type$ exs))) - (with-brackets (spaced (map arg-decl$ arg-decls))) + (with-brackets (spaced (L/map annotation$ anns))) + (with-brackets (spaced (L/map type-param$ type-vars))) + (with-brackets (spaced (L/map generic-type$ exs))) + (with-brackets (spaced (L/map arg-decl$ arg-decls))) (generic-type$ return-type) (code;to-text (pre-walk-replace replacer body))))) @@ -1265,10 +1265,10 @@ (spaced (list "abstract" name (privacy-modifier$ pm) - (with-brackets (spaced (map annotation$ anns))) - (with-brackets (spaced (map type-param$ type-vars))) - (with-brackets (spaced (map generic-type$ exs))) - (with-brackets (spaced (map arg-decl$ arg-decls))) + (with-brackets (spaced (L/map annotation$ anns))) + (with-brackets (spaced (L/map type-param$ type-vars))) + (with-brackets (spaced (L/map generic-type$ exs))) + (with-brackets (spaced (L/map arg-decl$ arg-decls))) (generic-type$ return-type)))) (#NativeMethod type-vars arg-decls return-type exs) @@ -1276,10 +1276,10 @@ (spaced (list "native" name (privacy-modifier$ pm) - (with-brackets (spaced (map annotation$ anns))) - (with-brackets (spaced (map type-param$ type-vars))) - (with-brackets (spaced (map generic-type$ exs))) - (with-brackets (spaced (map arg-decl$ arg-decls))) + (with-brackets (spaced (L/map annotation$ anns))) + (with-brackets (spaced (L/map type-param$ type-vars))) + (with-brackets (spaced (L/map generic-type$ exs))) + (with-brackets (spaced (L/map arg-decl$ arg-decls))) (generic-type$ return-type)))) )) @@ -1328,11 +1328,11 @@ (:= .resolved true) (let [sleepers .waitingList sleepers-count (java.util.List.size [] sleepers)] - (map (function [idx] - (let [sleeper (java.util.List.get [(l2i idx)] sleepers)] - (Executor.execute [(runnable (lux.Function.apply [(:! Object value)] sleeper))] - executor))) - (i.range 0 (i.dec (i2l sleepers-count))))) + (L/map (function [idx] + (let [sleeper (java.util.List.get [(l2i idx)] sleepers)] + (Executor.execute [(runnable (lux.Function.apply [(:! Object value)] sleeper))] + executor))) + (i.range 0 (i.dec (i2l sleepers-count))))) (:= .waitingList (null)) true))))) (#public [] poll [] A @@ -1363,19 +1363,19 @@ (do Monad [current-module macro;current-module-name #let [fully-qualified-class-name (format (text;replace-all "/" "." current-module) "." full-class-name) - field-parsers (map (field->parser fully-qualified-class-name) fields) - method-parsers (map (method->parser (product;right class-decl) fully-qualified-class-name) methods) - replacer (parser->replacer (fold p;either - (p;fail "") - (List/append field-parsers method-parsers))) + field-parsers (L/map (field->parser fully-qualified-class-name) fields) + method-parsers (L/map (method->parser (product;right class-decl) fully-qualified-class-name) methods) + replacer (parser->replacer (L/fold p;either + (p;fail "") + (L/append field-parsers method-parsers))) def-code (format "class:" (spaced (list (class-decl$ class-decl) (super-class-decl$ super) - (with-brackets (spaced (map super-class-decl$ interfaces))) + (with-brackets (spaced (L/map super-class-decl$ interfaces))) (inheritance-modifier$ im) - (with-brackets (spaced (map annotation$ annotations))) - (with-brackets (spaced (map field-decl$ fields))) - (with-brackets (spaced (map (method-def$ replacer super) methods))))))]] + (with-brackets (spaced (L/map annotation$ annotations))) + (with-brackets (spaced (L/map field-decl$ fields))) + (with-brackets (spaced (L/map (method-def$ replacer super) methods))))))]] (wrap (list (` (;_lux_proc ["jvm" (~ (code;text def-code))] [])))))) (syntax: #export (interface: [#let [imports (class-imports *compiler*)]] @@ -1393,9 +1393,9 @@ ([] foo [boolean String] void #throws [Exception])))} (let [def-code (format "interface:" (spaced (list (class-decl$ class-decl) - (with-brackets (spaced (map super-class-decl$ supers))) - (with-brackets (spaced (map annotation$ annotations))) - (spaced (map method-decl$ members)))))] + (with-brackets (spaced (L/map super-class-decl$ supers))) + (with-brackets (spaced (L/map annotation$ annotations))) + (spaced (L/map method-decl$ members)))))] (wrap (list (` (;_lux_proc ["jvm" (~ (code;text def-code))] [])))) )) @@ -1419,9 +1419,9 @@ )} (let [def-code (format "anon-class:" (spaced (list (super-class-decl$ super) - (with-brackets (spaced (map super-class-decl$ interfaces))) - (with-brackets (spaced (map constructor-arg$ constructor-args))) - (with-brackets (spaced (map (method-def$ id super) methods))))))] + (with-brackets (spaced (L/map super-class-decl$ interfaces))) + (with-brackets (spaced (L/map constructor-arg$ constructor-args))) + (with-brackets (spaced (L/map (method-def$ id super) methods))))))] (wrap (list (` (;_lux_proc ["jvm" (~ (code;text def-code))] [])))))) (syntax: #export (null) @@ -1527,7 +1527,7 @@ )]])))} (with-gensyms [g!obj] (wrap (list (` (let [(~ g!obj) (~ obj)] - (exec (~@ (map (complete-call$ g!obj) methods)) + (exec (~@ (L/map (complete-call$ g!obj) methods)) (~ g!obj)))))))) (def: (class-import$ long-name? [full-name params]) @@ -1544,7 +1544,7 @@ (host (~ (code;symbol ["" full-name]))))) (#;Cons _) - (let [params' (map (function [[p _]] (code;symbol ["" p])) params)] + (let [params' (L/map (function [[p _]] (code;symbol ["" p])) params)] (` (def: (~ (code;symbol ["" def-name])) {#;type? true #;;jvm-class (~ (code;text full-name))} @@ -1557,7 +1557,7 @@ (-> (List TypeParam) ImportMemberDecl (List TypeParam)) (case member (#ConstructorDecl [commons _]) - (List/append class-tvars (get@ #import-member-tvars commons)) + (L/append class-tvars (get@ #import-member-tvars commons)) (#MethodDecl [commons _]) (case (get@ #import-member-kind commons) @@ -1565,7 +1565,7 @@ (get@ #import-member-tvars commons) _ - (List/append class-tvars (get@ #import-member-tvars commons))) + (L/append class-tvars (get@ #import-member-tvars commons))) _ class-tvars)) @@ -1585,17 +1585,17 @@ arg-name)])))) import-member-args) #let [arg-classes (: (List Text) - (map (. (simple-class$ (List/append type-params import-member-tvars)) product;right) - import-member-args)) - arg-types (map (: (-> [Bool GenericType] Code) - (function [[maybe? arg]] - (let [arg-type (class->type (get@ #import-member-mode commons) type-params arg)] - (if maybe? - (` (Maybe (~ arg-type))) - arg-type)))) - import-member-args) - arg-function-inputs (map product;left arg-inputs) - arg-method-inputs (map product;right arg-inputs)]] + (L/map (. (simple-class$ (L/append type-params import-member-tvars)) product;right) + import-member-args)) + arg-types (L/map (: (-> [Bool GenericType] Code) + (function [[maybe? arg]] + (let [arg-type (class->type (get@ #import-member-mode commons) type-params arg)] + (if maybe? + (` (Maybe (~ arg-type))) + arg-type)))) + import-member-args) + arg-function-inputs (L/map product;left arg-inputs) + arg-method-inputs (L/map product;right arg-inputs)]] (wrap [arg-function-inputs arg-method-inputs arg-classes arg-types]))) _ @@ -1706,8 +1706,8 @@ #AutoPrM (` (let [(~@ (|> inputs - (List/map auto-conv) - List/join))] + (L/map auto-conv) + L/join))] (~ body))))) (def: (with-mode-field-get mode class output) @@ -1742,8 +1742,8 @@ (-> (List TypeParam) ClassKind ClassDecl [(List Code) (List Code) (List Text) (List Code)] ImportMemberDecl Text (Lux (List Code))) (let [[full-name class-tvars] class all-params (|> (member-type-vars class-tvars member) - (filter free-type-param?) - (map type-param->type-arg))] + (list;filter free-type-param?) + (L/map type-param->type-arg))] (case member (#EnumDecl enum-members) (do Monad @@ -1754,8 +1754,8 @@ _ (let [=class-tvars (|> class-tvars - (filter free-type-param?) - (map type-param->type-arg))] + (list;filter free-type-param?) + (L/map type-param->type-arg))] (` (All [(~@ =class-tvars)] (host (~ (code;symbol ["" full-name])) [(~@ =class-tvars)])))))) getter-interop (: (-> Text Code) (function [name] @@ -1763,7 +1763,7 @@ (` (def: (~ getter-name) (~ enum-type) (;_lux_proc ["jvm" (~ (code;text (format "getstatic" ":" full-name ":" name)))] []))))))]] - (wrap (map getter-interop enum-members))) + (wrap (L/map getter-interop enum-members))) (#ConstructorDecl [commons _]) (do Monad @@ -1835,8 +1835,8 @@ base-gtype) tvar-asts (: (List Code) (|> class-tvars - (filter free-type-param?) - (map type-param->type-arg))) + (list;filter free-type-param?) + (L/map type-param->type-arg))) getter-name (code;symbol ["" (format method-prefix member-separator import-field-name)]) setter-name (code;symbol ["" (format method-prefix member-separator import-field-name "!")])] getter-interop (with-gensyms [g!obj] @@ -1972,7 +1972,7 @@ (do Monad [kind (class-kind class-decl) =members (mapM @ (member-import$ (product;right class-decl) long-name? kind class-decl) members)] - (wrap (list& (class-import$ long-name? class-decl) (List/join =members))))) + (wrap (list& (class-import$ long-name? class-decl) (L/join =members))))) (syntax: #export (array [#let [imports (class-imports *compiler*)]] [type (generic-type^ imports (list))] @@ -2096,17 +2096,17 @@ bar (do-something-else my-res2)] (do-one-last-thing foo bar))))} (with-gensyms [g!output g!_] - (let [inits (List/join (List/map (function [[res-name res-ctor]] - (list (code;symbol ["" res-name]) res-ctor)) - bindings)) - closes (List/map (function [res] - (` (try (;_lux_proc ["jvm" "invokevirtual:java.io.Closeable:close:"] - [(~ (code;symbol ["" (product;left res)]))])))) - bindings)] + (let [inits (L/join (L/map (function [[res-name res-ctor]] + (list (code;symbol ["" res-name]) res-ctor)) + bindings)) + closes (L/map (function [res] + (` (try (;_lux_proc ["jvm" "invokevirtual:java.io.Closeable:close:"] + [(~ (code;symbol ["" (product;left res)]))])))) + bindings)] (wrap (list (` (do Monad [(~@ inits) (~ g!output) (~ body) - (~' #let) [(~ g!_) (exec (~@ (reverse closes)) [])]] + (~' #let) [(~ g!_) (exec (~@ (list;reverse closes)) [])]] ((~' wrap) (~ g!output))))))))) (syntax: #export (class-for [#let [imports (class-imports *compiler*)]] @@ -2125,7 +2125,7 @@ (cond (fully-qualified-class-name? name) (#;Some name) - (member? text;Eq java.lang-classes name) + (list;member? text;Eq java.lang-classes name) (#;Some (format "java.lang." name)) ## else diff --git a/stdlib/source/lux/macro.lux b/stdlib/source/lux/macro.lux index c2ea0f04e..49a119388 100644 --- a/stdlib/source/lux/macro.lux +++ b/stdlib/source/lux/macro.lux @@ -4,9 +4,9 @@ (control functor applicative monad) - (data (coll [list #* "List/" Monoid Monad]) + (data (coll [list "L/" Monoid Monad]) [number] - [text "Text/" Monoid Eq] + [text "T/" Monoid Eq] [product] [ident "Ident/" Codec] maybe @@ -66,7 +66,7 @@ #;None (#;Cons [k' v] plist') - (if (Text/= k k') + (if (T/= k k') (#;Some v) (get k plist')))) @@ -117,7 +117,7 @@ (#R;Success [state module]) _ - (#R;Error ($_ Text/append "Unknown module: " name))))) + (#R;Error ($_ T/append "Unknown module: " name))))) (def: #export current-module-name (Lux Text) @@ -147,8 +147,8 @@ (let [[p n] tag] (case anns (#;Cons [[p' n'] dmv] anns') - (if (and (Text/= p p') - (Text/= n n')) + (if (and (T/= p p') + (T/= n n')) (#;Some dmv) (get-ann tag anns')) @@ -192,7 +192,7 @@ (do-template [ ] [(def: #export - {#;doc (#;TextA ($_ Text/append "Checks whether a definition is " "."))} + {#;doc (#;TextA ($_ T/append "Checks whether a definition is " "."))} (-> Anns Bool) (flag-set? (ident-for )))] @@ -221,7 +221,7 @@ (do-template [ ] [(def: #export ( anns) - {#;doc (#;TextA ($_ Text/append "Looks up the arguments of a " "."))} + {#;doc (#;TextA ($_ T/append "Looks up the arguments of a " "."))} (-> Anns (List Text)) (default (list) (do Monad @@ -240,7 +240,7 @@ [$module (get module modules) [def-type def-anns def-value] (: (Maybe Def) (|> (: Module $module) (get@ #;defs) (get name)))] (if (and (macro? def-anns) - (or (export? def-anns) (Text/= module this-module))) + (or (export? def-anns) (T/= module this-module))) (#;Some (:! Macro def-value)) (case (get-ann ["lux" "alias"] def-anns) (#;Some (#;IdentA [r-module r-name])) @@ -307,7 +307,7 @@ (do Monad [expansion (macro args) expansion' (mapM Monad expand expansion)] - (wrap (:: Monad join expansion'))) + (wrap (L/join expansion'))) #;None (:: Monad wrap (list syntax)))) @@ -328,23 +328,23 @@ (do Monad [expansion (macro args) expansion' (mapM Monad expand-all expansion)] - (wrap (:: Monad join expansion'))) + (wrap (L/join expansion'))) #;None (do Monad [parts' (mapM Monad expand-all (list& (code;symbol name) args))] - (wrap (list (code;form (:: Monad join parts'))))))) + (wrap (list (code;form (L/join parts'))))))) [_ (#;Form (#;Cons [harg targs]))] (do Monad [harg+ (expand-all harg) targs+ (mapM Monad expand-all targs)] - (wrap (list (code;form (List/append harg+ (:: Monad join (: (List (List Code)) targs+))))))) + (wrap (list (code;form (L/append harg+ (L/join (: (List (List Code)) targs+))))))) [_ (#;Tuple members)] (do Monad [members' (mapM Monad expand-all members)] - (wrap (list (code;tuple (:: Monad join members'))))) + (wrap (list (code;tuple (L/join members'))))) _ (:: Monad wrap (list syntax)))) @@ -356,7 +356,7 @@ (-> Text (Lux Code)) (function [state] (#R;Success [(update@ #;seed n.inc state) - (code;symbol ["" ($_ Text/append "__gensym__" prefix (:: number;Codec encode (get@ #;seed state)))])]))) + (code;symbol ["" ($_ T/append "__gensym__" prefix (:: number;Codec encode (get@ #;seed state)))])]))) (def: (get-local-symbol ast) (-> Code (Lux Text)) @@ -365,7 +365,7 @@ (:: Monad wrap name) _ - (fail (Text/append "Code is not a local symbol: " (code;to-text ast))))) + (fail (T/append "Code is not a local symbol: " (code;to-text ast))))) (macro: #export (with-gensyms tokens) {#;doc (doc "Creates new symbols and offers them to the body expression." @@ -381,9 +381,9 @@ (^ (list [_ (#;Tuple symbols)] body)) (do Monad [symbol-names (mapM @ 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))]] + #let [symbol-defs (L/join (L/map (: (-> Text (List Code)) + (function [name] (list (code;symbol ["" name]) (` (gensym (~ (code;text name))))))) + symbol-names))]] (wrap (list (` (do Monad [(~@ symbol-defs)] (~ body)))))) @@ -425,15 +425,15 @@ (-> Text (Lux Type)) (function [state] (let [test (: (-> [Text [Type Top]] Bool) - (|>. product;left (Text/= name)))] + (|>. product;left (T/= name)))] (case (do Monad - [scope (find (function [env] - (or (any? test (: (List [Text [Type Top]]) - (get@ [#;locals #;mappings] env))) - (any? test (: (List [Text [Type Top]]) - (get@ [#;captured #;mappings] env))))) - (get@ #;scopes state)) - [_ [type _]] (try-both (find test) + [scope (list;find (function [env] + (or (list;any? test (: (List [Text [Type Top]]) + (get@ [#;locals #;mappings] env))) + (list;any? test (: (List [Text [Type Top]]) + (get@ [#;captured #;mappings] env))))) + (get@ #;scopes state)) + [_ [type _]] (try-both (list;find test) (: (List [Text [Type Top]]) (get@ [#;locals #;mappings] scope)) (: (List [Text [Type Top]]) @@ -443,7 +443,7 @@ (#R;Success [state var-type]) #;None - (#R;Error ($_ Text/append "Unknown variable: " name)))))) + (#R;Error ($_ T/append "Unknown variable: " name)))))) (def: #export (find-def name) {#;doc "Looks-up a definition's whole data in the available modules (including the current one)."} @@ -458,7 +458,7 @@ (#R;Success [state _anns]) _ - (#R;Error ($_ Text/append "Unknown definition: " (Ident/encode name)))))) + (#R;Error ($_ T/append "Unknown definition: " (Ident/encode name)))))) (def: #export (find-def-type name) {#;doc "Looks-up a definition's type in the available modules (including the current one)."} @@ -489,7 +489,7 @@ (-> Text (Lux (List [Text Def]))) (function [state] (case (get module-name (get@ #;modules state)) - #;None (#R;Error ($_ Text/append "Unknown module: " module-name)) + #;None (#R;Error ($_ T/append "Unknown module: " module-name)) (#;Some module) (#R;Success [state (get@ #;defs module)]) ))) @@ -498,10 +498,10 @@ (-> Text (Lux (List [Text Def]))) (do Monad [defs (defs module-name)] - (wrap (filter (function [[name [def-type def-anns def-value]]] - (and (export? def-anns) - (not (hidden? def-anns)))) - defs)))) + (wrap (list;filter (function [[name [def-type def-anns def-value]]] + (and (export? def-anns) + (not (hidden? def-anns)))) + defs)))) (def: #export modules {#;doc "All the available modules (including the current one)."} @@ -559,12 +559,12 @@ (case (get name (get@ #;tags =module)) (#;Some [idx tag-list exported? type]) (if (or exported? - (Text/= this-module-name module)) + (T/= this-module-name module)) (wrap [idx tag-list type]) - (fail ($_ Text/append "Cannot access tag: " (Ident/encode tag) " from module " this-module-name))) + (fail ($_ T/append "Cannot access tag: " (Ident/encode tag) " from module " this-module-name))) _ - (fail ($_ Text/append "Unknown tag: " (Ident/encode tag)))))) + (fail ($_ T/append "Unknown tag: " (Ident/encode tag)))))) (def: #export (tag-lists module) {#;doc "All the tag-lists defined in a module, with their associated types."} @@ -575,9 +575,9 @@ (wrap (|> (get@ #;types =module) (list;filter (function [[type-name [tag-list exported? type]]] (or exported? - (Text/= this-module-name module)))) - (List/map (function [[type-name [tag-list exported? type]]] - [tag-list type])))))) + (T/= this-module-name module)))) + (L/map (function [[type-name [tag-list exported? type]]] + [tag-list type])))))) (def: #export locals {#;doc "All the local variables currently in scope, separated in different scopes."} @@ -589,10 +589,10 @@ (#;Some scopes) (#R;Success [state - (List/map (|>. (get@ [#;locals #;mappings]) - (List/map (function [[name [type _]]] - [name type]))) - scopes)])))) + (L/map (|>. (get@ [#;locals #;mappings]) + (L/map (function [[name [type _]]] + [name type]))) + scopes)])))) (def: #export (un-alias def-name) {#;doc "Given an aliased definition's name, returns the original definition being referenced."} @@ -632,19 +632,19 @@ token)) (do Monad [output ( token) - #let [_ (List/map (. log! code;to-text) - output)]] + #let [_ (L/map (. log! code;to-text) + output)]] (wrap (list))) (^ (list token)) (do Monad [output ( token) - #let [_ (List/map (. log! code;to-text) - output)]] + #let [_ (L/map (. log! code;to-text) + output)]] (wrap output)) _ - (fail ($_ Text/append "Wrong syntax for " "."))))] + (fail ($_ T/append "Wrong syntax for " "."))))] [log-expand expand "log-expand"] [log-expand-all expand-all "log-expand-all"] diff --git a/stdlib/test/test/lux/control/reader.lux b/stdlib/test/test/lux/control/reader.lux index f7aa8630f..b3e89f353 100644 --- a/stdlib/test/test/lux/control/reader.lux +++ b/stdlib/test/test/lux/control/reader.lux @@ -27,7 +27,7 @@ (let [(^open "io/") io;Monad] (test "Can add reader functionality to any monad." (|> (do (&;ReaderT io;Monad) - [a (&;lift-reader (io/wrap 123)) + [a (&;lift (io/wrap 123)) b (wrap 456)] (wrap (i.+ a b))) (&;run "") diff --git a/stdlib/test/test/lux/control/state.lux b/stdlib/test/test/lux/control/state.lux index d789010ea..cc5db9ee1 100644 --- a/stdlib/test/test/lux/control/state.lux +++ b/stdlib/test/test/lux/control/state.lux @@ -72,12 +72,11 @@ [state R;nat left R;nat right R;nat] - (let [lift (&;lift-state io;Monad) - (^open "io/") io;Monad] + (let [(^open "io/") io;Monad] (test "Can add state functionality to any monad." (|> (: (&;State' io;IO Nat Nat) (do (&;StateT io;Monad) - [a (lift (io/wrap left)) + [a (&;lift io;Monad (io/wrap left)) b (wrap right)] (wrap (n.+ a b)))) (&;run' state) diff --git a/stdlib/test/test/lux/data/coll/list.lux b/stdlib/test/test/lux/data/coll/list.lux index 7e91ed06c..7315c3013 100644 --- a/stdlib/test/test/lux/data/coll/list.lux +++ b/stdlib/test/test/lux/data/coll/list.lux @@ -209,7 +209,7 @@ )) (context: "Monad transformer" - (let [lift (&;lift-list io;Monad) + (let [lift (&;lift io;Monad) (^open "io/") io;Monad] (test "Can add list functionality to any monad." (|> (io;run (do (&;ListT io;Monad) diff --git a/stdlib/test/test/lux/data/log.lux b/stdlib/test/test/lux/data/log.lux index 959d1a65f..6286b19fb 100644 --- a/stdlib/test/test/lux/data/log.lux +++ b/stdlib/test/test/lux/data/log.lux @@ -31,7 +31,7 @@ ))) (context: "Monad transformer" - (let [lift (&;lift-log text;Monoid io;Monad) + (let [lift (&;lift text;Monoid io;Monad) (^open "io/") io;Monad] (test "Can add log functionality to any monad." (|> (io;run (do (&;LogT text;Monoid io;Monad) diff --git a/stdlib/test/test/lux/data/maybe.lux b/stdlib/test/test/lux/data/maybe.lux index 85ce7be83..2f426d65f 100644 --- a/stdlib/test/test/lux/data/maybe.lux +++ b/stdlib/test/test/lux/data/maybe.lux @@ -45,7 +45,7 @@ ))) (context: "Monad transformer" - (let [lift (&;lift-maybe io;Monad) + (let [lift (&;lift io;Monad) (^open "io/") io;Monad] (test "Can add maybe functionality to any monad." (|> (io;run (do (&;MaybeT io;Monad) diff --git a/stdlib/test/test/lux/data/result.lux b/stdlib/test/test/lux/data/result.lux index 485f56a13..498d55439 100644 --- a/stdlib/test/test/lux/data/result.lux +++ b/stdlib/test/test/lux/data/result.lux @@ -45,7 +45,7 @@ ))) (context: "Monad transformer" - (let [lift (&;lift-result io;Monad) + (let [lift (&;lift io;Monad) (^open "io/") io;Monad] (test "Can add result functionality to any monad." (|> (io;run (do (&;ResultT io;Monad) -- cgit v1.2.3