{ Standard speed test. 0.202 new domains, old parser ||reductions = 12104147, cells claimed = 16617664, no of gc's = 115, cpu = 645.58 0.203 polymorphism, new domains, old parser ||reductions = 21233515, cells claimed = 28216776, no of gc's = 317, cpu = 1290.43 0.2031 polymorphism, new domains, new parser ||reductions = 23331864, cells claimed = 31379551, no of gc's = 313, cpu = 1912.27 0.204 as 0.2031 and proper handling of HOFs, and new name management scheme ||reductions = 22821816, cells claimed = 30431703, no of gc's = 230, cpu = 1543.68 0.204 as of end Sunday ||reductions = 21935678, cells claimed = 29447796, no of gc's = 208, cpu = 1536.43 0.2041 as previous with constructor-recycling ||reductions = 15819053, cells claimed = 21934376, no of gc's = 74, cpu = 648.53 } day ::= Monday | Tuesday | Wednesday | Thursday | Friday | Saturday | Sunday ; domain ::= Unit | Lift (domain); pair a b ::= Pair a b; list a ::= Nil | Cons a (list a); tree a ::= Leaf | Branch (tree a) a (tree a); assoc a b ::= NilAssoc | Assoc a b (assoc a b) ; ;; bottomAny = bottomAny; qsort l = letrec bigs = \d l2 -> case l2 of Nil -> Nil; Cons l2x l2xs -> case l2x>d of True -> Cons l2x (bigs d l2xs); False -> bigs d l2xs end end; smalls = \d l2 -> case l2 of Nil -> Nil; Cons l2x l2xs -> case l2x<=d of True -> Cons l2x (smalls d l2xs); False -> smalls d l2xs end end in case l of Nil -> Nil; Cons h t -> append (qsort (smalls h t)) (Cons h (qsort (bigs h t))) end; {topInt = 42;} domainHeight d = case d of Unit -> 1; Lift d1 -> 1 + domainHeight d1 end; workingHours d = case d of Saturday -> 0; Sunday -> 0; Monday -> 2; Tuesday -> 4; Wednesday -> 5; Thursday -> 3; Friday -> 1 end; incHead l = case l of Nil -> Nil; Cons a as -> Cons (a+1) as end; tricky a b = case a==0 of True -> b; False -> tricky (a-1) b end; length x = case x of Nil -> 0; Cons a as -> 1 + length as end; sum x = case x of Nil -> 0; Cons a as -> a + sum as end; append x y = case x of Nil -> y; Cons a as -> Cons a (append as y) end; rev x = case x of Nil -> Nil; Cons a as -> append (rev as) (Cons a Nil) end; take n l = case l of Nil -> Nil; Cons x xs -> case (n==0) of True -> Nil; False -> Cons x (take (n-1) xs) end end; drop n l = case l of Nil -> Nil; Cons x xs -> case (n==0) of True -> Cons x xs; False -> drop (n-1) xs end end; first p = case p of Pair a b -> a end; second p = case p of Pair a b -> b end; mirror t = case t of Leaf -> Leaf; Branch l x r -> Branch (mirror r) x (mirror l) end; sumt t = case t of Leaf -> 0; Branch l x r -> sumt l + x + sumt r end; aLookupDef al key default = case al of NilAssoc -> default; Assoc a b abs -> case a==key of True -> b; False -> aLookupDef abs key default end end; aDomain al = case al of NilAssoc -> Nil; Assoc a b abs -> Cons a (aDomain abs) end; aInverse al = case al of NilAssoc -> NilAssoc; Assoc a b abs -> Assoc b a (aInverse abs) end; flatten t = case t of Leaf -> Nil; Branch l x r -> append (flatten l) (Cons x (flatten r)) end; insert x t = case t of Leaf -> Branch Leaf x Leaf; Branch l x1 r -> case x==x1 of True -> Branch l x1 r; False -> case x Branch (insert x l) x1 r; False -> Branch l x1 (insert x r) end end end; listToTree l = letrec ltt = \tr li -> case li of Nil -> tr; Cons x xs -> ltt (insert x tr) xs end in ltt Leaf l; nodups l = flatten (listToTree l);