From 3f4cbb5f7f9deef169728e445e5b69ef14fedd30 Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adamc@hcoop.net>
Date: Sun, 13 Jun 2010 14:13:06 -0400
Subject: Catch a missed ReduceLocal of field projection annotations

---
 src/expl_env.sig     |  4 +++-
 src/expl_env.sml     | 11 ++++++++++-
 src/expl_print.sml   |  4 ++--
 src/reduce_local.sml |  4 ++--
 4 files changed, 17 insertions(+), 6 deletions(-)

(limited to 'src')

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) =>
-- 
cgit v1.2.3