type 'a list = [ `Nil | `Cons of 'a * 'a list ] let rec map : ('a -> 'b) -> 'a list -> 'b list = fun f -> function | `Nil -> `Nil | `Cons (hd,tl) -> `Cons (f hd, map f tl) let rec equals a b = match a,b with | `Nil,`Nil -> true | `Cons (h,a), `Cons (h',b) when h=h' -> equals a b | _ -> false type 'a alist = [ `Append of 'a alist * 'a alist | `Cons of 'a * 'a alist | `Nil ] let rec amap f = function | `Nil -> `Nil | `Cons (hd,tl) -> `Cons (f hd, amap f tl) | `Append (l,r) -> `Append (amap f l, amap f r) let rec flatten : 'a alist -> 'a list = function | `Append (`Cons (hd,tl), l) -> `Cons (hd, flatten (`Append (tl, l))) | `Append (`Nil, l) -> flatten l | `Append (`Append (a,b), c) -> flatten (`Append (a, `Append (b,c))) | `Cons (hd,t) -> `Cons (hd, flatten t) | `Nil -> `Nil let () = let make = List.fold_left (fun a b -> `Cons (b,a)) `Nil in let a = make ['b';'l';'a'] in let b = `Append (a,a) in let b = flatten b in assert (equals b (make ['b';'l';'a';'b';'l';'a'])) module Bonus = struct type ('a,'t) open_list = [ `Nil | `Cons of 'a * 't ] type ('a,'t) append = [ `Append of 't * 't ] type 'a list = ('a, 'a list) open_list type 'a alist = [ ('a, 'a alist) open_list | ('a, 'a alist) append ] let map_list map f = function | `Nil -> `Nil | `Cons (hd,tl) -> `Cons (f hd, map f tl) let map_append map f = function | `Append (l,r) -> `Append (map f l, map f r) let rec map_alist : ('a -> 'b) -> 'a alist -> 'b alist = fun f -> function | #append as x -> map_append map_alist f x | #open_list as x -> map_list map_alist f x end