{-

A partial evaluator that aggregates the residual program. The simple
inlining-oriented predecessor is enhanced by a
state monad to aggregate the residual program as a function
environment.

-}

module Exp where

import Prelude hiding (exp)
import Data.Maybe
import Data.HashTable (hashString)
import Control.Monad.State

type Prog = (Expr, [FunctionDefinition])

type FunctionDefinition = (FunctionName, ([VariableName], Expr))

data Val
 = IVal  { getInt :: Int }
 | BVal { getBool :: Bool }
 | Char { getChar :: Char }
 | Pair { getPair :: (Val, Val) }
 | List { getList :: [Val] }

type VariableName = String
type FunctionName = String
data Expr
 = Const { getVal :: Val }
 | Var VariableName
 | Prim Op [Expr]
 | If Expr Expr Expr
 | Apply FunctionName [Expr]

instance Show Expr where
 show (Const v) = show v
 show (Var s) = s
 show (Apply fun args) = fun ++ show args
 show (Prim op args) = show op ++ show args
 show (If c a b) = "if " ++ show c ++ " then " ++ show a ++ " else " ++ show b

instance Show Val
 where
  show (IVal i) = show i
  show (BVal b) = show b
  show (Char c) = show c
  show (Pair p) = show p
  show (List l) = show l

data Op = Equal | Add | Sub | Mul
 | MkPair | Cons | Fst | Snd | Null | Head | Tail

instance Show Op where
  show Equal = "=="
  show Add = "+"
  show Sub = "-"
  show Mul = "*"
  show MkPair = ","
  show Cons = ":"
  show Fst = "FST"
  show Snd = "SND"
  show Null = "NULL"
  show Head = "HEAD"
  show Tail = "TAIL"

prim Fst [Pair p] = fst p
prim Snd [Pair p] = snd p
prim Null [List l] = BVal (null l)
prim Head [List (x:_)] = x
prim Tail [List (_:xs)] = List xs

prim Equal [BVal b1, BVal b2] = BVal (b1 == b2)
prim Equal [Char c1, Char c2] = BVal (c1 == c2)
prim Equal [IVal i1, IVal i2] = BVal (i1 == i2)
prim Add [IVal i1, IVal i2] = IVal (i1 + i2)
prim Sub [IVal i1, IVal i2] = IVal (i1 - i2)
prim Mul [IVal i1, IVal i2] = IVal (i1 * i2)
prim MkPair [v1, v2] = Pair (v1, v2)
prim Cons [v, List l] = List (v:l)
prim uop vs = error (show uop ++ " " ++ show vs)
nil = Const (List [])

  
-- Update a list that is supposed to be a map/dictionary

update :: Eq k => (v -> v) -> k -> [(k, v)] -> [(k, v)]
update f k ((k', v):kvs) = if k==k' then (k', f v):kvs else (k', v):update f k kvs

isVal :: Expr -> Bool
isVal (Const _) = True
isVal _ = False


-- Testing

baseEnv = [(
 "exp", (["x","n"],
  If (Prim Equal [Var "n", Const (IVal 0)])
     (Const (IVal 1))  
     (Prim Mul 
       [Var "x",
        Apply "exp" [Var "x", Prim Sub [Var "n", Const (IVal 1)]]])))]

expProg = (Apply "exp" [Const (IVal 2), Const (IVal 3)], baseEnv)

printBind (name, (args, body)) = do 
    putStr "  " 
    putStr name
    print args
    putStr "    "
    print body