RefactorX camil
authorCamil Staps <info@camilstaps.nl>
Mon, 18 May 2015 12:47:30 +0000 (14:47 +0200)
committerCamil Staps <info@camilstaps.nl>
Mon, 18 May 2015 12:47:30 +0000 (14:47 +0200)
fp2/week45/camil/RefactorX.dcl [new file with mode: 0644]
fp2/week45/camil/RefactorX.icl [new file with mode: 0644]

diff --git a/fp2/week45/camil/RefactorX.dcl b/fp2/week45/camil/RefactorX.dcl
new file mode 100644 (file)
index 0000000..3ddc8a4
--- /dev/null
@@ -0,0 +1,18 @@
+definition module RefactorX\r
+\r
+import StdEnv\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
+from StdClass import class toString\r
+\r
+instance toString Expr\r
+free                           :: Expr -> [Name]\r
+remove_unused_lets     :: Expr -> Expr\r
+eval                           :: Expr -> Val\r
diff --git a/fp2/week45/camil/RefactorX.icl b/fp2/week45/camil/RefactorX.icl
new file mode 100644 (file)
index 0000000..3f273e0
--- /dev/null
@@ -0,0 +1,82 @@
+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