parameters.ml 3.69 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13
(******************************************************************************)
(*                                                                            *)
(*                                   Menhir                                   *)
(*                                                                            *)
(*                       François Pottier, Inria Paris                        *)
(*              Yann Régis-Gianas, PPS, Université Paris Diderot              *)
(*                                                                            *)
(*  Copyright Inria. All rights reserved. This file is distributed under the  *)
(*  terms of the GNU General Public License version 2, as described in the    *)
(*  file LICENSE.                                                             *)
(*                                                                            *)
(******************************************************************************)

14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30
(* TEMPORARY clean up and write an .mli file *)

open Syntax
open Positions

let app p ps =
  match ps with
  | [] ->
      ParameterVar p
  | _ ->
      ParameterApp (p, ps)

let unapp = function
  | ParameterVar x ->
      (x, [])
  | ParameterApp (p, ps) ->
      (p, ps)
31 32 33
  | ParameterAnonymous _ ->
      (* Anonymous rules are eliminated early on. *)
      assert false
34

35 36 37 38 39 40 41
let unvar = function
  | ParameterVar x ->
      x
  | ParameterApp _
  | ParameterAnonymous _ ->
      assert false

42 43 44 45 46
let rec map f = function
  | ParameterVar x ->
      ParameterVar (f x)
  | ParameterApp (p, ps) ->
      ParameterApp (f p, List.map (map f) ps)
47 48 49
  | ParameterAnonymous _ ->
      (* Anonymous rules are eliminated early on. *)
      assert false
50 51 52 53 54 55

let rec fold f init = function
  | ParameterVar x ->
      f init x
  | ParameterApp (p, ps) ->
      f (List.fold_left (fold f) init ps) p
56 57 58
  | ParameterAnonymous _ ->
      (* Anonymous rules are eliminated early on. *)
      assert false
59 60

let identifiers m p =
61
  fold (fun accu x -> StringMap.add x.value x.position accu) m p
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
let rec occurs (x : symbol) (p : parameter) =
  match p with
  | ParameterVar y ->
      x = y.value
  | ParameterApp (y, ps) ->
      x = y.value || List.exists (occurs x) ps
  | ParameterAnonymous _ ->
      assert false

let occurs_shallow (x : symbol) (p : parameter) =
  match p with
  | ParameterVar y ->
      x = y.value
  | ParameterApp (y, _) ->
      assert (x <> y.value);
      false
  | ParameterAnonymous _ ->
      assert false

let occurs_deep (x : symbol) (p : parameter) =
  match p with
  | ParameterVar _ ->
      false
  | ParameterApp (_, ps) ->
      List.exists (occurs x) ps
  | ParameterAnonymous _ ->
      assert false

91 92
type t = parameter

93
let rec equal x y =
94
  match x, y with
95 96
    | ParameterVar x, ParameterVar y ->
        x.value = y.value
97
    | ParameterApp (p1, p2), ParameterApp (p1', p2') ->
98
        p1.value = p1'.value && List.for_all2 equal p2 p2'
99 100 101
    | _ ->
        (* Anonymous rules are eliminated early on. *)
        false
102 103 104 105 106

let hash = function
  | ParameterVar x
  | ParameterApp (x, _) ->
      Hashtbl.hash (Positions.value x)
107 108 109
  | ParameterAnonymous _ ->
      (* Anonymous rules are eliminated early on. *)
      assert false
110 111

let position = function
112
  | ParameterVar x
113 114
  | ParameterApp (x, _) ->
      Positions.position x
115 116
  | ParameterAnonymous bs ->
      Positions.position bs
117 118 119

let with_pos p =
  Positions.with_pos (position p) p
120

121 122 123
let rec print with_spaces = function
  | ParameterVar x
  | ParameterApp (x, []) ->
124 125
      x.value
  | ParameterApp (x, ps) ->
126 127 128 129
      let separator = if with_spaces then ", " else "," in
      Printf.sprintf "%s(%s)"
        x.value
        (Misc.separated_list_to_string (print with_spaces) separator ps)
130 131
  | ParameterAnonymous _ ->
      assert false