Mercurial > urweb

annotate tests/type_class.ur @ 1121:0cee0c8d8c37

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Support for protocol-specific expunger dispatch
author Adam Chlipala <adamc@hcoop.net>
date Sun, 10 Jan 2010 10:40:57 -0500
parents 81573f62d6c3
children
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@675 12
adamc@677 13 (*val uh_oh : t ::: Type -> default t -> default t*)
adamc@677 14
adamc@675 15 class awesome
adamc@675 16 val awesome_default : t ::: Type -> awesome t -> default t
adamc@675 17
adamc@675 18 val float_awesome : awesome float
adamc@677 19
adamc@677 20 val oh_my : t ::: Type -> awesome (option t) -> awesome (option t)
adamc@677 21
adamc@677 22 val awesome : t ::: Type -> awesome t -> t
adamc@674 23 end = struct
adamc@674 24 class default t = t
adamc@674 25 fun get (t ::: Type) (x : t) = x
adamc@212 26
adamc@674 27 val string_default = "Hi"
adamc@674 28 val int_default = 0
adamc@674 29
adamc@674 30 fun option_default (t ::: Type) (x : t) = Some x
adamc@674 31 fun pair_default (a ::: Type) (b ::: Type) (x : a) (y : b) = Pair (x, y)
adamc@675 32
adamc@677 33 (*fun uh_oh (t ::: Type) (x : t) = x*)
adamc@677 34
adamc@675 35 class awesome t = t
adamc@675 36 fun awesome_default (t ::: Type) (x : t) = x
adamc@675 37
adamc@675 38 val float_awesome = 1.23
adamc@677 39
adamc@677 40 fun oh_my (t ::: Type) (x : option t) = x
adamc@677 41
adamc@677 42 fun awesome (t ::: Type) (x : t) = x
adamc@674 43 end
adamc@674 44
adamc@674 45 open M
adamc@674 46
adamc@674 47 fun default (t ::: Type) (_ : default t) : t = get
adamc@674 48 val hi : string = default
adamc@674 49 val zero : int = default
adamc@674 50 val some_zero : option int = default
adamc@674 51 val hi_zero : pair string int = default
adamc@675 52 val ott : float = default
adamc@674 53
adamc@674 54 fun frob (t ::: Type) (_ : default t) : t = default
adamc@674 55 val hi_again : string = frob
adamc@674 56 val zero_again : int = frob
adamc@674 57
adamc@674 58 fun show_option (t ::: Type) (_ : show t) : show (option t) =
adamc@674 59 mkShow (fn x =>
adamc@674 60 case x of
adamc@674 61 None => "None"
adamc@674 62 | Some y => show y)
adamc@674 63
adamc@677 64 (*val x : option float = awesome*)
adamc@677 65
adamc@674 66 fun show_pair (a ::: Type) (b ::: Type) (_ : show a) (_ : show b) : show (pair a b) =
adamc@674 67 mkShow (fn x =>
adamc@674 68 case x of
adamc@674 69 Pair (y, z) => "(" ^ show y ^ "," ^ show z ^ ")")
adamc@674 70
adamc@674 71 fun main () : transaction page = return <xml><body>
adamc@675 72 {[hi_again]}, {[zero_again]}, {[some_zero]}, {[hi_zero]}, {[ott]}
adamc@674 73 </body></xml>