diff options
| -rw-r--r-- | src/crates/library/src/hashmap.rs | 51 | ||||
| -rw-r--r-- | src/crates/primrose/src/analysis.rs | 38 | ||||
| -rw-r--r-- | src/crates/primrose/src/bounded_ops.rs | 70 | ||||
| -rw-r--r-- | src/crates/primrose/src/library_specs.rs | 3 | ||||
| -rw-r--r-- | src/crates/primrose/src/parser.rs | 15 | ||||
| -rw-r--r-- | src/crates/primrose/src/run_matching.rs | 1 | ||||
| -rw-r--r-- | src/crates/primrose/src/type_check.rs | 2 | ||||
| -rw-r--r-- | src/crates/primrose/src/types.rs | 16 | ||||
| -rw-r--r-- | src/racket_specs/combinators.rkt | 9 | ||||
| -rw-r--r-- | src/racket_specs/mapping-setup.rkt | 47 |
10 files changed, 235 insertions, 17 deletions
diff --git a/src/crates/library/src/hashmap.rs b/src/crates/library/src/hashmap.rs index ace6453..58bf564 100644 --- a/src/crates/library/src/hashmap.rs +++ b/src/crates/library/src/hashmap.rs @@ -10,26 +10,77 @@ use std::hash::Hash; Mapping *ENDIMPL*/ impl<K: Ord + Hash, V> Mapping<K, V> for HashMap<K, V> { + /*LIBSPEC* + /*OPNAME* + len len pre-len post-len + *ENDOPNAME*/ + (define (pre-len xs) (is-map? xs)) + (define (len xs) (cons xs (length xs))) + (define (post-len xs r) (equal? r (len xs))) + *ENDLIBSPEC*/ fn len(&self) -> usize { HashMap::len(self) } + /*LIBSPEC* + /*OPNAME* + contains contains pre-contains post-contains + *ENDOPNAME*/ + (define (pre-contains xs) (is-map? xs)) + (define (contains xs k) (assoc k xs)) + (define (post-contains xs k r) (equal? r (contains xs k))) + *ENDLIBSPEC*/ fn contains(&mut self, x: &K) -> bool { HashMap::contains_key(self, x) } + /*LIBSPEC* + /*OPNAME* + insert insert pre-insert post-insert + *ENDOPNAME*/ + (define (pre-insert xs) (is-map? xs)) + (define (insert xs k v) + (let ([idx (index-where xs (lambda (p) (equal? k (car p))))]) + (cond [idx (list-set xs idx (cons k v))] + [else (list* (cons k v) xs)]))) + (define (post-insert xs k v r) (equal? r (insert xs k v))) + *ENDLIBSPEC*/ fn insert(&mut self, key: K, val: V) -> Option<V> { HashMap::insert(self, key, val) } + /*LIBSPEC* + /*OPNAME* + get get pre-get post-get + *ENDOPNAME*/ + (define (pre-get xs) (is-map? xs)) + (define (get xs k) (cdr (assoc k xs))) + (define (post-get xs k r) (equal? r (get xs k))) + *ENDLIBSPEC*/ fn get(&mut self, key: &K) -> Option<&V> { HashMap::get(self, key) } + /*LIBSPEC* + /*OPNAME* + remove remove pre-remove post-remove + *ENDOPNAME*/ + (define (pre-remove xs) (is-map? xs)) + (define (remove xs k) (cdr (assoc k xs))) + (define (post-remove xs k r) (equal? r (remove xs k))) + *ENDLIBSPEC*/ fn remove(&mut self, key: &K) -> Option<V> { HashMap::remove(self, key) } + /*LIBSPEC* + /*OPNAME* + clear clear pre-clear post-clear + *ENDOPNAME*/ + (define (pre-clear xs) (is-map? xs)) + (define (clear xs) null) + (define (post-clear xs r) (equal? r (clear xs))) + *ENDLIBSPEC*/ fn clear(&mut self) { HashMap::clear(self) } diff --git a/src/crates/primrose/src/analysis.rs b/src/crates/primrose/src/analysis.rs index 5f3eb09..ba80a17 100644 --- a/src/crates/primrose/src/analysis.rs +++ b/src/crates/primrose/src/analysis.rs @@ -8,10 +8,23 @@ use std::io::{Error, Write}; pub type AnalyserError = String; const LANGDECL: &str = "#lang rosette\n"; -const REQUIRE: &str = "(require \"../combinators.rkt\")\n"; -const EXTRAREQUIRE: &str = "(require \"../gen_lib_spec/ops.rkt\")\n"; +pub const REQUIRE: &str = "(require \"../combinators.rkt\")\n"; +pub const EXTRAREQUIRE: &str = "(require \"../gen_lib_spec/ops.rkt\")\n"; const GENPATH: &str = "./racket_specs/gen_prop_spec/"; +fn gen_dict_model(size: usize) -> String { + format!( + r#" +(define (generate-dict n) + (define-symbolic* ks integer? #:length n) + (define-symbolic* vs integer? #:length n) + (map cons ks vs)) +(define-symbolic len (bitvector 32)) +(define ls (take-bv (generate-dict {size}) len)) +"# + ) +} + fn gen_list_model(size: usize) -> String { format!( r#" @@ -114,7 +127,7 @@ impl Analyser { fn analyse_prop_decl(&mut self, decl: &Decl, model_size: usize) -> Result<(), AnalyserError> { match decl { - Decl::PropertyDecl((id, _), term) => { + Decl::PropertyDecl(is_dict, (id, _), term) => { let mut mterm = term.clone(); let mut cdr_added = Vec::<String>::new(); let mut symbolics = Vec::<String>::new(); @@ -131,8 +144,14 @@ impl Analyser { if !symbolics.is_empty() { symbolics_provided = gen_symbolics(&symbolics); } - self.write_prop_spec_file(filename.clone(), code, symbolics_provided, model_size) - .map_err(|e| format!("{}", e))?; + self.write_prop_spec_file( + filename.clone(), + code, + symbolics_provided, + model_size, + *is_dict, + ) + .map_err(|e| format!("{}", e))?; let prop_tag = Tag::Prop(id.to_string()); self.ctx.entry(id.to_string()).or_insert(prop_tag); if symbolics.is_empty() { @@ -359,13 +378,18 @@ impl Analyser { contents: String, symbolics: String, model_size: usize, + is_dict: bool, ) -> Result<(), Error> { let mut output = fs::File::create(GENPATH.to_owned() + &filename)?; write!(output, "{}", LANGDECL)?; write!(output, "{}", REQUIRE)?; write!(output, "{}", EXTRAREQUIRE)?; - let list_model = gen_list_model(model_size); - write!(output, "{}", list_model)?; + let model = if is_dict { + gen_dict_model(model_size) + } else { + gen_list_model(model_size) + }; + write!(output, "{}", model)?; write!(output, "{}", contents)?; write!(output, "{}", symbolics)?; Ok(()) diff --git a/src/crates/primrose/src/bounded_ops.rs b/src/crates/primrose/src/bounded_ops.rs index 25d9a01..6496c78 100644 --- a/src/crates/primrose/src/bounded_ops.rs +++ b/src/crates/primrose/src/bounded_ops.rs @@ -39,5 +39,75 @@ pub fn generate_bounded_ops() -> BoundedOps { ), ); ops.insert("Stack".to_string(), vec![push, pop]); + + // Mapping operations + let mapping_ty = Type::Con( + "Con".to_string(), + vec![TypeVar::new("K").into(), TypeVar::new("V").into()], + Bounds::from(["Mapping".to_string()]), + ); + ops.insert( + "Mapping".to_string(), + vec![ + ( + "len".to_string(), + Type::Fun(Box::new(mapping_ty.clone()), Box::new(Type::Int)), + ), + ( + "is_empty".to_string(), + Type::Fun(Box::new(mapping_ty.clone()), Box::new(Type::Bool())), + ), + ( + "contains".to_string(), + Type::Fun( + Box::new(mapping_ty.clone()), + Box::new(Type::Fun( + Box::new(TypeVar::new("K").into()), + Box::new(Type::Bool()), + )), + ), + ), + ( + "insert".to_string(), + Type::Fun( + Box::new(mapping_ty.clone()), + Box::new(Type::Fun( + Box::new(TypeVar::new("K").into()), + Box::new(Type::Fun( + Box::new(TypeVar::new("V").into()), + Box::new(mapping_ty.clone()), + )), + )), + ), + ), + ( + "get".to_string(), + Type::Fun( + Box::new(mapping_ty.clone()), + Box::new(Type::Fun( + Box::new(TypeVar::new("K").into()), + Box::new(TypeVar::new("V").into()), + )), + ), + ), + ( + "remove".to_string(), + Type::Fun( + Box::new(mapping_ty.clone()), + Box::new(Type::Fun( + Box::new(TypeVar::new("K").into()), + Box::new(mapping_ty.clone()), + )), + ), + ), + ( + "clear".to_string(), + Type::Fun(Box::new(mapping_ty.clone()), Box::new(mapping_ty.clone())), + ), + ], + ); + + // TODO: Shouldn't this have container operations? + ops } diff --git a/src/crates/primrose/src/library_specs.rs b/src/crates/primrose/src/library_specs.rs index 6b30ae6..262fa01 100644 --- a/src/crates/primrose/src/library_specs.rs +++ b/src/crates/primrose/src/library_specs.rs @@ -10,6 +10,8 @@ use std::path::Path; use log::debug; +use crate::analysis::EXTRAREQUIRE; +use crate::analysis::REQUIRE; use crate::spec_map::{Bounds, LibSpecs, ProvidedOps}; const LIBSPECNAME: &str = "/*LIBSPEC-NAME*"; @@ -263,6 +265,7 @@ fn generate_provide( /// Extract the relevant LIBSPEC blocks fn extract_lib_specs(src: String) -> Result<RawLibSpec, ErrorMessage> { let mut result = Vec::<String>::new(); + result.push(REQUIRE.to_string()); let mut contents = src.trim(); let mut op_infos = BTreeMap::<String, (String, String, String)>::new(); let mut provided_ops = Vec::<String>::new(); diff --git a/src/crates/primrose/src/parser.rs b/src/crates/primrose/src/parser.rs index 1bb769b..d8b269c 100644 --- a/src/crates/primrose/src/parser.rs +++ b/src/crates/primrose/src/parser.rs @@ -53,13 +53,13 @@ impl ToString for Term { #[derive(Clone, Debug)] pub enum Decl { - PropertyDecl((Id, Type), Box<Term>), + PropertyDecl(bool, (Id, Vec<Type>), Box<Term>), ConTypeDecl(Type, (Id, Bounds, Refinement)), } impl Decl { pub fn is_prop_decl(&self) -> bool { - matches!(self, Decl::PropertyDecl(_, _)) + matches!(self, Decl::PropertyDecl(_, _, _)) } pub fn is_contype_decl(&self) -> bool { @@ -72,7 +72,7 @@ impl Decl { let (con, _) = con_ty.get_con_elem().unwrap(); con } - Decl::PropertyDecl((id, _), _) => id.to_string(), + Decl::PropertyDecl(_, (id, _), _) => id.to_string(), } } } @@ -158,9 +158,14 @@ pub grammar spec() for str { pub rule decl() -> Decl = precedence! { - _ "property" __ p:id() _ "<" _ ty:ty() _ ">" _ "{" _ t:term() _ "}" _ + _ "property" __ p:id() _ "<" _ tys:( ty:ty() ** "," ) _ ">" _ "{" _ t:term() _ "}" _ { - Decl::PropertyDecl((p, ty), Box::new(t)) + Decl::PropertyDecl(false, (p, tys), Box::new(t)) + } + -- + _ "dictProperty" __ p:id() _ "<" _ tys:( ty:ty() ** "," ) _ ">" _ "{" _ t:term() _ "}" _ + { + Decl::PropertyDecl(true, (p, tys), Box::new(t)) } -- _ "type" __ ty:ty() _ "=" _ "{" _ c:id() _ "impl" __ "(" _ b:bounds() _ ")" _ "|" _ t:refinement() _ "}" _ diff --git a/src/crates/primrose/src/run_matching.rs b/src/crates/primrose/src/run_matching.rs index c494f50..384b5d5 100644 --- a/src/crates/primrose/src/run_matching.rs +++ b/src/crates/primrose/src/run_matching.rs @@ -26,6 +26,7 @@ pub fn initialise_match_setup() -> MatchSetup { "../indexable-setup.rkt".to_string(), ); match_setup.insert("Stack".to_string(), "../stack-setup.rkt".to_string()); + match_setup.insert("Mapping".to_string(), "../mapping-setup.rkt".to_string()); match_setup } diff --git a/src/crates/primrose/src/type_check.rs b/src/crates/primrose/src/type_check.rs index b507ec2..b601ced 100644 --- a/src/crates/primrose/src/type_check.rs +++ b/src/crates/primrose/src/type_check.rs @@ -259,7 +259,7 @@ impl TypeChecker { /// Check a single property declaration fn check_prop_decl(&mut self, decl: &Decl) -> Result<(), TypeError> { - let Decl::PropertyDecl((id, _ty), term) = decl else { + let Decl::PropertyDecl(_, (id, _ty), term) = decl else { return Err(TypeError("Not a valid property declaration".to_string())); }; diff --git a/src/crates/primrose/src/types.rs b/src/crates/primrose/src/types.rs index 4efac98..8d36c03 100644 --- a/src/crates/primrose/src/types.rs +++ b/src/crates/primrose/src/types.rs @@ -11,6 +11,7 @@ pub type Bounds = HashSet<Name>; #[derive(Eq, PartialEq, Clone, Debug)] pub enum Type { Bool(), + Int, Var(TypeVar), Con(Name, Vec<Type>, Bounds), Fun(Box<Type>, Box<Type>), @@ -36,6 +37,7 @@ impl ToString for Type { fn to_string(&self) -> String { match self { Type::Bool() => "bool".to_string(), + Type::Int => "int".to_string(), Type::Var(tv) => tv.to_string(), Type::Con(n, t, bounds) => { n.to_string() @@ -178,8 +180,10 @@ pub struct TypeVar { } impl TypeVar { - pub fn new(s: Name) -> TypeVar { - TypeVar { name: s } + pub fn new(s: impl ToString) -> TypeVar { + TypeVar { + name: s.to_string(), + } } /// Attempt to bind a type variable to a type, returning an appropriate substitution. fn bind(&self, ty: &Type) -> Result<Subst, UnificationError> { @@ -201,6 +205,12 @@ impl TypeVar { } } +impl Into<Type> for TypeVar { + fn into(self) -> Type { + Type::Var(self) + } +} + impl ToString for TypeVar { fn to_string(&self) -> String { self.name.to_string() @@ -233,7 +243,7 @@ impl Types for Type { fn ftv(&self) -> HashSet<TypeVar> { match self { Type::Var(s) => [s.clone()].iter().cloned().collect(), - &Type::Bool() => HashSet::new(), + Type::Bool() | Type::Int => HashSet::new(), Type::Fun(i, o) => i.ftv().union(&o.ftv()).cloned().collect(), Type::Con(_, s, _) => s.ftv().union(&HashSet::new()).cloned().collect(), } diff --git a/src/racket_specs/combinators.rkt b/src/racket_specs/combinators.rkt index a74296b..016a44f 100644 --- a/src/racket_specs/combinators.rkt +++ b/src/racket_specs/combinators.rkt @@ -74,5 +74,12 @@ [(< (length l) 2) null] [else (append (list (take l 2)) (consecutive-pairs (drop l 1)))])) +; Mapping helpers + +; (is-map? lst) -> boolean? +(define (is-map? l) + (and (list? l) + (andmap pair? l))) + ; Export procedures -(provide for-all-unique-pairs for-all-consecutive-pairs for-all-elems elem-and not-equal? leq? geq? unique-count?)
\ No newline at end of file +(provide for-all-unique-pairs for-all-consecutive-pairs for-all-elems elem-and not-equal? leq? geq? unique-count? is-map?) diff --git a/src/racket_specs/mapping-setup.rkt b/src/racket_specs/mapping-setup.rkt new file mode 100644 index 0000000..6b6fc48 --- /dev/null +++ b/src/racket_specs/mapping-setup.rkt @@ -0,0 +1,47 @@ +#lang rosette + +(define (check-spec-len prop pre spec xs) + (assume (and (prop xs) (pre xs))) + (assert (prop (car (spec xs))))) + +(define (check-spec-is-empty prop pre spec xs) + (assume (and (prop xs) (pre xs))) + (assert (prop (car (spec xs))))) + +(define (check-spec-contains prop pre spec xs x) + (assume (and (prop xs) (pre xs))) + (assert (prop (car (spec xs x))))) + +(define (check-spec-insert prop pre spec xs x) + (assume (and (prop xs) (pre xs))) + (assert (prop (spec xs x)))) + +(define (check-spec-remove prop pre spec xs x) + (assume (and (prop xs) (pre xs))) + (assert (prop (car (spec xs x))))) + +(define (check-spec-clear prop pre spec xs) + (assume (and (prop xs) (pre xs))) + (assert (prop (spec xs)))) + +(define (check-not-contradict prop pre xs) + (assert (and (prop xs) (pre xs) (> (length xs) 1)))) + +(define (check prop pres specs xs k v) + (cond + [(or (unsat? (solve (check-not-contradict prop (first pres) xs))) + (unsat? (solve (check-not-contradict prop (second pres) xs))) + (unsat? (solve (check-not-contradict prop (third pres) xs))) + (unsat? (solve (check-not-contradict prop (fourth pres) xs))) + (unsat? (solve (check-not-contradict prop (fifth pres) xs))) + (unsat? (solve (check-not-contradict prop (sixth pres) xs))) + ) #f] + [else (and (unsat? (verify (check-spec-clear prop (first pres) (first specs) xs))) + (unsat? (verify (check-spec-contains prop (second pres) (second specs) xs k))) + (unsat? (verify (check-spec-insert prop (third pres) (third specs) xs k v))) + (unsat? (verify (check-spec-is-empty prop (fourth pres) (fourth specs) xs))) + (unsat? (verify (check-spec-len prop (fifth pres) (fifth specs) xs))) + (unsat? (verify (check-spec-remove prop (sixth pres) (sixth specs) xs k))) + )])) + +(provide check) |