Mercurial > urweb

comparison tests/specialize.ur @ 317:6a4e365db60c

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Fix memory bounds checks; specialization of multi-argument polymorphic function works
author Adam Chlipala <adamc@hcoop.net>
date Thu, 11 Sep 2008 10:34:47 -0400
parents 04ebfe929a98
children 60907c06b4c4
comparison
equal deleted inserted replaced
316:04ebfe929a98 317:6a4e365db60c
8 fun append (t ::: Type) (ls1 : list t) (ls2 : list t) : list t = 8 fun append (t ::: Type) (ls1 : list t) (ls2 : list t) : list t =
9 case ls1 of 9 case ls1 of
10 Nil => ls2 10 Nil => ls2
11 | Cons (x, ls1') => Cons (x, append ls1' ls2) 11 | Cons (x, ls1') => Cons (x, append ls1' ls2)
12 12
13 fun pairAppend (t1 ::: Type) (t2 ::: Type) (ls1 : list (t1 * t2)) (ls2 : list (t1 * t2)) : list (t1 * t2) =
14 case ls1 of
15 Nil => ls2
16 | Cons (x, ls1') => Cons (x, pairAppend ls1' ls2)
17
13 fun delist (ls : list string) : xml body [] [] = 18 fun delist (ls : list string) : xml body [] [] =
14 case ls of 19 case ls of
15 Nil => <body>Nil</body> 20 Nil => <body>Nil</body>
16 | Cons (h, t) => <body>{cdata h} :: {delist t}</body> 21 | Cons (h, t) => <body>{cdata h} :: {delist t}</body>
17 22
23 fun pairDelist (ls : list (string * int)) : xml body [] [] =
24 case ls of
25 Nil => <body>Nil</body>
26 | Cons ((s, n), t) => <body>({cdata s}, {cdata (show _ n)}) :: {pairDelist t}</body>
27
18 val ls = Cons ("X", Cons ("Y", Cons ("Z", Nil))) 28 val ls = Cons ("X", Cons ("Y", Cons ("Z", Nil)))
19 val ls' = Cons ("A", Cons ("B", Nil)) 29 val ls' = Cons ("A", Cons ("B", Nil))
30
31 val pls = Cons (("X", 1), Cons (("Y", 2), Cons (("Z", 3), Nil)))
32 val pls' = Cons (("A", 1), Cons (("B", 2), Nil))
20 33
21 fun main () : transaction page = return <html><body> 34 fun main () : transaction page = return <html><body>
22 {if isNil ls then <body>It's Nil.</body> else <body>It's not Nil.</body>} 35 {if isNil ls then <body>It's Nil.</body> else <body>It's not Nil.</body>}
23 36
24 <p>{delist (append ls' ls)}</p> 37 <p>{delist (append ls' ls)}</p>
38
39 <p>{pairDelist (pairAppend pls' pls)}</p>
25 </body></html> 40 </body></html>
26 41
27 42
28 43
29 44