Commits

Maxime Buquet committed cadb807

integer interval reduced to [0; 127], type Bf.t changed in order to implement
the opt function

Comments (0)

Files changed (3)

 module Env = Zip.Make (struct type t = int let zero = 0 end)
 
 type t =
-    | Plus
-    | Minus
+    | Plus of int
+    | Minus of int
     | Right
     | Left
     | Print
 
 let new_env () = Env.empty
 
+(* Plus / Minus: [0; 127], can loop. *)
 let rec eval env = function
-    | Plus :: tl ->
-            let v = Env.pop env in
-            let v = if v + 1 = 256 then 0 else v in
-            eval (Env.push (v + 1) env) tl
-    | Minus :: tl ->
-            let v = Env.pop env in
-            let v = if v - 1 = (-1) then 255 else v in
-            eval (Env.push (v - 1) env) tl
+    | (Plus i) :: tl ->
+            let v = ((Env.pop env) + i) mod 128 in
+            eval (Env.push v env) tl
+    | (Minus i) :: tl ->
+            let v = (Env.pop env) - i in
+            let v = if v <= (-1) then (256 - v) else v in
+            eval (Env.push v env) tl
     | Right :: tl ->
             eval (Env.right env) tl
     | Left :: tl ->
 let parse exp =
     let (||) exp (l1, l2) = (exp :: l1, l2) in
     let rec sub = function
-        | '+' :: tl -> (||) Plus (sub tl)
-        | '-' :: tl -> (||) Minus (sub tl)
+        | '+' :: tl -> (||) (Plus 1) (sub tl)
+        | '-' :: tl -> (||) (Minus 1) (sub tl)
         | '>' :: tl -> (||) Right (sub tl)
         | '<' :: tl -> (||) Left (sub tl)
         | '.' :: tl -> (||) Print (sub tl)
         | [] -> ([], [])
     in
         fst (sub exp)
+
+let rec opt = function
+    | (Plus n1) :: (Plus n2) :: tl ->
+        opt ((Plus (n1 + n2)) :: tl)
+    | (Minus n1) :: (Minus n2) :: tl ->
+        opt ((Minus (n1 + n2)) :: tl)
+    | (Plus n1) :: (Minus n2) :: tl -> (
+        match (n1 - n2) with
+            | 0 -> opt tl
+            | v when v > 0 -> opt ((Plus v) :: tl)
+            | v -> opt ((Minus (-v)) :: tl)
+        )
+    | (Minus n1) :: (Plus n2) :: tl -> (
+        match (n2 - n1) with
+            | 0 -> opt tl
+            | v when v > 0 -> opt ((Plus v) :: tl)
+            | v -> opt ((Minus (-v)) :: tl)
+        )
+    | Loop exp :: tl ->
+        (Loop (opt exp)) :: opt tl
+    | [] -> []
+    | exp :: tl -> exp :: opt tl
+
 val eval : Env.t -> t list -> Env.t
 val to_list : string -> char list
 val parse : char list -> t list
+val opt : t list -> t list
 
 let rec loop () =
     if (try
-            let () = print_string "\nbf> " in
-            let exp = read_line () in
+            let () = print_string "bf> " in
+            let exp = Bf.to_list (read_line ()) in
             let () = ignore (
-              Bf.eval (Bf.new_env ()) (Bf.parse (Bf.to_list exp))) in
+              Bf.eval (Bf.new_env ()) (
+                Bf.opt (Bf.parse exp))) in
               true
         with _ -> false)
     then
         loop ()
 
 let header () =
-    print_string "ml-brainfuck interpreter"
+    print_endline "ml-brainfuck interpreter"
 
 let main () =
     header ();