summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@hcoop.net>2010-06-13 14:13:06 -0400
committerGravatar Adam Chlipala <adamc@hcoop.net>2010-06-13 14:13:06 -0400
commit3f4cbb5f7f9deef169728e445e5b69ef14fedd30 (patch)
tree5dced3d3a8af23f27538d99bc31bcf107222a15a /src
parent760ea275ff60358b2c3cf61588cfd5dde27c4e0e (diff)
Catch a missed ReduceLocal of field projection annotations
Diffstat (limited to 'src')
-rw-r--r--src/expl_env.sig4
-rw-r--r--src/expl_env.sml11
-rw-r--r--src/expl_print.sml4
-rw-r--r--src/reduce_local.sml4
4 files changed, 17 insertions, 6 deletions
diff --git a/src/expl_env.sig b/src/expl_env.sig
index 5ded0f02..89594d08 100644
--- a/src/expl_env.sig
+++ b/src/expl_env.sig
@@ -1,4 +1,4 @@
-(* Copyright (c) 2008, Adam Chlipala
+(* Copyright (c) 2008-2010, Adam Chlipala
* All rights reserved.
*
* Redistribution and use in source and binary forms, with or without
@@ -66,4 +66,6 @@ signature EXPL_ENV = sig
val declBinds : env -> Expl.decl -> env
val sgiBinds : env -> Expl.sgn_item -> env
+ val patBinds : env -> Expl.pat -> env
+
end
diff --git a/src/expl_env.sml b/src/expl_env.sml
index 583e4881..9abe7099 100644
--- a/src/expl_env.sml
+++ b/src/expl_env.sml
@@ -1,4 +1,4 @@
-(* Copyright (c) 2008, Adam Chlipala
+(* Copyright (c) 2008-2010, Adam Chlipala
* All rights reserved.
*
* Redistribution and use in source and binary forms, with or without
@@ -400,4 +400,13 @@ fun sgiBinds env (sgi, loc) =
| SgiSgn (x, n, sgn) => pushSgnNamed env x n sgn
| SgiStr (x, n, sgn) => pushStrNamed env x n sgn
+fun patBinds env (p, loc) =
+ case p of
+ PWild => env
+ | PVar (x, t) => pushERel env x t
+ | PPrim _ => env
+ | PCon (_, _, _, NONE) => env
+ | PCon (_, _, _, SOME p) => patBinds env p
+ | PRecord xps => foldl (fn ((_, p, _), env) => patBinds env p) env xps
+
end
diff --git a/src/expl_print.sml b/src/expl_print.sml
index c953350c..5a914194 100644
--- a/src/expl_print.sml
+++ b/src/expl_print.sml
@@ -1,4 +1,4 @@
-(* Copyright (c) 2008, Adam Chlipala
+(* Copyright (c) 2008-2010, Adam Chlipala
* All rights reserved.
*
* Redistribution and use in source and binary forms, with or without
@@ -422,7 +422,7 @@ fun p_exp' par env (e, loc) =
space,
string "=>",
space,
- p_exp env e]) pes])
+ p_exp (E.patBinds env p) e]) pes])
| ELet (x, t, e1, e2) => box [string "let",
space,
diff --git a/src/reduce_local.sml b/src/reduce_local.sml
index 1be2b14b..9370c95b 100644
--- a/src/reduce_local.sml
+++ b/src/reduce_local.sml
@@ -286,12 +286,12 @@ fun exp env (all as (e, loc)) =
| EKAbs (x, e) => (EKAbs (x, exp env e), loc)
| ERecord xcs => (ERecord (map (fn (x, e, t) => (con env x, exp env e, con env t)) xcs), loc)
- | EField (e, c, others) =>
+ | EField (e, c, {field = f, rest = r}) =>
let
val e = exp env e
val c = con env c
- fun default () = (EField (e, c, others), loc)
+ fun default () = (EField (e, c, {field = con env f, rest = con env r}), loc)
in
case (#1 e, #1 c) of
(ERecord xcs, CName x) =>