aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux/data/collection/dictionary.lux48
-rw-r--r--stdlib/source/lux/tool/compiler/phase/analysis/case.lux19
2 files changed, 40 insertions, 27 deletions
diff --git a/stdlib/source/lux/data/collection/dictionary.lux b/stdlib/source/lux/data/collection/dictionary.lux
index 3580b0ddd..2f07ceb3e 100644
--- a/stdlib/source/lux/data/collection/dictionary.lux
+++ b/stdlib/source/lux/data/collection/dictionary.lux
@@ -1,6 +1,9 @@
(.module:
[lux #*
[abstract
+ [monoid (#+)]
+ [fold (#+)]
+ [monad (#+)]
[hash (#+ Hash)]
[equivalence (#+ Equivalence)]
[functor (#+ Functor)]]
@@ -681,28 +684,29 @@
#0))
(keys test)))))
+(structure: functor'
+ (All [k] (Functor (Node k)))
+ (def: (map f fa)
+ (case fa
+ (#Hierarchy size hierarchy)
+ (#Hierarchy size (array@map (map f) hierarchy))
+
+ (#Base bitmap base)
+ (#Base bitmap (array@map (function (_ either)
+ (case either
+ (#.Left fa')
+ (#.Left (map f fa'))
+
+ (#.Right [k v])
+ (#.Right [k (f v)])))
+ base))
+
+ (#Collisions hash collisions)
+ (#Collisions hash (array@map (function (_ [k v])
+ [k (f v)])
+ collisions)))))
+
(structure: #export functor
(All [k] (Functor (Dictionary k)))
(def: (map f fa)
- (update@ #root
- (function (recur node)
- (case node
- (#Hierarchy size hierarchy)
- (#Hierarchy size (array@map recur hierarchy))
-
- (#Base bitmap base)
- (#Base bitmap (array@map (function (_ either)
- (case either
- (#.Left node)
- (#.Left (recur node))
-
- (#.Right [k v])
- (#.Right [k (f v)])))
- base))
-
- (#Collisions hash collisions)
- (#Collisions hash (array@map (function (_ [k v])
- [k (f v)])
- collisions))))
- fa)
- ))
+ (update@ #root (:: ..functor' map f) fa)))
diff --git a/stdlib/source/lux/tool/compiler/phase/analysis/case.lux b/stdlib/source/lux/tool/compiler/phase/analysis/case.lux
index 9d7c9ea7f..dff106eb7 100644
--- a/stdlib/source/lux/tool/compiler/phase/analysis/case.lux
+++ b/stdlib/source/lux/tool/compiler/phase/analysis/case.lux
@@ -90,9 +90,9 @@
(#.ExQ _)
(do ///.monad
- [[ex-id exT] (//type.with-env
- check.existential)]
- (recur envs (maybe.assume (type.apply (list exT) caseT))))
+ [[var-id varT] (//type.with-env
+ check.var)]
+ (recur envs (maybe.assume (type.apply (list varT) caseT))))
(#.Apply inputT funcT)
(.case funcT
@@ -215,7 +215,7 @@
thenA])))
_
- (/.throw cannot-match-with-pattern [inputT pattern])
+ (/.throw cannot-match-with-pattern [inputT' pattern])
)))
[cursor (#.Record record)]
@@ -260,8 +260,17 @@
_
(/.throw sum-has-no-case [idx inputT])))
+ (#.UnivQ _)
+ (do ///.monad
+ [[ex-id exT] (//type.with-env
+ check.existential)]
+ (analyse-pattern num-tags
+ (maybe.assume (type.apply (list exT) inputT'))
+ pattern
+ next))
+
_
- (/.throw cannot-match-with-pattern [inputT pattern]))))
+ (/.throw cannot-match-with-pattern [inputT' pattern]))))
(^ [cursor (#.Form (list& [_ (#.Tag tag)] values))])
(/.with-cursor cursor