Mercurial > urweb
annotate 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 |
rev | line source |
---|---|
adamc@674 | 1 datatype pair a b = Pair of a * b |
adamc@211 | 2 |
adamc@674 | 3 structure M : sig |
adamc@674 | 4 class default |
adamc@674 | 5 val get : t ::: Type -> default t -> t |
adamc@211 | 6 |
adamc@674 | 7 val string_default : default string |
adamc@674 | 8 val int_default : default int |
adamc@212 | 9 |
adamc@674 | 10 val option_default : t ::: Type -> default t -> default (option t) |
adamc@674 | 11 val pair_default : a ::: Type -> b ::: Type -> default a -> default b -> default (pair a b) |
adamc@674 | 12 end = struct |
adamc@674 | 13 class default t = t |
adamc@674 | 14 fun get (t ::: Type) (x : t) = x |
adamc@212 | 15 |
adamc@674 | 16 val string_default = "Hi" |
adamc@674 | 17 val int_default = 0 |
adamc@674 | 18 |
adamc@674 | 19 fun option_default (t ::: Type) (x : t) = Some x |
adamc@674 | 20 fun pair_default (a ::: Type) (b ::: Type) (x : a) (y : b) = Pair (x, y) |
adamc@674 | 21 end |
adamc@674 | 22 |
adamc@674 | 23 open M |
adamc@674 | 24 |
adamc@674 | 25 fun default (t ::: Type) (_ : default t) : t = get |
adamc@674 | 26 val hi : string = default |
adamc@674 | 27 val zero : int = default |
adamc@674 | 28 val some_zero : option int = default |
adamc@674 | 29 val hi_zero : pair string int = default |
adamc@674 | 30 |
adamc@674 | 31 fun frob (t ::: Type) (_ : default t) : t = default |
adamc@674 | 32 val hi_again : string = frob |
adamc@674 | 33 val zero_again : int = frob |
adamc@674 | 34 |
adamc@674 | 35 fun show_option (t ::: Type) (_ : show t) : show (option t) = |
adamc@674 | 36 mkShow (fn x => |
adamc@674 | 37 case x of |
adamc@674 | 38 None => "None" |
adamc@674 | 39 | Some y => show y) |
adamc@674 | 40 |
adamc@674 | 41 fun show_pair (a ::: Type) (b ::: Type) (_ : show a) (_ : show b) : show (pair a b) = |
adamc@674 | 42 mkShow (fn x => |
adamc@674 | 43 case x of |
adamc@674 | 44 Pair (y, z) => "(" ^ show y ^ "," ^ show z ^ ")") |
adamc@674 | 45 |
adamc@674 | 46 fun main () : transaction page = return <xml><body> |
adamc@674 | 47 {[hi_again]}, {[zero_again]}, {[some_zero]}, {[hi_zero]} |
adamc@674 | 48 </body></xml> |