diff options
| author |  Adam Chlipala <adamc@hcoop.net> | 2009-07-19 17:45:02 -0400 |
|---|---|---|
| committer | Adam Chlipala <adamc@hcoop.net> | 2009-07-19 17:45:02 -0400 |
| commit | 1409fcbff76f7846cbcb3434ebb5c0617177cf40 (patch) | |
| tree | 89ce0f6149e50fdfece4b083c2be2033c7727c63 /src | |
| parent | bbac4b6f898bbad12e17db434cc24c69cb448ef5 (diff) | |
Working on Grid; have gone from one dynamic table bizareness to another
Diffstat (limited to 'src')
| -rw-r--r-- | src/compiler.sig | 1 | ||||
| -rw-r--r-- | src/compiler.sml | 4 | ||||
| -rw-r--r-- | src/elaborate.sml | 14 |
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 |