From 821b60d969dfda0302aba7aea8a93bfed2fa628d Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Mon, 26 Jun 2017 19:34:58 -0400 Subject: - Miscellaneous refactoring. --- stdlib/source/lux/concurrency/task.lux | 4 ++++ stdlib/source/lux/control/effect.lux | 4 ++-- stdlib/source/lux/control/parser.lux | 2 +- stdlib/source/lux/host.jvm.lux | 2 +- stdlib/source/lux/type.lux | 39 +++++++++++++++++++--------------- stdlib/source/lux/type/auto.lux | 6 +++--- stdlib/source/lux/type/check.lux | 2 +- stdlib/test/test/lux/type.lux | 6 +++--- 8 files changed, 37 insertions(+), 28 deletions(-) (limited to 'stdlib') diff --git a/stdlib/source/lux/concurrency/task.lux b/stdlib/source/lux/concurrency/task.lux index f46d1f0da..6f880ef79 100644 --- a/stdlib/source/lux/concurrency/task.lux +++ b/stdlib/source/lux/concurrency/task.lux @@ -25,6 +25,10 @@ (All [a] (-> a (Task a))) (:: P;Applicative wrap (#R;Success value))) +(def: #export (try computation) + (All [a] (-> (Task a) (Task (R;Result a)))) + (:: P;Functor map (|>. #R;Success) computation)) + (struct: #export _ (Functor Task) (def: (map f fa) (:: P;Functor map diff --git a/stdlib/source/lux/control/effect.lux b/stdlib/source/lux/control/effect.lux index 6c6feee06..d1e472ce6 100644 --- a/stdlib/source/lux/control/effect.lux +++ b/stdlib/source/lux/control/effect.lux @@ -322,10 +322,10 @@ output macro;expected-type] (case [input output] (^multi [(#;Apply _ eff0) (#;Apply recT0 stackT0)] - [(type;apply-type stackT0 recT0) (#;Some unfoldT0)] + [(type;apply (list recT0) stackT0) (#;Some unfoldT0)] [stackT0 (^ (#;Apply stackT1 (#;Named (ident-for M;Free) _)))] - [(type;apply-type stackT1 recT0) (#;Some unfoldT1)] + [(type;apply (list recT0) stackT1) (#;Some unfoldT1)] [(flatten-effect-stack unfoldT1) stack] [(|> stack list;enumerate (list;find (function [[idx effect]] diff --git a/stdlib/source/lux/control/parser.lux b/stdlib/source/lux/control/parser.lux index 71b4377d9..1e25032a8 100644 --- a/stdlib/source/lux/control/parser.lux +++ b/stdlib/source/lux/control/parser.lux @@ -240,7 +240,7 @@ _ param] (wrap output))) -(def: #export (constrain test parser) +(def: #export (filter test parser) (All [s a] (-> (-> a Bool) (Parser s a) (Parser s a))) (do Monad [output parser diff --git a/stdlib/source/lux/host.jvm.lux b/stdlib/source/lux/host.jvm.lux index 77b77c219..17f89e7ba 100644 --- a/stdlib/source/lux/host.jvm.lux +++ b/stdlib/source/lux/host.jvm.lux @@ -2007,7 +2007,7 @@ (:: Monad wrap name) (#;Apply A F) - (case (type;apply-type F A) + (case (type;apply (list A) F) #;None (macro;fail (format "Cannot apply type: " (type;to-text F) " to " (type;to-text A))) diff --git a/stdlib/source/lux/type.lux b/stdlib/source/lux/type.lux index fa55ca41b..48f6c3bd7 100644 --- a/stdlib/source/lux/type.lux +++ b/stdlib/source/lux/type.lux @@ -140,24 +140,29 @@ [flatten-tuple #;Product] ) -(def: #export (apply-type type-func param) - (-> Type Type (Maybe Type)) - (case type-func - (^template [] - ( env body) - (#;Some (beta-reduce (list& type-func param env) body))) - ([#;UnivQ] [#;ExQ]) +(def: #export (apply params func) + (-> (List Type) Type (Maybe Type)) + (case params + #;Nil + (#;Some func) - (#;Apply A F) - (do Monad - [type-fn* (apply-type F A)] - (apply-type type-fn* param)) + (#;Cons param params') + (case func + (^template [] + ( env body) + (|> body + (beta-reduce (list& func param env)) + (apply params'))) + ([#;UnivQ] [#;ExQ]) - (#;Named name type) - (apply-type type param) - - _ - #;None)) + (#;Apply A F) + (apply (list& A params) F) + + (#;Named name unnamed) + (apply params unnamed) + + _ + #;None))) (def: #export (to-ast type) (-> Type Code) @@ -333,7 +338,7 @@ (#;Apply A F) (default false (do Monad - [applied (apply-type F A)] + [applied (apply (list A) F)] (wrap (quantified? applied)))) (^or (#;UnivQ _) (#;ExQ _)) diff --git a/stdlib/source/lux/type/auto.lux b/stdlib/source/lux/type/auto.lux index b0018525b..99e5e0431 100644 --- a/stdlib/source/lux/type/auto.lux +++ b/stdlib/source/lux/type/auto.lux @@ -55,7 +55,7 @@ (find-member-type idx sig-type') (#;Apply arg func) - (case (type;apply-type func arg) + (case (type;apply (list arg) func) #;None (tc;fail (format "Cannot apply type " (%type func) " to type " (%type arg))) @@ -157,7 +157,7 @@ (do Monad [[id var] tc;create-var] (apply-function-type (default (undefined) - (type;apply-type func var)) + (type;apply (list var) func)) arg)) (#;Function input output) @@ -175,7 +175,7 @@ (do Monad [[id var] tc;create-var [ids final-output] (concrete-type (default (undefined) - (type;apply-type type var)))] + (type;apply (list var) type)))] (wrap [(#;Cons id ids) final-output])) diff --git a/stdlib/source/lux/type/check.lux b/stdlib/source/lux/type/check.lux index 1779f62bd..a51f641cd 100644 --- a/stdlib/source/lux/type/check.lux +++ b/stdlib/source/lux/type/check.lux @@ -132,7 +132,7 @@ (def: (apply-type! t-func t-arg) (-> Type Type (Check Type)) (function [context] - (case (type;apply-type t-func t-arg) + (case (type;apply (list t-arg) t-func) #;None (#R;Error (format "Invalid type application: " (%type t-func) " on " (%type t-arg))) diff --git a/stdlib/test/test/lux/type.lux b/stdlib/test/test/lux/type.lux index a4c1019f3..3896d6fcc 100644 --- a/stdlib/test/test/lux/type.lux +++ b/stdlib/test/test/lux/type.lux @@ -53,10 +53,10 @@ (test "Can apply quantified types (universal and existential quantification)." (and (default false (do Monad - [partial (&;apply-type Meta Bool) - full (&;apply-type partial Int)] + [partial (&;apply (list Bool) Meta) + full (&;apply (list Int) partial)] (wrap (:: &;Eq = full (#;Product Bool Int))))) - (|> (&;apply-type Text Bool) + (|> (&;apply (list Bool) Text) (case> #;None true _ false))))) (context: "Naming" -- cgit v1.2.3