support constraint checking on mappings

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)