Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Proposal: Globals (pre-cursor to Compilation Units) #30

Open
wants to merge 8 commits into
base: master
Choose a base branch
from
Open
Show file tree
Hide file tree
Changes from 4 commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion bedrock2/src/BasicC64Semantics.v
Original file line number Diff line number Diff line change
Expand Up @@ -33,5 +33,5 @@ Instance parameters : parameters := {|
(* TODO: faster maps *)
mem := UnorderedList.map {| UnorderedList.key_eqb a b := if Word.weq a b then true else false |};
locals := UnorderedList.map {| UnorderedList.key_eqb := String.eqb |};
funname_eqb := String.eqb;
word_eqb := @Word.weqb 64
|}.
2 changes: 1 addition & 1 deletion bedrock2/src/BasicC64Syntax.v
Original file line number Diff line number Diff line change
Expand Up @@ -33,7 +33,7 @@ Definition to_c_parameters : ToCString.parameters := {|
| eq => e1++"=="++e2
end%string;
c_var := id;
c_fun := id;
c_glob := id;
c_act := ToCString.c_call;

varname_eqb := String.eqb;
Expand Down
107 changes: 107 additions & 0 deletions bedrock2/src/CompilationUnit.v
Original file line number Diff line number Diff line change
@@ -0,0 +1,107 @@
Require Import Coq.Strings.String.
Require Import Coq.ZArith.BinIntDef.
Require Import ExtLib.Data.HList.
Require Import ExtLib.Data.Fin.
Require Import ExtLib.Data.Map.FMapAList.
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

looks like these ExtLib dependencies are not needed (but make the build fail)

Require Import bedrock2.Macros bedrock2.Notations bedrock2.Map.
Require Import bedrock2.Syntax.
Require Import bedrock2.Semantics.

(* Compilation units should be fairly simple
* - the basic idea is that you have "externals", "internals", and "exports"
* - definitions can call externals and internals
* - exports must be a subset of external and internal
* - in the module-level semantics, one type of interaction needs to be
* external call.
* - note(gmm): we don't have to support recursive linking if we want to keep
* the terminating semantics.
*)

Module module.
Section with_parameters.
Context {p : Syntax.parameters}.

Variant data : Set :=
| Data (_ : list Z).

Variant definition : Type :=
| X (_ : list data)
| Function (_ : list varname * list varname * Syntax.cmd).


(* note(gmm): this could be made more uniform with the rest of the development
* if we used `map`.
*)
Record module : Type :=
{ imports : list globname
; internal : list globname
; exports : list globname
; definitions : list (globname * definition)
}.

End with_parameters.
End module.

(* the meaning of a module is a function of the meaning of the imports to the
* meaning of the outputs.
* note(gmm): an alternative way to represent this to treat calls to imports
* as actions.
*)

Require Import bedrock2.WeakestPrecondition.

Section module_semantics.
Variable p : Semantics.parameters.
Variable resolver : globname -> option word.

Definition func_meaning : Type :=
(trace -> Prop) ->
(trace -> Prop) ->
(trace -> trace -> Prop) ->
trace ->
mem ->
list word ->
(trace -> mem -> list word -> Prop) -> Prop.

Variables (mod : module.module)
(denoteImports : globname -> func_meaning).

Definition functions : list _ :=
(fix functions ls :=
match ls with
| nil => nil
| cons (a, module.Function b) ls =>
match resolver a with
| Some a => cons (a,b) (functions ls)
| None => functions ls
end
| cons _ ls => functions ls
end) mod.(module.definitions).

Definition module_definitions (g : globname)
: func_meaning.
refine (fun rely guarantee progress t mem args post =>
exists body, List.In (g, body) mod.(module.definitions) /\
match body with
| module.Function body =>
exists n,
WeakestPrecondition.func rely guarantee progress resolver
(fun w t mem args post =>
exists g, resolver g = Some w /\
(List.In g mod.(module.imports) /\
denoteImports g rely guarantee progress t mem args post)
\/ call_rec rely guarantee progress resolver
functions n w t mem args post)
body
t mem args post
| _ => False
end).
Defined.

Definition module (g : globname)
: func_meaning :=
fun rely guarantee progress t mem args post =>
List.In g mod.(module.exports) /\
module_definitions g rely guarantee progress t mem args post.

End module_semantics.
14 changes: 8 additions & 6 deletions bedrock2/src/Examples/Swap.v
Original file line number Diff line number Diff line change
Expand Up @@ -16,8 +16,8 @@ Section bsearch.
)).

Definition swap_swap : list varname * list varname * cmd := (("a"::"b"::nil), nil, bedrock_func_body:(
cmd.call nil "swap" (var "a"::var "b"::nil);
cmd.call nil "swap" (var "a"::var "b"::nil)
cmd.call nil (expr.global "swap") (var "a"::var "b"::nil);
cmd.call nil (expr.global "swap") (var "a"::var "b"::nil)
)).
End bsearch.

Expand Down Expand Up @@ -92,10 +92,10 @@ end.

Context (__A : map.ok Semantics.mem).
Lemma swap_ok :
forall a_addr a b_addr b (m:map.rep (value:=@Semantics.byte _)) R t,
forall l a_addr a b_addr b (m:map.rep (value:=@Semantics.byte _)) R t,
(sep (ptsto 1 a_addr a) (sep (ptsto 1 b_addr b) R)) m ->
WeakestPrecondition.func
(fun _ => True) (fun _ => False) (fun _ _ => True) (fun _ _ _ _ _ => False)
(fun _ => True) (fun _ => False) (fun _ _ => True) l (fun _ _ _ _ _ => False)
(@swap BasicC64Syntax.params) t m (a_addr::b_addr::nil)
(fun t' m' rets => t=t' /\ (sep (ptsto 1 a_addr b) (sep (ptsto 1 b_addr a) R)) m' /\ rets = nil).
Proof.
Expand All @@ -104,13 +104,14 @@ Proof.
Qed.

Lemma swap_swap_ok :
forall a_addr a b_addr b (m:map.rep (value:=@Semantics.byte _)) R t,
forall l a_addr a b_addr b (m:map.rep (value:=@Semantics.byte _)) R t,
(sep (ptsto 1 a_addr a) (sep (ptsto 1 b_addr b) R)) m ->
WeakestPrecondition.func
(fun _ => True) (fun _ => False) (fun _ _ => True) (WeakestPrecondition.call (fun _ => True) (fun _ => False) (fun _ _ => True) [("swap", (@swap BasicC64Syntax.params))])
(fun _ => True) (fun _ => False) (fun _ _ => True) l (WeakestPrecondition.call (fun _ => True) (fun _ => False) (fun _ _ => True) l [("swap", (@swap BasicC64Syntax.params))])
(@swap_swap BasicC64Syntax.params) t m (a_addr::b_addr::nil)
(fun t' m' rets => t=t' /\ (sep (ptsto 1 a_addr a) (sep (ptsto 1 b_addr b) R)) m' /\ rets = nil).
Proof.
Print WeakestPrecondition.func.
intros. rename H into Hm.
eexists.
eexists.
Expand All @@ -121,6 +122,7 @@ Proof.
eexists.
eexists.
eexists.
unfold WeakestPrecondition.list_map.
intros. eapply WeakestPreconditionProperties.Proper_func.
6: eapply swap_ok.
1,2,3,4,5 : cbv [Morphisms.pointwise_relation trace Basics.flip Basics.impl Morphisms.respectful]; try solve [typeclasses eauto with core].
Expand Down
7 changes: 3 additions & 4 deletions bedrock2/src/Semantics.v
Original file line number Diff line number Diff line change
Expand Up @@ -9,6 +9,7 @@ Class parameters := {
word_succ : word -> word;
word_test : word -> bool;
word_of_Z : BinNums.Z -> option word;
word_eqb : word -> word -> bool;
interp_binop : bopname -> word -> word -> word;

byte : Type;
Expand All @@ -17,14 +18,12 @@ Class parameters := {
split : nat -> word -> byte * word;

mem :> map word byte;
locals :> map varname word;

funname_eqb : funname -> funname -> bool
locals :> map varname word
}.

Section semantics.
Context {pp : unique! parameters}.

Fixpoint load_rec (sz : nat) (m:mem) (a:word) : option word :=
match sz with
| O => Some word_zero
Expand Down
2 changes: 1 addition & 1 deletion bedrock2/src/StringNamesSyntax.v
Original file line number Diff line number Diff line change
Expand Up @@ -9,7 +9,7 @@ Class parameters := {

Instance make (p : parameters) : Syntax.parameters := {|
Syntax.varname := string;
Syntax.funname := string;
Syntax.globname := string;

Syntax.actname := actname;
Syntax.bopname := bopname;
Expand Down
5 changes: 3 additions & 2 deletions bedrock2/src/Syntax.v
Original file line number Diff line number Diff line change
Expand Up @@ -4,7 +4,7 @@ Require Import Coq.Numbers.BinNums.

Class parameters := {
varname : Set;
funname : Set;
globname : Set;
actname : Set;
bopname : Set;
}.
Expand All @@ -15,6 +15,7 @@ Module expr. Section expr.
Inductive expr : Type :=
| literal (v: Z)
| var (x: varname)
| global (_ : globname)
| load (access_size_in_bytes:Z) (addr:expr)
| op (op: bopname) (e1 e2: expr).
End expr. End expr. Notation expr := expr.expr.
Expand All @@ -28,6 +29,6 @@ Module cmd. Section cmd.
| cond (condition : expr) (nonzero_branch zero_branch : cmd)
| seq (s1 s2: cmd)
| while (test : expr) (body : cmd)
| call (binds : list varname) (function : funname) (args: list expr)
| call (binds : list varname) (function : expr) (args: list expr)
| interact (binds : list varname) (action : actname) (args: list expr).
End cmd. End cmd. Notation cmd := cmd.cmd.
9 changes: 5 additions & 4 deletions bedrock2/src/ToCString.v
Original file line number Diff line number Diff line change
Expand Up @@ -11,7 +11,7 @@ Class parameters := {
c_lit : Z -> String.string;
c_bop : string -> bopname -> string -> string;
c_var : varname -> String.string;
c_fun : funname -> String.string;
c_glob : globname -> String.string;
c_act : list varname -> actname -> list String.string -> string;
}.

Expand All @@ -33,6 +33,7 @@ Section ToCString.
match e with
| expr.literal v => c_lit v
| expr.var x => c_var x
| expr.global x => c_glob x
| expr.load s ea => "*(" ++ c_size s ++ "*)(" ++ c_expr ea ++ ")"
| expr.op op e1 e2 => c_bop ("(" ++ c_expr e1 ++ ")") op ("(" ++ c_expr e2 ++ ")")
end.
Expand Down Expand Up @@ -79,13 +80,13 @@ Section ToCString.
| cmd.skip =>
indent ++ "/*skip*/" ++ LF
| cmd.call args f es =>
indent ++ c_call (List.map c_var args) (c_fun f) (List.map c_expr es)
indent ++ c_call (List.map c_var args) (c_expr f) (List.map c_expr es)
| cmd.interact binds action es =>
indent ++ c_act binds action (List.map c_expr es)
end%string.

Definition c_decl (rett : string) (args : list varname) (name : funname) (retptrs : list varname) : string :=
(rett ++ " " ++ c_fun name ++ "(" ++ concat ", " (
Definition c_decl (rett : string) (args : list varname) (name : globname) (retptrs : list varname) : string :=
(rett ++ " " ++ c_glob name ++ "(" ++ concat ", " (
List.map (fun a => "uintptr_t "++c_var a) args ++
List.map (fun r => "uintptr_t* "++c_var r) retptrs) ++
")")%string.
Expand Down
3 changes: 2 additions & 1 deletion bedrock2/src/Variables.v
Original file line number Diff line number Diff line change
Expand Up @@ -6,8 +6,9 @@ Module expr. Section expr. Import Syntax.expr.
Context {p : unique! Syntax.parameters}.
Fixpoint vars (e : expr) : list varname :=
match e with
| literal v => nil
| literal _ => nil
| var x => cons x nil
| global _ => nil
| load _ ea => vars ea
| op _ e1 e2 => List.app (vars e1) (vars e2)
end.
Expand Down
Loading