Commit ec80900d authored by Pietro Abate's avatar Pietro Abate

Convert Descr.Abstrat to a BooVar Bdd

Tallying and printing still broken.
parent 4696df52
......@@ -75,7 +75,7 @@ and typ_descr = function
| Abstract "int" -> Builtin_defs.caml_int
| Abstract "char" -> Builtin_defs.char_latin1
| Abstract "string" -> Builtin_defs.string_latin1
| Abstract s -> Types.abstract (Types.Abstract.atom s)
| Abstract s -> Types.abstract (Types.Abstracts.atom s)
| Builtin ("list", [t])
| Builtin ("array", [t]) -> Types.descr (Sequence.star_node (typ t))
| Builtin ("Pervasives.ref", [t]) -> Builtin_defs.ref_type (typ t)
......
......@@ -614,7 +614,7 @@ EXTEND Gram
| "("; a = IDENT; ":="; c = expr; ")" ->
mk _loc (Constant (ident a,c))
| "!"; a = IDENT ->
mk _loc (Internal (Types.abstract (Types.Abstract.atom a)))
mk _loc (Internal (Types.abstract (Types.Abstracts.atom a)))
| ids = LIST1 ident_or_keyword SEP "." ->
let ids = List.map (fun x -> ident x) ids in
mk _loc (PatVar ids)
......
......@@ -250,7 +250,7 @@ and run_disp_kind env actions v =
| Abstraction (Some iface,_,sigma) ->
run_disp_basic v (fun t -> inzero env v t) actions.basic
| Abstract (abs,_) ->
run_disp_basic v (fun t -> Types.Abstract.contains abs (Types.get_abstract t))
run_disp_basic v (fun t -> Types.Abstract.has_abstract t abs (* Types.Abstracts.contains abs (Types.Abstract.get t) *))
actions.basic
| Absent ->
run_disp_basic v (fun t -> Types.Record.has_absent t) actions.basic
......
......@@ -18,7 +18,7 @@ and t =
| Integer of Intervals.V.t
| Char of Chars.V.t
| Abstraction of (Types.descr * Types.descr) list option * (t -> t) * sigma
| Abstract of Types.Abstract.V.t
| Abstract of Types.Abstracts.V.t
| String_latin1 of int * int * string * t
| String_utf8 of Utf8.uindex * Utf8.uindex * Utf8.t * t
| Concat of t * t
......@@ -531,7 +531,7 @@ let rec compare x y =
| _, Abstraction (_,_,_) ->
raise (CDuceExn (string_latin1 "comparing functional values"))
| Abstract (s1,v1), Abstract (s2,v2) ->
let c = Types.Abstract.T.compare s1 s2 in if c <> 0 then c
let c = Types.Abstracts.T.compare s1 s2 in if c <> 0 then c
else begin
match s1 with
|"float" -> Pervasives.compare (Obj.magic v1 : float) (Obj.magic v2 : float)
......
......@@ -19,7 +19,7 @@ and t =
| Integer of Intervals.V.t
| Char of Chars.V.t
| Abstraction of (Types.descr * Types.descr) list option * (t -> t) * sigma
| Abstract of Types.Abstract.V.t
| Abstract of Types.Abstracts.V.t
| String_latin1 of int * int * string * t
| String_utf8 of Utf8.uindex * Utf8.uindex * Utf8.t * t
| Concat of t * t
......@@ -73,7 +73,7 @@ val get_field_ascii : t -> string -> t
val get_variant : t -> string * t option
val abstract : Types.Abstract.abs -> 'a -> t
val abstract : Types.Abstracts.abs -> 'a -> t
val get_abstract : t -> 'a
val mk_ref : Types.t -> t -> t
......
......@@ -12,10 +12,9 @@ let parse_typ s =
module ESet = OUnitDiff.SetMake (struct
type t = (Var.var * Types.t)
let compare (v1,t1) (v2,t2) =
let a = Types.abstract Abstract.any in
if (v1,t1) == (v2,t2) then 0
else let c = Var.compare v1 v2 in if c <> 0 then c
else Types.compare (diff t1 a) (diff t2 a)
else Types.compare t1 t2
let pp_printer ppf (v,t) = Format.fprintf ppf "(%a = %a)" Var.pp v Types.Print.pp_type t
let pp_print_sep = OUnitDiff.pp_comma_separator
end)
......
......@@ -156,7 +156,7 @@ let float_abs =
"float"
let float =
Types.abstract (Types.Abstract.atom float_abs)
Types.abstract (Types.Abstracts.atom float_abs)
let any_attr_node = Types.cons (Types.record_fields (true,LabelMap.empty))
let any_xml,any_xml_seq,any_xml_content =
......
......@@ -40,7 +40,7 @@ val mk_ref: get:'a -> set:'a -> 'a Ident.label_map
val ref_type: Types.Node.t -> Types.t
val float: Types.t
val float_abs: Types.Abstract.abs
val float_abs: Types.Abstracts.abs
val any_xml : Types.t
......
This diff is collapsed.
open Ident
module BoolAtoms : BoolVar.S with
type s = Atoms.t and
type elem = Atoms.t Var.pairvar
module BoolIntervals : BoolVar.S with
type s = Intervals.t and
type elem = Intervals.t Var.pairvar
module BoolChars : BoolVar.S with
type s = Chars.t and
type elem = Chars.t Var.pairvar
type const =
| Integer of Intervals.V.t
| Atom of Atoms.V.t
......@@ -64,7 +54,7 @@ module CompUnit : sig
end
*)
module Abstract : sig
module Abstracts : sig
module T : Custom.T with type t = string
type abs = T.t
type t
......@@ -72,15 +62,26 @@ module Abstract : sig
val atom: abs -> t
val compare: t -> t -> int
module V : sig
type t = abs * Obj.t
end
module V : sig type t = abs * Obj.t end
val contains: abs -> t -> bool
end
(** Algebra **)
module BoolAtoms : BoolVar.S with
type s = Atoms.t and
type elem = Atoms.t Var.pairvar
module BoolIntervals : BoolVar.S with
type s = Intervals.t and
type elem = Intervals.t Var.pairvar
module BoolChars : BoolVar.S with
type s = Chars.t and
type elem = Chars.t Var.pairvar
module BoolAbstracts: BoolVar.S with
type s = Abstracts.t and
type elem = Abstracts.t Var.pairvar
include Custom.T
module Node : Custom.T
......@@ -140,7 +141,7 @@ val record : label -> Node.t -> t
val record_fields : bool * Node.t label_map -> t
val char : Chars.t -> t
val constant : const -> t
val abstract : Abstract.t -> t
val abstract : Abstracts.t -> t
(** Helpers *)
......@@ -154,8 +155,7 @@ val empty_open_record: t
(** Positive systems and least solutions **)
module Positive :
sig
module Positive : sig
type v
val forward: unit -> v
val define: v -> v -> unit
......@@ -303,7 +303,14 @@ module Char : sig
val any : t
end
val get_abstract: t -> Abstract.t
module Abstract : sig
val has_abstract : t -> Abstracts.T.t -> bool
val get: t -> BoolAbstracts.t
val any : t
end
(*
val get_abstract: t -> Abstracts.t
*)
val normalize : t -> 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