@ -905,7 +905,7 @@ let simp_cond cnd thn els =
| _ ->
| _ ->
App { op = App { op = App { op = Conditional ; arg = cnd } ; arg = thn } ; arg = els }
App { op = App { op = App { op = Conditional ; arg = cnd } ; arg = thn } ; arg = els }
let simp_and x y =
let rec simp_and x y =
match ( x , y ) with
match ( x , y ) with
(* i && j *)
(* i && j *)
| Integer { data = i ; typ } , Integer { data = j } ->
| Integer { data = i ; typ } , Integer { data = j } ->
@ -921,11 +921,15 @@ let simp_and x y =
| _ , ( Integer { data ; typ = Integer { bits = 1 } } as f )
| _ , ( Integer { data ; typ = Integer { bits = 1 } } as f )
when Z . is_false data ->
when Z . is_false data ->
f
f
(* e && ( c ? t : f ) ==> ( c ? e && t : e && f ) *)
| e , App { op = App { op = App { op = Conditional ; arg = c } ; arg = t } ; arg = f }
| App { op = App { op = App { op = Conditional ; arg = c } ; arg = t } ; arg = f } , e ->
simp_cond c ( simp_and e t ) ( simp_and e f )
(* e && e ==> e *)
(* e && e ==> e *)
| _ when equal x y -> x
| _ when equal x y -> x
| _ -> App { op = App { op = And ; arg = x } ; arg = y }
| _ -> App { op = App { op = And ; arg = x } ; arg = y }
let simp_or x y =
let rec simp_or x y =
match ( x , y ) with
match ( x , y ) with
(* i || j *)
(* i || j *)
| Integer { data = i ; typ } , Integer { data = j } ->
| Integer { data = i ; typ } , Integer { data = j } ->
@ -941,6 +945,10 @@ let simp_or x y =
| e , Integer { data ; typ = Integer { bits = 1 } }
| e , Integer { data ; typ = Integer { bits = 1 } }
when Z . is_false data ->
when Z . is_false data ->
e
e
(* e || ( c ? t : f ) ==> ( c ? e || t : e || f ) *)
| e , App { op = App { op = App { op = Conditional ; arg = c } ; arg = t } ; arg = f }
| App { op = App { op = App { op = Conditional ; arg = c } ; arg = t } ; arg = f } , e ->
simp_cond c ( simp_or e t ) ( simp_or e f )
(* e || e ==> e *)
(* e || e ==> e *)
| _ when equal x y -> x
| _ when equal x y -> x
| _ -> App { op = App { op = Or ; arg = x } ; arg = y }
| _ -> App { op = App { op = Or ; arg = x } ; arg = y }
@ -1001,15 +1009,25 @@ and simp_eq x y =
simp_not Typ . bool b
simp_not Typ . bool b
else (* b = true ==> b *)
else (* b = true ==> b *)
b
b
(* e = ( c ? t : f ) ==> ( c ? e = t : e = f ) *)
| e , App { op = App { op = App { op = Conditional ; arg = c } ; arg = t } ; arg = f }
| App { op = App { op = App { op = Conditional ; arg = c } ; arg = t } ; arg = f } , e ->
simp_cond c ( simp_eq e t ) ( simp_eq e f )
(* e = e ==> true *)
(* e = e ==> true *)
| x , y when equal x y -> bool true
| x , y when equal x y -> bool true
| x , y -> App { op = App { op = Eq ; arg = x } ; arg = y }
| x , y -> App { op = App { op = Eq ; arg = x } ; arg = y }
and simp_dq x y =
and simp_dq x y =
match simp_eq x y with
match ( x , y ) with
| App { op = App { op = Eq ; arg = x } ; arg = y } ->
(* e ≠ ( c ? t : f ) ==> ( c ? e ≠ t : e ≠ f ) *)
App { op = App { op = Dq ; arg = x } ; arg = y }
| e , App { op = App { op = App { op = Conditional ; arg = c } ; arg = t } ; arg = f }
| b -> simp_not Typ . bool b
| App { op = App { op = App { op = Conditional ; arg = c } ; arg = t } ; arg = f } , e ->
simp_cond c ( simp_dq e t ) ( simp_dq e f )
| _ -> (
match simp_eq x y with
| App { op = App { op = Eq ; arg = x } ; arg = y } ->
App { op = App { op = Dq ; arg = x } ; arg = y }
| b -> simp_not Typ . bool b )
let simp_xor x y =
let simp_xor x y =
match ( x , y ) with
match ( x , y ) with
@ -1114,16 +1132,20 @@ let app1 ?(partial = false) op arg =
(* every App subexp of output appears in input *)
(* every App subexp of output appears in input *)
match op with
match op with
| App { op = Eq | Dq } -> ()
| App { op = Eq | Dq } -> ()
| _ ->
| _ -> (
iter e ~ f : ( function
match e with
| App { op = Eq | Dq } -> ()
| App { op = App { op = App { op = Conditional } } } -> ()
| App _ as a ->
| _ ->
assert (
iter e ~ f : ( function
is_subexp ~ sub : a ~ sup : op | | is_subexp ~ sub : a ~ sup : arg
| App { op = Eq | Dq } -> ()
| | Trace . fail
| App _ as a ->
" simplifying %a %a@ yields %a@ with new subexp %a "
assert (
pp op pp arg pp e pp a )
is_subexp ~ sub : a ~ sup : op | | is_subexp ~ sub : a ~ sup : arg
| _ -> () ) )
| | Trace . fail
" simplifying %a %a@ yields %a@ with new subexp \
% a "
pp op pp arg pp e pp a )
| _ -> () ) ) )
let app2 op x y = app1 ( app1 ~ partial : true op x ) y
let app2 op x y = app1 ( app1 ~ partial : true op x ) y
let app3 op x y z = app1 ( app1 ~ partial : true ( app1 ~ partial : true op x ) y ) z
let app3 op x y z = app1 ( app1 ~ partial : true ( app1 ~ partial : true op x ) y ) z