@@ -0,0 +1,68 @@
1+module Main
2+
3+data Ty = TyInt | TyBool| TyFun Ty Ty
4+
5+interpTy : Ty -> Type
6+interpTy TyInt = Int
7+interpTy TyBool = Bool
8+interpTy (TyFun s t) = interpTy s -> interpTy t
9+
10+using (G : Vect n Ty)
11+
12+ data Env : Vect n Ty -> Type where
13+ Nil : Env Nil
14+ (::) : interpTy a -> Env G -> Env (a :: G)
15+
16+ data HasType : (i : Fin n) -> Vect n Ty -> Ty -> Type where
17+ Stop : HasType FZ (t :: G) t
18+ Pop : HasType k G t -> HasType (FS k) (u :: G) t
19+
20+ lookup : HasType i G t -> Env G -> interpTy t
21+ lookup Stop (x :: xs) = x
22+ lookup (Pop k) (x :: xs) = lookup k xs
23+
24+ data Expr : Vect n Ty -> Ty -> Type where
25+ Var : HasType i G t -> Expr G t
26+ Val : (x : Int) -> Expr G TyInt
27+ Lam : Expr (a :: G) t -> Expr G (TyFun a t)
28+ App : Expr G (TyFun a t) -> Expr G a -> Expr G t
29+ Op : (interpTy a -> interpTy b -> interpTy c) -> Expr G a -> Expr G b ->
30+ Expr G c
31+ If : Expr G TyBool -> Lazy (Expr G a) -> Lazy (Expr G a) -> Expr G a
32+
33+ interp : Env G -> [static] (e : Expr G t) -> interpTy t
34+ interp env (Var i) = lookup i env
35+ interp env (Val x) = x
36+ interp env (Lam sc) = \x => interp (x :: env) sc
37+ interp env (App f s) = interp env f (interp env s)
38+ interp env (Op op x y) = op (interp env x) (interp env y)
39+ interp env (If x t e) = if interp env x then interp env t
40+ else interp env e
41+
42+ eId : Expr G (TyFun TyInt TyInt)
43+ eId = Lam (Var Stop)
44+
45+ eAdd : Expr G (TyFun TyInt (TyFun TyInt TyInt))
46+ eAdd = Lam (Lam (Op (+) (Var Stop) (Var (Pop Stop))))
47+
48+ eEq : Expr G (TyFun TyInt (TyFun TyInt TyBool))
49+ eEq = Lam (Lam (Op (==) (Var Stop) (Var (Pop Stop))))
50+
51+ eDouble : Expr G (TyFun TyInt TyInt)
52+ eDouble = Lam (App (App eAdd (Var Stop)) (Var Stop))
53+
54+ fact : Expr G (TyFun TyInt TyInt)
55+ fact = Lam (If (Op (==) (Var Stop) (Val 0))
56+ (Val 1) (Op (*) (App fact (Op (-) (Var Stop) (Val 1))) (Var Stop)))
57+
58+testFac : Int
59+testFac = interp [] fact 4
60+
61+-- unitTestFac : so (interp [] fact 4 == 24)
62+-- unitTestFac = oh
63+
64+main : IO ()
65+main = do putStr "Enter a number: "
66+ x <- getLine
67+ print (interp [] fact (cast x))
68+