Skip to content
This repository
tag: v3
Fetching contributors…

Cannot retrieve contributors at this time

file 163 lines (132 sloc) 7.583 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163
(*
Copyright © 2011 MLstate

This file is part of OPA.

OPA is free software: you can redistribute it and/or modify it under the
terms of the GNU Affero General Public License, version 3, as published by
the Free Software Foundation.

OPA is distributed in the hope that it will be useful, but WITHOUT ANY
WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
more details.

You should have received a copy of the GNU Affero General Public License
along with OPA. If not, see <http://www.gnu.org/licenses/>.
*)


(** This module contains facilities to do some walk on the ast, like maping, folding, testing etc... *)

(** For constuctors and deconstructors, the functions should preferably be put in qmlAstCons.ml *)

(** Some work has been done to factor the code.
Se also traverse.ml in libqml.
*)

module Row :
sig

  val fold_left : ('a -> string -> QmlAst.ty -> 'a) -> 'a -> QmlAst.ty_row -> 'a
  val fold_left_map : ('a -> QmlAst.ty -> 'a * QmlAst.ty) -> 'a -> QmlAst.ty_row -> 'a * QmlAst.ty_row
  val fold_right : (string -> QmlAst.ty -> 'a -> 'a) -> QmlAst.ty_row -> 'a -> 'a

  val elements : QmlAst.ty_row -> ( string * QmlAst.ty ) list
  val ordered_elements : QmlAst.ty_row -> ( string * QmlAst.ty ) list

  (** like a fold_left, but the fields are sorted by increasing alphabetic order before the fold *)
  val ordered_fold : ('a -> string -> QmlAst.ty -> 'a) -> 'a -> QmlAst.ty_row -> 'a

  (** a more complete pos_of_field, with a double indexation *)
  val pos_of_field : QmlAst.ty_row -> (string * QmlAst.ty) array * (int * QmlAst.ty) StringMap.t

  (** field occur checking *)
  val has_field : string -> QmlAst.ty_row -> bool
  val get_field : string -> QmlAst.ty_row -> QmlAst.ty option

  val length : QmlAst.ty_row -> int

end

module Col :
sig
  (** Folds on the types that are below the edges of ty_col (two levels)
{e i.e.}, on the column [c] such that [TypeSum c = t],
if [t = { a: ta; b: tb } / { c: tc }], will fold on [ta, tb, tc] *)
  val fold_left_map : ('a -> QmlAst.ty -> 'a * QmlAst.ty) -> 'a -> QmlAst.ty_col -> 'a * QmlAst.ty_col

  (** Folds on the rows contained in the column, converted to record types
{e i.e.}, on the column [c] such that [TypeSum c = t],
if [t = { a: ta; b: tb } / { c: tc }], will fold on [ { a: ta; b: tb }, { c: tc } ]*)
  val fold_records : ('a -> QmlAst.ty -> 'a) -> 'a -> QmlAst.ty_col -> 'a
end

module Ty_sums :
sig
  val elements : QmlAst.ty list -> QmlAst.ty list
  val fold : (QmlAst.ty -> 'a -> 'a) -> QmlAst.ty list -> 'a -> 'a
end

module Type : TraverseInterface.TRAVERSE
  with
    type 'a t = QmlAst.ty constraint 'a = _ * _ * _
  and type 'a container = QmlAst.ty constraint 'a = _ * _ * _

module Top :
sig
  (* maps only at top-level, not recursively *)
  val iter_expr : (QmlAst.expr -> unit) -> QmlAst.code_elt -> unit
  val map_expr : (QmlAst.expr -> QmlAst.expr) -> QmlAst.code_elt -> QmlAst.code_elt
  val fold_expr : ('a -> QmlAst.expr -> 'a) -> 'a -> QmlAst.code_elt -> 'a
  val fold_map_expr : ('a -> QmlAst.expr -> 'a * QmlAst.expr) -> 'a -> QmlAst.code_elt -> 'a * QmlAst.code_elt
  (* same but the ident of expr is also used *)
  val fold_name_expr : ('a -> ( QmlAst.ident * QmlAst.expr) -> 'a ) -> 'a -> QmlAst.code_elt -> 'a
  val fold_names : ('a -> QmlAst.ident -> 'a) -> 'a -> QmlAst.code_elt -> 'a
  val map_name_expr : (QmlAst.ident * QmlAst.expr -> QmlAst.ident * QmlAst.expr) -> QmlAst.code_elt -> QmlAst.code_elt
  val fold_map_name_expr : ('a -> (QmlAst.ident * QmlAst.expr) -> 'a * (QmlAst.ident * QmlAst.expr)) -> 'a -> QmlAst.code_elt -> 'a * QmlAst.code_elt
  val iter_name_expr : (QmlAst.ident * QmlAst.expr -> unit) -> QmlAst.code_elt -> unit
end

module CodeExpr :
sig
  (* maps only at top-level, not recursively *)
  val iter : (QmlAst.expr -> unit) -> QmlAst.code -> unit
  val map : (QmlAst.expr -> QmlAst.expr) -> QmlAst.code -> QmlAst.code
  val fold : ('a -> QmlAst.expr -> 'a) -> 'a -> QmlAst.code -> 'a
  val fold_name_expr : ('a -> (QmlAst.ident *QmlAst.expr) -> 'a) -> 'a -> QmlAst.code -> 'a
  val fold_map_name_expr : ('a -> (QmlAst.ident * QmlAst.expr) -> 'a * (QmlAst.ident * QmlAst.expr)) -> 'a -> QmlAst.code -> 'a * QmlAst.code
  val map_name_expr : (QmlAst.ident * QmlAst.expr -> QmlAst.ident * QmlAst.expr) -> QmlAst.code -> QmlAst.code
  val fold_map : ('a -> QmlAst.expr -> 'a * QmlAst.expr) -> 'a -> QmlAst.code -> 'a * QmlAst.code
  val fold_names : ('a -> QmlAst.ident -> 'a) -> 'a -> QmlAst.code -> 'a

  val iter_with_code_elt : (QmlAst.code_elt -> QmlAst.expr -> unit) -> QmlAst.code -> unit
  val exists : (QmlAst.expr -> bool) -> QmlAst.code -> bool
end

module Code :
sig
  val filter_binding : (QmlAst.ident * QmlAst.expr -> bool) -> QmlAst.code -> QmlAst.code
  val iter_binding : (QmlAst.ident * QmlAst.expr -> unit) -> QmlAst.code -> unit
end

module Pattern :
sig
  val iter_down : (QmlAst.pat -> unit) -> QmlAst.pat -> unit
  val fold_down : ('a -> QmlAst.pat -> 'a) -> 'a -> QmlAst.pat -> 'a
  val foldmap_down : ('a -> QmlAst.pat -> 'a * QmlAst.pat) -> 'a -> QmlAst.pat -> 'a * QmlAst.pat
  val map_down : (QmlAst.pat -> QmlAst.pat) -> QmlAst.pat -> QmlAst.pat

  val get_fields : QmlAst.pat -> ( (string * QmlAst.pat) list * bool ) option (** extend : true *)
end

module Expr : sig
  include TraverseInterface.TRAVERSE with type 'a t = QmlAst.expr constraint 'a = _ * _ * _
                                      and type 'a container = QmlAst.expr constraint 'a = _ * _ * _

  (** fold with value environment,
first arg is used to update the environment:
-declared values are added with their expression in an option
-lambda and pattern var are added with None
-for lambda, the fold is applied in a currified way
*)
  val fold_with_env : ('env -> QmlAst.ident -> QmlAst.expr option -> 'env) -> 'env -> ('env -> 'a -> QmlAst.expr -> 'a) -> 'a -> QmlAst.expr -> 'a
  (** special case with a default environmemt *)
  val fold_with_exprmap : ?env:(QmlAst.expr option) IdentMap.t -> (QmlAst.expr option IdentMap.t -> 'a -> QmlAst.expr -> 'a) -> 'a -> QmlAst.expr -> 'a
end

module ExprPatt : sig
  val iter_down : (QmlAst.expr -> unit) -> (QmlAst.pat -> unit) -> QmlAst.expr -> unit
  val foldmap_down : ('a -> QmlAst.expr -> 'a * QmlAst.expr) -> ('a -> QmlAst.pat -> 'a * QmlAst.pat) -> 'a -> QmlAst.expr -> 'a * QmlAst.expr
  val map_down : (QmlAst.expr -> QmlAst.expr) -> (QmlAst.pat -> QmlAst.pat) -> QmlAst.expr -> QmlAst.expr
  val fold_down : ('a -> QmlAst.expr -> 'a) -> ('a -> QmlAst.pat -> 'a) -> 'a -> QmlAst.expr -> 'a
  val iter : (QmlAst.expr -> unit) -> (QmlAst.pat -> unit) -> QmlAst.expr -> unit
  val foldmap : ('a -> QmlAst.expr -> 'a * QmlAst.expr) -> ('a -> QmlAst.pat -> 'a * QmlAst.pat) -> 'a -> QmlAst.expr -> 'a * QmlAst.expr
  val map : (QmlAst.expr -> QmlAst.expr) -> (QmlAst.pat -> QmlAst.pat) -> QmlAst.expr -> QmlAst.expr
  val fold : ('a -> QmlAst.expr -> 'a) -> ('a -> QmlAst.pat -> 'a) -> 'a -> QmlAst.expr -> 'a
end

(** a test of occurence of anything depending on db in an expr *)
module UseDb :
sig
  val expr : QmlAst.expr -> bool
  val code_elt : ?ignore_declaration:bool -> QmlAst.code_elt -> bool
  val code : ?ignore_declaration:bool -> QmlAst.code -> bool
end

module Misc :
sig
  (** removes all nested Coerce at the top of the expression *)
  val remove_coerce : QmlAst.expr -> QmlAst.expr
  (** shows the number of nodes in the expressions of a code *)
  val code_size : QmlAst.code -> int
end
Something went wrong with that request. Please try again.