comparison lib/top.ur @ 345:b85e6ba56618

Merge CDisjoint and TDisjoint
author Adam Chlipala <adamc@hcoop.net>
date Sat, 04 Oct 2008 15:50:28 -0400
parents 389399d65331
children 383c72d11db8
comparison
equal deleted inserted replaced
344:3c0feecd057d 345:b85e6ba56618
20 20
21 fun txt (t ::: Type) (ctx ::: {Unit}) (use ::: {Type}) (sh : show t) (v : t) = cdata (show sh v) 21 fun txt (t ::: Type) (ctx ::: {Unit}) (use ::: {Type}) (sh : show t) (v : t) = cdata (show sh v)
22 22
23 fun foldTR (tf :: Type -> Type) (tr :: {Type} -> Type) 23 fun foldTR (tf :: Type -> Type) (tr :: {Type} -> Type)
24 (f : nm :: Name -> t :: Type -> rest :: {Type} -> [nm] ~ rest 24 (f : nm :: Name -> t :: Type -> rest :: {Type} -> [nm] ~ rest
25 -> tf t -> tr rest -> tr ([nm = t] ++ rest)) 25 => tf t -> tr rest -> tr ([nm = t] ++ rest))
26 (i : tr []) = 26 (i : tr []) =
27 fold [fn r :: {Type} => $(mapTT tf r) -> tr r] 27 fold [fn r :: {Type} => $(mapTT tf r) -> tr r]
28 (fn (nm :: Name) (t :: Type) (rest :: {Type}) (acc : _ -> tr rest) => 28 (fn (nm :: Name) (t :: Type) (rest :: {Type}) (acc : _ -> tr rest) =>
29 [[nm] ~ rest] => 29 [[nm] ~ rest] =>
30 fn r => f [nm] [t] [rest] r.nm (acc (r -- nm))) 30 fn r => f [nm] [t] [rest] r.nm (acc (r -- nm)))
31 (fn _ => i) 31 (fn _ => i)
32 32
33 fun foldT2R (tf :: (Type * Type) -> Type) (tr :: {(Type * Type)} -> Type) 33 fun foldT2R (tf :: (Type * Type) -> Type) (tr :: {(Type * Type)} -> Type)
34 (f : nm :: Name -> t :: (Type * Type) -> rest :: {(Type * Type)} -> [nm] ~ rest 34 (f : nm :: Name -> t :: (Type * Type) -> rest :: {(Type * Type)} -> [nm] ~ rest
35 -> tf t -> tr rest -> tr ([nm = t] ++ rest)) 35 => tf t -> tr rest -> tr ([nm = t] ++ rest))
36 (i : tr []) = 36 (i : tr []) =
37 fold [fn r :: {(Type * Type)} => $(mapT2T tf r) -> tr r] 37 fold [fn r :: {(Type * Type)} => $(mapT2T tf r) -> tr r]
38 (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) (acc : _ -> tr rest) => 38 (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) (acc : _ -> tr rest) =>
39 [[nm] ~ rest] => 39 [[nm] ~ rest] =>
40 fn r => f [nm] [t] [rest] r.nm (acc (r -- nm))) 40 fn r => f [nm] [t] [rest] r.nm (acc (r -- nm)))
41 (fn _ => i) 41 (fn _ => i)
42 42
43 fun foldTR2 (tf1 :: Type -> Type) (tf2 :: Type -> Type) (tr :: {Type} -> Type) 43 fun foldTR2 (tf1 :: Type -> Type) (tf2 :: Type -> Type) (tr :: {Type} -> Type)
44 (f : nm :: Name -> t :: Type -> rest :: {Type} -> [nm] ~ rest 44 (f : nm :: Name -> t :: Type -> rest :: {Type} -> [nm] ~ rest
45 -> tf1 t -> tf2 t -> tr rest -> tr ([nm = t] ++ rest)) 45 => tf1 t -> tf2 t -> tr rest -> tr ([nm = t] ++ rest))
46 (i : tr []) = 46 (i : tr []) =
47 fold [fn r :: {Type} => $(mapTT tf1 r) -> $(mapTT tf2 r) -> tr r] 47 fold [fn r :: {Type} => $(mapTT tf1 r) -> $(mapTT tf2 r) -> tr r]
48 (fn (nm :: Name) (t :: Type) (rest :: {Type}) (acc : _ -> _ -> tr rest) => 48 (fn (nm :: Name) (t :: Type) (rest :: {Type}) (acc : _ -> _ -> tr rest) =>
49 [[nm] ~ rest] => 49 [[nm] ~ rest] =>
50 fn r1 r2 => f [nm] [t] [rest] r1.nm r2.nm (acc (r1 -- nm) (r2 -- nm))) 50 fn r1 r2 => f [nm] [t] [rest] r1.nm r2.nm (acc (r1 -- nm) (r2 -- nm)))
51 (fn _ _ => i) 51 (fn _ _ => i)
52 52
53 fun foldT2R2 (tf1 :: (Type * Type) -> Type) (tf2 :: (Type * Type) -> Type) (tr :: {(Type * Type)} -> Type) 53 fun foldT2R2 (tf1 :: (Type * Type) -> Type) (tf2 :: (Type * Type) -> Type) (tr :: {(Type * Type)} -> Type)
54 (f : nm :: Name -> t :: (Type * Type) -> rest :: {(Type * Type)} -> [nm] ~ rest 54 (f : nm :: Name -> t :: (Type * Type) -> rest :: {(Type * Type)} -> [nm] ~ rest
55 -> tf1 t -> tf2 t -> tr rest -> tr ([nm = t] ++ rest)) 55 => tf1 t -> tf2 t -> tr rest -> tr ([nm = t] ++ rest))
56 (i : tr []) = 56 (i : tr []) =
57 fold [fn r :: {(Type * Type)} => $(mapT2T tf1 r) -> $(mapT2T tf2 r) -> tr r] 57 fold [fn r :: {(Type * Type)} => $(mapT2T tf1 r) -> $(mapT2T tf2 r) -> tr r]
58 (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) (acc : _ -> _ -> tr rest) => 58 (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) (acc : _ -> _ -> tr rest) =>
59 [[nm] ~ rest] => 59 [[nm] ~ rest] =>
60 fn r1 r2 => f [nm] [t] [rest] r1.nm r2.nm (acc (r1 -- nm) (r2 -- nm))) 60 fn r1 r2 => f [nm] [t] [rest] r1.nm r2.nm (acc (r1 -- nm) (r2 -- nm)))
61 (fn _ _ => i) 61 (fn _ _ => i)
62 62
63 fun foldTRX (tf :: Type -> Type) (ctx :: {Unit}) 63 fun foldTRX (tf :: Type -> Type) (ctx :: {Unit})
64 (f : nm :: Name -> t :: Type -> rest :: {Type} -> [nm] ~ rest 64 (f : nm :: Name -> t :: Type -> rest :: {Type} -> [nm] ~ rest
65 -> tf t -> xml ctx [] []) = 65 => tf t -> xml ctx [] []) =
66 foldTR [tf] [fn _ => xml ctx [] []] 66 foldTR [tf] [fn _ => xml ctx [] []]
67 (fn (nm :: Name) (t :: Type) (rest :: {Type}) => 67 (fn (nm :: Name) (t :: Type) (rest :: {Type}) =>
68 [[nm] ~ rest] => 68 [[nm] ~ rest] =>
69 fn r acc => <xml>{f [nm] [t] [rest] r}{acc}</xml>) 69 fn r acc => <xml>{f [nm] [t] [rest] r}{acc}</xml>)
70 <xml></xml> 70 <xml></xml>
71 71
72 fun foldT2RX (tf :: (Type * Type) -> Type) (ctx :: {Unit}) 72 fun foldT2RX (tf :: (Type * Type) -> Type) (ctx :: {Unit})
73 (f : nm :: Name -> t :: (Type * Type) -> rest :: {(Type * Type)} -> [nm] ~ rest 73 (f : nm :: Name -> t :: (Type * Type) -> rest :: {(Type * Type)} -> [nm] ~ rest
74 -> tf t -> xml ctx [] []) = 74 => tf t -> xml ctx [] []) =
75 foldT2R [tf] [fn _ => xml ctx [] []] 75 foldT2R [tf] [fn _ => xml ctx [] []]
76 (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) => 76 (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) =>
77 [[nm] ~ rest] => 77 [[nm] ~ rest] =>
78 fn r acc => <xml>{f [nm] [t] [rest] r}{acc}</xml>) 78 fn r acc => <xml>{f [nm] [t] [rest] r}{acc}</xml>)
79 <xml></xml> 79 <xml></xml>
80 80
81 fun foldTRX2 (tf1 :: Type -> Type) (tf2 :: Type -> Type) (ctx :: {Unit}) 81 fun foldTRX2 (tf1 :: Type -> Type) (tf2 :: Type -> Type) (ctx :: {Unit})
82 (f : nm :: Name -> t :: Type -> rest :: {Type} -> [nm] ~ rest 82 (f : nm :: Name -> t :: Type -> rest :: {Type} -> [nm] ~ rest
83 -> tf1 t -> tf2 t -> xml ctx [] []) = 83 => tf1 t -> tf2 t -> xml ctx [] []) =
84 foldTR2 [tf1] [tf2] [fn _ => xml ctx [] []] 84 foldTR2 [tf1] [tf2] [fn _ => xml ctx [] []]
85 (fn (nm :: Name) (t :: Type) (rest :: {Type}) => 85 (fn (nm :: Name) (t :: Type) (rest :: {Type}) =>
86 [[nm] ~ rest] => 86 [[nm] ~ rest] =>
87 fn r1 r2 acc => <xml>{f [nm] [t] [rest] r1 r2}{acc}</xml>) 87 fn r1 r2 acc => <xml>{f [nm] [t] [rest] r1 r2}{acc}</xml>)
88 <xml></xml> 88 <xml></xml>
89 89
90 fun foldT2RX2 (tf1 :: (Type * Type) -> Type) (tf2 :: (Type * Type) -> Type) (ctx :: {Unit}) 90 fun foldT2RX2 (tf1 :: (Type * Type) -> Type) (tf2 :: (Type * Type) -> Type) (ctx :: {Unit})
91 (f : nm :: Name -> t :: (Type * Type) -> rest :: {(Type * Type)} -> [nm] ~ rest 91 (f : nm :: Name -> t :: (Type * Type) -> rest :: {(Type * Type)} -> [nm] ~ rest
92 -> tf1 t -> tf2 t -> xml ctx [] []) = 92 => tf1 t -> tf2 t -> xml ctx [] []) =
93 foldT2R2 [tf1] [tf2] [fn _ => xml ctx [] []] 93 foldT2R2 [tf1] [tf2] [fn _ => xml ctx [] []]
94 (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) => 94 (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) =>
95 [[nm] ~ rest] => 95 [[nm] ~ rest] =>
96 fn r1 r2 acc => <xml>{f [nm] [t] [rest] r1 r2}{acc}</xml>) 96 fn r1 r2 acc => <xml>{f [nm] [t] [rest] r1 r2}{acc}</xml>)
97 <xml></xml> 97 <xml></xml>