changeset 621:8998114760c1

"Hello world" compiles, after replacing type-level fold with map
author Adam Chlipala <adamc@hcoop.net>
date Sat, 21 Feb 2009 15:33:20 -0500
parents d828b143e147
children d64533157f40
files lib/ur/basis.urs lib/ur/top.ur lib/ur/top.urs src/core.sml src/core_print.sml src/core_util.sml src/corify.sml src/disjoint.sml src/elab.sml src/elab_ops.sml src/elab_print.sml src/elab_util.sml src/elaborate.sml src/elisp/urweb-defs.el src/elisp/urweb-mode.el src/expl.sml src/expl_print.sml src/expl_util.sml src/explify.sml src/monoize.sml src/reduce.sml src/source.sml src/source_print.sml src/urweb.grm src/urweb.lex
diffstat 25 files changed, 221 insertions(+), 414 deletions(-) [+]
line wrap: on
line diff
--- a/lib/ur/basis.urs	Sat Feb 21 14:10:06 2009 -0500
+++ b/lib/ur/basis.urs	Sat Feb 21 15:33:20 2009 -0500
@@ -120,31 +120,20 @@
 con sql_subset :: {{Type}} -> {{Type}} -> Type
 val sql_subset : keep_drop :: {({Type} * {Type})}
                               -> sql_subset
-                                     (fold (fn nm (fields :: ({Type} * {Type}))
-                                                  acc [[nm] ~ acc]
-                                                  [fields.1 ~ fields.2] =>
-                                               [nm = fields.1 ++ fields.2]
-                                                   ++ acc) [] keep_drop)
-                                     (fold (fn nm (fields :: ({Type} * {Type}))
-                                                  acc [[nm] ~ acc] =>
-                                               [nm = fields.1] ++ acc)
-                                               [] keep_drop)
+                                     (map (fn fields :: ({Type} * {Type}) => fields.1 ++ fields.2) keep_drop)
+                                     (map (fn fields :: ({Type} * {Type}) => fields.1) keep_drop)
 val sql_subset_all : tables :: {{Type}} -> sql_subset tables tables
 
 val sql_query1 : tables ::: {{Type}}
                  -> grouped ::: {{Type}}
                  -> selectedFields ::: {{Type}}
                  -> selectedExps ::: {Type}
-                 -> {From : $(fold (fn nm (fields :: {Type}) acc [[nm] ~ acc] =>
-                                       [nm = sql_table fields] ++ acc)
-                                       [] tables),
+                 -> {From : $(map (fn fields :: {Type} => sql_table fields) tables),
                      Where : sql_exp tables [] [] bool,
                      GroupBy : sql_subset tables grouped,
                      Having : sql_exp grouped tables [] bool,
                      SelectFields : sql_subset grouped selectedFields,
-                     SelectExps : $(fold (fn nm (t :: Type) acc [[nm] ~ acc] =>
-                                             [nm = sql_exp grouped tables [] t]
-                                                 ++ acc) [] selectedExps) }
+                     SelectExps : $(map (fn (t :: Type) => sql_exp grouped tables [] t) selectedExps) }
                  -> sql_query1 tables selectedFields selectedExps
 
 type sql_relop 
@@ -291,8 +280,7 @@
             -> fn [tables ~ exps] =>
                   state ::: Type
                   -> sql_query tables exps
-                  -> ($(exps ++ fold (fn nm (fields :: {Type}) acc [[nm] ~ acc] =>
-                                         [nm = $fields] ++ acc) [] tables)
+                  -> ($(exps ++ map (fn fields :: {Type} => $fields) tables)
                       -> state
                       -> transaction state)
                   -> state
@@ -306,17 +294,12 @@
 
 val insert : fields ::: {Type}
              -> sql_table fields
-             -> $(fold (fn nm (t :: Type) acc [[nm] ~ acc] =>
-                           [nm = sql_exp [] [] [] t] ++ acc)
-                           [] fields)
+             -> $(map (fn t :: Type => sql_exp [] [] [] t) fields)
              -> dml
 
 val update : unchanged ::: {Type} -> changed :: {Type} ->
              fn [changed ~ unchanged] =>
-                $(fold (fn nm (t :: Type) acc [[nm] ~ acc] =>
-                           [nm = sql_exp [T = changed ++ unchanged] [] [] t]
-                               ++ acc)
-                           [] changed)
+                $(map (fn t :: Type => sql_exp [T = changed ++ unchanged] [] [] t) changed)
                 -> sql_table (changed ++ unchanged)
                 -> sql_exp [T = changed ++ unchanged] [] [] bool
                 -> dml
--- a/lib/ur/top.ur	Sat Feb 21 14:10:06 2009 -0500
+++ b/lib/ur/top.ur	Sat Feb 21 15:33:20 2009 -0500
@@ -8,17 +8,7 @@
 con sndTTT (t :: (Type * Type * Type)) = t.2
 con thdTTT (t :: (Type * Type * Type)) = t.3
 
-con mapTT (f :: Type -> Type) = fold (fn nm t acc [[nm] ~ acc] =>
-                                         [nm = f t] ++ acc) []
-
-con mapUT = fn f :: Type => fold (fn nm t acc [[nm] ~ acc] =>
-                                     [nm = f] ++ acc) []
-
-con mapT2T (f :: (Type * Type) -> Type) = fold (fn nm t acc [[nm] ~ acc] =>
-                                                   [nm = f t] ++ acc) []
-
-con mapT3T (f :: (Type * Type * Type) -> Type) = fold (fn nm t acc [[nm] ~ acc] =>
-                                                          [nm = f t] ++ acc) []
+con mapUT = fn f :: Type => map (fn _ :: Unit => f)
 
 con ex = fn tf :: (Type -> Type) =>
             res ::: Type -> (choice :: Type -> tf choice -> res) -> res
@@ -69,7 +59,7 @@
                 -> fn [[nm] ~ rest] =>
                       tf t -> tr rest -> tr ([nm = t] ++ rest))
            (i : tr []) =
-    fold [fn r :: {Type} => $(mapTT tf r) -> tr r]
+    fold [fn r :: {Type} => $(map tf r) -> tr r]
              (fn (nm :: Name) (t :: Type) (rest :: {Type}) (acc : _ -> tr rest)
                               [[nm] ~ rest] r =>
                  f [nm] [t] [rest] r.nm (acc (r -- nm)))
@@ -80,7 +70,7 @@
                  -> fn [[nm] ~ rest] =>
                        tf t -> tr rest -> tr ([nm = t] ++ rest))
             (i : tr []) =
-    fold [fn r :: {(Type * Type)} => $(mapT2T tf r) -> tr r]
+    fold [fn r :: {(Type * Type)} => $(map tf r) -> tr r]
              (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)})
                               (acc : _ -> tr rest) [[nm] ~ rest] r =>
                  f [nm] [t] [rest] r.nm (acc (r -- nm)))
@@ -91,7 +81,7 @@
                  -> fn [[nm] ~ rest] =>
                        tf t -> tr rest -> tr ([nm = t] ++ rest))
             (i : tr []) =
-    fold [fn r :: {(Type * Type * Type)} => $(mapT3T tf r) -> tr r]
+    fold [fn r :: {(Type * Type * Type)} => $(map tf r) -> tr r]
              (fn (nm :: Name) (t :: (Type * Type * Type)) (rest :: {(Type * Type * Type)})
                               (acc : _ -> tr rest) [[nm] ~ rest] r =>
                  f [nm] [t] [rest] r.nm (acc (r -- nm)))
@@ -102,7 +92,7 @@
                  -> fn [[nm] ~ rest] =>
                        tf1 t -> tf2 t -> tr rest -> tr ([nm = t] ++ rest))
             (i : tr []) =
-    fold [fn r :: {Type} => $(mapTT tf1 r) -> $(mapTT tf2 r) -> tr r]
+    fold [fn r :: {Type} => $(map tf1 r) -> $(map tf2 r) -> tr r]
              (fn (nm :: Name) (t :: Type) (rest :: {Type})
                               (acc : _ -> _ -> tr rest) [[nm] ~ rest] r1 r2 =>
                  f [nm] [t] [rest] r1.nm r2.nm (acc (r1 -- nm) (r2 -- nm)))
@@ -114,7 +104,7 @@
                   -> fn [[nm] ~ rest] =>
                         tf1 t -> tf2 t -> tr rest -> tr ([nm = t] ++ rest))
              (i : tr []) =
-    fold [fn r :: {(Type * Type)} => $(mapT2T tf1 r) -> $(mapT2T tf2 r) -> tr r]
+    fold [fn r :: {(Type * Type)} => $(map tf1 r) -> $(map tf2 r) -> tr r]
              (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)})
                               (acc : _ -> _ -> tr rest) [[nm] ~ rest] r1 r2 =>
                  f [nm] [t] [rest] r1.nm r2.nm (acc (r1 -- nm) (r2 -- nm)))
@@ -126,7 +116,7 @@
                   -> fn [[nm] ~ rest] =>
                         tf1 t -> tf2 t -> tr rest -> tr ([nm = t] ++ rest))
              (i : tr []) =
-    fold [fn r :: {(Type * Type * Type)} => $(mapT3T tf1 r) -> $(mapT3T tf2 r) -> tr r]
+    fold [fn r :: {(Type * Type * Type)} => $(map tf1 r) -> $(map tf2 r) -> tr r]
              (fn (nm :: Name) (t :: (Type * Type * Type)) (rest :: {(Type * Type * Type)})
                               (acc : _ -> _ -> tr rest) [[nm] ~ rest] r1 r2 =>
                  f [nm] [t] [rest] r1.nm r2.nm (acc (r1 -- nm) (r2 -- nm)))
@@ -195,8 +185,7 @@
 
 fun queryX (tables ::: {{Type}}) (exps ::: {Type}) (ctx ::: {Unit})
            (q : sql_query tables exps) [tables ~ exps]
-           (f : $(exps ++ fold (fn nm (fields :: {Type}) acc [[nm] ~ acc] =>
-                                   [nm = $fields] ++ acc) [] tables)
+           (f : $(exps ++ map (fn fields :: {Type} => $fields) tables)
                 -> xml ctx [] []) =
     query q
           (fn fs acc => return <xml>{acc}{f fs}</xml>)
@@ -204,8 +193,7 @@
 
 fun queryX' (tables ::: {{Type}}) (exps ::: {Type}) (ctx ::: {Unit})
             (q : sql_query tables exps) [tables ~ exps]
-            (f : $(exps ++ fold (fn nm (fields :: {Type}) acc [[nm] ~ acc] =>
-                                    [nm = $fields] ++ acc) [] tables)
+            (f : $(exps ++ map (fn fields :: {Type} => $fields) tables)
                  -> transaction (xml ctx [] [])) =
     query q
           (fn fs acc =>
--- a/lib/ur/top.urs	Sat Feb 21 14:10:06 2009 -0500
+++ b/lib/ur/top.urs	Sat Feb 21 15:33:20 2009 -0500
@@ -8,17 +8,7 @@
 con sndTTT = fn t :: (Type * Type * Type) => t.2
 con thdTTT = fn t :: (Type * Type * Type) => t.3
 
-con mapTT = fn f :: Type -> Type => fold (fn nm t acc [[nm] ~ acc] =>
-                                             [nm = f t] ++ acc) []
-
-con mapUT = fn f :: Type => fold (fn nm t acc [[nm] ~ acc] =>
-                                     [nm = f] ++ acc) []
-
-con mapT2T = fn f :: (Type * Type) -> Type => fold (fn nm t acc [[nm] ~ acc] =>
-                                                       [nm = f t] ++ acc) []
-
-con mapT3T = fn f :: (Type * Type * Type) -> Type => fold (fn nm t acc [[nm] ~ acc] =>
-                                                              [nm = f t] ++ acc) []
+con mapUT = fn f :: Type => map (fn _ :: Unit => f)
 
 con ex = fn tf :: (Type -> Type) =>
             res ::: Type -> (choice :: Type -> tf choice -> res) -> res
@@ -53,19 +43,19 @@
              -> (nm :: Name -> t :: Type -> rest :: {Type}
                  -> fn [[nm] ~ rest] =>
                        tf t -> tr rest -> tr ([nm = t] ++ rest))
-             -> tr [] -> r :: {Type} -> $(mapTT tf r) -> tr r
+             -> tr [] -> r :: {Type} -> $(map tf r) -> tr r
 
 val foldT2R : tf :: ((Type * Type) -> Type) -> tr :: ({(Type * Type)} -> Type)
               -> (nm :: Name -> t :: (Type * Type) -> rest :: {(Type * Type)}
                   -> fn [[nm] ~ rest] =>
                         tf t -> tr rest -> tr ([nm = t] ++ rest))
-              -> tr [] -> r :: {(Type * Type)} -> $(mapT2T tf r) -> tr r
+              -> tr [] -> r :: {(Type * Type)} -> $(map tf r) -> tr r
 
 val foldT3R : tf :: ((Type * Type * Type) -> Type) -> tr :: ({(Type * Type * Type)} -> Type)
               -> (nm :: Name -> t :: (Type * Type * Type) -> rest :: {(Type * Type * Type)}
                   -> fn [[nm] ~ rest] =>
                         tf t -> tr rest -> tr ([nm = t] ++ rest))
-              -> tr [] -> r :: {(Type * Type * Type)} -> $(mapT3T tf r) -> tr r
+              -> tr [] -> r :: {(Type * Type * Type)} -> $(map tf r) -> tr r
 
 val foldTR2 : tf1 :: (Type -> Type) -> tf2 :: (Type -> Type)
               -> tr :: ({Type} -> Type)
@@ -73,7 +63,7 @@
                   -> fn [[nm] ~ rest] =>
                         tf1 t -> tf2 t -> tr rest -> tr ([nm = t] ++ rest))
               -> tr []
-              -> r :: {Type} -> $(mapTT tf1 r) -> $(mapTT tf2 r) -> tr r
+              -> r :: {Type} -> $(map tf1 r) -> $(map tf2 r) -> tr r
                                                                     
 val foldT2R2 : tf1 :: ((Type * Type) -> Type) -> tf2 :: ((Type * Type) -> Type)
                -> tr :: ({(Type * Type)} -> Type)
@@ -81,7 +71,7 @@
                    -> fn [[nm] ~ rest] =>
                          tf1 t -> tf2 t -> tr rest -> tr ([nm = t] ++ rest))
                -> tr [] -> r :: {(Type * Type)}
-               -> $(mapT2T tf1 r) -> $(mapT2T tf2 r) -> tr r
+               -> $(map tf1 r) -> $(map tf2 r) -> tr r
 
 val foldT3R2 : tf1 :: ((Type * Type * Type) -> Type) -> tf2 :: ((Type * Type * Type) -> Type)
                -> tr :: ({(Type * Type * Type)} -> Type)
@@ -89,32 +79,32 @@
                    -> fn [[nm] ~ rest] =>
                          tf1 t -> tf2 t -> tr rest -> tr ([nm = t] ++ rest))
                -> tr [] -> r :: {(Type * Type * Type)}
-               -> $(mapT3T tf1 r) -> $(mapT3T tf2 r) -> tr r
+               -> $(map tf1 r) -> $(map tf2 r) -> tr r
 
 val foldTRX : tf :: (Type -> Type) -> ctx :: {Unit}
               -> (nm :: Name -> t :: Type -> rest :: {Type}
                   -> fn [[nm] ~ rest] =>
                         tf t -> xml ctx [] [])
-              -> r :: {Type} -> $(mapTT tf r) -> xml ctx [] []
+              -> r :: {Type} -> $(map tf r) -> xml ctx [] []
 
 val foldT2RX : tf :: ((Type * Type) -> Type) -> ctx :: {Unit}
                -> (nm :: Name -> t :: (Type * Type) -> rest :: {(Type * Type)}
                    -> fn [[nm] ~ rest] =>
                          tf t -> xml ctx [] [])
-               -> r :: {(Type * Type)} -> $(mapT2T tf r) -> xml ctx [] []
+               -> r :: {(Type * Type)} -> $(map tf r) -> xml ctx [] []
 
 val foldT3RX : tf :: ((Type * Type * Type) -> Type) -> ctx :: {Unit}
                -> (nm :: Name -> t :: (Type * Type * Type) -> rest :: {(Type * Type * Type)}
                    -> fn [[nm] ~ rest] =>
                          tf t -> xml ctx [] [])
-               -> r :: {(Type * Type * Type)} -> $(mapT3T tf r) -> xml ctx [] []
+               -> r :: {(Type * Type * Type)} -> $(map tf r) -> xml ctx [] []
 
 val foldTRX2 : tf1 :: (Type -> Type) -> tf2 :: (Type -> Type) -> ctx :: {Unit}
                -> (nm :: Name -> t :: Type -> rest :: {Type}
                    -> fn [[nm] ~ rest] =>
                          tf1 t -> tf2 t -> xml ctx [] [])
                -> r :: {Type}
-               -> $(mapTT tf1 r) -> $(mapTT tf2 r) -> xml ctx [] []
+               -> $(map tf1 r) -> $(map tf2 r) -> xml ctx [] []
 
 val foldT2RX2 : tf1 :: ((Type * Type) -> Type) -> tf2 :: ((Type * Type) -> Type)
                 -> ctx :: {Unit}
@@ -122,7 +112,7 @@
                     -> fn [[nm] ~ rest] =>
                           tf1 t -> tf2 t -> xml ctx [] [])
                 -> r :: {(Type * Type)}
-                -> $(mapT2T tf1 r) -> $(mapT2T tf2 r) -> xml ctx [] []
+                -> $(map tf1 r) -> $(map tf2 r) -> xml ctx [] []
 
 
 val foldT3RX2 : tf1 :: ((Type * Type * Type) -> Type) -> tf2 :: ((Type * Type * Type) -> Type)
@@ -131,21 +121,19 @@
                     -> fn [[nm] ~ rest] =>
                           tf1 t -> tf2 t -> xml ctx [] [])
                 -> r :: {(Type * Type * Type)}
-                -> $(mapT3T tf1 r) -> $(mapT3T tf2 r) -> xml ctx [] []
+                -> $(map tf1 r) -> $(map tf2 r) -> xml ctx [] []
 
 val queryX : tables ::: {{Type}} -> exps ::: {Type} -> ctx ::: {Unit}
              -> sql_query tables exps
              -> fn [tables ~ exps] =>
-                   ($(exps ++ fold (fn nm (fields :: {Type}) acc [[nm] ~ acc] =>
-                                       [nm = $fields] ++ acc) [] tables)
+                   ($(exps ++ map (fn fields :: {Type} => $fields) tables)
                     -> xml ctx [] [])
                    -> transaction (xml ctx [] [])
 
 val queryX' : tables ::: {{Type}} -> exps ::: {Type} -> ctx ::: {Unit}
               -> sql_query tables exps
               -> fn [tables ~ exps] =>
-                    ($(exps ++ fold (fn nm (fields :: {Type}) acc [[nm] ~ acc] =>
-                                        [nm = $fields] ++ acc) [] tables)
+                    ($(exps ++ map (fn fields :: {Type} => $fields) tables)
                      -> transaction (xml ctx [] []))
                     -> transaction (xml ctx [] [])
                        
@@ -155,20 +143,14 @@
                         transaction
                             (option
                                  $(exps
-                                       ++ fold (fn nm (fields :: {Type}) acc
-                                                      [[nm] ~ acc] =>
-                                                   [nm = $fields] ++ acc)
-                                                   [] tables))
+                                       ++ map (fn fields :: {Type} => $fields) tables))
 
 val oneRow : tables ::: {{Type}} -> exps ::: {Type}
              -> sql_query tables exps
              -> fn [tables ~ exps] =>
                    transaction
                        $(exps
-                             ++ fold (fn nm (fields :: {Type}) acc
-                                            [[nm] ~ acc] =>
-                                         [nm = $fields] ++ acc)
-                                         [] tables)
+                             ++ map (fn fields :: {Type} => $fields) tables)
 
 val eqNullable : tables ::: {{Type}} -> agg ::: {{Type}} -> exps ::: {Type}
                  -> t ::: Type -> sql_injectable (option t)
--- a/src/core.sml	Sat Feb 21 14:10:06 2009 -0500
+++ b/src/core.sml	Sat Feb 21 15:33:20 2009 -0500
@@ -54,7 +54,7 @@
 
        | CRecord of kind * (con * con) list
        | CConcat of con * con
-       | CFold of kind * kind
+       | CMap of kind * kind
 
        | CUnit
 
--- a/src/core_print.sml	Sat Feb 21 14:10:06 2009 -0500
+++ b/src/core_print.sml	Sat Feb 21 15:33:20 2009 -0500
@@ -138,7 +138,7 @@
                                               string "++",
                                               space,
                                               p_con env c2])
-      | CFold _ => string "fold"
+      | CMap _ => string "map"
       | CUnit => string "()"
 
       | CTuple cs => box [string "(",
--- a/src/core_util.sml	Sat Feb 21 14:10:06 2009 -0500
+++ b/src/core_util.sml	Sat Feb 21 15:33:20 2009 -0500
@@ -178,11 +178,11 @@
       | (CConcat _, _) => LESS
       | (_, CConcat _) => GREATER
 
-      | (CFold (d1, r1), CFold (d2, r2)) =>
+      | (CMap (d1, r1), CMap (d2, r2)) =>
         join (Kind.compare (d1, r2),
               fn () => Kind.compare (r1, r2))
-      | (CFold _, _) => LESS
-      | (_, CFold _) => GREATER
+      | (CMap _, _) => LESS
+      | (_, CMap _) => GREATER
 
       | (CUnit, CUnit) => EQUAL
       | (CUnit, _) => LESS
@@ -261,12 +261,12 @@
                          S.map2 (mfc ctx c2,
                               fn c2' =>
                                  (CConcat (c1', c2'), loc)))
-              | CFold (k1, k2) =>
+              | CMap (k1, k2) =>
                 S.bind2 (mfk k1,
                          fn k1' =>
                             S.map2 (mfk k2,
                                     fn k2' =>
-                                       (CFold (k1', k2'), loc)))
+                                       (CMap (k1', k2'), loc)))
 
               | CUnit => S.return2 cAll
 
--- a/src/corify.sml	Sat Feb 21 14:10:06 2009 -0500
+++ b/src/corify.sml	Sat Feb 21 15:33:20 2009 -0500
@@ -473,7 +473,7 @@
       | L.CRecord (k, xcs) =>
         (L'.CRecord (corifyKind k, map (fn (c1, c2) => (corifyCon st c1, corifyCon st c2)) xcs), loc)
       | L.CConcat (c1, c2) => (L'.CConcat (corifyCon st c1, corifyCon st c2), loc)
-      | L.CFold (k1, k2) => (L'.CFold (corifyKind k1, corifyKind k2), loc)
+      | L.CMap (k1, k2) => (L'.CMap (corifyKind k1, corifyKind k2), loc)
       | L.CUnit => (L'.CUnit, loc)
 
       | L.CTuple cs => (L'.CTuple (map (corifyCon st) cs), loc)
--- a/src/disjoint.sml	Sat Feb 21 14:10:06 2009 -0500
+++ b/src/disjoint.sml	Sat Feb 21 15:33:20 2009 -0500
@@ -213,37 +213,8 @@
                                                 ("c'", ElabPrint.p_con env (#1 (hnormCon (env, denv) c)))];*)
                 case #1 (#1 (hnormCon (env, denv) c)) of
                     CApp (
-                    (CApp (
-                     (CApp ((CFold (dom, ran), _), f), _),
-                     i), _),
-                    r) =>
-                    let
-                        val (env', nm) = E.pushCNamed env "nm" (KName, loc) NONE
-                        val (env', v) = E.pushCNamed env' "v" dom NONE
-                        val (env', st) = E.pushCNamed env' "st" ran NONE
-
-                        val (denv', gs') = assert env' denv ((CRecord (dom, [((CNamed nm, loc),
-                                                                              (CUnit, loc))]), loc),
-                                                             (CNamed st, loc))
-
-                        val c' = (CApp (f, (CNamed nm, loc)), loc)
-                        val c' = (CApp (c', (CNamed v, loc)), loc)
-                        val c' = (CApp (c', (CNamed st, loc)), loc)
-                        val (ps, gs'') = decomposeRow (env', denv') c'
-
-                        fun covered p =
-                            case p of
-                                Unknown _ => false
-                              | Piece p =>
-                                case p of
-                                    (NameN n, []) => n = nm
-                                  | (RowN n, []) => n = st
-                                  | _ => false
-
-                        val ps = List.filter (not o covered) ps
-                    in
-                        decomposeRow' (i, decomposeRow' (r, (ps @ acc, gs'' @ gs' @ gs)))
-                    end
+                    (CApp ((CMap _, _), _), _),
+                    r) => decomposeRow' (r, (acc, gs))
                   | _ => default ()
             end
     in
--- a/src/elab.sml	Sat Feb 21 14:10:06 2009 -0500
+++ b/src/elab.sml	Sat Feb 21 15:33:20 2009 -0500
@@ -66,7 +66,7 @@
 
        | CRecord of kind * (con * con) list
        | CConcat of con * con
-       | CFold of kind * kind
+       | CMap of kind * kind
 
        | CUnit
 
--- a/src/elab_ops.sml	Sat Feb 21 14:10:06 2009 -0500
+++ b/src/elab_ops.sml	Sat Feb 21 15:33:20 2009 -0500
@@ -114,181 +114,98 @@
                                           ("sc", ElabPrint.p_con env sc)];*)
                  sc
              end
-           | c1' as CApp (c', i) =>
+           | c1' as CApp (c', f) =>
              let
                  fun default () = (CApp ((c1', loc), hnormCon env c2), loc)
              in
                  case #1 (hnormCon env c') of
-                     CApp (c', f) =>
-                     (case #1 (hnormCon env c') of
-                          CFold ks =>
-                          (case #1 (hnormCon env c2) of
-                               CRecord (_, []) => hnormCon env i
-                             | CRecord (k, (x, c) :: rest) =>
-                               hnormCon env
-                                        (CApp ((CApp ((CApp (f, x), loc), c), loc),
-                                               (CApp ((CApp ((CApp ((CFold ks, loc), f), loc), i), loc),
-                                                      (CRecord (k, rest), loc)), loc)), loc)
-                             | CConcat ((CRecord (k, (x, c) :: rest), _), rest') =>
-                               let
-                                   val rest'' = (CConcat ((CRecord (k, rest), loc), rest'), loc)
+                     CMap (ks as (k1, k2)) =>
+                     (case #1 (hnormCon env c2) of
+                          CRecord (_, []) => (CRecord (k2, []), loc)
+                        | CRecord (_, (x, c) :: rest) =>
+                          hnormCon env
+                                   (CConcat ((CRecord (k2, [(x, (CApp (f, c), loc))]), loc),
+                                             (CApp (c1, (CRecord (k2, rest), loc)), loc)), loc)
+                        | CConcat ((CRecord (k, (x, c) :: rest), _), rest') =>
+                          let
+                              val rest'' = (CConcat ((CRecord (k, rest), loc), rest'), loc)
+                          in
+                              hnormCon env
+                                       (CConcat ((CRecord (k2, [(x, (CApp (f, c), loc))]), loc),
+                                                 (CApp (c1, rest''), loc)), loc)
+                          end
+                        | _ =>
+                          let
+                              fun unconstraint c =
+                                  case hnormCon env c of
+                                      (CDisjoint (_, _, _, c), _) => unconstraint c
+                                    | c => c
 
-                               (*val ccc = (CApp ((CApp ((CApp (f, x), loc), c), loc),
-                                                  (CApp ((CApp ((CApp ((CFold ks, loc), f), loc), i), loc),
-                                                         rest''), loc)), loc)*)
-                               in
-                                   (*eprefaces "Red to" [("ccc", p_con env ccc), ("ccc'", p_con env (hnormCon env ccc))];*)
-                                   hnormCon env
-                                            (CApp ((CApp ((CApp (f, x), loc), c), loc),
-                                                   (CApp ((CApp ((CApp ((CFold ks, loc), f), loc), i), loc),
-                                                          rest''), loc)), loc)
-                               end
-                             | _ =>
-                               let
-                                   fun cunif () =
-                                       let
-                                           val r = ref NONE
-                                       in
-                                           (r, (CUnif (loc, (KType, loc), "_", r), loc))
-                                       end
+                              fun tryDistributivity () =
+                                  case hnormCon env c2 of
+                                      (CConcat (c1, c2'), _) =>
+                                      let
+                                          val c = (CMap ks, loc)
+                                          val c = (CApp (c, f), loc)
+                                                  
+                                          val c1 = (CApp (c, c1), loc)
+                                          val c2 = (CApp (c, c2'), loc)
+                                          val c = (CConcat (c1, c2), loc)
+                                      in
+                                          hnormCon env c
+                                      end
+                                    | _ => default ()
 
-                                   val (nmR, nm) = cunif ()
-                                   val (vR, v) = cunif ()
-                                   val (rR, r) = cunif ()
+                              fun tryFusion () =
+                                  case #1 (hnormCon env c2) of
+                                      CApp (f', r') =>
+                                      (case #1 (hnormCon env f') of
+                                           CApp (f', inner_f) =>
+                                           (case #1 (hnormCon env f') of
+                                                CMap (dom, _) =>
+                                                let
+                                                    val f' = (CApp (inner_f, (CRel 0, loc)), loc)
+                                                    val f' = (CApp (f, f'), loc)
+                                                    val f' = (CAbs ("v", dom, f'), loc)
 
-                                   val c = f
-                                   val c = (CApp (c, nm), loc)
-                                   val c = (CApp (c, v), loc)
-                                   val c = (CApp (c, r), loc)
-                                   fun unconstraint c =
-                                       case hnormCon env c of
-                                           (CDisjoint (_, _, _, c), _) => unconstraint c
-                                         | c => c
-                                   val c = unconstraint c
+                                                    val c = (CMap (dom, k2), loc)
+                                                    val c = (CApp (c, f'), loc)
+                                                    val c = (CApp (c, r'), loc)
+                                                in
+                                                    hnormCon env c
+                                                end
+                                              | _ => tryDistributivity ())
+                                         | _ => tryDistributivity ())
+                                    | _ => tryDistributivity ()
 
-                                   fun tryDistributivity () =
-                                       let
-                                           fun distribute (c1, c2) =
-                                               let
-                                                   val c = (CFold ks, loc)
-                                                   val c = (CApp (c, f), loc)
-                                                   val c = (CApp (c, i), loc)
+                              fun tryIdentity () =
+                                  let
+                                      fun cunif () =
+                                          let
+                                              val r = ref NONE
+                                          in
+                                              (r, (CUnif (loc, (KType, loc), "_", r), loc))
+                                          end
+                                          
+                                      val (vR, v) = cunif ()
 
-                                                   val c1 = (CApp (c, c1), loc)
-                                                   val c2 = (CApp (c, c2), loc)
-                                                   val c = (CConcat (c1, c2), loc)
-                                               in
-                                                   hnormCon env c
-                                               end
-                                       in
-                                           case (hnormCon env i, hnormCon env c2, hnormCon env c) of
-                                               ((CRecord (_, []), _),
-                                                (CConcat (arg1, arg2), _),
-                                                (CConcat (c1, c2'), _)) =>
-                                               (case (hnormCon env c1, hnormCon env c2') of
-                                                    ((CRecord (_, [(nm', v')]), _),
-                                                     (CUnif (_, _, _, rR'), _)) =>
-                                                    (case hnormCon env nm' of
-                                                         (CUnif (_, _, _, nmR'), _) =>
-                                                         if nmR' = nmR andalso rR' = rR then
-                                                             distribute (arg1, arg2)
-                                                         else
-                                                             default ()
-                                                       | _ => default ())
-                                                  | _ => default ())
-                                             | _ => default ()
-                                       end
-
-                                   fun tryFusion () =
-                                       let
-                                           fun fuse (dom, new_v, r') =
-                                               let
-                                                   val ran = #2 ks
-
-                                                   val f = (CApp (f, (CRel 2, loc)), loc)
-                                                   val f = (CApp (f, new_v), loc)
-                                                   val f = (CApp (f, (CRel 0, loc)), loc)
-                                                   val f = (CAbs ("acc", ran, f), loc)
-                                                   val f = (CAbs ("v", dom, f), loc)
-                                                   val f = (CAbs ("nm", (KName, loc), f), loc)
-
-                                                   val c = (CFold (dom, ran), loc)
-                                                   val c = (CApp (c, f), loc)
-                                                   val c = (CApp (c, i), loc)
-                                                   val c = (CApp (c, r'), loc)
-                                               in
-                                                   hnormCon env c
-                                               end
-                                       in
-                                           case #1 (hnormCon env c2) of
-                                               CApp (f, r') =>
-                                               (case #1 (hnormCon env f) of
-                                                    CApp (f, inner_i) =>
-                                                    (case (#1 (hnormCon env f), #1 (hnormCon env inner_i)) of
-                                                         (CApp (f, inner_f), CRecord (_, [])) =>
-                                                         (case #1 (hnormCon env f) of
-                                                              CFold (dom, _) =>
-                                                              let
-                                                                  val c = inner_f
-                                                                  val c = (CApp (c, nm), loc)
-                                                                  val c = (CApp (c, v), loc)
-                                                                  val c = (CApp (c, r), loc)
-                                                                  val c = unconstraint c
-
-                                                                  (*val () = Print.prefaces "Onto something!"
-                                                                           [("c", ElabPrint.p_con env cAll),
-                                                                            ("c'", ElabPrint.p_con env c)]*)
-
-                                                              in
-                                                                  case #1 (hnormCon env c) of
-                                                                      CConcat (first, rest) =>
-                                                                      (case (#1 (hnormCon env first),
-                                                                             #1 (hnormCon env rest)) of
-                                                                           (CRecord (_, [(nm', v')]),
-                                                                            CUnif (_, _, _, rR')) =>
-                                                                           (case #1 (hnormCon env nm') of
-                                                                                CUnif (_, _, _, nmR') =>
-                                                                                if rR' = rR andalso nmR' = nmR then
-                                                                                    (nmR := SOME (CRel 2, loc);
-                                                                                     vR := SOME (CRel 1, loc);
-                                                                                     rR := SOME (CError, loc);
-                                                                                     fuse (dom, v', r'))
-                                                                                else
-                                                                                    tryDistributivity ()
-                                                                              | _ => tryDistributivity ())
-                                                                         | _ => tryDistributivity ())
-                                                                    | _ => tryDistributivity ()
-                                                              end
-                                                            | _ => tryDistributivity ())
-                                                       | _ => tryDistributivity ())
-                                                  | _ => tryDistributivity ())
-                                             | _ => tryDistributivity ()
-                                       end
-
-                               in
-                                   (*Print.prefaces "Consider" [("c", ElabPrint.p_con env c)];*)
-                                   case (hnormCon env i, unconstraint c) of
-                                       ((CRecord (_, []), _),
-                                        (CConcat (c1, c2'), _)) =>
-                                       (case (hnormCon env c1, hnormCon env c2') of
-                                            ((CRecord (_, [(nm', v')]), _),
-                                             (CUnif (_, _, _, rR'), _)) =>
-                                            (case (hnormCon env nm', hnormCon env v') of
-                                                 ((CUnif (_, _, _, nmR'), _),
-                                                  (CUnif (_, _, _, vR'), _)) =>
-                                                 if nmR' = nmR andalso vR' = vR andalso rR' = rR then
-                                                     hnormCon env c2
-                                                 else
-                                                     tryFusion ()
-                                               | _ => tryFusion ())
-                                          | _ => tryFusion ())
-                                     | _ => tryFusion ()
-                               end)
-                        | _ => default ())
+                                      val c = (CApp (f, v), loc)
+                                  in
+                                      case unconstraint c of
+                                          (CUnif (_, _, _, vR'), _) =>
+                                          if vR' = vR then
+                                              hnormCon env c2
+                                          else
+                                              tryFusion ()
+                                        | _ => tryFusion ()
+                                  end
+                          in
+                              tryIdentity ()
+                          end)
                    | _ => default ()
              end
            | c1' => (CApp ((c1', loc), hnormCon env c2), loc))
-
+        
       | CConcat (c1, c2) =>
         (case (hnormCon env c1, hnormCon env c2) of
              ((CRecord (k, xcs1), loc), (CRecord (_, xcs2), _)) =>
--- a/src/elab_print.sml	Sat Feb 21 14:10:06 2009 -0500
+++ b/src/elab_print.sml	Sat Feb 21 15:33:20 2009 -0500
@@ -167,7 +167,7 @@
                                               string "++",
                                               space,
                                               p_con env c2])
-      | CFold _ => string "fold"
+      | CMap _ => string "map"
 
       | CUnit => string "()"
 
--- a/src/elab_util.sml	Sat Feb 21 14:10:06 2009 -0500
+++ b/src/elab_util.sml	Sat Feb 21 15:33:20 2009 -0500
@@ -168,12 +168,12 @@
                          S.map2 (mfc ctx c2,
                               fn c2' =>
                                  (CConcat (c1', c2'), loc)))
-              | CFold (k1, k2) =>
+              | CMap (k1, k2) =>
                 S.bind2 (mfk k1,
                          fn k1' =>
                             S.map2 (mfk k2,
                                     fn k2' =>
-                                       (CFold (k1', k2'), loc)))
+                                       (CMap (k1', k2'), loc)))
 
               | CUnit => S.return2 cAll
 
--- a/src/elaborate.sml	Sat Feb 21 14:10:06 2009 -0500
+++ b/src/elaborate.sml	Sat Feb 21 15:33:20 2009 -0500
@@ -182,13 +182,10 @@
        | L.KTuple ks => (L'.KTuple (map elabKind ks), loc)
        | L.KWild => kunif loc
 
- fun foldKind (dom, ran, loc)=
-     (L'.KArrow ((L'.KArrow ((L'.KName, loc),
-                             (L'.KArrow (dom,
-                                         (L'.KArrow (ran, ran), loc)), loc)), loc),
-                 (L'.KArrow (ran,
-                             (L'.KArrow ((L'.KRecord dom, loc),
-                                         ran), loc)), loc)), loc)
+ fun mapKind (dom, ran, loc)=
+     (L'.KArrow ((L'.KArrow (dom, ran), loc),
+                 (L'.KArrow ((L'.KRecord dom, loc),
+                             (L'.KRecord ran, loc)), loc)), loc)
 
  fun hnormKind (kAll as (k, _)) =
      case k of
@@ -355,13 +352,13 @@
              ((L'.CConcat (c1', c2'), loc), k,
               D.prove env denv (c1', c2', loc) @ gs1 @ gs2)
          end
-       | L.CFold =>
+       | L.CMap =>
          let
              val dom = kunif loc
              val ran = kunif loc
          in
-             ((L'.CFold (dom, ran), loc),
-              foldKind (dom, ran, loc),
+             ((L'.CMap (dom, ran), loc),
+              mapKind (dom, ran, loc),
               [])
          end
 
@@ -489,7 +486,7 @@
 
        | L'.CRecord (k, _) => (L'.KRecord k, loc)
        | L'.CConcat (c, _) => kindof env c
-       | L'.CFold (dom, ran) => foldKind (dom, ran, loc)
+       | L'.CMap (dom, ran) => mapKind (dom, ran, loc)
 
        | L'.CUnit => (L'.KUnit, loc)
 
@@ -504,41 +501,21 @@
 
  val hnormCon = D.hnormCon
 
- datatype con_summary =
-          Nil
-        | Cons
-        | Unknown
-
- fun compatible cs =
-     case cs of
-         (Unknown, _) => false
-       | (_, Unknown) => false
-       | (s1, s2) => s1 = s2
-
- fun summarizeCon (env, denv) c =
+ fun deConstraintCon (env, denv) c =
      let
          val (c, gs) = hnormCon (env, denv) c
      in
          case #1 c of
-             L'.CRecord (_, []) => (Nil, gs)
-           | L'.CRecord (_, _ :: _) => (Cons, gs)
-           | L'.CConcat ((L'.CRecord (_, _ :: _), _), _) => (Cons, gs)
-           | L'.CDisjoint (_, _, _, c) =>
+             L'.CDisjoint (_, _, _, c) =>
              let
-                 val (s, gs') = summarizeCon (env, denv) c
+                 val (c', gs') = deConstraintCon (env, denv) c
              in
-                 (s, gs @ gs')
+                 (c', gs @ gs')
              end
-           | _ => (Unknown, gs)
+           | _ => (c, gs)
      end
 
- fun p_con_summary s =
-     Print.PD.string (case s of
-                          Nil => "Nil"
-                        | Cons => "Cons"
-                        | Unknown => "Unknown")
-
- exception SummaryFailure
+ exception GuessFailure
 
  fun isUnitCon env (c, loc) =
      case c of
@@ -574,7 +551,7 @@
 
        | L'.CRecord _ => false
        | L'.CConcat _ => false
-       | L'.CFold _ => false
+       | L'.CMap _ => false
 
        | L'.CUnit => true
 
@@ -720,14 +697,14 @@
 
          fun isGuessable (other, fs) =
              let
-                 val gs = guessFold (env, denv) (other, (L'.CRecord (k, fs), loc), [], SummaryFailure)
+                 val gs = guessMap (env, denv) (other, (L'.CRecord (k, fs), loc), [], GuessFailure)
              in
                  List.all (fn (loc, env, denv, c1, c2) =>
                               case D.prove env denv (c1, c2, loc) of
                                   [] => true
                                 | _ => false) gs
              end
-             handle SummaryFailure => false
+             handle GuessFailure => false
 
          val (fs1, fs2, others1, others2) =
              case (fs1, fs2, others1, others2) of
@@ -783,79 +760,68 @@
                                        ("#2", p_summary env s2)]*)
      end
 
- and guessFold (env, denv) (c1, c2, gs, ex) =
+ and guessMap (env, denv) (c1, c2, gs, ex) =
      let
          val loc = #2 c1
 
-         fun unfold (dom, ran, f, i, r, c) =
+         fun unfold (dom, ran, f, r, c) =
              let
-                 val nm = cunif (loc, (L'.KName, loc))
-                 val v =
-                     case dom of
-                         (L'.KUnit, _) => (L'.CUnit, loc)
-                       | _ => cunif (loc, dom)
-                 val rest = cunif (loc, (L'.KRecord dom, loc))
-                 val acc = (L'.CFold (dom, ran), loc)
-                 val acc = (L'.CApp (acc, f), loc)
-                 val acc = (L'.CApp (acc, i), loc)
-                 val acc = (L'.CApp (acc, rest), loc)
-
-                 val (iS, gs3) = summarizeCon (env, denv) i
-
-                 val app = (L'.CApp (f, nm), loc)
-                 val app = (L'.CApp (app, v), loc)
-                 val app = (L'.CApp (app, acc), loc)
-                 val (appS, gs4) = summarizeCon (env, denv) app
-
-                 val (cS, gs5) = summarizeCon (env, denv) c
+                 fun unfold (r, c) =
+                     let
+                         val (c', gs1) = deConstraintCon (env, denv) c
+                     in
+                         case #1 c' of
+                             L'.CRecord (_, []) =>
+                             let
+                                 val gs2 = unifyCons (env, denv) r (L'.CRecord (dom, []), loc)
+                             in
+                                 gs1 @ gs2
+                             end
+                           | L'.CRecord (_, [(x, v)]) =>
+                             let
+                                 val v' = case dom of
+                                              (L'.KUnit, _) => (L'.CUnit, loc)
+                                            | _ => cunif (loc, dom)
+                                 val gs2 = unifyCons (env, denv) v' (L'.CApp (f, v), loc)
+
+                                 val gs3 = unifyCons (env, denv) r (L'.CRecord (dom, [(x, v')]), loc)
+                             in
+                                 gs1 @ gs2 @ gs3
+                             end
+                           | L'.CRecord (_, (x, v) :: rest) =>
+                             let
+                                 val r1 = cunif (loc, (L'.KRecord dom, loc))
+                                 val r2 = cunif (loc, (L'.KRecord dom, loc))
+                                 val gs2 = unifyCons (env, denv) r (L'.CConcat (r1, r2), loc)
+
+                                 val gs3 = unfold (r1, (L'.CRecord (ran, [(x, v)]), loc))
+                                 val gs4 = unfold (r2, (L'.CRecord (ran, rest), loc))
+                             in
+                                 gs1 @ gs2 @ gs3 @ gs4
+                             end
+                           | L'.CConcat (c1', c2') =>
+                             let
+                                 val r1 = cunif (loc, (L'.KRecord dom, loc))
+                                 val r2 = cunif (loc, (L'.KRecord dom, loc))
+                                 val gs2 = unifyCons (env, denv) r (L'.CConcat (r1, r2), loc)
+
+                                 val gs3 = unfold (r1, c1')
+                                 val gs4 = unfold (r2, c2')
+                             in
+                                 gs1 @ gs2 @ gs3 @ gs4
+                             end
+                           | _ => raise ex
+                     end
              in
-                 (*prefaces "Summaries" [("iS", p_con_summary iS),
-                                         ("appS", p_con_summary appS),
-                                         ("cS", p_con_summary cS)];*)
-
-                 if compatible (iS, appS) then
-                     raise ex
-                 else if compatible (cS, iS) then
-                     let
-                         (*val () = prefaces "Same?" [("i", p_con env i),
-                                                    ("c", p_con env c)]*)
-                         val gs6 = unifyCons (env, denv) i c
-                         (*val () = TextIO.print "Yes!\n"*)
-
-                         val gs7 = unifyCons (env, denv) r (L'.CRecord (dom, []), loc)
-                     in
-                         gs @ gs3 @ gs5 @ gs6 @ gs7
-                     end
-                 else if compatible (cS, appS) then
-                     let
-                         (*val () = prefaces "Same?" [("app", p_con env app),
-                                                      ("c", p_con env c),
-                                                      ("app'", p_con env (#1 (hnormCon (env, denv) app)))]*)
-                         val gs6 = unifyCons (env, denv) app c
-                         (*val () = TextIO.print "Yes!\n"*)
-
-                         val singleton = (L'.CRecord (dom, [(nm, v)]), loc)
-                         val concat = (L'.CConcat (singleton, rest), loc)
-                         (*val () = prefaces "Pre-crew" [("r", p_con env r),
-                                                         ("concat", p_con env concat)]*)
-                         val gs7 = unifyCons (env, denv) r concat
-                     in
-                         (*prefaces "The crew" [("nm", p_con env nm),
-                                                ("v", p_con env v),
-                                                ("rest", p_con env rest)];*)
-
-                         gs @ gs3 @ gs4 @ gs5 @ gs6 @ gs7
-                     end
-                 else
-                     raise ex
+                 unfold (r, c)
              end
              handle _ => raise ex
      in
          case (#1 c1, #1 c2) of
-             (L'.CApp ((L'.CApp ((L'.CApp ((L'.CFold (dom, ran), _), f), _), i), _), r), _) =>
-             unfold (dom, ran, f, i, r, c2)
-           | (_, L'.CApp ((L'.CApp ((L'.CApp ((L'.CFold (dom, ran), _), f), _), i), _), r)) =>
-             unfold (dom, ran, f, i, r, c1)
+             (L'.CApp ((L'.CApp ((L'.CMap (dom, ran), _), f), _), r), _) =>
+             unfold (dom, ran, f, r, c2)
+           | (_, L'.CApp ((L'.CApp ((L'.CMap (dom, ran), _), f), _), r)) =>
+             unfold (dom, ran, f, r, c1)
            | _ => raise ex
      end
 
@@ -890,7 +856,7 @@
                                                                                  (Time.- (Time.now (), befor)))))];*)
                      gs1 @ gs2 @ gs3
                  end
-                 handle ex => guessFold (env, denv) (c1, c2, gs1 @ gs2, ex)
+                 handle ex => guessMap (env, denv) (c1, c2, gs1 @ gs2, ex)
              end
 
  and unifyCons'' (env, denv) (c1All as (c1, loc)) (c2All as (c2, _)) =
@@ -1017,7 +983,7 @@
                  (r := SOME c1All;
                   [])
 
-           | (L'.CFold (dom1, ran1), L'.CFold (dom2, ran2)) =>
+           | (L'.CMap (dom1, ran1), L'.CMap (dom2, ran2)) =>
              (unifyKinds dom1 dom2;
               unifyKinds ran1 ran2;
               [])
@@ -2740,7 +2706,7 @@
 
               | CRecord xcs => List.all (fn (c1, c2) => none c1 andalso none c2) xcs
               | CConcat (c1, c2) => none c1 andalso none c2
-              | CFold => true
+              | CMap => true
 
               | CUnit => true
 
@@ -2766,7 +2732,7 @@
 
               | CRecord xcs => List.all (fn (c1, c2) => none c1 andalso pos c2) xcs
               | CConcat (c1, c2) => pos c1 andalso pos c2
-              | CFold => true
+              | CMap => true
 
               | CUnit => true
 
--- a/src/elisp/urweb-defs.el	Sat Feb 21 14:10:06 2009 -0500
+++ b/src/elisp/urweb-defs.el	Sat Feb 21 15:33:20 2009 -0500
@@ -107,7 +107,7 @@
                  "if" "then" "else" "case" "of" "fn" "fun" "val" "and"
                  "datatype" "type" "open" "include"
                  urweb-module-head-syms
-                 "con" "fold" "where" "extern" "constraint" "constraints"
+                 "con" "map" "where" "extern" "constraint" "constraints"
                  "table" "sequence" "class" "cookie")
   "Symbols starting an sexp.")
 
@@ -192,7 +192,7 @@
   "The starters of new expressions.")
 
 (defconst urweb-exptrail-syms
-  '("if" "then" "else" "case" "of" "fn" "with" "fold"))
+  '("if" "then" "else" "case" "of" "fn" "with" "map"))
 
 (defconst urweb-pipeheads
    '("|" "of" "fun" "fn" "and" "datatype")
--- a/src/elisp/urweb-mode.el	Sat Feb 21 14:10:06 2009 -0500
+++ b/src/elisp/urweb-mode.el	Sat Feb 21 15:33:20 2009 -0500
@@ -133,7 +133,7 @@
 
 (defconst urweb-keywords-regexp
   (urweb-syms-re "and" "case" "class" "con" "constraint" "constraints"
-	       "datatype" "else" "end" "extern" "fn" "fold"
+	       "datatype" "else" "end" "extern" "fn" "map"
 	       "fun" "functor" "if" "include"
 	       "of" "open" "let" "in"
 	       "rec" "sequence" "sig" "signature" "cookie"
--- a/src/expl.sml	Sat Feb 21 14:10:06 2009 -0500
+++ b/src/expl.sml	Sat Feb 21 15:33:20 2009 -0500
@@ -54,7 +54,7 @@
 
        | CRecord of kind * (con * con) list
        | CConcat of con * con
-       | CFold of kind * kind
+       | CMap of kind * kind
 
        | CUnit
 
--- a/src/expl_print.sml	Sat Feb 21 14:10:06 2009 -0500
+++ b/src/expl_print.sml	Sat Feb 21 15:33:20 2009 -0500
@@ -149,7 +149,7 @@
                                               string "++",
                                               space,
                                               p_con env c2])
-      | CFold _ => string "fold"
+      | CMap _ => string "map"
       | CUnit => string "()"
 
       | CTuple cs => box [string "(",
--- a/src/expl_util.sml	Sat Feb 21 14:10:06 2009 -0500
+++ b/src/expl_util.sml	Sat Feb 21 15:33:20 2009 -0500
@@ -145,12 +145,12 @@
                          S.map2 (mfc ctx c2,
                               fn c2' =>
                                  (CConcat (c1', c2'), loc)))
-              | CFold (k1, k2) =>
+              | CMap (k1, k2) =>
                 S.bind2 (mfk k1,
                          fn k1' =>
                             S.map2 (mfk k2,
                                     fn k2' =>
-                                       (CFold (k1', k2'), loc)))
+                                       (CMap (k1', k2'), loc)))
 
               | CUnit => S.return2 cAll
 
--- a/src/explify.sml	Sat Feb 21 14:10:06 2009 -0500
+++ b/src/explify.sml	Sat Feb 21 15:33:20 2009 -0500
@@ -63,7 +63,7 @@
 
       | L.CRecord (k, xcs) => (L'.CRecord (explifyKind k, map (fn (c1, c2) => (explifyCon c1, explifyCon c2)) xcs), loc)
       | L.CConcat (c1, c2) => (L'.CConcat (explifyCon c1, explifyCon c2), loc)
-      | L.CFold (dom, ran) => (L'.CFold (explifyKind dom, explifyKind ran), loc)
+      | L.CMap (dom, ran) => (L'.CMap (explifyKind dom, explifyKind ran), loc)
 
       | L.CUnit => (L'.CUnit, loc)
 
--- a/src/monoize.sml	Sat Feb 21 14:10:06 2009 -0500
+++ b/src/monoize.sml	Sat Feb 21 15:33:20 2009 -0500
@@ -206,7 +206,7 @@
 
                   | L.CRecord _ => poly ()
                   | L.CConcat _ => poly ()
-                  | L.CFold _ => poly ()
+                  | L.CMap _ => poly ()
                   | L.CUnit => poly ()
 
                   | L.CTuple _ => poly ()
--- a/src/reduce.sml	Sat Feb 21 14:10:06 2009 -0500
+++ b/src/reduce.sml	Sat Feb 21 15:33:20 2009 -0500
@@ -103,14 +103,13 @@
                         CAbs (_, _, b) =>
                         con (KnownC c2 :: deKnown env) b
 
-                      | CApp ((CApp ((CFold _, _), f), _), i) =>
+                      | CApp ((CMap (dom, ran), _), f) =>
                         (case #1 c2 of
-                             CRecord (_, []) => i
-                           | CRecord (k, (x, c) :: rest) =>
+                             CRecord (_, []) => (CRecord (ran, []), loc)
+                           | CRecord (_, (x, c) :: rest) =>
                              con (deKnown env)
-                                 (CApp ((CApp ((CApp (f, x), loc), c), loc),
-                                        (CApp (c1,
-                                               (CRecord (k, rest), loc)), loc)), loc)
+                                 (CConcat ((CRecord (ran, [(x, (CApp (f, c), loc))]), loc),
+                                           (CApp (c1, (CRecord (dom, rest), loc)), loc)), loc)
                            | _ => (CApp (c1, c2), loc))                           
 
                       | _ => (CApp (c1, c2), loc)
@@ -130,7 +129,7 @@
                         (CRecord (k, xcs1 @ xcs2), loc)
                       | _ => (CConcat (c1, c2), loc)
                 end
-              | CFold _ => all
+              | CMap _ => all
 
               | CUnit => all
 
--- a/src/source.sml	Sat Feb 21 14:10:06 2009 -0500
+++ b/src/source.sml	Sat Feb 21 15:33:20 2009 -0500
@@ -60,7 +60,7 @@
 
        | CRecord of (con * con) list
        | CConcat of con * con
-       | CFold
+       | CMap
 
        | CUnit
 
--- a/src/source_print.sml	Sat Feb 21 14:10:06 2009 -0500
+++ b/src/source_print.sml	Sat Feb 21 15:33:20 2009 -0500
@@ -139,7 +139,7 @@
                                               string "++",
                                               space,
                                               p_con c2])
-      | CFold => string "fold"
+      | CMap => string "map"
 
       | CUnit => string "()"
 
--- a/src/urweb.grm	Sat Feb 21 14:10:06 2009 -0500
+++ b/src/urweb.grm	Sat Feb 21 15:33:20 2009 -0500
@@ -184,7 +184,7 @@
  | LPAREN | RPAREN | LBRACK | RBRACK | LBRACE | RBRACE
  | EQ | COMMA | COLON | DCOLON | TCOLON | DOT | HASH | UNDER | UNDERUNDER | BAR
  | PLUS | MINUS | DIVIDE | DOTDOTDOT | MOD | AT
- | CON | LTYPE | VAL | REC | AND | FUN | FOLD | UNIT | KUNIT | CLASS
+ | CON | LTYPE | VAL | REC | AND | FUN | MAP | FOLD | UNIT | KUNIT | CLASS
  | DATATYPE | OF
  | TYPE | NAME
  | ARROW | LARROW | DARROW | STAR | SEMI
@@ -681,7 +681,7 @@
        | path DOT INT                   (CProj ((CVar path, s (pathleft, pathright)), Int64.toInt INT),
                                          s (pathleft, INTright))
        | UNDER                          (CWild (KWild, s (UNDERleft, UNDERright)), s (UNDERleft, UNDERright))
-       | FOLD                           (CFold, s (FOLDleft, FOLDright))
+       | MAP                            (CMap, s (MAPleft, MAPright))
        | UNIT                           (CUnit, s (UNITleft, UNITright))
        | LPAREN ctuplev RPAREN          (CTuple ctuplev, s (LPARENleft, RPARENright))
 
--- a/src/urweb.lex	Sat Feb 21 14:10:06 2009 -0500
+++ b/src/urweb.lex	Sat Feb 21 15:33:20 2009 -0500
@@ -290,6 +290,7 @@
 <INITIAL> "and"       => (Tokens.AND (pos yypos, pos yypos + size yytext));
 <INITIAL> "fun"       => (Tokens.FUN (pos yypos, pos yypos + size yytext));
 <INITIAL> "fn"        => (Tokens.FN (pos yypos, pos yypos + size yytext));
+<INITIAL> "map"       => (Tokens.MAP (pos yypos, pos yypos + size yytext));
 <INITIAL> "fold"      => (Tokens.FOLD (pos yypos, pos yypos + size yytext));
 <INITIAL> "case"      => (Tokens.CASE (pos yypos, pos yypos + size yytext));
 <INITIAL> "if"        => (Tokens.IF (pos yypos, pos yypos + size yytext));