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.
This commit is contained in:
William J. Bowman
parent
13d3016c85
commit
31603bf109
|
|
@ -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-current-proof
|
||||
proof-state-original-goal
|
||||
print-proof-state
|
||||
current-theorem
|
||||
empty-proof
|
||||
proof-state-proof
|
||||
proof-state-theorem
|
||||
new-proof
|
||||
new-proof-state
|
||||
push-env
|
||||
ctxt?
|
||||
proof-complete?
|
||||
update-current-proof
|
||||
update-current-goal
|
||||
proof-state-proof-complete?
|
||||
proof-state-goal-ref
|
||||
proof-state-current-goal-ref
|
||||
proof-state-current-goal-set
|
||||
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: during a tactic-based proof, unless I were to either reimplement the
|
||||
;; NB: type-checker or extend it with a notion of holes.
|
||||
;; TODO: A notion of holes my be useful in general...
|
||||
#| NB:
|
||||
| The design of Cur currently seems to prevent intermediate type-checking
|
||||
| during a tactic-based proof, unless I were to either reimplement the
|
||||
| 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: type-checking intermediate results has to do with the fact that Cur
|
||||
;; NB: contexts are not exposed properly, nor is type-checking defined on
|
||||
;; NB: them.
|
||||
#| NB:
|
||||
| Per below, note that Cur already has contexts. The issue with
|
||||
| type-checking intermediate results has to do with the fact that Cur
|
||||
| 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 Expr is a syntax object representing Cur expression (term).
|
||||
|
||||
;;; 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 Environment is a map from Symbol to Goal.
|
||||
|
||||
;;; The compile-time proof-state interface.
|
||||
#|
|
||||
| A Goal, aka, Theorem is a syntax object representing a Cur proposition (type).
|
||||
|
|
||||
| A Expr is a syntax object representing Cur expression (term).
|
||||
|
|
||||
| A Hole is a procedure of type
|
||||
|
|
||||
| A Proof is (Either Ctxt Expr)
|
||||
|
|
||||
| A Ctxt is a procedure Proof -> Proof representing a Cur expression
|
||||
| with a hole.
|
||||
|
|
||||
| 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)
|
||||
|
||||
;; 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))
|
||||
(define current-hole-pretty-symbol (make-parameter 'hole))
|
||||
|
||||
;; 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.
|
||||
(define current-theorem (make-parameter #f))
|
||||
;; -----------------------------------------------------------------------
|
||||
;;; Syntax for tactic-based proofs similar to Coq.
|
||||
|
||||
(define empty-proof values)
|
||||
|
||||
(define (new-proof-state prop)
|
||||
(proof-state (make-immutable-hash) (make-immutable-hash) prop
|
||||
empty-proof prop))
|
||||
|
||||
;; push-env adds a mapping from name to P in (proof-state-env ps).
|
||||
;; Proof-State -> Symbol -> Goal -> Proof-State
|
||||
(define (push-env ps name P)
|
||||
(struct-copy proof-state ps
|
||||
[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]))
|
||||
#|
|
||||
| A tactic is a phase 1 Racket function that manipulates the current proof state.
|
||||
| Tactic : Any ... Proof-State -> Proof-State
|
||||
|
|
||||
| Examples:
|
||||
|
|
||||
| (define-tactic command-name function)
|
||||
| (define-tactic (command-name args ... ps) body)
|
||||
|#
|
||||
(define-syntax define-tactic (make-rename-transformer #'define-for-syntax))
|
||||
|
||||
(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))))
|
||||
|
||||
;;; ======================================================================
|
||||
|
||||
;; A tactic is a Racket function that manipulates the current proof state.
|
||||
;; Tactic : Args ... Proof-State -> Proof-State
|
||||
|
||||
;;; 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)
|
||||
(begin-for-syntax
|
||||
;; The current theorem; used internally to achieve a Coq-like notation
|
||||
;; for defining theorems and tactic-based proofs.
|
||||
(define current-theorem (make-parameter #f)))
|
||||
|
||||
;; 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
|
||||
;; TODO: prevent eta expanding these.
|
||||
(define-syntax-rule (define-lemma s ...) (define-theorem s ...))
|
||||
;; (define-syntax define-lemma (make-rename-transformer #'define-theorem))
|
||||
|
||||
(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
|
||||
;; Thread proof state through tactic calls, and eval
|
||||
;; at compile-time.
|
||||
(for/fold ([ps (new-proof-state t)])
|
||||
([f f*] [args args*])
|
||||
(apply (lookup-tactic f) (append args (list ps)))))])
|
||||
(when (ctxt? pf)
|
||||
(raise-syntax-error 'qed "Proof contains holes" (pf hole)))
|
||||
(unless (type-check/syn? pf t)
|
||||
(raise-syntax-error 'qed "Invalid proof" pf t))
|
||||
pf)))
|
||||
[ps ;; Thread proof state through tactic calls, and eval
|
||||
;; at compile-time.
|
||||
(for/fold ([ps (new-proof-state t)])
|
||||
([f f*] [args args*])
|
||||
(apply (lookup-tactic f) (append args (list ps))))]
|
||||
[pf (proof-state-proof ps)])
|
||||
(unless (proof-state-proof-complete? ps)
|
||||
(raise-syntax-error 'qed "Proof contains holes" (pf (current-hole-pretty-symbol))))
|
||||
(unless (type-check/syn? pf t)
|
||||
(raise-syntax-error 'qed "Invalid proof" pf t))
|
||||
pf)))
|
||||
|
||||
;; The proof macro starts a proof environment. Every proof should begin
|
||||
;; with it.
|
||||
|
|
|
|||
|
|
@ -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)])
|
||||
|
|
|
|||
|
|
@ -13,33 +13,28 @@
|
|||
by-assumption
|
||||
interactive))
|
||||
|
||||
;;; TACTICS
|
||||
;;; A tactic is a function from proof state to proof state
|
||||
|
||||
;; TODO: Tactics probably should not error for failure. Perhaps return
|
||||
;; TODO: proof state unmodified, or raise an exception.
|
||||
#| TODO:
|
||||
| Tactics should probably not error on failure. Perhaps Maybe monad, or list monad, or return proof
|
||||
| state unmodified, or raise exception, or ...
|
||||
|#
|
||||
(define-tactic (intro name ps)
|
||||
;; TODO: Maybe cur-expand current-goal by default
|
||||
(syntax-parse (cur-expand (proof-state-current-goal ps))
|
||||
;; TODO: Provide cur-match, which wraps syntax-parse and uses cur-expand.
|
||||
(syntax-parse (cur-expand (proof-state-current-goal-ref ps))
|
||||
[(forall (x:id : P:expr) body:expr)
|
||||
(update-current-goal
|
||||
(update-current-proof
|
||||
;; TODO: Should hide syntax-e in push-env
|
||||
(push-env ps (syntax-e name) #'P)
|
||||
(lambda (x) #`(λ (#,x : P) #,x)))
|
||||
#'body)]
|
||||
(let* ([ps (proof-state-extend-env ps name #'P)]
|
||||
[ps (proof-state-current-goal-set ps #'body)]
|
||||
[ps (proof-state-fill-proof-hole ps (lambda (x) #`(lambda (#,name : P) #,x)))])
|
||||
ps)]
|
||||
[_ (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)))
|
||||
=> (curry update-current-proof (update-current-goal ps #f))]
|
||||
[(proof-state-env-ref-by-type ps (proof-state-current-goal-ref ps))
|
||||
=>
|
||||
(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)
|
||||
(struct-copy proof-state ps
|
||||
[current-goal (proof-state-original-goal ps)]
|
||||
[current-proof empty-proof]))
|
||||
(define-tactic (restart ps) (new-proof-state (proof-state-theorem ps)))
|
||||
|
||||
(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)))
|
||||
Loading…
Reference in New Issue
Block a user