Commits

camlspotter committed d53de2f

added loop for ocaml

Comments (0)

Files changed (2)

   | Object of (string * t) list
   | Tuple of t list
   | Unit
+  | Let_rec of string * t * t
+  | Var of string
 
 type ocaml = t
 
 	(format_list sep f) xs
 
 let format ?(no_poly=false) ?(raw_string=false) ppf v = 
+  let f = fprintf in
   let rec format ppf = function
-    | Bool b -> fprintf ppf "%b" b
-    | Int31 i -> fprintf ppf "%d" i
-    | Int63 i -> fprintf ppf "%Ld" i
-    | Int32 i -> fprintf ppf "%ldl" i
-    | Int64 i -> fprintf ppf "%LdL" i
-    | Nativeint32 i -> fprintf ppf "%ldn" i
-    | Nativeint64 i -> fprintf ppf "%Ldn" i
-    | Float f -> fprintf ppf "%F" f
-    | Char c -> fprintf ppf "%C" c
-    | String s -> if raw_string then fprintf ppf "\"%s\"" s else fprintf ppf "%S" s
-    | List [] -> fprintf ppf "[]"
-    | List ts -> fprintf ppf "[ @[%a@] ]" (format_list ";@ " format) ts
-    | Array ts -> fprintf ppf "[ @[%a@] ]" (format_list ";@ " format) ts
-    | Variant ("::", [hd;tl]) -> fprintf ppf "@[<2>(%a@ :: %a)@]" format hd format tl
-    | Variant (tag, []) -> fprintf ppf "%s" tag
-    | Variant (tag, [t]) -> fprintf ppf "@[<2>%s@ @[%a@]@]" tag format t
-    | Variant (tag, ts) -> fprintf ppf "@[<2>%s@ (@[%a@])@]" tag (format_list ",@ " format) ts
-    | Poly_variant (tag, [])  when no_poly -> fprintf ppf "%s" tag
-    | Poly_variant (tag, [t]) when no_poly -> fprintf ppf "@[<2>%s@ @[%a@]@]" tag format t
-    | Poly_variant (tag, ts)  when no_poly -> fprintf ppf "@[<2>%s@ (@[%a@])@]" tag (format_list ",@ " format) ts
-    | Poly_variant (tag, []) -> fprintf ppf "`%s" tag
-    | Poly_variant (tag, [t]) -> fprintf ppf "@[<2>`%s@ @[%a@]@]" tag format t
-    | Poly_variant (tag, ts) -> fprintf ppf "@[<2>`%s@ (@[%a@])@]" tag (format_list ",@ " format) ts
-    | Record fields -> fprintf ppf "@[<2>{ @[%a@] }@]" (format_list ";@ " (fun ppf (f, v) -> fprintf ppf "%s= %a" f format v)) fields
-    | Object fields when no_poly -> fprintf ppf "@[<2>{ @[%a@] }@]" (format_list ";@ " (fun ppf (f, v) -> fprintf ppf "%s= %a" f format v)) fields
-    | Object fields -> fprintf ppf "@[@[<2>object@,@[%a@]@]@,end@]" (format_list "@ " (fun ppf (f, v) -> fprintf ppf "method %s= %a" f format v)) fields
-    | Tuple ts -> fprintf ppf "(@[%a@])" (format_list ",@ " format) ts
-    | Unit -> fprintf ppf "()"
+    | Bool b -> f ppf "%b" b
+    | Int31 i -> f ppf "%d" i
+    | Int63 i -> f ppf "%Ld" i
+    | Int32 i -> f ppf "%ldl" i
+    | Int64 i -> f ppf "%LdL" i
+    | Nativeint32 i -> f ppf "%ldn" i
+    | Nativeint64 i -> f ppf "%Ldn" i
+    | Float fl -> f ppf "%F" fl
+    | Char c -> f ppf "%C" c
+    | String s -> if raw_string then f ppf "\"%s\"" s else f ppf "%S" s
+    | List [] -> f ppf "[]"
+    | List ts -> f ppf "[ @[%a@] ]" (format_list ";@ " format) ts
+    | Array ts -> f ppf "[ @[%a@] ]" (format_list ";@ " format) ts
+    | Variant ("::", [hd;tl]) -> f ppf "@[<2>(%a@ :: %a)@]" format hd format tl
+    | Variant (tag, []) -> f ppf "%s" tag
+    | Variant (tag, [t]) -> f ppf "@[<2>%s@ @[%a@]@]" tag format t
+    | Variant (tag, ts) -> f ppf "@[<2>%s@ (@[%a@])@]" tag (format_list ",@ " format) ts
+    | Poly_variant (tag, [])  when no_poly -> f ppf "%s" tag
+    | Poly_variant (tag, [t]) when no_poly -> f ppf "@[<2>%s@ @[%a@]@]" tag format t
+    | Poly_variant (tag, ts)  when no_poly -> f ppf "@[<2>%s@ (@[%a@])@]" tag (format_list ",@ " format) ts
+    | Poly_variant (tag, []) -> f ppf "`%s" tag
+    | Poly_variant (tag, [t]) -> f ppf "@[<2>`%s@ @[%a@]@]" tag format t
+    | Poly_variant (tag, ts) -> f ppf "@[<2>`%s@ (@[%a@])@]" tag (format_list ",@ " format) ts
+    | Record fields -> f ppf "@[<2>{ @[%a@] }@]" (format_list ";@ " (fun ppf (fi, v) -> f ppf "%s= %a" fi format v)) fields
+    | Object fields when no_poly -> f ppf "@[<2>{ @[%a@] }@]" (format_list ";@ " (fun ppf (fi, v) -> f ppf "%s= %a" fi format v)) fields
+    | Object fields -> f ppf "@[@[<2>object@,@[%a@]@]@,end@]" (format_list "@ " (fun ppf (fi, v) -> f ppf "method %s= %a" fi format v)) fields
+    | Tuple ts -> f ppf "(@[%a@])" (format_list ",@ " format) ts
+    | Unit -> f ppf "()"
+    | Var s -> pp_print_string ppf s
+    | Let_rec (s, t1, t2) -> f ppf "@[@[<2>let rec %s = %a in@]@ %a@]" s format t1 format t2
   in
   format ppf v
 
 
   let format_error ppf e = 
     let open Format in
+    let f = fprintf in
     let loc = loc_of_error e in
-    if not (loc = Location.none) then fprintf ppf "%a: " Location.print loc;
+    if not (loc = Location.none) then f ppf "%a: " Location.print loc;
     match e with
-    | `Invalid_construct _ -> fprintf ppf "invalid construct for simple ocaml value"
-    | `Exn (Failure s) -> fprintf ppf "failure: %s" s
-    | `Exn exn  -> fprintf ppf "exn: %s" (Printexc.to_string exn)
-    | `Lexer (_loc, e)  -> fprintf ppf "lexer error: %a"  Lexer.report_error e
-    | `Parser e -> fprintf ppf "parser error: %a" Syntaxerr.report_error e
+    | `Invalid_construct _ -> f ppf "invalid construct for simple ocaml value"
+    | `Exn (Failure s) -> f ppf "failure: %s" s
+    | `Exn exn  -> f ppf "exn: %s" (Printexc.to_string exn)
+    | `Lexer (_loc, e)  -> f ppf "lexer error: %a"  Lexer.report_error e
+    | `Parser e -> f ppf "parser error: %a" Syntaxerr.report_error e
 
   let () = Printexc.register_printer (function
     | Error e -> Some (format_sprintf "%a" format_error e)
     | Pexp_object class_str ->
         (* Ignores class_str.pcstr_pat *)
         object_ class_str.pcstr_fields
+    | Pexp_let (Recursive, [ {ppat_desc = Ppat_var {txt = s}}, e1], e2) -> Let_rec (s, expression e1, expression e2)
+    | Pexp_ident {txt = Longident.Lident s } -> Var s
     | _ -> invalid e.pexp_loc
 
   and constant = function
   | Object of (string * t) list
   | Tuple of t list
   | Unit
+  | Let_rec of string * t * t
+  | Var of string
 
 type ocaml = t