Commit d1a25cde authored by Kim Nguyễn's avatar Kim Nguyễn

Implement some semantic simplification of BDDs. This fixes the exponential...

Implement some semantic simplification of BDDs. This fixes the exponential beahviour during the typing of the application of flatten.
parent a8f46774
...@@ -98,8 +98,8 @@ struct ...@@ -98,8 +98,8 @@ struct
| _ -> () | _ -> ()
let rec dump ppf = function let rec dump ppf = function
| True -> Format.fprintf ppf "⊤"
| False -> Format.fprintf ppf "⊥" | False -> Format.fprintf ppf "⊥"
| True -> Format.fprintf ppf "⊤"
| Split (_,x, p,i,n) -> | Split (_,x, p,i,n) ->
Format.fprintf ppf "@[@[%a@][@[<hov>%a,@\n%a,@\n%a@]]@]" Format.fprintf ppf "@[@[%a@][@[<hov>%a,@\n%a,@\n%a@]]@]"
X.dump x dump p dump i dump n X.dump x dump p dump i dump n
......
...@@ -2,11 +2,12 @@ let flatten_all (l : X where X = [ ( 'a \ [Any*] | X)* ]) : [ ( 'a \ [Any*] )* ...@@ -2,11 +2,12 @@ let flatten_all (l : X where X = [ ( 'a \ [Any*] | X)* ]) : [ ( 'a \ [Any*] )*
match l with match l with
[] -> [] [] -> []
| (e \[Any*], ll) -> (e, flatten_all ll) | (e \[Any*], ll) -> (e, flatten_all ll)
| (ll1, ll2) -> (flatten_all ll1) @ (flatten_all ll2) | (ll1, ll2) -> flatten_all (ll1 @ ll2)
;; ;;
let v = flatten_all [ [ [ `A ] ] ]
;;
let v = flatten_all [ `A [ `B `C [`D]] [[[[[[[[[[[[[[[[[[[[[[[[[[1]]]]]]]]]]]]]]]]]]]]]]]]] let v = flatten_all [ `A [ `B `C [`D]] [[[[[[[[[[[[[[[[[[[[[[[[[[1]]]]]]]]]]]]]]]]]]]]]]]]]
]] ]]
\ No newline at end of file
...@@ -19,6 +19,7 @@ module type S = sig ...@@ -19,6 +19,7 @@ module type S = sig
val pp_print : Format.formatter -> t -> unit val pp_print : Format.formatter -> t -> unit
val print : ?f:(Format.formatter -> elem -> unit) -> t -> (Format.formatter -> unit) list val print : ?f:(Format.formatter -> elem -> unit) -> t -> (Format.formatter -> unit) list
val extract : t -> [ `Empty | `Full | `Split of (elem * t * t * t) ]
end end
...@@ -119,8 +120,8 @@ module Make (T : Bool.S) : S with module Atom = T and type elem = T.t Var.var_or ...@@ -119,8 +120,8 @@ module Make (T : Bool.S) : S with module Atom = T and type elem = T.t Var.var_or
| _ -> () | _ -> ()
let rec dump ppf = function let rec dump ppf = function
| True -> Format.fprintf ppf "⫧" | False -> Format.fprintf ppf "⊥"
| False -> Format.fprintf ppf "⫨" | True -> Format.fprintf ppf "⊤"
| Split (_,x, p,i,n) -> | Split (_,x, p,i,n) ->
let fmt = format_of_string ( let fmt = format_of_string (
match x with match x with
...@@ -382,4 +383,10 @@ module Make (T : Bool.S) : S with module Atom = T and type elem = T.t Var.var_or ...@@ -382,4 +383,10 @@ module Make (T : Bool.S) : S with module Atom = T and type elem = T.t Var.var_or
let cap = ( ** ) let cap = ( ** )
let diff = ( // ) let diff = ( // )
let extract =
function
| False -> `Empty
| True -> `Full
| Split (_,x,p,i,n) -> `Split (x,p,i,n)
end end
...@@ -16,6 +16,7 @@ module type S = sig ...@@ -16,6 +16,7 @@ module type S = sig
val print : ?f:(Format.formatter -> elem -> unit) -> t -> (Format.formatter -> unit) list val print : ?f:(Format.formatter -> elem -> unit) -> t -> (Format.formatter -> unit) list
val extract : t -> [ `Empty | `Full | `Split of (elem * t * t * t) ]
end end
module Make : functor (T : Bool.S) -> S with module Atom = T and type elem = T.t Var.var_or_atom module Make : functor (T : Bool.S) -> S with module Atom = T and type elem = T.t Var.var_or_atom
This diff is collapsed.
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