Mercurial > urweb

comparison tests/type_class.ur @ 674:fab5998b840e

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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>