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

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 ...@@ -105,7 +105,6 @@ and branches = (ppat * pexpr) list
and ppat = ppat' located and ppat = ppat' located
and ppat' = and ppat' =
| TVar of U.t (** polymorphic type variables *)
| PatVar of U.t list | PatVar of U.t list
| Cst of pexpr | Cst of pexpr
| NsT of U.t | NsT of U.t
......
...@@ -25,7 +25,7 @@ module Gram = Camlp4.Struct.Grammar.Static.Make(Ulexer) ...@@ -25,7 +25,7 @@ module Gram = Camlp4.Struct.Grammar.Static.Make(Ulexer)
let id_dummy = U.mk "$$$" let id_dummy = U.mk "$$$"
let ident s = let ident_aux s =
let b = Buffer.create (String.length s) in let b = Buffer.create (String.length s) in
let rec aux i = let rec aux i =
if (i = String.length s) then Buffer.contents b if (i = String.length s) then Buffer.contents b
...@@ -35,8 +35,8 @@ let ident s = ...@@ -35,8 +35,8 @@ let ident s =
in in
aux 0 aux 0
let label s = U.mk (ident s) let label s = U.mk (ident_aux s)
let ident s = U.mk (ident s) let ident s = U.mk (ident_aux s)
let prog = Gram.Entry.mk "prog" let prog = Gram.Entry.mk "prog"
let top_phrases = Gram.Entry.mk "toplevel phrases" let top_phrases = Gram.Entry.mk "toplevel phrases"
...@@ -596,17 +596,17 @@ EXTEND Gram ...@@ -596,17 +596,17 @@ EXTEND Gram
located_ident: [ [ a = ident_or_keyword -> (lop _loc,ident a) ] ]; located_ident: [ [ a = ident_or_keyword -> (lop _loc,ident a) ] ];
pat: [ pat: [
[ x = pat; "where"; [ x = pat; "where";
b = LIST1 [ (la,a) = located_ident; "="; y = pat -> b = LIST1 [ (la,a) = located_ident; "="; y = pat -> (la,a,y) ] SEP "and" ->
(la,a,y) ] SEP "and" mk _loc (Recurs (x,b)) ]
-> mk _loc (Recurs (x,b)) ]
| RIGHTA [ x = pat; "->"; y = pat -> mk _loc (Arrow (x,y)) | 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 (Concat (x,y))
| x = pat; "+"; y = pat -> mk _loc (Merge (x,y)) ] | x = pat; "+"; y = pat -> mk _loc (Merge (x,y)) ]
| "no_arrow" [ x = pat; "|"; y = pat -> mk _loc (Or (x,y)) ] | "no_arrow" [ x = pat; "|"; y = pat -> mk _loc (Or (x,y)) ]
| "simple" [ x = pat; "&"; y = pat -> mk _loc (And (x,y)) | "simple" [ x = pat; "&"; y = pat -> mk _loc (And (x,y))
| x = pat; "\\"; y = pat -> mk _loc (Diff (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 [ "{"; r = record_spec; "}" -> r
| "ref"; p = pat -> | "ref"; p = pat ->
......
module V = struct module V = struct
type t = { id : string ; fr : int } type t = { id : Ident.U.t ; fr : int }
let dump ppf t = Format.fprintf ppf "{%s(%d)}" t.id t.fr 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 compare x y = Pervasives.compare (x.id,x.fr) (y.id,y.fr)
let equal x y = (compare x y) = 0 let equal x y = (compare x y) = 0
let hash x = Hashtbl.hash (x.id,x.fr) let hash x = Hashtbl.hash (x.id,x.fr)
let check _ = () let check _ = ()
let id x = x.id
let is_fresh x = x.fr > 0 let is_fresh x = x.fr > 0
let fresh v = { v with fr = v.fr + 1 }
let mk id = { id = id ; fr = 0 } let mk id = { id = Ident.U.mk id; fr = 0 }
let id x = Ident.U.get_str x.id
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 fresh v = { v with fr = v.fr + 1 } let pp ppf x = Format.fprintf ppf "'%a" Ident.U.print x.id
end end
include V include V
......
...@@ -6,8 +6,8 @@ val pp : Format.formatter -> t -> unit ...@@ -6,8 +6,8 @@ val pp : Format.formatter -> t -> unit
val mk : string -> t val mk : string -> t
val id : t -> string val id : t -> string
val fresh : t -> t val fresh : t -> t
val is_fresh : t -> bool
(* (*
val is_fresh : t -> bool
val is_internal : t -> bool val is_internal : t -> bool
*) *)
......
...@@ -333,7 +333,6 @@ module IType = struct ...@@ -333,7 +333,6 @@ module IType = struct
(* Ast -> symbolic type *) (* Ast -> symbolic type *)
let rec derecurs env p = let rec derecurs env p =
match p.descr with match p.descr with
| TVar s -> mk_type (Types.var (Var.mk (U.to_string s)))
| PatVar ids -> derecurs_var env p.loc ids | PatVar ids -> derecurs_var env p.loc ids
| Recurs (p,b) -> derecurs (fst (derecurs_def env b)) p | Recurs (p,b) -> derecurs (fst (derecurs_def env b)) p
| Internal t -> mk_type t | 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