{-
  * Copyright (c): Uwe Schmidt, FH Wedel
  *
  * You may study, modify and distribute this source code
  * FOR NON-COMMERCIAL PURPOSES ONLY.
  * This copyright message has to remain unchanged.
  *
  * Note that this document is provided 'as is',
  * WITHOUT WARRANTY of any kind either expressed or implied.
-}

module ProgLang
where

import Data.Maybe

import           Data.Map(Map)
import qualified Data.Map as M

-- ------------------------------------------------------------
--
-- the abstract syntax (syntactic domains)

data Stmt	= Assign	Ident Expr
		| If		Expr Stmt Stmt
		| While		Expr Stmt
		| StmtList	[Stmt]
		  deriving (Show)

data Expr	= Const		Value
		| Var		Ident
		| BinExpr	Op Expr Expr
		  deriving (Show)

data Op		= Plus
		| Minus
		| Mult
		| Div
		| Equal
		| NotEqual
		| GreaterThan
		| GreaterOrEq
		  deriving (Eq, Show)

type Value	= Int
type Ident	= String

-- ------------------------------------------------------------
--
-- semantic domains

type State	= Map Ident Value

-- ------------------------------------------------------------
--
-- the statement interpreter

interprete	:: Stmt -> State -> State

interprete (Assign v e) s
    = M.insertWith (\ x y -> x) v val s
      where
      val = eval e s

interprete (If condExpr thenPart elsePart) s
    | cond /= 0	= interprete thenPart s
    | otherwise	= interprete elsePart s
    where
    cond = eval condExpr s

interprete st@(While condExpr body) s
    | cond /= 0	= let
		  s1 = interprete body s
		  in
		  interprete st s1
    | otherwise	= s
    where
    cond = eval condExpr s

interprete (StmtList sl) s
    = foldl (flip interprete) s sl

-- ------------------------------------------------------------
--
-- the expression evaluator

eval		:: Expr -> State -> Value
eval (Const val) s
    = val

eval (Var v) s
    = fromJust . M.lookup v $ s

eval (BinExpr op e1 e2) s
    = (fromJust . lookup op $ fctMap) val1 val2
      where
      val1 = eval e1 s
      val2 = eval e2 s
      fctMap = [ (Plus,		(+)	)
	       , (Minus,	(-)	)
	       , (Mult,		(*)	)
	       , (Div,		div	)
	       , (Equal,	pred (==))
	       , (NotEqual,	pred (/=))
	       , (GreaterThan,	pred (> ))
	       , (GreaterOrEq,	pred (>=))
	       ]
      pred rel x y
	  = fromEnum (x `rel` y)

-- ------------------------------------------------------------
--
-- greatest common divisor

idx = "x"
idy = "y"


prog1	:: Stmt
prog1
    = While
      ( BinExpr NotEqual x y )
      ( If
	( BinExpr GreaterThan x y )
	( Assign idx (BinExpr Minus x y) )
	( Assign idy (BinExpr Minus y x) )
      )
    where
    x  = Var idx
    y  = Var idy

state0	:: State
state0
    = M.fromList [(idx, 18), (idy, 10)]


state1 = interprete prog1 state0