--- /dev/null
+implementation module RefactorX\r
+\r
+import StdEnv\r
+\r
+Start = map eval [E1,E2,E3,E4,E5]\r
+\r
+E1 = OP (LET "x" (OP (NR 42) MIN (NR 3)) (OP (VAR "x") DIV (NR 0)))\r
+ PLUS\r
+ (LET "y" (NR 6) (OP (VAR "y") MUL (VAR "y")))\r
+E2 = LET "x" (NR 42) (OP (VAR "x") PLUS (LET "x" (NR 58) (VAR "x")))\r
+E3 = LET "x" (NR 1) (LET "y" (NR 2) (LET "x" (NR 3) (NR 4)))\r
+E4 = LET "x" (NR 1) (OP (VAR "x") PLUS (VAR "y"))\r
+E5 = OP (LET "x" (NR 1) (VAR "x")) MUL (VAR "x")\r
+\r
+:: Expr = NR Int\r
+ | VAR Name\r
+ | OP Expr Operator Expr\r
+ | LET Name Expr Expr\r
+:: Name :== String\r
+:: Operator = PLUS | MIN | MUL | DIV\r
+:: Val = Result Int | Undef\r
+\r
+(<+) infixl 9 :: String a -> String | toString a\r
+(<+) str a = str +++ toString a\r
+\r
+instance toString Operator where\r
+ toString PLUS = "+"\r
+ toString MIN = "-"\r
+ toString MUL = "*"\r
+ toString DIV = "/"\r
+\r
+// expressies afdrukken:\r
+instance toString Expr where\r
+ toString (NR n) = toString n\r
+ toString (VAR s) = s\r
+ toString (LET s e1 e2) = "let " <+ s <+ " = " <+ e1 <+ " in " <+ e2\r
+ toString (OP e1 o e2) = bracket e1 <+ o <+ bracket e2\r
+ where\r
+ bracket :: Expr -> String\r
+ bracket (OP e1 o e2) = "(" <+ e1 <+ o <+ e2 <+ ")"\r
+ bracket (LET s e1 e2) = "(" <+ (LET s e1 e2) <+ ")"\r
+ bracket x = toString x\r
+\r
+// vrije variabelen:\r
+free :: Expr -> [Name]\r
+free (NR _) = []\r
+free (VAR s) = [s]\r
+free (LET s _ e2) = [n \\ n <- free e2 | n <> s]\r
+free (OP e1 _ e2) = (free e1) ++ (free e2)\r
+\r
+// verwijder deelexpressies met ongebruikte let-variabelen:\r
+remove_unused_lets :: Expr -> Expr\r
+remove_unused_lets (LET s e1 e2)\r
+| isMember s (free e2) = (LET s (remove_unused_lets e1) (remove_unused_lets e2))\r
+| otherwise = remove_unused_lets e2\r
+remove_unused_lets (OP e1 o e2) = OP (remove_unused_lets e1) o (remove_unused_lets e2)\r
+remove_unused_lets x = x\r
+\r
+// evaluator met tabel van naam-waarde paren:\r
+eval :: Expr -> Val\r
+eval e = fst (eval` e [])\r
+where\r
+ eval` :: Expr [(Name, Val)] -> (Val, [(Name, Val)])\r
+ eval` (NR n) vs = (Result n, [])\r
+ eval` (VAR s) vs = (find s vs, [])\r
+ where\r
+ find :: Name [(Name, Val)] -> Val\r
+ find _ [] = Undef\r
+ find s [(t,v):vs]\r
+ | s == t = v\r
+ | otherwise = find s vs\r
+ eval` (LET s e1 e2) vs = eval` e2 [(s,fst (eval` e1 vs)):vs]\r
+ eval` (OP e1 o e2) vs = (op o (fst (eval` e1 vs)) (fst (eval` e2 vs)), [])\r
+ where\r
+ op :: Operator Val Val -> Val\r
+ op _ Undef _ = Undef\r
+ op _ _ Undef = Undef\r
+ op PLUS (Result x) (Result y) = Result (x + y)\r
+ op MIN (Result x) (Result y) = Result (x - y)\r
+ op MUL (Result x) (Result y) = Result (x * y)\r
+ op DIV _ (Result 0) = Undef\r
+ op DIV (Result x) (Result y) = Result (x / y)\r