Commit 8e28f5bb authored by Jean-Christophe Filliâtre's avatar Jean-Christophe Filliâtre
Browse files

a built-in theory of Booleans

parent 2740d5b6
...@@ -130,7 +130,7 @@ theory real.RealInfix ...@@ -130,7 +130,7 @@ theory real.RealInfix
end end
theory bool.Bool theory Bool
syntax type bool "bool" syntax type bool "bool"
syntax function True "true" syntax function True "true"
syntax function False "false" syntax function False "false"
......
...@@ -27,12 +27,15 @@ theory BuiltIn ...@@ -27,12 +27,15 @@ theory BuiltIn
syntax predicate (=) "(%1 = %2)" syntax predicate (=) "(%1 = %2)"
end end
theory bool.Bool theory Bool
syntax type bool "bool" syntax type bool "bool"
syntax function True "true" syntax function True "true"
syntax function False "false" syntax function False "false"
end
theory bool.Bool
syntax function andb "(andb %1 %2)" syntax function andb "(andb %1 %2)"
syntax function orb "(orb %1 %2)" syntax function orb "(orb %1 %2)"
......
...@@ -123,15 +123,18 @@ theory real.FromInt ...@@ -123,15 +123,18 @@ theory real.FromInt
end end
theory bool.Bool theory Bool
syntax type bool "BITVECTOR(1)" syntax type bool "BITVECTOR(1)"
syntax function True "0bin1" syntax function True "0bin1"
syntax function False "0bin0" syntax function False "0bin0"
meta "encoding : kept" type bool
end
theory bool.Bool
syntax function andb "(%1 & %2)" syntax function andb "(%1 & %2)"
syntax function orb "(%1 | %2)" syntax function orb "(%1 | %2)"
syntax function xorb "(BVXOR(%1,%2))" syntax function xorb "(BVXOR(%1,%2))"
syntax function notb "(~ %1)" syntax function notb "(~ %1)"
meta "encoding : kept" type bool
end end
(* (*
......
...@@ -47,12 +47,14 @@ theory map.Map ...@@ -47,12 +47,14 @@ theory map.Map
*) *)
end end
theory bool.Bool theory Bool
syntax type bool "bool" syntax type bool "bool"
syntax function True "TRUE" syntax function True "TRUE"
syntax function False "FALSE" syntax function False "FALSE"
end
theory bool.Bool
syntax function andb "(%1 AND %2)" syntax function andb "(%1 AND %2)"
syntax function orb "(%1 OR %2)" syntax function orb "(%1 OR %2)"
......
...@@ -108,15 +108,18 @@ theory real.Real ...@@ -108,15 +108,18 @@ theory real.Real
end end
theory bool.Bool theory Bool
syntax type bool "bool" syntax type bool "bool"
syntax function True "true" syntax function True "true"
syntax function False "false" syntax function False "false"
meta "encoding : kept" type bool
end
theory bool.Bool
syntax function andb "(and %1 %2)" syntax function andb "(and %1 %2)"
syntax function orb "(or %1 %2)" syntax function orb "(or %1 %2)"
syntax function xorb "(xor %1 %2)" syntax function xorb "(xor %1 %2)"
syntax function notb "(not %1)" syntax function notb "(not %1)"
meta "encoding : kept" type bool
end end
......
...@@ -110,14 +110,16 @@ theory real.Real ...@@ -110,14 +110,16 @@ theory real.Real
end end
theory bool.Bool theory Bool
syntax type bool "bool" syntax type bool "bool"
syntax function True "true" syntax function True "true"
syntax function False "false" syntax function False "false"
meta "encoding : kept" type bool
end
theory bool.Bool
syntax function andb "(and %1 %2)" syntax function andb "(and %1 %2)"
syntax function orb "(or %1 %2)" syntax function orb "(or %1 %2)"
syntax function notb "(not %1)" syntax function notb "(not %1)"
meta "encoding : kept" type bool
end end
......
...@@ -110,15 +110,17 @@ theory real.Real ...@@ -110,15 +110,17 @@ theory real.Real
end end
theory bool.Bool theory Bool
syntax type bool "Bool" syntax type bool "Bool"
syntax function True "true" syntax function True "true"
syntax function False "false" syntax function False "false"
meta "encoding : kept" type bool
end
theory bool.Bool
syntax function andb "(and %1 %2)" syntax function andb "(and %1 %2)"
syntax function orb "(or %1 %2)" syntax function orb "(or %1 %2)"
syntax function xorb "(xor %1 %2)" syntax function xorb "(xor %1 %2)"
syntax function notb "(not %1)" syntax function notb "(not %1)"
meta "encoding : kept" type bool
end end
theory int.EuclideanDivision theory int.EuclideanDivision
......
...@@ -111,15 +111,17 @@ end ...@@ -111,15 +111,17 @@ end
(* (*
(* L'encodage des types sommes bloquent cette théorie builtin *) (* L'encodage des types sommes bloquent cette théorie builtin *)
theory bool.Bool theory Bool
syntax type bool "bool" syntax type bool "bool"
syntax function True "true" syntax function True "true"
syntax function False "false" syntax function False "false"
meta cloned "encoding_decorate : kept" type bool
end
theory bool.Bool
syntax function andb "(and %1 %2)" syntax function andb "(and %1 %2)"
syntax function orb "(or %1 %2)" syntax function orb "(or %1 %2)"
syntax function xorb "(xor %1 %2)" syntax function xorb "(xor %1 %2)"
syntax function notb "(not %1)" syntax function notb "(not %1)"
meta cloned "encoding_decorate : kept" type bool
end end
*) *)
......
...@@ -159,6 +159,7 @@ let find_library env sl = ...@@ -159,6 +159,7 @@ let find_library env sl =
let get_builtin s = let get_builtin s =
if s = builtin_theory.th_name.id_string then builtin_theory else if s = builtin_theory.th_name.id_string then builtin_theory else
if s = bool_theory.th_name.id_string then bool_theory else
if s = highord_theory.th_name.id_string then highord_theory else if s = highord_theory.th_name.id_string then highord_theory else
match tuple_theory_name s with match tuple_theory_name s with
| Some n -> tuple_theory n | Some n -> tuple_theory n
......
...@@ -802,6 +802,9 @@ let ps_equ = ...@@ -802,6 +802,9 @@ let ps_equ =
let t_equ t1 t2 = ps_app ps_equ [t1; t2] let t_equ t1 t2 = ps_app ps_equ [t1; t2]
let t_neq t1 t2 = t_not (ps_app ps_equ [t1; t2]) let t_neq t1 t2 = t_not (ps_app ps_equ [t1; t2])
let fs_true = create_fsymbol (id_fresh "True") [] ty_bool
let fs_false = create_fsymbol (id_fresh "False") [] ty_bool
let fs_tuple_ids = Hid.create 17 let fs_tuple_ids = Hid.create 17
let fs_tuple = Util.memo_int 17 (fun n -> let fs_tuple = Util.memo_int 17 (fun n ->
......
...@@ -291,6 +291,9 @@ val t_neq : term -> term -> term ...@@ -291,6 +291,9 @@ val t_neq : term -> term -> term
val t_equ_simp : term -> term -> term val t_equ_simp : term -> term -> term
val t_neq_simp : term -> term -> term val t_neq_simp : term -> term -> term
val fs_true : lsymbol
val fs_false: lsymbol
val fs_tuple : int -> lsymbol (* n-tuple *) val fs_tuple : int -> lsymbol (* n-tuple *)
val t_tuple : term list -> term val t_tuple : term list -> term
......
...@@ -745,6 +745,14 @@ let builtin_theory = ...@@ -745,6 +745,14 @@ let builtin_theory =
let uc = add_logic_decl uc [ps_equ, None] in let uc = add_logic_decl uc [ps_equ, None] in
close_theory uc close_theory uc
let create_theory ?(path=[]) n =
use_export (empty_theory n path) builtin_theory
let bool_theory =
let uc = empty_theory (id_fresh "Bool") [] in
let uc = add_ty_decl uc [ts_bool, Talgebraic [fs_true; fs_false]] in
close_theory uc
let highord_theory = let highord_theory =
let uc = empty_theory (id_fresh "HighOrd") [] in let uc = empty_theory (id_fresh "HighOrd") [] in
let uc = add_ty_decl uc [ts_func, Tabstract] in let uc = add_ty_decl uc [ts_func, Tabstract] in
...@@ -753,9 +761,6 @@ let highord_theory = ...@@ -753,9 +761,6 @@ let highord_theory =
let uc = add_logic_decl uc [ps_pred_app, None] in let uc = add_logic_decl uc [ps_pred_app, None] in
close_theory uc close_theory uc
let create_theory ?(path=[]) n =
use_export (empty_theory n path) builtin_theory
let tuple_theory = Util.memo_int 17 (fun n -> let tuple_theory = Util.memo_int 17 (fun n ->
let uc = empty_theory (id_fresh ("Tuple" ^ string_of_int n)) [] in let uc = empty_theory (id_fresh ("Tuple" ^ string_of_int n)) [] in
let uc = add_ty_decl uc [ts_tuple n, Talgebraic [fs_tuple n]] in let uc = add_ty_decl uc [ts_tuple n, Talgebraic [fs_tuple n]] in
......
...@@ -189,6 +189,8 @@ val on_meta: meta-> ('a -> meta_arg list -> 'a) -> 'a -> theory -> 'a ...@@ -189,6 +189,8 @@ val on_meta: meta-> ('a -> meta_arg list -> 'a) -> 'a -> theory -> 'a
val builtin_theory : theory val builtin_theory : theory
val bool_theory : theory
val highord_theory : theory val highord_theory : theory
val tuple_theory : int -> theory val tuple_theory : int -> theory
......
...@@ -219,9 +219,11 @@ let ty_match s ty1 ty2 = ...@@ -219,9 +219,11 @@ let ty_match s ty1 ty2 =
let ts_int = create_tysymbol (id_fresh "int") [] None let ts_int = create_tysymbol (id_fresh "int") [] None
let ts_real = create_tysymbol (id_fresh "real") [] None let ts_real = create_tysymbol (id_fresh "real") [] None
let ts_bool = create_tysymbol (id_fresh "bool") [] None
let ty_int = ty_app ts_int [] let ty_int = ty_app ts_int []
let ty_real = ty_app ts_real [] let ty_real = ty_app ts_real []
let ty_bool = ty_app ts_bool []
let ts_func = let ts_func =
let tv_a = create_tvsymbol (id_fresh "a") in let tv_a = create_tvsymbol (id_fresh "a") in
......
...@@ -113,9 +113,11 @@ val ty_equal_check : ty -> ty -> unit ...@@ -113,9 +113,11 @@ val ty_equal_check : ty -> ty -> unit
val ts_int : tysymbol val ts_int : tysymbol
val ts_real : tysymbol val ts_real : tysymbol
val ts_bool : tysymbol
val ty_int : ty val ty_int : ty
val ty_real : ty val ty_real : ty
val ty_bool : ty
val ts_func : tysymbol val ts_func : tysymbol
val ts_pred : tysymbol val ts_pred : tysymbol
......
...@@ -123,9 +123,6 @@ let empty_module n p = { ...@@ -123,9 +123,6 @@ let empty_module n p = {
muc_used = Sid.empty; muc_used = Sid.empty;
} }
let create_module ?(path=[]) n =
empty_module n path
let close_module uc = let close_module uc =
let th = close_theory uc.muc_theory in (* catches errors *) let th = close_theory uc.muc_theory in (* catches errors *)
{ mod_theory = th; { mod_theory = th;
...@@ -199,6 +196,9 @@ let clone_export_theory uc th i = ...@@ -199,6 +196,9 @@ let clone_export_theory uc th i =
let add_meta uc m al = let add_meta uc m al =
{ uc with muc_theory = Theory.add_meta uc.muc_theory m al } { uc with muc_theory = Theory.add_meta uc.muc_theory m al }
let create_module ?(path=[]) n =
use_export_theory (empty_module n path) bool_theory
(** Program decls *) (** Program decls *)
(* (*
......
theory Bool theory Bool
type bool = True | False use export Bool (* built-in theory of Booleans *)
function andb (x y : bool) : bool = function andb (x y : bool) : bool =
match x, y with match x, y with
...@@ -38,7 +38,7 @@ end ...@@ -38,7 +38,7 @@ end
theory Ite theory Ite
use import Bool use import Bool (* this is the previously declared local theory *)
function ite (b:bool) (x y : 'a) : 'a = function ite (b:bool) (x y : 'a) : 'a =
match b with match b with
......
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