Filtering...

prove

books/projects/smtlink/trusted/prove
other
(in-package "SMT")
other
(include-book "centaur/fty/top" :dir :system)
other
(include-book "xdoc/top" :dir :system)
other
(include-book "std/util/define" :dir :system)
other
(include-book "centaur/misc/tshell" :dir :system)
other
(include-book "../verified/hint-interface")
other
(include-book "../verified/expand-cp")
other
(include-book "../config")
other
(include-book "./run")
other
(include-book "./write")
other
(include-book "./z3-py/names")
other
(include-book "./z3-py/translator")
other
(include-book "./z3-py/header")
other
(defttag :tshell)
other
(value-triple (tshell-ensure))
other
(defsection smt-prove
  :parents (trusted)
  :short "SMT-prove is the main functions for transliteration into SMT languages and calling the external SMT solver."
  (encapsulate nil
    (local (defthm lemma-1
        (implies (and (string-listp x) x)
          (consp x))))
    (local (defthm lemma-2
        (b* (((mv ?exit-status ?lines) (tshell-call cmd :print print :save save)))
          (implies lines (consp lines)))))
    (local (defthm lemma-3
        (implies (and (string-listp x) x)
          (stringp (car x)))))
    (local (defthm lemma-4
        (b* (((mv ?exit-status ?lines) (tshell-call cmd :print print :save save)))
          (implies lines (stringp (car lines))))))
    (local (in-theory (enable string-or-symbol-p)))
    (define make-fname
      ((dir stringp) (fname stringp) state)
      :returns (mv (full-fname stringp) state)
      :guard-debug t
      (b* ((dir (str-fix dir)) (fname (str-fix fname))
          (dir (if (equal dir "")
              "/tmp/py_file"
              dir))
          ((unless (equal fname "")) (mv (concatenate 'string dir "/" fname)
              state))
          (cmd (concatenate 'string
              "mkdir -p "
              dir
              " && "
              "mktemp "
              dir
              "/smtlink.XXXXX")))
        (mv-let (exit-status lines state)
          (time$ (tshell-call cmd :print nil :save t)
            :msg ""
            :args (list cmd))
          (if (and (equal exit-status 0)
              (not (equal lines nil)))
            (mv (car lines) state)
            (prog2$ (er hard?
                'smt-prove=>make-fname
                "Error: Command ~x0 ~
                                                      failed."
                cmd)
              (mv "" state)))))))
  (define smt-prove
    ((term pseudo-termp) (smtlink-hint smtlink-hint-p)
      (state))
    :mode :program (b* ((term (pseudo-term-fix term)) (smtlink-hint (smtlink-hint-fix smtlink-hint))
        (flextypes-table (table-alist 'flextypes-table (w state)))
        ((unless (alistp flextypes-table)) (mv nil nil state))
        (smtlink-hint1 (generate-fty-info-alist smtlink-hint
            flextypes-table))
        (smtlink-hint2 (generate-fty-types-top smtlink-hint1
            flextypes-table))
        ((smtlink-hint h) smtlink-hint2)
        (c h.smt-cnf)
        ((mv smt-file state) (make-fname h.smt-dir h.smt-fname state))
        ((mv smt-term smt-precond) (smt-translation term h state))
        ((mv head import) (smt-head c))
        (state (smt-write-file smt-file
            head
            import
            smt-term
            state))
        ((mv result state) (smt-interpret smt-file
            h.rm-file
            c
            state)))
      (mv result smt-precond state))))