Commits

camlspotter  committed 7b94fec

more closure creation profile

  • Participants
  • Parent commits 48f87cd

Comments (0)

Files changed (2)

File ocaml/OMakefile

 
 # BYTE_ENABLED= true
 
-OCAMLINCLUDES +=
+OCAMLINCLUDES += ..
 
-OCAMLFLAGS    += -annot -w Ae -I ocaml/parsing -I ocaml/utils -I ..
+OCAMLFLAGS    += -annot -w Ae -I ocaml/parsing -I ocaml/utils
 OCAMLCFLAGS   +=
 OCAMLOPTFLAGS += 
 OCAML_LINK_FLAGS += 
 %.out.ml: %.ml ../pa_monad_custom/pa_monad.cmo ../pa_bind_inline/pa_bind_inline.cmo
 	camlp4o -printer OCaml ../pa_monad_custom/pa_monad.cmo ../planck/pa_bind_inline/pa_bind_inline.cmo $< > $@
 
-OCAMLDEPFLAGS= -syntax camlp4o -package sexplib.syntax,monad -I ..
+OCAMLDEPFLAGS= -syntax camlp4o -package sexplib.syntax,monad
 OCAMLPPFLAGS= -syntax camlp4o -package sexplib.syntax,monad
 
 FILES[] = 
 
   open Open
 
-  let take : Str.elem t = fun s -> match Str.peek s with
+  let take : Str.elem t = fun s -> 
+    Profile.incr ();
+    match Str.peek s with
     | None -> Error (Str.position s, "unexpected end of stream")
     | Some (elem, _pos, s') -> Ok (elem, s')
 
-  let take_ : unit t = fun s -> match Str.peek s with
+  let take_ : unit t = fun s -> 
+    Profile.incr ();
+    match Str.peek s with
     | None -> Error (Str.position s, "unexpected end of stream")
     | Some (_, _, s') -> Ok ((),s')
 
-  let position : Str.Pos.t t = fun st -> Ok (Str.position st, st)
+  let position : Str.Pos.t t = fun st -> Profile.incr (); Ok (Str.position st, st)
 
-  let error s : 'a t = fun st -> Error (Str.position st, s)
-  let throw err = fun _st -> Error err
+  let error s : 'a t = fun st -> Profile.incr (); Error (Str.position st, s)
+  let throw err = fun _st -> Profile.incr (); Error err
 
-  let critical_error pos s = raise (Critical_error (pos, s))
+  let critical_error pos s = Profile.incr (); raise (Critical_error (pos, s))
 
-  let throw e : 'a t = fun _st -> Error e
+  let throw e : 'a t = fun _st -> Profile.incr (); Error e
 
-  let stream : Str.t t = fun st -> Ok (st, st)
+  let stream : Str.t t = fun st -> Profile.incr (); Ok (st, st)
 
-  let eos : unit t = fun s -> match Str.peek s with
+  let eos : unit t = fun s -> 
+    Profile.incr ();
+    match Str.peek s with
     | Some _ -> Error (Str.position s, "end of stream expected")
     | None -> Ok ((), s)
 
   let (<?>) : 'a t -> string -> 'a t = fun c mes st ->
+    Profile.incr ();
     let res = c st in
     match res with
     | Ok _ -> res
     | Error (pos, _) -> Error (pos, "expected " ^ mes)
 
   let (<?!>) : 'a t -> string -> 'a t = fun c mes st ->
+    Profile.incr ();
     let res = c st in
     match res with
     | Ok _ -> res
     | Error (pos, _) -> Error (pos, mes)
 
   let (<?@>) : 'a t -> Str.Pos.t -> 'a t = fun c pos st ->
+    Profile.incr ();
     let res = c st in
     match res with
     | Ok _ -> res
          (String.concat " " (List.map Str.show_elem tkns))
 
   let tokens : Str.elem list -> unit t = fun elems str ->
+    Profile.incr ();
     let rec aux str = function
       | [] -> return () str
       | x::xs -> 
     aux str elems
   
   let option : 'a t -> 'a option t = fun com s ->
+    Profile.incr ();
     match com s with
     | Error _ -> return None s
     | Ok (v, s') -> return (Some v) s'
 
   let option_ : unit t -> unit t = fun com s ->
+    Profile.incr ();
     match com s with
     | Error _ -> return () s
     | Ok ((), s') -> return () s'
 
   let result : 'a t -> ('a, error) Result.t t = fun c st ->
+    Profile.incr ();
     match c st with
     | Ok (res, st) -> Ok (Ok res, st)
     | Error e -> Ok (Error e, st)
 
   let ( ?** ) : 'a t -> 'a list t = fun com ->
     let rec aux st = fun s ->
+      Profile.incr ();
       match com s with
       | Error _ -> return (List.rev st) s
       | Ok (v, s') -> aux (v :: st) s'
   
   let ( ?* ) : 'a t -> unit t = fun com ->
     let rec aux = fun s ->
+      Profile.incr ();
       match com s with
       | Error _ -> return () s
       | Ok (_v, s') -> aux  s'
 
   let surrounded left right content =
     left >>= fun _ ->
-      content >>= fun res ->
-        right >>= fun _ ->
-  	  return res
+    content >>= fun res ->
+    right >>= fun _ ->
+    return res
   
   let critical : 'a t -> 'a t = fun t st ->
+    Profile.incr ();
     match t st with
     | (Ok _ as res) -> res
     | Error (pos, s) -> raise (Critical_error (pos, s))
 
   let (<|>) : 'a t -> 'a t -> 'a t = fun c1 c2 st -> 
+    Profile.incr ();
     let pos0 = Str.position st in
     let res = c1 st in
     match res with
 
   (* CR jfuruse: _ is used in a different meaning than option_ *)
   let try_ : 'a t -> 'a t = fun c st ->
+    Profile.incr ();
     let pos0 = Str.position st in
     let res = c st in
     match res with
     | Error (_, err) -> Error (pos0, err)
 
   let (<!>) : 'a t -> 'a t -> 'a t = fun c1 c2 st -> 
+    Profile.incr ();
     Profile.start ();
     let pos = Str.position st in
     match c1 st with
         c2 st
 
   let (<<>) : 'a t -> 'a t -> 'a t = fun c1 c2 st ->
+    Profile.incr ();
     let pos = Str.position st in
     let res1 = c1 st in
     match res1 with
   (* Used for push back *)          
   let (<&>) : 'a t -> ('a -> 'b t) -> 'b t = fun c1 c2 -> 
     fun st ->
+      Profile.incr ();
       match c1 st with
       | Ok (v, _) -> c2 v st
       | (Error _ as res) -> res
       | None -> return None
       | Some _ -> c2 >>= fun v -> return (Some v)
 
-  let set_stream new_st _st = Ok ((), new_st)
+  let set_stream new_st _st = Profile.incr (); Ok ((), new_st)
 
   let run : 'a t -> Str.t -> ('a, error) Result.t = fun t st ->
+    Profile.incr ();
     match t st with
     | Ok (v, _) -> Ok v
     | Error err -> Error err