Commits

camlspotter committed efb6c79 Merge

merge

  • Participants
  • Parent commits 98625ee, 9a80020
  • Branches profile

Comments (0)

Files changed (4)

 let _ =
   let files = 
     let rev_files = ref [] in
-    Arg.parse [] (fun s -> rev_files := s :: !rev_files) "lambda <scripts>";
+    Arg.parse ["-print-step", Arg.Set Vm.Eval.print_step, "print execution states" ] (fun s -> rev_files := s :: !rev_files) "lambda <scripts>";
     List.rev !rev_files 
   in
   match files with
 
 ((fun (x) x) 
    (add 1 2))
-
+ 
 (let (id (fun (x) x)))
-
+ 
 ; partial application
 (let (succ (add 1)))
-
+ 
 (succ 2)
-
+ 
 ; conditional
 (if #true 10 20)
-
+ 
 (add 43 -1)
-
+ 
 ; multi parameter
 (let (sub (fun (x y) ((prim - 2) x y))))
+ 
+(sub 10)
 
 (sub 10 5)
 
 	        (add (fib (sub x 1))
 		     (fib (sub x 2))))))))
 
-(fib 30)
-   
+(fib 10)
   Format.eprintf "@.exec@.";
   let codes = Array.append existing_codes codes in
   let state = { Vm.State.pc = pc; stack = []; env = venv; prof = Profile.create () } in
-  let v, venv, prof = Vm.Eval.run codes state in
+  let v, prof = Vm.Eval.run codes state in
   Format.eprintf "@.result=%a@." Sexplib.Sexp.pp_hum (Vm.Value.sexp_of_t v);
   Format.printf "%a@." Sexplib.Sexp.pp_hum (Vm.Value.sexp_of_t v);
   Format.eprintf "%a@." Profile.format prof;
-  v, codes, venv
+  v, codes
 
 let exec env existing_codes venv top =
   let identopt, deb = to_deb env top in
   match top, identopt, deb with
   | Expr _, None, d ->
-      let _v, codes, venv = exec_deb existing_codes venv [] d in
+      let _v, codes = exec_deb existing_codes venv [ Vm.Code.Label (Vm.Label.create ())] d in
       env, codes, venv
 
   | Let (name, _), Some ident, d ->
-      let v, codes, venv = exec_deb existing_codes venv [ Vm.Code.Comment (Printf.sprintf "top let %s = ..." name) ] d in
+      let v, codes = exec_deb existing_codes venv [ Vm.Code.Comment (Printf.sprintf "top let %s = ..." name)
+                                                        ; Vm.Code.Label (Vm.Label.create ())
+                                                        ] d 
+      in
       (name, ident) :: env, codes, Vm.Env.push venv ident v
 
   | Letrec (name, _), Some ident, d ->
-      let v, codes, venv = exec_deb existing_codes venv [ Vm.Code.Comment (Printf.sprintf "top letrec %s = ..." name) ] d in
+      let v, codes = exec_deb existing_codes venv [ Vm.Code.Comment (Printf.sprintf "top letrec %s = ..." name)
+                                                        ; Vm.Code.Label (Vm.Label.create ())
+                                                        ] d 
+      in
       (name, ident) :: env, codes, Vm.Env.push venv ident v
 
   | _ -> assert false
         * Ident.t list (** waiting arg names *)
         * env         (** freevars+applied args *)
 
-    | Frame of (** return information from function call *)
+     | Frame of (** return information from function call *)
         int (** return adrs *)
         * env       (** return environment *)
 
 
 module Code : sig
 
+  (* Almost identical to CAM *)
   type t =
     | Push_prim of Prim.t (* not a value ? *)
     | Push_const of Const.t (* not a value ? *)
 
 module Eval : sig
 
-  val step : ?print_step: bool -> Code.t array -> State.t -> State.t
+  val print_step : bool ref
+
+  val step : Code.t array -> State.t -> State.t
   (** One step evaluation *)
 
-  val run : ?print_step: bool -> Code.t array -> State.t -> Value.t * Env.t * Profile.t
-  (** Evaluate till the end. PC is set to -1 *)
+  val run : Code.t array -> State.t -> Value.t * Profile.t
+  (** Evaluate till the end. *)
 
 end = struct
 
 
   module C = Code
 
+  let print_step = ref false
+
   (** One step evaluation *)    
-  let step ?(print_step=false) code_groups ({ pc; env; stack; prof } as state) =
+  let step code_groups ({ pc; env; stack; prof } as state) =
     let code = code_groups.(pc) in
     match code with
     | C.Comment _ -> { state with pc = pc + 1 } (* NOP *)
     | _ -> 
-        if print_step then begin
+        if !print_step then begin
           Format.eprintf "%d %a@." pc Sexplib.Sexp.pp_hum (Code.sexp_of_t code);
           Format.eprintf "    STACK %a@." Sexplib.Sexp.pp_hum (Stack.sexp_of_t stack);
 (*
             Profile.exit prof id;
             { state with pc = pc + 1 }
             
-  let run ?print_step codes state =
+  let run codes state =
     let rec loop state =
-      let state = step ?print_step codes state in
+      let state = step codes state in
       if state.pc = -1 then 
         match state.stack with
-        | [v] -> v, state.env, state.prof
+        | [v] -> v, state.prof
         | _ -> assert false
       else loop state
     in