Commit 737730a2 authored by Pietro Abate's avatar Pietro Abate

More var.ml cleanup

- Var identifiers are now of type U.t instead of string
- Remove TVar from ast. Polymorphic variables are just types
parent af8cccfd
......@@ -105,7 +105,6 @@ and branches = (ppat * pexpr) list
and ppat = ppat' located
and ppat' =
| TVar of U.t (** polymorphic type variables *)
| PatVar of U.t list
| Cst of pexpr
| NsT of U.t
......
......@@ -25,7 +25,7 @@ module Gram = Camlp4.Struct.Grammar.Static.Make(Ulexer)
let id_dummy = U.mk "$$$"
let ident s =
let ident_aux s =
let b = Buffer.create (String.length s) in
let rec aux i =
if (i = String.length s) then Buffer.contents b
......@@ -35,8 +35,8 @@ let ident s =
in
aux 0
let label s = U.mk (ident s)
let ident s = U.mk (ident s)
let label s = U.mk (ident_aux s)
let ident s = U.mk (ident_aux s)
let prog = Gram.Entry.mk "prog"
let top_phrases = Gram.Entry.mk "toplevel phrases"
......@@ -596,17 +596,17 @@ EXTEND Gram
located_ident: [ [ a = ident_or_keyword -> (lop _loc,ident a) ] ];
pat: [
[ x = pat; "where";
b = LIST1 [ (la,a) = located_ident; "="; y = pat ->
(la,a,y) ] SEP "and"
-> mk _loc (Recurs (x,b)) ]
[ x = pat; "where";
b = LIST1 [ (la,a) = located_ident; "="; y = pat -> (la,a,y) ] SEP "and" ->
mk _loc (Recurs (x,b)) ]
| RIGHTA [ x = pat; "->"; y = pat -> mk _loc (Arrow (x,y))
| x = pat; "@"; y = pat -> mk _loc (Concat (x,y))
| x = pat; "+"; y = pat -> mk _loc (Merge (x,y)) ]
| "no_arrow" [ x = pat; "|"; y = pat -> mk _loc (Or (x,y)) ]
| "simple" [ x = pat; "&"; y = pat -> mk _loc (And (x,y))
| x = pat; "\\"; y = pat -> mk _loc (Diff (x,y)) ]
| "var_typ" [ x = PTYPE -> mk _loc (TVar (ident x)) ]
| "var_typ" [ x = PTYPE ->
mk _loc (Internal (Types.var (Var.mk (ident_aux x)))) ]
|
[ "{"; r = record_spec; "}" -> r
| "ref"; p = pat ->
......
module V = struct
type t = { id : string ; fr : int }
let dump ppf t = Format.fprintf ppf "{%s(%d)}" t.id t.fr
type t = { id : Ident.U.t ; fr : int }
let dump ppf t = Format.fprintf ppf "{%a(%d)}" Ident.U.print t.id t.fr
let compare x y = Pervasives.compare (x.id,x.fr) (y.id,y.fr)
let equal x y = (compare x y) = 0
let hash x = Hashtbl.hash (x.id,x.fr)
let check _ = ()
let id x = x.id
let is_fresh x = x.fr > 0
let fresh v = { v with fr = v.fr + 1 }
let mk id = { id = id ; fr = 0 }
let pp ppf x =
(*
let pre = if x.fr == 0 then "" else (Printf.sprintf "_fresh_%d" x.fr) in
*)
Format.fprintf ppf "'%s" x.id
let mk id = { id = Ident.U.mk id; fr = 0 }
let id x = Ident.U.get_str x.id
let fresh v = { v with fr = v.fr + 1 }
let pp ppf x = Format.fprintf ppf "'%a" Ident.U.print x.id
end
include V
......
......@@ -6,8 +6,8 @@ val pp : Format.formatter -> t -> unit
val mk : string -> t
val id : t -> string
val fresh : t -> t
val is_fresh : t -> bool
(*
val is_fresh : t -> bool
val is_internal : t -> bool
*)
......
......@@ -333,7 +333,6 @@ module IType = struct
(* Ast -> symbolic type *)
let rec derecurs env p =
match p.descr with
| TVar s -> mk_type (Types.var (Var.mk (U.to_string s)))
| PatVar ids -> derecurs_var env p.loc ids
| Recurs (p,b) -> derecurs (fst (derecurs_def env b)) p
| Internal t -> mk_type t
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment