summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@hcoop.net>2009-07-19 17:45:02 -0400
committerGravatar Adam Chlipala <adamc@hcoop.net>2009-07-19 17:45:02 -0400
commit94a1373401529f500640b0c0628e7173612cdabe (patch)
tree89ce0f6149e50fdfece4b083c2be2033c7727c63 /src
parent19cd9e965929d541e6714f62154f01b9e487a712 (diff)
Working on Grid; have gone from one dynamic table bizareness to another
Diffstat (limited to 'src')
-rw-r--r--src/compiler.sig1
-rw-r--r--src/compiler.sml4
-rw-r--r--src/elaborate.sml14
3 files changed, 17 insertions, 2 deletions
diff --git a/src/compiler.sig b/src/compiler.sig
index c36ae2cc..73605d7c 100644
--- a/src/compiler.sig
+++ b/src/compiler.sig
@@ -120,6 +120,7 @@ signature COMPILER = sig
val toSpecialize : (string, Core.file) transform
val toShake3 : (string, Core.file) transform
val toEspecialize : (string, Core.file) transform
+ val toReduce2 : (string, Core.file) transform
val toShake4 : (string, Core.file) transform
val toMarshalcheck : (string, Core.file) transform
val toEffectize : (string, Core.file) transform
diff --git a/src/compiler.sml b/src/compiler.sml
index 622b0e62..c99c0eeb 100644
--- a/src/compiler.sml
+++ b/src/compiler.sml
@@ -779,7 +779,9 @@ val toShake3 = transform shake "shake3" o toSpecialize
val toEspecialize = transform especialize "especialize" o toShake3
-val toShake4 = transform shake "shake4" o toEspecialize
+val toReduce2 = transform reduce "reduce2" o toEspecialize
+
+val toShake4 = transform shake "shake4" o toReduce2
val marshalcheck = {
func = (fn file => (MarshalCheck.check file; file)),
diff --git a/src/elaborate.sml b/src/elaborate.sml
index f0aa8d7a..6b25cedb 100644
--- a/src/elaborate.sml
+++ b/src/elaborate.sml
@@ -1116,6 +1116,18 @@
fun elabHead (env, denv) infer (e as (_, loc)) t =
let
+ fun unravelKind (t, e) =
+ case hnormCon env t of
+ (L'.TKFun (x, t'), _) =>
+ let
+ val u = kunif loc
+
+ val t'' = subKindInCon (0, u) t'
+ in
+ unravelKind (t'', (L'.EKApp (e, u), loc))
+ end
+ | t => (e, t, [])
+
fun unravel (t, e) =
case hnormCon env t of
(L'.TKFun (x, t'), _) =>
@@ -1184,7 +1196,7 @@
| t => (e, t, [])
in
case infer of
- L.DontInfer => (e, t, [])
+ L.DontInfer => unravelKind (t, e)
| _ => unravel (t, e)
end