While in Haskell

git-svn-id: https://slps.svn.sourceforge.net/svnroot/slps@725 ab42f6e0-554d-0410-b580-99e487e6eeb2

topics/exercises/README.txt

@@ -1,15 +1,16 @@
-while1	- a DCG parser for a fragment of While
-while2	- a DCG parser for While
-while3	- big step semantics for While (+ a DCG parser)
-while4	- small step semantics for While (+ a DCG parser)
-while5  - typed While
-xml1	- a DCG parser for XML subset (elements only)
-xml2	- a DCG parser for XML subset (elements and attributes)
-nb1	- abstract syntax for NB
-nb2	- semantics and types for NB
-lambda1	- lambda calculus abstract and concrete syntax in Prolog
-lambda2	- lambda caclulus with Church numbers
-lambda3 - lambda calculus abstract syntax, free variables, substitution, evaluation
-lambda4	- untyped lambda calculus with alpha conversion & fixed point combinator
-lambda5 - typed lambda calculus with alpha conversion
+while1	 - a DCG parser for a fragment of While
+while2	 - a DCG parser for While
+while3	 - big step semantics for While (+ a DCG parser)
+while4	 - small step semantics for While (+ a DCG parser)
+while5   - typed While
+while6   - While evaluation in Haskell (incomplete)
+xml1	 - a DCG parser for XML subset (elements only)
+xml2	 - a DCG parser for XML subset (elements and attributes)
+nb1	 - abstract syntax for NB
+nb2	 - semantics and types for NB
+lambda1	 - lambda calculus abstract and concrete syntax in Prolog
+lambda2	 - lambda caclulus with Church numbers
+lambda3  - lambda calculus abstract syntax, free variables, substitution, evaluation
+lambda4	 - untyped lambda calculus with alpha conversion & fixed point combinator
+lambda5  - typed lambda calculus with alpha conversion
 

topics/exercises/while6/Makefile

@@ -0,0 +1,6 @@
+test:
+	ghci while.hs
+
+clean:
+	rm -f *~
+

topics/exercises/while6/while.hs

@@ -0,0 +1,76 @@
+-- assignment 5, part 1
+{-
+lookup(M,X,Y) :- append(_,[(X,Y)|_],M).
+update([],X,Y,[(X,Y)]).
+update([(X,_)|M],X,Y,[(X,Y)|M]).
+update([(X1,Y1)|M1],X2,Y2,[(X1,Y1)|M2]) :- \+ X1 = X2, update(M1,X2,Y2,M2).
+-}
+mylookup :: Identifier -> LookupTable -> Maybe Int
+mylookup e [] = Nothing
+mylookup e ((x,v):xvs) = if e == x then Just v else mylookup e xvs
+
+--myupdate :: LookupTable -> Identifier -> Int -> LookupTable
+--myupdate ... = ...
+
+-- assignment 5, part 2
+data Statement
+ = SList Statement Statement
+ | Skip
+ | Assign Identifier AExpression
+ | IfThenElse BExpression Statement Statement
+ | While BExpression Statement
+
+data AExpression
+ = Number Int
+ | Identifier String
+ | Add AExpression AExpression
+ | Sub AExpression AExpression
+ | Mul AExpression AExpression
+
+data BExpression
+ = BTrue
+ | BFalse
+ | Equals AExpression AExpression
+ | LessThanOrEqual AExpression AExpression
+ | Not BExpression
+ | And BExpression BExpression
+
+type Identifier = String
+type LookupTable = [(Identifier, Int)]
+
+{- 
+y:=2;
+x:=(y+4);
+if (y = 2 ^ x = 6)
+ then
+  z := y
+ else
+  z := 1000;
+while x≤10 do x := (x + 1)
+-}
+test = SList (Assign "y" (Number 2))
+      (SList (Assign "x" (Add (Identifier "y") (Number 4)))
+      (SList (IfThenElse (And (Equals (Identifier "y") (Number 2)) (Equals (Identifier "x") (Number 6)))
+                         (Assign "z" (Identifier "y"))
+                         (Assign "z" (Number 1000)))
+      (While (LessThanOrEqual (Identifier "x") (Number 10))
+             (Assign "x" (Add (Identifier "x") (Number 1))))))
+
+skips = SList Skip Skip
+
+evals :: Statement -> LookupTable -> LookupTable
+evals (SList s1 s2) e = evals s2 (evals s1 e)
+evals Skip e = e
+-- evals (Assign i a) e = myupdate e i (evala a e)
+-- evals (IfThenElse b st se) e = ...
+-- evals (While b s) e = ...
+
+evala :: AExpression -> LookupTable -> Int
+evala (Number n) _ = n
+evala (Identifier i) e = maybe (error "Undefined variable") id (mylookup i e)
+evala (Add a1 a2) e = (evala a1 e) + (evala a2 e)
+evala (Sub a1 a2) e = (evala a1 e) - (evala a2 e)
+evala (Mul a1 a2) e = (evala a1 e) * (evala a2 e)
+
+-- evalb :: BExpression -> LookupTable -> Bool
+--- evalb ... = ...