Catch a missed ReduceLocal of field projection annotations

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) =>