cleaning up programs

parent 3047a120
...@@ -153,6 +153,11 @@ pgml_options=--type-only ...@@ -153,6 +153,11 @@ pgml_options=--type-only
bad_programs bench/programs/bad-typing bad_programs bench/programs/bad-typing
echo "" echo ""
echo "=== Type-checking modules ==="
pgml_options=--type-only
programs modules
echo ""
echo "=== Type-checking good programs ===" echo "=== Type-checking good programs ==="
pgml_options=--type-only pgml_options=--type-only
programs bench/programs/good programs bench/programs/good
......
...@@ -21,7 +21,7 @@ module Muller ...@@ -21,7 +21,7 @@ module Muller
invariant { 0 <= count = num_of a.elts 0 i <= i and invariant { 0 <= count = num_of a.elts 0 i <= i and
length u = num_of a.elts 0 (length a) } length u = num_of a.elts 0 (length a) }
if a[i] <> 0 then begin set u !count a[i]; incr count end if a[i] <> 0 then begin set u !count a[i]; incr count end
doneg done
end end
......
theory String
type char
clone export map.Map
type string = map int char
logic create int : string
logic length string : int
logic sub string int int : string
logic app string string : string
end
module M module M
use import int.Int use import int.Int
use import String
(* use import module string.String *)
namespace import S
type char
type string
logic length string : int
logic get string int : char
logic app string string : string
logic sub string int int : string
logic create int : string
end
type rope = type rope =
| Str string int (len: int) | Str string int (len: int)
...@@ -22,40 +19,42 @@ module M ...@@ -22,40 +19,42 @@ module M
logic inv (r: rope) = match r with logic inv (r: rope) = match r with
| Str s ofs len -> | Str s ofs len ->
len = 0 or 0 <= ofs < length s and ofs + len <= length s len = 0 or 0 <= ofs < S.length s and ofs + len <= S.length s
| App l r _ -> | App l r _ ->
0 < len l and inv l and 0 < len r and inv r 0 < len l and inv l and 0 < len r and inv r
end end
logic model (r: rope) : string = match r with logic model (r: rope) : string = match r with
| Str s ofs len -> sub s ofs len | Str s ofs len -> S.sub s ofs len
| App l r _ -> app (model l) (model r) | App l r _ -> S.app (model l) (model r)
end end
logic eq (s1 s2: string) = logic eq (s1 s2: string) =
length s1 = length s2 and S.length s1 = S.length s2 and
forall i:int. 0 <= i < length s1 -> get s1 i = get s2 i forall i:int. 0 <= i < S.length s1 -> S.get s1 i = S.get s2 i
let empty () = let empty () =
{} {}
Str (create 0) 0 0 Str (S.create 0) 0 0
{ len result = 0 and inv result and eq (model result) (create 0) } { len result = 0 and inv result and eq (model result) (S.create 0) }
let length r = let length r =
{} {}
len r len r
{ result = len r } { result = len r }
let rec get r i = (**
let rec get (r: rope) i =
{ inv r and 0 <= i < len r } { inv r and 0 <= i < len r }
match r with match r with
| Str s ofs len -> | Str s ofs len ->
get s (ofs + i) S.get s (ofs + i)
| App l r _ -> | App l r _ ->
let n = length l in let n = length l in
if i < n then get l i else get r (i - n) if i < n then get l i else get r (i - n)
end end
{ result = get (model r) i } { result = S.get (model r) i }
**)
end end
......
...@@ -6,7 +6,7 @@ module Stack ...@@ -6,7 +6,7 @@ module Stack
use import list.List use import list.List
use import list.Length use import list.Length
type t 'a model {| mutable contents : list 'a |} type t 'a model {| mutable contents: list 'a |}
parameter create : unit -> {} t 'a { result = Nil } parameter create : unit -> {} t 'a { result = Nil }
......
...@@ -34,7 +34,6 @@ module Array ...@@ -34,7 +34,6 @@ module Array
type array 'a model {| length : int; mutable elts : map int 'a |} type array 'a model {| length : int; mutable elts : map int 'a |}
logic ([]) (a: array 'a) (i :int) : 'a = M.([]) a.elts i logic ([]) (a: array 'a) (i :int) : 'a = M.([]) a.elts i
logic unsafe_get (a: array 'a) (i :int) : 'a = M.([]) a.elts i
parameter ([]) : a:array 'a -> i:int -> parameter ([]) : a:array 'a -> i:int ->
{ 0 <= i < length a } 'a reads a { result = a[i] } { 0 <= i < length a } 'a reads a { result = a[i] }
...@@ -42,6 +41,12 @@ module Array ...@@ -42,6 +41,12 @@ module Array
parameter set : a:array 'a -> i:int -> v:'a -> parameter set : a:array 'a -> i:int -> v:'a ->
{ 0 <= i < length a } unit writes a { a.elts = (old a.elts)[i <- v] } { 0 <= i < length a } unit writes a { a.elts = (old a.elts)[i <- v] }
(* unsafe get/set operations with no precondition *)
parameter unsafe_get : a:array 'a -> i:int ->
{ } 'a reads a { result = a[i] }
parameter unsafe_set : a:array 'a -> i:int -> v:'a ->
{ } unit writes a { a.elts = (old a.elts)[i <- v] }
parameter length : a:array 'a -> {} int { result = a.length } parameter length : a:array 'a -> {} int { result = a.length }
parameter make : n:int -> v:'a -> parameter make : n:int -> v:'a ->
......
...@@ -35,45 +35,52 @@ module String ...@@ -35,45 +35,52 @@ module String
use import int.Int use import int.Int
use import module Char use import module Char
use map.Map as S use import map.Map as M
type string model {| length: int; mutable chars: S.t int char |} type string model {| length: int; mutable chars: map int char |}
parameter create : len:int -> { len >= 0 } string { S.length result = len } parameter create : len:int -> { len >= 0 } string { length result = len }
logic ([]) (s: string) (i :int) : char = M.([]) s.chars i
logic get (s: string) (i :int) : char = M.([]) s.chars i
parameter make : len:int -> c:char -> parameter make : len:int -> c:char ->
{ len >= 0 } { len >= 0 }
string string
{ S.length result = len and { length result = len and
forall i:int. 0 <= i < len -> S.get result i = c } forall i:int. 0 <= i < len -> result[i] = c }
parameter get : s:string -> i:int -> parameter get : s:string -> i:int ->
{ 0 <= i < S.length s } char reads s { result = S.get s i } { 0 <= i < length s } char reads s { result = s[i] }
parameter unsafe_get : s:string -> i:int ->
{ } char reads s { result = s[i] }
parameter set : s:string -> i:int -> v:char -> parameter set : s:string -> i:int -> v:char ->
{ 0 <= i < S.length s } unit writes s { s = S.set (old s) i v } { 0 <= i < length s } unit writes s { s.chars = (old s.chars)[i <- v] }
parameter unsafe_set : s:string -> i:int -> v:char ->
{ } unit writes s { s.chars = (old s.chars)[i <- v] }
parameter length : s:string -> {} int reads s { result = S.length s } parameter length : s:string -> {} int reads s { result = length s }
parameter copy : s:string -> parameter copy : s:string ->
{} {}
string string
{ S.length result = S.length s and { length result = length s and
forall i:int. 0 <= i < S.length result -> S.get result i = S.get s i } forall i:int. 0 <= i < length result -> result[i] = s[i] }
parameter uppercase : s:string -> parameter uppercase : s:string ->
{} {}
string string
{ S.length result = S.length s and { length result = length s and
forall i:int. 0 <= i < S.length result -> forall i:int. 0 <= i < length result ->
S.get result i = Char.uppercase (S.get s i) } result[i] = Char.uppercase s[i] }
parameter lowercase : s:string -> parameter lowercase : s:string ->
{} {}
string string
{ S.length result = S.length s and { length result = length s and
forall i:int. 0 <= i < S.length result -> forall i:int. 0 <= i < length result ->
S.get result i = Char.lowercase (S.get s i) } result[i] = Char.lowercase s[i] }
(* TODO (* TODO
- copy - copy
...@@ -92,30 +99,34 @@ module Buffer ...@@ -92,30 +99,34 @@ module Buffer
use import int.Int use import int.Int
use import module Char use import module Char
use import module String use import module String as S
use import map.Map as M
type t model {| length : int; mutable contents : S.t int char |} type t model {| mutable length: int; mutable contents: map int char |}
parameter create : size:int -> { size >= 0 } t { result.length = 0 } parameter create : size:int -> { size >= 0 } t { result.length = 0 }
(** [size] is only given as a hint for the initial size *) (** [size] is only given as a hint for the initial size *)
parameter contents : b:t -> { } string { result = b } parameter contents : b:t -> { } string { S.length result = length b }
parameter add_char : parameter add_char :
b:t -> c:char -> b:t -> c:char ->
{ } { }
unit writes b unit writes b.length b.contents
{ S.length b = old (S.length b) + 1 and { length b = old (length b) + 1 and
S.sub b 0 (S.length b - 1) = old b and (forall i: int.
S.get b (S.length b - 1) = c } 0 <= i < length b -> b.contents[i] = (old b.contents)[i]) and
b.contents[length b - 1] = c }
parameter add_string : parameter add_string :
b:t -> s:string -> b:t -> s:string ->
{ } { }
unit reads s writes b unit reads s writes b.length b.contents
{ S.length b = old (S.length b) + S.length s and { length b = old (length b) + S.length s and
S.sub b 0 (old (S.length b)) = old b and (forall i: int.
S.sub b (old (S.length b)) (S.length s) = s } 0 <= i < old (length b) -> b.contents[i] = (old b.contents)[i]) and
(forall i: int.
0 <= i < S.length s -> b.contents[old (length b) + i] = S.get s i) }
(* TODO (* TODO
- add_substring - add_substring
...@@ -124,11 +135,11 @@ module Buffer ...@@ -124,11 +135,11 @@ module Buffer
end end
(***
module Test module Test
use module Char use module Char
use module String use module String
use array.ArrayRich as S
use module Buffer use module Buffer
let test1 () = let test1 () =
...@@ -148,6 +159,7 @@ module Test ...@@ -148,6 +159,7 @@ module Test
assert { S.get u 41 = 97 } assert { S.get u 41 = 97 }
end end
***)
(* (*
Local Variables: Local Variables:
......
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