changeset 124:541282b81454

Explifying (non-mutual) 'val rec'
author Adam Chlipala <adamc@hcoop.net>
date Thu, 17 Jul 2008 10:13:18 -0400
parents e3041657d653
children fd98dd10dce7
files src/corify.sml src/expl.sml src/expl_env.sml src/expl_print.sml src/explify.sml
diffstat 5 files changed, 30 insertions(+), 14 deletions(-) [+]
line wrap: on
line diff
--- a/src/corify.sml	Thu Jul 17 10:09:34 2008 -0400
+++ b/src/corify.sml	Thu Jul 17 10:13:18 2008 -0400
@@ -384,6 +384,7 @@
         in
             ([(L'.DVal (x, n, corifyCon st t, corifyExp st e, s), loc)], st)
         end
+      | L.DValRec _ => raise Fail "Explify DValRec"
                                                                         
       | L.DSgn _ => ([], st)
 
@@ -531,7 +532,8 @@
 fun maxName ds = foldl (fn ((d, _), n) =>
                            case d of
                                L.DCon (_, n', _, _) => Int.max (n, n')
-                             | L.DVal (_, n', _ , _) => Int.max (n, n')
+                             | L.DVal (_, n', _, _) => Int.max (n, n')
+                             | L.DValRec vis => foldl (fn ((_, n', _, _), n) => Int.max (n, n)) n vis
                              | L.DSgn (_, n', _) => Int.max (n, n')
                              | L.DStr (_, n', _, str) => Int.max (n, Int.max (n', maxNameStr str))
                              | L.DFfiStr (_, n', _) => Int.max (n, n')
--- a/src/expl.sml	Thu Jul 17 10:09:34 2008 -0400
+++ b/src/expl.sml	Thu Jul 17 10:13:18 2008 -0400
@@ -97,6 +97,7 @@
 datatype decl' =
          DCon of string * int * kind * con
        | DVal of string * int * con * exp
+       | DValRec of (string * int * con * exp) list
        | DSgn of string * int * sgn
        | DStr of string * int * sgn * str
        | DFfiStr of string * int * sgn
--- a/src/expl_env.sml	Thu Jul 17 10:09:34 2008 -0400
+++ b/src/expl_env.sml	Thu Jul 17 10:13:18 2008 -0400
@@ -240,6 +240,7 @@
     case d of
         DCon (x, n, k, c) => pushCNamed env x n k (SOME c)
       | DVal (x, n, t, _) => pushENamed env x n t
+      | DValRec vis => foldl (fn ((x, n, t, _), env) => pushENamed env x n t) env vis
       | DSgn (x, n, sgn) => pushSgnNamed env x n sgn
       | DStr (x, n, sgn, _) => pushStrNamed env x n sgn
       | DFfiStr (x, n, sgn) => pushStrNamed env x n sgn
--- a/src/expl_print.sml	Thu Jul 17 10:09:34 2008 -0400
+++ b/src/expl_print.sml	Thu Jul 17 10:13:18 2008 -0400
@@ -345,7 +345,17 @@
             p_list_sep (string ".") string (m1x :: ms @ [x])
         end
 
-fun p_decl env ((d, _) : decl) =
+fun p_vali env (x, n, t, e) = box [p_named x n,
+                                   space,
+                                   string ":",
+                                   space,
+                                   p_con env t,
+                                   space,
+                                   string "=",
+                                   space,
+                                   p_exp env e]
+
+fun p_decl env (dAll as (d, _) : decl) =
     case d of
         DCon (x, n, k, c) => box [string "con",
                                   space,
@@ -358,17 +368,19 @@
                                   string "=",
                                   space,
                                   p_con env c]
-      | DVal (x, n, t, e) => box [string "val",
-                                  space,
-                                  p_named x n,
-                                  space,
-                                  string ":",
-                                  space,
-                                  p_con env t,
-                                  space,
-                                  string "=",
-                                  space,
-                                  p_exp env e]
+      | DVal vi => box [string "val",
+                        space,
+                        p_vali env vi]
+      | DValRec vis =>
+        let
+            val env = E.declBinds env dAll
+        in
+            box [string "val",
+                 space,
+                 string "rec",
+                 space,
+                 p_list_sep (box [newline, string "and", space]) (p_vali env) vis]
+        end
                              
       | DSgn (x, n, sgn) => box [string "signature",
                                  space,
--- a/src/explify.sml	Thu Jul 17 10:09:34 2008 -0400
+++ b/src/explify.sml	Thu Jul 17 10:13:18 2008 -0400
@@ -111,7 +111,7 @@
     case d of
         L.DCon (x, n, k, c) => SOME (L'.DCon (x, n, explifyKind k, explifyCon c), loc)
       | L.DVal (x, n, t, e) => SOME (L'.DVal (x, n, explifyCon t, explifyExp e), loc)
-      | L.DValRec _ => raise Fail "Expliofy DValRec"
+      | L.DValRec vis => SOME (L'.DValRec (map (fn (x, n, t, e) => (x, n, explifyCon t, explifyExp e)) vis), loc)
 
       | L.DSgn (x, n, sgn) => SOME (L'.DSgn (x, n, explifySgn sgn), loc)
       | L.DStr (x, n, sgn, str) => SOME (L'.DStr (x, n, explifySgn sgn, explifyStr str), loc)