-- -------------------------------------------------------------------
--
-- appD.gs
-- 
-- An implementation of appendix D of
-- [Nielson and Nielson, semantics with applications]
--
-- -------------------------------------------------------------------
   
-- -------------------------------------------------------------------
-- Secion D.1  Direct style semantics
-- -------------------------------------------------------------------

cond (p, g1, g2) s	=  g1 s, if p s
			=  g2 s, if not(p s)

fix ff			=  ff (fix ff)

s_ds			:: Stm -> State -> State
s_ds (Ass x a)		=  \s -> update s (a_val a s) x
			   where update s v x y = v,   if x == y
			                        = s y, otherwise
s_ds Skip		=  id
s_ds (Comp ss1 ss2)	=  (s_ds ss2) .  (s_ds ss1)
s_ds (If b ss1 ss2)	=  cond (b_val b, s_ds ss1, s_ds ss2)
s_ds (While b ss) 	=  fix ff where ff g = cond(b_val b, g . s_ds ss, id)

-- Example D.1
s_final = s_ds factorial s_init
-- End Example D.1