aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source
diff options
context:
space:
mode:
authorEduardo Julian2017-05-09 17:49:03 -0400
committerEduardo Julian2017-05-09 17:49:03 -0400
commitfb031d2157cfbebe359ab58db02de363b96fe909 (patch)
treee0cff590966865d09f8462d64adbe4d64eee8c13 /stdlib/source
parentdd5220e13b03c8f85972feac535a34ef64525222 (diff)
- Small fixes and refactorings.
Diffstat (limited to 'stdlib/source')
-rw-r--r--stdlib/source/lux.lux4
-rw-r--r--stdlib/source/lux/data/format/json.lux16
-rw-r--r--stdlib/source/lux/type/check.lux25
3 files changed, 25 insertions, 20 deletions
diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux
index ed2d81667..bcf620c8f 100644
--- a/stdlib/source/lux.lux
+++ b/stdlib/source/lux.lux
@@ -5306,8 +5306,8 @@
(do Monad<Lux>
[expansion (macro-expand-once macro-expr)]
(case (place-tokens var-name expansion (` (;with-expansions
- [(~@ bindings')]
- (~@ bodies))))
+ [(~@ bindings')]
+ (~@ bodies))))
(#Some output)
(wrap output)
diff --git a/stdlib/source/lux/data/format/json.lux b/stdlib/source/lux/data/format/json.lux
index 863c8cd3e..b75b9dbf7 100644
--- a/stdlib/source/lux/data/format/json.lux
+++ b/stdlib/source/lux/data/format/json.lux
@@ -787,7 +787,7 @@
<basic>
(with-gensyms [g!type-fun g!case g!input g!key g!val]
(do @
- [:sub: (poly;list :x:)
+ [:sub: (poly;apply-1 (ident-for ;List) :x:)
[g!vars members] (poly;tuple :sub:)
:val: (case members
(^ (list :key: :val:))
@@ -821,12 +821,12 @@
)))
))
(do @
- [:sub: (poly;maybe :x:)
+ [:sub: (poly;apply-1 (ident-for ;Maybe) :x:)
.sub. (Codec<JSON,?>//encode *env* :sub:)]
(wrap (` (: (~ (->Codec//encode (type;to-ast :x:)))
(;;gen-nullable (~ .sub.))))))
(do @
- [:sub: (poly;list :x:)
+ [:sub: (poly;apply-1 (ident-for ;List) :x:)
.sub. (Codec<JSON,?>//encode *env* :sub:)]
(wrap (` (: (~ (->Codec//encode (type;to-ast :x:)))
(|>. (_map_ (~ .sub.)) vector;from-list ;;gen-array)))))
@@ -942,13 +942,13 @@
(wrap (` (: (~ (->Codec//decode (type;to-ast :x:)))
(<decoder> (~ .sub.))))))]
- [Maybe poly;maybe ;;nullable]
- [List poly;list ;;array])]
+ [Maybe (poly;apply-1 (ident-for ;Maybe)) ;;nullable]
+ [List (poly;apply-1 (ident-for ;List)) ;;array])]
($_ macro;either
<basic>
(with-gensyms [g!type-fun g!case g!input g!key g!val]
(do @
- [:sub: (poly;list :x:)
+ [:sub: (poly;apply-1 (ident-for ;List) :x:)
[g!vars members] (poly;tuple :sub:)
:val: (case members
(^ (list :key: :val:))
@@ -1046,8 +1046,8 @@
(do Monad<Error>
[(~@ (List/join extraction))]
((~ (' wrap)) (~ (code;record (List/map (function [[name :slot:]]
- [(code;tag name) (code;symbol ["" (product;right name)])])
- members))))))
+ [(code;tag name) (code;symbol ["" (product;right name)])])
+ members))))))
)))))
(with-gensyms [g!type-fun g!case g!input]
(do @
diff --git a/stdlib/source/lux/type/check.lux b/stdlib/source/lux/type/check.lux
index 5db2059fa..56198f5ab 100644
--- a/stdlib/source/lux/type/check.lux
+++ b/stdlib/source/lux/type/check.lux
@@ -381,6 +381,17 @@
(-> [Type Type] Bool Fixed Fixed)
(#;Cons [ea status] fixed))
+(def: (on-var id type then else)
+ (All [a]
+ (-> Nat Type (Check a) (-> Type (Check a))
+ (Check a)))
+ (either (do Monad<Check>
+ [_ (write-var id type)]
+ then)
+ (do Monad<Check>
+ [bound (read-var id)]
+ (else bound))))
+
(def: #export (check' expected actual fixed)
{#;doc "Type-check to ensure that the 'expected' type subsumes the 'actual' type."}
(-> Type Type Fixed (Check Fixed))
@@ -409,19 +420,13 @@
(check' etype atype fixed))))
[(#;Var id) _]
- (either (do Monad<Check>
- [_ (write-var id actual)]
- (wrap fixed))
- (do Monad<Check>
- [bound (read-var id)]
+ (on-var id actual (Check/wrap fixed)
+ (function [bound]
(check' bound actual fixed)))
[_ (#;Var id)]
- (either (do Monad<Check>
- [_ (write-var id expected)]
- (wrap fixed))
- (do Monad<Check>
- [bound (read-var id)]
+ (on-var id expected (Check/wrap fixed)
+ (function [bound]
(check' expected bound fixed)))
[(#;App (#;Ex eid) eA) (#;App (#;Ex aid) aA)]