record types in the logic (only type declaration so far, as syntactic sugar for an algebraic)

parent 13f10733
o record types in the logic
- introduced with syntax "type t = {| a:int; b:bool |}"
- actually syntactic sugar for "type t = T (a:int) (b:bool)"
i.e. an algebraic with one constructor and projection functions
version 0.64, Feb 16, 2011 version 0.64, Feb 16, 2011
========================== ==========================
......
...@@ -213,6 +213,10 @@ rule token = parse ...@@ -213,6 +213,10 @@ rule token = parse
{ LEFTBRC } { LEFTBRC }
| "}" | "}"
{ RIGHTBRC } { RIGHTBRC }
| "{|"
{ LEFTREC }
| "|}"
{ RIGHTREC }
| ":" | ":"
{ COLON } { COLON }
| ";" | ";"
......
...@@ -177,10 +177,10 @@ ...@@ -177,10 +177,10 @@
%token BACKQUOTE BAR %token BACKQUOTE BAR
%token COLON COMMA %token COLON COMMA
%token DOT EQUAL FUNC LAMBDA LTGT %token DOT EQUAL FUNC LAMBDA LTGT
%token LEFTPAR LEFTPAR_STAR_RIGHTPAR LEFTSQ %token LEFTPAR LEFTPAR_STAR_RIGHTPAR LEFTREC LEFTSQ
%token LRARROW %token LRARROW
%token PRED QUOTE %token PRED QUOTE
%token RIGHTPAR RIGHTSQ %token RIGHTPAR RIGHTREC RIGHTSQ
%token UNDERSCORE %token UNDERSCORE
%token EOF %token EOF
...@@ -393,6 +393,21 @@ typedefn: ...@@ -393,6 +393,21 @@ typedefn:
| EQUAL primitive_type { TDalias $2 } | EQUAL primitive_type { TDalias $2 }
| EQUAL typecases { TDalgebraic $2 } | EQUAL typecases { TDalgebraic $2 }
| EQUAL BAR typecases { TDalgebraic $3 } | EQUAL BAR typecases { TDalgebraic $3 }
| EQUAL record_type { TDrecord $2 }
;
record_type:
| LEFTREC list1_record_field RIGHTREC { $2 }
;
list1_record_field:
| record_field { [$1] }
| record_field SEMICOLON list1_record_field { $1 :: $3 }
;
record_field:
| opt_mutable lident COLON primitive_type
{ loc (), $1, $2, $4 }
; ;
typecases: typecases:
......
...@@ -103,10 +103,13 @@ type clone_subst = ...@@ -103,10 +103,13 @@ type clone_subst =
| CSlemma of qualid | CSlemma of qualid
| CSgoal of qualid | CSgoal of qualid
type is_mutable = bool
type type_def = type type_def =
| TDabstract | TDabstract
| TDalias of pty | TDalias of pty
| TDalgebraic of (loc * ident * param list) list | TDalgebraic of (loc * ident * param list) list
| TDrecord of (loc * is_mutable * ident * pty) list
type type_decl = { type type_decl = {
td_loc : loc; td_loc : loc;
...@@ -221,8 +224,6 @@ and expr_desc = ...@@ -221,8 +224,6 @@ and expr_desc =
and triple = pre * expr * post and triple = pre * expr * post
type is_mutable = bool
type program_decl = type program_decl =
| Dlet of ident * expr | Dlet of ident * expr
| Dletrec of (ident * binder list * variant option * triple) list | Dletrec of (ident * binder list * variant option * triple) list
......
...@@ -645,6 +645,7 @@ let add_projection cl p (fs,tyarg,tyval) th = ...@@ -645,6 +645,7 @@ let add_projection cl p (fs,tyarg,tyval) th =
let add_projections th d = match d.td_def with let add_projections th d = match d.td_def with
| TDabstract | TDalias _ -> th | TDabstract | TDalias _ -> th
| TDrecord _ -> assert false
| TDalgebraic cl -> | TDalgebraic cl ->
let per_cs acc (_,id,pl) = let per_cs acc (_,id,pl) =
let cs = find_lsymbol (Qident id) th in let cs = find_lsymbol (Qident id) th in
...@@ -726,6 +727,8 @@ let add_types dl th = ...@@ -726,6 +727,8 @@ let add_types dl th =
create_tysymbol id vl (Some (apply ty)) create_tysymbol id vl (Some (apply ty))
| TDabstract | TDalgebraic _ -> | TDabstract | TDalgebraic _ ->
create_tysymbol id vl None create_tysymbol id vl None
| TDrecord _ ->
assert false
in in
Hashtbl.add tysymbols x (Some ts); Hashtbl.add tysymbols x (Some ts);
ts ts
...@@ -761,6 +764,8 @@ let add_types dl th = ...@@ -761,6 +764,8 @@ let add_types dl th =
create_fsymbol (id_user ~labels id loc) tyl ty create_fsymbol (id_user ~labels id loc) tyl ty
in in
Talgebraic (List.map constructor cl) Talgebraic (List.map constructor cl)
| TDrecord _ ->
assert false
in in
ts, d ts, d
in in
...@@ -769,6 +774,20 @@ let add_types dl th = ...@@ -769,6 +774,20 @@ let add_types dl th =
in in
List.fold_left add_projections th dl List.fold_left add_projections th dl
let record_typedef td = match td.td_def with
| TDabstract | TDalgebraic _ | TDalias _ ->
td
| TDrecord fl ->
let field (loc, mut, id, ty) =
if mut then errorm ~loc "a logic record field cannot be mutable";
Some id, ty
in
let id = { td.td_ident with id = String.capitalize td.td_ident.id } in
{ td with td_def = TDalgebraic [td.td_loc, id, List.map field fl] }
let add_types dl th =
add_types (List.map record_typedef dl) th
let env_of_vsymbol_list vl = let env_of_vsymbol_list vl =
List.fold_left (fun env v -> Mstr.add v.vs_name.id_string v env) Mstr.empty vl List.fold_left (fun env v -> Mstr.add v.vs_name.id_string v env) Mstr.empty vl
......
theory List
type list 'a = Nil | Cons 'a (list 'a) theory Records
end use import bool.Bool
theory Length
use import int.Int
use import List
logic length (l : list 'a) : int =
match l with
| Nil -> 0
| Cons _ r -> 1 + length r
end
lemma Length_nonnegative : forall l:list 'a. length(l) >= 0
end
theory Sorted
use import List
use import int.Int use import int.Int
inductive sorted (list int) =
| Sorted_Nil :
sorted Nil
| Sorted_One :
forall x:int. sorted (Cons x Nil)
| Sorted_Two :
forall x y : int, l : list int.
x <= y -> sorted (Cons y l) -> sorted (Cons x (Cons y l))
end
theory Order type t = {| a:int; b:bool |}
type t logic inv (t:t) = a t = 0 <-> b t = True
logic (<=) t t
axiom Le_refl : forall x : t. x <= x goal g1 : forall t:t. inv t -> a t = 0 -> b t = True
axiom Le_asym : forall x y : t. x <= y -> y <= x -> x = y
axiom Le_trans: forall x y z : t. x <= y -> y <= z -> x <= z
end
theory SortedGen
use import List
clone import Order as O
inductive sorted (l : list t) =
| Sorted_Nil :
sorted Nil
| Sorted_One :
forall x:t. sorted (Cons x Nil)
| Sorted_Two :
forall x y : t, l : list t.
x <= y -> sorted (Cons y l) -> sorted (Cons x (Cons y l))
end
theory SortedIntList
use import int.Int
clone SortedGen with type O.t = int, logic O.(<=) = (<=)
end end
......
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