Mercurial > urweb

changeset 1278:cd8d2c73ccf4

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Catch a missed ReduceLocal of field projection annotations
author Adam Chlipala <adamc@hcoop.net>
date Sun, 13 Jun 2010 14:13:06 -0400
parents 1e6a4f9d3e4a
children 4c367c8f5b2d
files src/expl_env.sig src/expl_env.sml src/expl_print.sml src/reduce_local.sml
diffstat 4 files changed, 17 insertions(+), 6 deletions(-) [+]
line wrap: on
line diff
--- a/src/expl_env.sig	Sun Jun 13 10:55:20 2010 -0400
+++ b/src/expl_env.sig	Sun Jun 13 14:13:06 2010 -0400
@@ -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 @@
     val declBinds : env -> Expl.decl -> env
     val sgiBinds : env -> Expl.sgn_item -> env
 
+    val patBinds : env -> Expl.pat -> env
+
 end
--- a/src/expl_env.sml	Sun Jun 13 10:55:20 2010 -0400
+++ b/src/expl_env.sml	Sun Jun 13 14:13:06 2010 -0400
@@ -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 @@
       | 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
--- a/src/expl_print.sml	Sun Jun 13 10:55:20 2010 -0400
+++ b/src/expl_print.sml	Sun Jun 13 14:13:06 2010 -0400
@@ -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 @@
                                                         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,
--- a/src/reduce_local.sml	Sun Jun 13 10:55:20 2010 -0400
+++ b/src/reduce_local.sml	Sun Jun 13 14:13:06 2010 -0400
@@ -286,12 +286,12 @@
       | 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) =>