(module TypedLists in prelude out (hide everything (eq))) { Basic boolean support } (fun not Bool (x Bool) (if x False True)) (fun and Bool (x Bool y Bool) (if x y x)) (fun or Bool (x Bool y Bool) (if x x y)) { Equality on integers } (fun eq Bool (x Int y Int) (@and (<= x y) (<= y x))) { Lists } (global nil [a] (# nil)) (fun head h (x [h]) (!cons 0 x)) (fun tail [a] (x [a]) (!cons 1 x)) (fun fst a (x (a.b)) (!pair 0 x)) (fun list1 [a] (x a) (#cons x nil)) { convenience functions } (fun list2 [a] (x a y a) (#cons x (#cons y nil))) (fun list3 [a] (x a y a z a) (#cons x (#cons y (#cons z nil)))) { Pairs } (fun snd b (x (a.b)) (!pair 1 x)) (fun isnil Bool (l [a]) (? nil l)) { test for empty } (fun gen [Int] (n Int) { generate the list [1,2,...,n] } (local (temp nil) (block (:= temp nil) (while (@not (@eq n 0)) (block (:= temp (# cons n temp)) (:= n (- n 1)))) temp))) (fun length Int (l [a]) { return the length of l } (local (temp 0) (block (:= temp 0) (while (@not (?nil l)) (block (:= temp (+ temp 1)) (:= l (@ tail l)))) temp))) (fun append [a] (l [a] m [a] ) { return (l ++ m) } (if (@isnil l) m (#cons (@head l) (@append (@tail l) m)))) { demonstrate that functions can be mutually recursive } (fun even Bool (n Int) (if (@eq n 0) True (@ odd (- n 1)))) (fun odd Bool (n Int) (if (@eq n 0) False (@ even (- n 1)))) { Show that a function can have zero arguments } (fun thunk Int () (write tom)) { Define the error function which prints and then dies. Note it is polymorphic } (fun error b (message String x a) (block (write (#pair message x)) (@head nil))) {- Demonstrate some data definitions } (data (Tree a) (#tip a) (#fork (Tree a) (Tree a))) { A type with no arguments } (data (Color ) (#red) (#blue) (#green)) (data (Result a) (#found a) (#notFound)) { An abstract type } (adt (Env a) [(Char.a)] (global empty (Env a) nil) (fun extend (Env a) (key Char object a table (Env a)) (#cons (#pair key object) table)) (fun lookup (Result a) (tab (Env a) key Char) (if (?nil tab) (#notFound) (if (= key (@fst (@head tab))) (#found (@snd (@head tab))) (@lookup (@tail tab) key)))) ) { some stuff to play with } (global ll [Int] (#cons 3 (#cons 6 (#cons 7 nil))) ) (global pp (Int . Int) (#pair 5 7) ) (global tom Int 99 ) { Illustrate signatures and importing of files } (signature Stack (type (Stack a)) (val push (a -> (Stack a) -> (Stack a))) (val emptySt (Stack a)) (val pop ((Stack a) -> (a.(Stack a)))) ) (signature "test.e7") (import "small.e7" implementing Stack) main {Initializing code goes here} { a simple example } (#cons (@length (@list1 0)) (@append (@gen 2) (@gen 3)))