Mercurial > urweb
comparison tests/type_class.ur @ 674:fab5998b840e
Type class reductions, but no inclusions yet
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Thu, 26 Mar 2009 14:37:31 -0400 |
parents | 71bafe66dbe1 |
children | 43430b7190f4 |
comparison
equal
deleted
inserted
replaced
673:a8effb6159c2 | 674:fab5998b840e |
---|---|
1 class default t = t | 1 datatype pair a b = Pair of a * b |
2 | 2 |
3 val string_default : default string = "Hi" | 3 structure M : sig |
4 val int_default : default int = 0 | 4 class default |
5 val get : t ::: Type -> default t -> t | |
5 | 6 |
6 val default : t :: Type -> default t -> t = | 7 val string_default : default string |
7 fn t :: Type => fn d : default t => d | 8 val int_default : default int |
8 val hi = default [string] _ | |
9 val zero = default [int] _ | |
10 | 9 |
11 val frob : t :: Type -> default t -> t = | 10 val option_default : t ::: Type -> default t -> default (option t) |
12 fn t :: Type => fn _ : default t => default [t] _ | 11 val pair_default : a ::: Type -> b ::: Type -> default a -> default b -> default (pair a b) |
13 val hi_again = frob [string] _ | 12 end = struct |
14 val zero_again = frob [int] _ | 13 class default t = t |
14 fun get (t ::: Type) (x : t) = x | |
15 | 15 |
16 val main : unit -> page = fn () => <html><body> | 16 val string_default = "Hi" |
17 {cdata hi_again} | 17 val int_default = 0 |
18 </body></html> | 18 |
19 fun option_default (t ::: Type) (x : t) = Some x | |
20 fun pair_default (a ::: Type) (b ::: Type) (x : a) (y : b) = Pair (x, y) | |
21 end | |
22 | |
23 open M | |
24 | |
25 fun default (t ::: Type) (_ : default t) : t = get | |
26 val hi : string = default | |
27 val zero : int = default | |
28 val some_zero : option int = default | |
29 val hi_zero : pair string int = default | |
30 | |
31 fun frob (t ::: Type) (_ : default t) : t = default | |
32 val hi_again : string = frob | |
33 val zero_again : int = frob | |
34 | |
35 fun show_option (t ::: Type) (_ : show t) : show (option t) = | |
36 mkShow (fn x => | |
37 case x of | |
38 None => "None" | |
39 | Some y => show y) | |
40 | |
41 fun show_pair (a ::: Type) (b ::: Type) (_ : show a) (_ : show b) : show (pair a b) = | |
42 mkShow (fn x => | |
43 case x of | |
44 Pair (y, z) => "(" ^ show y ^ "," ^ show z ^ ")") | |
45 | |
46 fun main () : transaction page = return <xml><body> | |
47 {[hi_again]}, {[zero_again]}, {[some_zero]}, {[hi_zero]} | |
48 </body></xml> |