Skip to content

Commit

Permalink
Remove Ast_helper.Convenience submodule. This is better located in th…
Browse files Browse the repository at this point in the history
…e ppx_tools package.

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@14664 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
  • Loading branch information
alainfrisch committed Apr 23, 2014
1 parent 07bc0e6 commit c0f8627
Show file tree
Hide file tree
Showing 2 changed files with 0 additions and 139 deletions.
71 changes: 0 additions & 71 deletions parsing/ast_helper.ml
Original file line number Diff line number Diff line change
Expand Up @@ -404,74 +404,3 @@ module Exrb = struct
pexrb_loc = loc;
}
end

module Convenience = struct
open Location

let may_tuple tup = function
| [] -> None
| [x] -> Some x
| l -> Some (tup ?loc:None ?attrs:None l)

let lid s = mkloc (Longident.parse s) !default_loc
let tuple l = Exp.tuple l
let constr s args = Exp.construct (lid s) (may_tuple Exp.tuple args)
let nil () = constr "[]" []
let unit () = constr "()" []
let cons hd tl = constr "::" [hd; tl]
let list l = List.fold_right cons l (nil ())
let str s = Exp.constant (Const_string (s, None))
let int x = Exp.constant (Const_int x)
let char x = Exp.constant (Const_char x)
let float x = Exp.constant (Const_float (string_of_float x))
let record ?over l =
Exp.record (List.map (fun (s, e) -> (lid s, e)) l) over
let func l = Exp.function_ (List.map (fun (p, e) -> Exp.case p e) l)
let lam ?(label = "") ?default pat exp = Exp.fun_ label default pat exp
let app f l = Exp.apply f (List.map (fun a -> "", a) l)
let evar s = Exp.ident (lid s)
let let_in ?(recursive = false) b body =
Exp.let_ (if recursive then Recursive else Nonrecursive) b body

let pvar s = Pat.var (mkloc s !default_loc)
let pconstr s args = Pat.construct (lid s) (may_tuple Pat.tuple args)
let precord ?(closed = Open) l =
Pat.record (List.map (fun (s, e) -> (lid s, e)) l) closed
let pnil () = pconstr "[]" []
let pcons hd tl = pconstr "::" [hd; tl]
let punit () = pconstr "()" []
let plist l = List.fold_right pcons l (pnil ())
let ptuple l = Pat.tuple l

let pstr s = Pat.constant (Const_string (s, None))
let pint x = Pat.constant (Const_int x)
let pchar x = Pat.constant (Const_char x)
let pfloat x = Pat.constant (Const_float (string_of_float x))

let tconstr c l = Typ.constr (lid c) l

let get_str = function
| {pexp_desc=Pexp_constant (Const_string (s, _)); _} -> Some s
| e -> None

let get_lid = function
| {pexp_desc=Pexp_ident{txt=id;_};_} ->
Some (String.concat "." (Longident.flatten id))
| _ -> None

let find_attr s attrs =
try Some (snd (List.find (fun (x, _) -> x.txt = s) attrs))
with Not_found -> None

let expr_of_payload = function
| PStr [{pstr_desc=Pstr_eval(e, _)}] -> Some e
| _ -> None

let find_attr_expr s attrs =
match find_attr s attrs with
| Some e -> expr_of_payload e
| None -> None

let has_attr s attrs =
find_attr s attrs <> None
end
68 changes: 0 additions & 68 deletions parsing/ast_helper.mli
Original file line number Diff line number Diff line change
Expand Up @@ -340,71 +340,3 @@ module Exrb:
sig
val mk: ?loc:loc -> ?attrs:attrs -> str -> lid -> exception_rebind
end


(** {2 Convenience functions} *)

(** Convenience functions to help build and deconstruct AST fragments. *)
module Convenience :
sig

(** {2 Misc} *)

val lid: string -> lid

(** {2 Expressions} *)

val evar: string -> expression
val let_in: ?recursive:bool -> value_binding list -> expression -> expression

val constr: string -> expression list -> expression
val record: ?over:expression -> (string * expression) list -> expression
val tuple: expression list -> expression

val nil: unit -> expression
val cons: expression -> expression -> expression
val list: expression list -> expression

val unit: unit -> expression

val func: (pattern * expression) list -> expression
val lam: ?label:string -> ?default:expression -> pattern -> expression -> expression
val app: expression -> expression list -> expression

val str: string -> expression
val int: int -> expression
val char: char -> expression
val float: float -> expression

(** {2 Patterns} *)

val pvar: string -> pattern
val pconstr: string -> pattern list -> pattern
val precord: ?closed:closed_flag -> (string * pattern) list -> pattern
val ptuple: pattern list -> pattern

val pnil: unit -> pattern
val pcons: pattern -> pattern -> pattern
val plist: pattern list -> pattern

val pstr: string -> pattern
val pint: int -> pattern
val pchar: char -> pattern
val pfloat: float -> pattern

val punit: unit -> pattern


(** {2 Types} *)

val tconstr: string -> core_type list -> core_type

(** {2 AST deconstruction} *)

val get_str: expression -> string option
val get_lid: expression -> string option

val has_attr: string -> attributes -> bool
val find_attr: string -> attributes -> payload option
val find_attr_expr: string -> attributes -> expression option
end

0 comments on commit c0f8627

Please sign in to comment.