Mercurial > urweb

annotate lib/top.urs @ 418:ad7e854a518c

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Metaform demos, minus prose
author Adam Chlipala <adamc@hcoop.net>
date Thu, 23 Oct 2008 14:03:12 -0400
parents 06fcddcd20d3
children 0ce90d4d9ae7
rev   line source
adamc@329 1 con idT = fn t :: Type => t
adamc@329 2 con record = fn t :: {Type} => $t
adamc@339 3 con fstTT = fn t :: (Type * Type) => t.1
adamc@339 4 con sndTT = fn t :: (Type * Type) => t.2
adamc@329 5
adamc@355 6 con mapTT = fn f :: Type -> Type => fold (fn nm t acc [[nm] ~ acc] =>
adamc@355 7 [nm = f t] ++ acc) []
adamc@325 8
adamc@411 9 con mapUT = fn f :: Type => fold (fn nm t acc [[nm] ~ acc] =>
adamc@411 10 [nm = f] ++ acc) []
adamc@411 11
adamc@355 12 con mapT2T = fn f :: (Type * Type) -> Type => fold (fn nm t acc [[nm] ~ acc] =>
adamc@355 13 [nm = f t] ++ acc) []
adamc@339 14
adamc@339 15 con ex = fn tf :: (Type -> Type) =>
adamc@355 16 res ::: Type -> (choice :: Type -> tf choice -> res) -> res
adamc@339 17
adamc@339 18 val ex : tf :: (Type -> Type) -> choice :: Type -> tf choice -> ex tf
adamc@339 19
adamc@325 20 val compose : t1 ::: Type -> t2 ::: Type -> t3 ::: Type
adamc@355 21 -> (t2 -> t3) -> (t1 -> t2) -> (t1 -> t3)
adamc@325 22
adamc@325 23 val txt : t ::: Type -> ctx ::: {Unit} -> use ::: {Type} -> show t -> t
adamc@355 24 -> xml ctx use []
adamc@329 25
adamc@411 26 val foldUR : tf :: Type -> tr :: ({Unit} -> Type)
adamc@411 27 -> (nm :: Name -> rest :: {Unit}
adamc@411 28 -> fn [[nm] ~ rest] =>
adamc@411 29 tf -> tr rest -> tr ([nm] ++ rest))
adamc@411 30 -> tr [] -> r :: {Unit} -> $(mapUT tf r) -> tr r
adamc@411 31
adamc@418 32 val foldUR2 : tf1 :: Type -> tf2 :: Type -> tr :: ({Unit} -> Type)
adamc@418 33 -> (nm :: Name -> rest :: {Unit}
adamc@418 34 -> fn [[nm] ~ rest] =>
adamc@418 35 tf1 -> tf2 -> tr rest -> tr ([nm] ++ rest))
adamc@418 36 -> tr [] -> r :: {Unit} -> $(mapUT tf1 r) -> $(mapUT tf2 r) -> tr r
adamc@418 37
adamc@418 38 val foldURX2: tf1 :: Type -> tf2 :: Type -> ctx :: {Unit}
adamc@418 39 -> (nm :: Name -> rest :: {Unit}
adamc@418 40 -> fn [[nm] ~ rest] =>
adamc@418 41 tf1 -> tf2 -> xml ctx [] [])
adamc@418 42 -> r :: {Unit} -> $(mapUT tf1 r) -> $(mapUT tf2 r) -> xml ctx [] []
adamc@418 43
adamc@336 44 val foldTR : tf :: (Type -> Type) -> tr :: ({Type} -> Type)
adamc@355 45 -> (nm :: Name -> t :: Type -> rest :: {Type}
adamc@355 46 -> fn [[nm] ~ rest] =>
adamc@355 47 tf t -> tr rest -> tr ([nm = t] ++ rest))
adamc@355 48 -> tr [] -> r :: {Type} -> $(mapTT tf r) -> tr r
adamc@336 49
adamc@339 50 val foldT2R : tf :: ((Type * Type) -> Type) -> tr :: ({(Type * Type)} -> Type)
adamc@355 51 -> (nm :: Name -> t :: (Type * Type) -> rest :: {(Type * Type)}
adamc@355 52 -> fn [[nm] ~ rest] =>
adamc@355 53 tf t -> tr rest -> tr ([nm = t] ++ rest))
adamc@355 54 -> tr [] -> r :: {(Type * Type)} -> $(mapT2T tf r) -> tr r
adamc@339 55
adamc@355 56 val foldTR2 : tf1 :: (Type -> Type) -> tf2 :: (Type -> Type)
adamc@355 57 -> tr :: ({Type} -> Type)
adamc@355 58 -> (nm :: Name -> t :: Type -> rest :: {Type}
adamc@355 59 -> fn [[nm] ~ rest] =>
adamc@355 60 tf1 t -> tf2 t -> tr rest -> tr ([nm = t] ++ rest))
adamc@355 61 -> tr []
adamc@355 62 -> r :: {Type} -> $(mapTT tf1 r) -> $(mapTT tf2 r) -> tr r
adamc@355 63
adamc@339 64 val foldT2R2 : tf1 :: ((Type * Type) -> Type) -> tf2 :: ((Type * Type) -> Type)
adamc@355 65 -> tr :: ({(Type * Type)} -> Type)
adamc@355 66 -> (nm :: Name -> t :: (Type * Type) -> rest :: {(Type * Type)}
adamc@355 67 -> fn [[nm] ~ rest] =>
adamc@355 68 tf1 t -> tf2 t -> tr rest -> tr ([nm = t] ++ rest))
adamc@355 69 -> tr [] -> r :: {(Type * Type)}
adamc@355 70 -> $(mapT2T tf1 r) -> $(mapT2T tf2 r) -> tr r
adamc@339 71
adamc@336 72 val foldTRX : tf :: (Type -> Type) -> ctx :: {Unit}
adamc@355 73 -> (nm :: Name -> t :: Type -> rest :: {Type}
adamc@355 74 -> fn [[nm] ~ rest] =>
adamc@355 75 tf t -> xml ctx [] [])
adamc@355 76 -> r :: {Type} -> $(mapTT tf r) -> xml ctx [] []
adamc@336 77
adamc@339 78 val foldT2RX : tf :: ((Type * Type) -> Type) -> ctx :: {Unit}
adamc@355 79 -> (nm :: Name -> t :: (Type * Type) -> rest :: {(Type * Type)}
adamc@355 80 -> fn [[nm] ~ rest] =>
adamc@355 81 tf t -> xml ctx [] [])
adamc@355 82 -> r :: {(Type * Type)} -> $(mapT2T tf r) -> xml ctx [] []
adamc@339 83
adamc@332 84 val foldTRX2 : tf1 :: (Type -> Type) -> tf2 :: (Type -> Type) -> ctx :: {Unit}
adamc@355 85 -> (nm :: Name -> t :: Type -> rest :: {Type}
adamc@355 86 -> fn [[nm] ~ rest] =>
adamc@355 87 tf1 t -> tf2 t -> xml ctx [] [])
adamc@355 88 -> r :: {Type}
adamc@355 89 -> $(mapTT tf1 r) -> $(mapTT tf2 r) -> xml ctx [] []
adamc@334 90
adamc@355 91 val foldT2RX2 : tf1 :: ((Type * Type) -> Type) -> tf2 :: ((Type * Type) -> Type)
adamc@355 92 -> ctx :: {Unit}
adamc@355 93 -> (nm :: Name -> t :: (Type * Type) -> rest :: {(Type * Type)}
adamc@355 94 -> fn [[nm] ~ rest] =>
adamc@355 95 tf1 t -> tf2 t -> xml ctx [] [])
adamc@355 96 -> r :: {(Type * Type)}
adamc@355 97 -> $(mapT2T tf1 r) -> $(mapT2T tf2 r) -> xml ctx [] []
adamc@339 98
adamc@334 99 val queryX : tables ::: {{Type}} -> exps ::: {Type} -> ctx ::: {Unit}
adamc@355 100 -> sql_query tables exps
adamc@355 101 -> fn [tables ~ exps] =>
adamc@355 102 ($(exps ++ fold (fn nm (fields :: {Type}) acc [[nm] ~ acc] =>
adamc@355 103 [nm = $fields] ++ acc) [] tables)
adamc@355 104 -> xml ctx [] [])
adamc@355 105 -> transaction (xml ctx [] [])
adamc@341 106
adamc@355 107 val oneOrNoRows : tables ::: {{Type}} -> exps ::: {Type}
adamc@355 108 -> sql_query tables exps
adamc@355 109 -> fn [tables ~ exps] =>
adamc@355 110 transaction
adamc@355 111 (option
adamc@355 112 $(exps
adamc@355 113 ++ fold (fn nm (fields :: {Type}) acc
adamc@355 114 [[nm] ~ acc] =>
adamc@355 115 [nm = $fields] ++ acc)
adamc@355 116 [] tables))