Mercurial > urweb
diff lib/ur/top.urs @ 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 | 1d34d916c206 |
| children | 588b9d16b00a |
line wrap: on
line diff
--- 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)