Interpreter.hs

module Interpreter where

import Data
import DataUtil

int :: Program -> Expr -> Value
int p e = until isValue (intStep p) e

-- step-by-step interpreter
intStep :: Program -> Expr -> Expr
intStep p (Ctr name args) = 
	Ctr name (values ++ (intStep p x : xs)) where 
		(values, x : xs) = span isValue args

intStep p (FCall name args) = 
	e // (zip vs args) where 
		(FDef _ vs e) = fDef p name

intStep p (GCall gname (Ctr cname cargs : args)) = 
	e // (zip (cvs ++ vs) (cargs ++ args)) where 
		(GDef _ (Pat _ cvs) vs e) = gDef p gname cname

intStep p (GCall gname (e:es)) = 
	(GCall gname (intStep p e : es))
	
intStep p (Let binding e2) =
	e2 // [binding] 

-- top-down eval
eval :: Program -> Expr -> Expr
eval p (Ctr name args) = 
	Ctr name [eval p arg | arg <- args]

eval p (FCall name args) = 
	eval p (body // zip vs args) where
		(FDef _ vs body) = fDef p name

eval p (GCall gname (Ctr cname cargs : args)) = 
	eval p (body // (zip (cvs ++ vs) (cargs ++ args))) where 
		(GDef _ (Pat _ cvs) vs body) = gDef p gname cname

eval p (GCall gname (arg:args)) = 
	eval p (GCall gname (eval p arg:args))

eval p (Let (x, e1) e2) =
	eval p (e2 // [(x, e1)])

sll_run :: Task -> Env -> Value
sll_run (e, program) env = int program (e // env)
		
sll_trace :: Task -> Subst -> (Value, Integer)
sll_trace (e, prog) s = intC prog (e // s)

intC :: Program -> Expr -> (Expr, Integer) 
intC p e = until t f (e, 0) where
	t (e, n) = isValue e
	f (e, n) = (intStep p e, n + 1)