Cleaned up tactic base system

* Various style fixes
* Standardize the proof state interface/naming a little.
* Reorganized base.rkt; now easier to read
* Fixed some mismatch code/documentation
* Renamed "basic" to "standard"; basic was too close to base, and not
  really helpful.

stdlib/tactics/base.rkt

@@ -4,149 +4,183 @@
 (provide
   proof
   define-theorem
-  define-lemma
   define-tactic
 
   (for-syntax
-    hole
     proof-state
     proof-state-env
     proof-state-goals
-    proof-state-current-goal
+    proof-state-proof
-    proof-state-current-proof
+    proof-state-theorem
-    proof-state-original-goal
+    new-proof
-    print-proof-state
-    current-theorem
-    empty-proof
     new-proof-state
-    push-env
+    proof-state-proof-complete?
-    ctxt?
+    proof-state-goal-ref
-    proof-complete?
+    proof-state-current-goal-ref
-    update-current-proof
+    proof-state-current-goal-set
-    update-current-goal
+    proof-state-env-ref
+    proof-state-env-ref-by-type
+    proof-state-extend-env
+    proof-state-fill-proof-hole
+    proof-state-extend-proof-context
+    current-hole-pretty-symbol
+    print-proof-state
     lookup-tactic))
 
-;; NB: The design of Cur currently seems to prevent intermediate type-checking
+#| NB:
-;; NB: during a tactic-based proof, unless I were to either reimplement the
+ | The design of Cur currently seems to prevent intermediate type-checking
-;; NB: type-checker or extend it with a notion of holes.
+ | during a tactic-based proof, unless I were to either reimplement the
-;; TODO: A notion of holes my be useful in general...
+ | type-checker or extend it with a notion of holes.
+ | TODO: A noation of holes may be useful in general.
+ |#
 
-;; NB: Per below, note that Cur already has contexts. The issue with
+#| NB:
-;; NB: type-checking intermediate results has to do with the fact that Cur
+ | Per below, note that Cur already has contexts. The issue with
-;; NB: contexts are not exposed properly, nor is type-checking defined on
+ | type-checking intermediate results has to do with the fact that Cur
-;; NB: them.
+ | contexts are not exposed properly, nor is type-checking defined on
+ | them.
+ |#
 
-;;; ======================================================================
+;; ------------------------------------------------------------------------
-;;; Tactic support
+;;; Proof state interface
 
-;;; A Goal is a syntax object representing a Cur proposition (type).
+#|
-
+ | A Goal, aka, Theorem is a syntax object representing a Cur proposition (type).
-;;; A Expr is a syntax object representing Cur expression (term).
+ |
-
+ | A Expr is a syntax object representing Cur expression (term).
-;;; A Hole is a procedure of type
+ |
-
+ | A Hole is a procedure of type
-;;; A Ctxt is a procedure (Either Ctxt Expr) -> (Either Ctxt Expr)
+ |
-;;; representing a Cur expression with a hole.
+ | A Proof is (Either Ctxt Expr)
-
+ |
-;;; A Environment is a map from Symbol to Goal.
+ | A Ctxt is a procedure Proof -> Proof representing a Cur expression
-
+ | with a hole.
-;;; The compile-time proof-state interface.
+ |
+ | A Environment is a map from Symbol to Theorems.
+ |
+ | A Proof-State is a struct containing:
+ |   env: An Environment, the assumptions introduced during a tactic
+ |        script.
+ |   goals: A map from Natural to Goal, the goals necessary to finish
+ |          this proof
+ |   current-goal: A Natural, the index into goals of the current Goal
+ |                 to be proved.
+ |   proof: A Proof, representing the proof so far. when the proof is
+ |          an Expr, the proof is complete.
+ |   theorem: A Theorem, the original statement of the theorem this proof is
+ |            attempting to prove.
+ |#
 ;;; TODO: I'm partially implementing lens here.
 ;;; TODO: Interface is mildly inconsistent.
 (begin-for-syntax
+  (define-struct proof-state (env goals current-goal proof theorem))
+
+  (define new-proof values)
+
+  (define (new-proof-state prop)
+    (proof-state
+      (make-immutable-hash)
+      (dict-set (make-immutable-hash) 0 prop)
+      0
+      new-proof
+      prop))
+
+  ;; Given a Proof-State, return #t if the current-proof is complete
+  ;; (i.e. is a Expr and not a Ctxt), #f otherwise.
+  (define (proof-state-proof-complete? ps) (not (procedure? (proof-state-proof ps))))
+
+  ;;; Extra accessors
+
+  ;; Return the goal with index i in proof-state-goals
+  (define (proof-state-goal-ref ps i)
+    (dict-ref (proof-state-goals ps) i))
+
+  ;; Return the current-goal from proof-state-goals
+  (define (proof-state-current-goal-ref ps)
+    (proof-state-goal-ref ps (proof-state-current-goal ps)))
+
+  ;; Return the theorem named by name in the local environment
+  (define (proof-state-env-ref ps name)
+    (dict-ref (proof-state-env ps) name))
+
+  ;; Return the name of an assumption with type thm, or #f.
+  (define (proof-state-env-ref-by-type ps thm)
+    (for/first ([(k v) (in-dict (proof-state-env ps))]
+                #:when (cur-equal? v thm))
+      k))
+
+  ;;; Functional updators
+
+  (define (maybe-syntax->symbol name)
+    (if (syntax? name)
+        (syntax->datum name)
+        name))
+
+  ;; Extend the local environment with a new assumption, name, of type thm. Name can be a syntax
+  ;; object or a symbol.
+  (define (proof-state-extend-env ps name thm)
+    (struct-copy proof-state ps
+      [env (dict-set (proof-state-env ps) (maybe-syntax->symbol name) thm)]))
+
+  ;; Updates the current-goal to pf
+  (define (proof-state-current-goal-set ps pf)
+    (struct-copy proof-state ps
+      [goals (dict-set (proof-state-goals ps) (proof-state-current-goal ps) pf)]))
+
+  ;; Fill the current proof hole with pf
+  (define (proof-state-fill-proof-hole ps pf)
+    ;; TODO: Check for proof completion?
+    ;; TODO: What about multiple holes?
+    (struct-copy proof-state ps
+      [proof ((proof-state-proof ps) pf)]))
+
+  ;; Place the current proof in the context ctxt.
+  (define (proof-state-extend-proof-context ps ctxt)
+    (struct-copy proof-state ps
+      [proof (ctxt (proof-state-proof ps))]))
+
   ;; How to display a hole, for pretty printing.
-  (define hole 'hole)
+  (define current-hole-pretty-symbol (make-parameter 'hole))
-
-  ;; A Proof-State is a struct containing:
-  ;;   env: An Environment, the assumptions introduced during a tactic
-  ;;        script.
-  ;;   goals: A map from Natural to Goal, the goals necessary to finish
-  ;;          this proof
-  ;;   current-goal: A Natural, the index into goals of the current Goal
-  ;;                 to be proved.
-  ;;   current-proof: A (Either Ctxt Expr), representing the proof so far.
-  ;;                  current-proof is an Expr, the proof is complete.
-  (define-struct proof-state (env goals current-goal current-proof
-                              original-goal))
 
+  ;; A pretty printer for proof-state
   (define (print-proof-state ps)
     (for ([(k v) (in-dict (proof-state-env ps))])
       (printf "~n~a : ~a~n" k (syntax->datum v)))
     (printf "--------------------------------~n")
     (cond
-      [(proof-state-current-goal ps) =>
+      [(proof-state-current-goal-ref ps)
+       =>
        (lambda (x) (printf "~a~n~n" (syntax->datum x)))]
-      [else (printf "Goal complete!~n~n")]))
+      [else (printf "Goal complete!~n~n")])))
 
-  ;; The current theorem; used internally to achieve a Coq-like notation
+;; -----------------------------------------------------------------------
-  ;; for defining theorems and tactic-based proofs.
+;;; Syntax for tactic-based proofs similar to Coq.
-  (define current-theorem (make-parameter #f))
 
-  (define empty-proof values)
+#|
-
+ | A tactic is a phase 1 Racket function that manipulates the current proof state.
-  (define (new-proof-state prop)
+ | Tactic : Any ... Proof-State -> Proof-State
-    (proof-state (make-immutable-hash) (make-immutable-hash) prop
+ |
-                 empty-proof prop))
+ | Examples:
-
+ |
-  ;; push-env adds a mapping from name to P in (proof-state-env ps).
+ | (define-tactic command-name function)
-  ;; Proof-State -> Symbol -> Goal -> Proof-State
+ | (define-tactic (command-name args ... ps) body)
-  (define (push-env ps name P)
+ |#
-    (struct-copy proof-state ps
+(define-syntax define-tactic (make-rename-transformer #'define-for-syntax))
-      [env (hash-set (proof-state-env ps) name P)]))
-
-  ;; TODO: Cur already has contexts; perhaps they should be exposed?
-  ;; Ctxt -> (Either Ctxt Expr) -> (Either Ctxt Expr)
-  ;; C1[C2]
-  (define (plug-ctxt C1 C2) (C1 C2))
-
-  (define ctxt? procedure?)
-
-  ;; Given a Proof-State, return #t if the current-proof is complete
-  ;; (i.e. is a Expr and not a Ctxt), #f otherwise.
-  (define (proof-complete? ps) (not (ctxt? (proof-state-current-proof ps))))
-
-  ;; Given a Proof-State ps and Ctxt pf, plug pf into the current Ctxt
-  ;; and return the modified Proof-State.
-  (define (update-current-proof ps pf)
-    ;; TODO: Check for proof completion?
-    (struct-copy proof-state ps
-      [current-proof (plug-ctxt (proof-state-current-proof ps) pf)]))
-
-  ;; Given a Proof-State ps and a Goal, update the current goal and
-  ;; return the modified Proof-State.
-  (define (update-current-goal ps goal)
-    (struct-copy proof-state ps
-      [current-goal goal]))
 
+(begin-for-syntax
   ;; Takes a symbol or syntax object naming a tactic, and returns the
   ;; procedure for that tactic.
   (define (lookup-tactic syn)
     (eval
       (if (syntax? syn)
-          ;; Ensure eval gets the right environment
+          ;; NB: Ensure eval gets the right environment
           (datum->syntax (current-theorem) (syntax->datum syn))
           syn))))
 
-;;; ======================================================================
+(begin-for-syntax
-
+  ;; The current theorem; used internally to achieve a Coq-like notation
-;; A tactic is a Racket function that manipulates the current proof state.
+  ;; for defining theorems and tactic-based proofs.
-;; Tactic : Args ... Proof-State -> Proof-State
+  (define current-theorem (make-parameter #f)))
-
-;;; Syntax for defining tactics.
-;; (define-tactic command-name function)
-;; (define-tactic (command-name args ... Proof-State) body)
-;; TODO: Srsly?
-(define-syntax (define-tactic syn)
-  (syntax-case syn ()
-    [(_ (name args ... ps) body ...)
-     (quasisyntax/loc syn
-       (define-for-syntax (name args ... ps) body ...))]
-    [(_ name function)
-     (quasisyntax/loc syn
-       (define-for-syntax name function))]))
-
-;; (define-goal-tactic command-name function)
-;; (define-goal-tactic (command-name args ... ctx goal-list current-goal) body)
 
 ;; Define a theorem, with similar semantics to Coq theorems in that you
 ;; can define the theorem then define the proof next.
@@ -157,29 +191,28 @@
      #'(define name prop)]))
 
 ;; Aliases for theorems.
-;; TODO: I think there's some define-syntax-rename thing that would
+;; (define-syntax define-lemma (make-rename-transformer #'define-theorem))
-;; TODO: prevent eta expanding these.
-(define-syntax-rule (define-lemma s ...) (define-theorem s ...))
 
 (begin-for-syntax
   ;; Given a list of tactics and their arguments, run the tactic script
   ;; on the current theorem, returning the proof if the proof is valid.
   (define (run-tactic-script f* args*)
     (unless (current-theorem)
-      (raise-syntax-error 'proof
+      (raise-syntax-error
+        'proof
         "You can't use proof without a first using define-theorem"))
     (let* ([t (current-theorem)]
-           [pf (proof-state-current-proof
+           [ps ;; Thread proof state through tactic calls, and eval
-                 ;; Thread proof state through tactic calls, and eval
+               ;; at compile-time.
-                 ;; at compile-time.
+               (for/fold ([ps (new-proof-state t)])
-                 (for/fold ([ps (new-proof-state t)])
+                         ([f f*] [args args*])
-                           ([f f*] [args args*])
+                 (apply (lookup-tactic f) (append args (list ps))))]
-                    (apply (lookup-tactic f) (append args (list ps)))))])
+           [pf (proof-state-proof ps)])
-          (when (ctxt? pf)
+      (unless (proof-state-proof-complete? ps)
-            (raise-syntax-error 'qed "Proof contains holes" (pf hole)))
+        (raise-syntax-error 'qed "Proof contains holes" (pf (current-hole-pretty-symbol))))
-          (unless (type-check/syn? pf t)
+      (unless (type-check/syn? pf t)
-            (raise-syntax-error 'qed "Invalid proof" pf t))
+        (raise-syntax-error 'qed "Invalid proof" pf t))
-          pf)))
+      pf)))
 
 ;; The proof macro starts a proof environment. Every proof should begin
 ;; with it.

stdlib/tactics/sartactics.rkt

@@ -1,7 +1,7 @@
 #lang s-exp "../../redex-curnel.rkt"
 (require
   "base.rkt"
-  (prefix-in basic: "basic.rkt")
+  (prefix-in basic: "standard.rkt")
   (for-syntax racket/syntax))
 
 (provide
@@ -94,7 +94,7 @@
   (printf "Starting interactive tactic session. Prepared to be sassed:~n")
   (printf "Type (quit) to quit.~n")
   (let loop ([ps ps] [cmds '()])
-    (if (proof-complete? ps)
+    (if (proof-state-proof-complete? ps)
         (basic:print ps)
         (print ps))
     (let ([cmd (read-syntax)])

stdlib/tactics/standard.rkt

@@ -13,33 +13,28 @@
     by-assumption
     interactive))
 
-;;; TACTICS
+#| TODO:
-;;; A tactic is a function from proof state to proof state
+ | Tactics should probably not error on failure. Perhaps Maybe monad, or list monad, or return proof
-
+ | state unmodified, or raise exception, or ...
-;; TODO: Tactics probably should not error for failure. Perhaps return
+ |#
-;; TODO: proof state unmodified, or raise an exception.
 (define-tactic (intro name ps)
-  ;; TODO: Maybe cur-expand current-goal by default
+  ;; TODO: Provide cur-match, which wraps syntax-parse and uses cur-expand.
-  (syntax-parse (cur-expand (proof-state-current-goal ps))
+  (syntax-parse (cur-expand (proof-state-current-goal-ref ps))
     [(forall (x:id : P:expr) body:expr)
-     (update-current-goal
+     (let* ([ps (proof-state-extend-env ps name #'P)]
-       (update-current-proof
+            [ps (proof-state-current-goal-set ps #'body)]
-        ;; TODO: Should hide syntax-e in push-env
+            [ps (proof-state-fill-proof-hole ps (lambda (x) #`(lambda (#,name : P) #,x)))])
-        (push-env ps (syntax-e name) #'P)
+       ps)]
-        (lambda (x) #`(λ (#,x : P) #,x)))
-       #'body)]
     [_ (error 'intro "Can only intro when current goal is of the form (∀ (x : P) body)")]))
 
-(begin-for-syntax
-  (define (assumption ps type)
-    (for/first ([(k v) (in-dict (proof-state-env ps))]
-                #:when (cur-equal? v type))
-      k)))
-
 (define-tactic (by-assumption ps)
   (cond
-    [(assumption ps (cur-expand (proof-state-current-goal ps)))
+    [(proof-state-env-ref-by-type ps (proof-state-current-goal-ref ps))
-     => (curry update-current-proof (update-current-goal ps #f))]
+     =>
+     (lambda (x)
+       (let* ([ps (proof-state-fill-proof-hole ps x)]
+              [ps (proof-state-current-goal-set ps #f)])
+         ps))]
     [else (error 'by-assumption "Cannot find an assumption that matches the goal")]))
 
 ;; TODO: requires more support from curnel
@@ -49,19 +44,17 @@
 
 ;; Do the obvious thing
 (define-tactic (obvious ps)
-  (syntax-parse (cur-expand (proof-state-current-goal ps))
+  (syntax-parse (cur-expand (proof-state-current-goal-ref ps))
     [(forall (x : P) t)
      (obvious (intro #'x ps))]
     [t:expr
      (cond
-       [(assumption ps #'t) (by-assumption ps)]
+       ;; TODO: This would be cleaner if I could say "try all these things and do whichever works".
+       [(proof-state-env-ref-by-type ps #'t) (by-assumption ps)]
        ;[(inductive? ps #'t) (by-constructor ps)]
        [else (error 'obvious "This is not all that obvious to me.")])]))
 
-(define-tactic (restart ps)
+(define-tactic (restart ps) (new-proof-state (proof-state-theorem ps)))
-  (struct-copy proof-state ps
-    [current-goal (proof-state-original-goal ps)]
-    [current-proof empty-proof]))
 
 (define-tactic (print ps) (print-proof-state ps) ps)
 
@@ -80,6 +73,8 @@
         [(quit)
          (begin
            (printf "Your tactic script:~n")
+           ;; TODO: Using clever trickery, could problem write a version of interactive that actually
+           ;; modifies the file.
            (pretty-print (reverse (map syntax->datum cmds)))
            (newline)
            ps)]
@@ -127,7 +122,7 @@
   (proof (obvious))
   ;; TODO: Fix this unit test so it doesn't require interaction
   (define-theorem meow4 (forall (x : bool) bool))
-  #;(proof
+  (proof
     (interactive))
   ;; TODO: Add check-cur-equal? for unit testing?
   #;(check-pred (curry cur-equal? '(lambda (x : bool) x)))