Hygienic Macros for the ACL2 Theorem Prover Carl Eastlund Matthias Felleisen cce@ccs.neu.edu matthias@ccs.neu.edu Northeastern University Boston, MA, USA 1
The ACL2 Theorem Prover 2
(defun double (x) (+ x x)) (defun map-double (lst) (if (endp lst) lst (cons (double (car lst)) (map-double (cdr lst))))) (defthm len-double (equal (len (map-double lst)) (len lst))) 3
; Another function... (defun square (x) (* x x)) 4
; Another function... (defun square (x) (* x x)) ; ...means another map. (defun map-square (lst) (if (endp lst) lst (cons (square (car lst)) (map-square (cdr lst))))) 5
; Another function... (defun square (x) (* x x)) ; ...means another map. (defun map-square (lst) (if (endp lst) lst (cons (square (car lst)) (map-square (cdr lst))))) ; ACL2 is only first order! (defthm len-square (equal (len (map-square lst)) (len lst))) 6
; Abstract over names... (defmacro defun-map (map fun) `(defun ,map (lst) (if (endp lst) lst (cons (,fun (car lst)) (,map (cdr lst)))))) (defun-map map-double double) 7
; Abstract over names... (defmacro defun-map (map fun) `(defun ,map (lst) (if (endp lst) lst (cons (,fun (car lst)) (,map (cdr lst)))))) (defun-map map-double double) ! ; ...to generate map. (defun map-double (lst) (if (endp lst) lst (cons (double (car lst)) (map-double (cdr lst))))) 8
(defmacro or (a b) `(if ,a ,a ,b)) (defun find (n lst) (or (nth n lst) 0)) (defthm excluded-middle (or (not x) x)) 9
(defmacro or (a b) `(if ,a ,a ,b)) (defun find (n lst) (or (nth n lst) 0)) ! (defun find (n lst) ; Traverse twice. (if (nth n lst) (nth n lst) 0)) (defthm excluded-middle (or (not x) x)) 10
(defmacro or (a b) `(if ,a ,a ,b)) (defun find (n lst) (or (nth n lst) 0)) ! (defun find (n lst) ; Traverse twice. (if (nth n lst) (nth n lst) 0)) (defthm excluded-middle (or (not x) x)) ! (defthm excluded-middle (if (not x) (not x) x)) 11
(defmacro or (a b) ; Bind x. `(let ((x ,a)) (if x x ,b))) (defun find (n lst) (or (nth n lst) 0)) (defthm excluded-middle (or (not x) x)) 12
(defmacro or (a b) ; Bind x. `(let ((x ,a)) (if x x ,b))) (defun find (n lst) (or (nth n lst) 0)) ! (defun find (n lst) ; Traverse once. (let ((x (nth n lst))) (if x x 0))) (defthm excluded-middle (or (not x) x)) 13
(defmacro or (a b) ; Bind x. `(let ((x ,a)) (if x x ,b))) (defun find (n lst) (or (nth n lst) 0)) ! (defun find (n lst) ; Traverse once. (let ((x (nth n lst))) (if x x 0))) (defthm excluded-middle (or (not x) x)) ! (defthm excluded-middle ; Name clash! (let ((x (not x))) (if x x x))) 14
15
Unhygienic macros are not abstractions. 16
(defstructure point x y) ! (STRUCTURES::CAPSULE (... (LOCAL (IN-THEORY (THEORY 'STRUCTURES::MINIMAL-THEORY-FOR-DEFSTRUCTURE ))) (DEFMACRO UPDATE-POINT (DEFUN POINT (X Y) (&WHOLE STRUCTURES::FORM (LET ((POINT 'POINT)) STRUCTURES::STRUCT &REST ARGS) (CONS POINT (CONS X (CONS Y NIL))))) (STRUCTURES::KEYWORD-UPDATER-FN STRUCTURES::FORM (DEFTHM DEFS-ACL2-COUNT-POINT STRUCTURES::STRUCT ARGS 'POINT (EQUAL (ACL2-COUNT (POINT X Y)) 'UPDATE-POINT (+ 3 (ACL2-COUNT X) (ACL2-COUNT Y)))) '(:X :Y) (DEFUN WEAK-POINT-P (POINT) 'NIL (AND (CONSP POINT) ':COPY (CONSP (CDR POINT)) '(POINT X Y) (CONSP (CDR (CDR POINT))) '((:X . POINT-X) (:Y . POINT-Y)) (NULL (CDR (CDR (CDR POINT)))) '((:X) (:Y)))) (EQ (CAR POINT) 'POINT))) (DEFTHM DEFS-READ-POINT (DEFTHM (AND (EQUAL (POINT-X (POINT X Y)) X) DEFS-WEAK-POINT-P-POINT (EQUAL (POINT-Y (POINT X Y)) Y))) (EQUAL (WEAK-POINT-P (POINT X Y)) T) (DEFTHM DEFS-POINT-LIFT-IF :RULE-CLASSES ((:REWRITE) (AND (EQUAL (POINT-X (IF POINT-TEST POINT-LEFT POINT-RIGHT)) (:BUILT-IN-CLAUSE :COROLLARY (WEAK-POINT-P (POINT X Y))))) (IF POINT-TEST (POINT-X POINT-LEFT) (DEFUN POINT-X (POINT) (POINT-X POINT-RIGHT))) (CAR (CDR POINT))) (EQUAL (POINT-Y (IF POINT-TEST POINT-LEFT POINT-RIGHT)) (DEFUN POINT-Y (POINT) (IF POINT-TEST (POINT-Y POINT-LEFT) (CAR (CDR (CDR POINT)))) (POINT-Y POINT-RIGHT))))) (DEFUN POINT-P (POINT) (DEFTHM DEFS-ELIMINATE-POINT (AND (WEAK-POINT-P POINT) T)) (IMPLIES (WEAK-POINT-P POINT) (DEFTHM DEFS-POINT-P-INCLUDES-WEAK-POINT-P (EQUAL (POINT (POINT-X POINT) (POINT-Y POINT)) (IMPLIES (POINT-P POINT) POINT)) (WEAK-POINT-P POINT)) :RULE-CLASSES (:REWRITE :ELIM)) :RULE-CLASSES (:FORWARD-CHAINING :REWRITE :BUILT-IN-CLAUSE)) (DEFTHEORY DEFS-POINT-DEFINITION-THEORY (DEFTHM DEFS-POINT-P-POINT '(POINT WEAK-POINT-P POINT-P POINT-X POINT-Y)) (EQUAL (POINT-P (POINT X Y)) T)) (IN-THEORY (DISABLE DEFS-POINT-DEFINITION-THEORY ))) (DEFMACRO MAKE-POINT (STRUCTURES::CAPSULE (&WHOLE STRUCTURES::FORM &REST ARGS) (DEFTHEORY DEFS-POINT-LEMMA-THEORY (STRUCTURES::KEYWORD-CONSTRUCTOR-FN STRUCTURES::FORM ARGS 'POINT '(DEFS-ACL2-COUNT-POINT DEFS-ELIMINATE-POINT 'MAKE-POINT DEFS-POINT-LIFT-IF DEFS-POINT-P-POINT '((:X) (:Y)) DEFS-POINT-P-INCLUDES-WEAK-POINT-P '(:X :Y) DEFS-READ-POINT '(:X :Y)))) DEFS-WEAK-POINT-P-POINT))) 17
(defmacro or (a b) ; Special case... Compiler magic! ) (defun find (n lst) (or (nth n lst) 0)) (defthm excluded-middle (or (not x) x)) 18
(defmacro or (a b) ; Special case... Compiler magic! ) (defun find (n lst) (or (nth n lst) 0)) ! (defun find (n lst) ; Fresh variable here... (let ((x.1 (nth n lst))) (if x.1 x.1 0))) (defthm excluded-middle (or (not x) x)) 19
(defmacro or (a b) ; Special case... Compiler magic! ) (defun find (n lst) (or (nth n lst) 0)) ! (defun find (n lst) ; Fresh variable here... (let ((x.1 (nth n lst))) (if x.1 x.1 0))) (defthm excluded-middle (or (not x) x)) ! (defthm excluded-middle ; ...copy code here. (if (not x) (not x) x)) 20
(defmacro or (a b) ; Bind x. `(let ((x ,a)) (if x x ,b))) (defun find (n lst) (or (nth n lst) 0)) (defthm excluded-middle (or (not x) x)) 21
(defmacro or (a b) ; Bind x. `(let ((x ,a)) (if x x ,b))) (defun find (n lst) (or (nth n lst) 0)) ! (defun find (n lst) ; Fresh variable. (let ((x.1 (nth n lst))) (if x.1 x.1 0))) (defthm excluded-middle (or (not x) x)) 22
(defmacro or (a b) ; Bind x. `(let ((x ,a)) (if x x ,b))) (defun find (n lst) (or (nth n lst) 0)) ! (defun find (n lst) ; Fresh variable. (let ((x.1 (nth n lst))) (if x.1 x.1 0))) (defthm excluded-middle (or (not x) x)) ! (defthm excluded-middle ; Fresh variable. (let ((x.1 (not x))) (if x.1 x.1 x))) 23
Hygienic Macros 24
(define-syntax or ; Hygienic macro in Scheme. (syntax-rules () ((or a b) (let ((x a)) (if x x b))))) (or (not x) x) 25
(define-syntax or ; Hygienic macro in Scheme. (syntax-rules () ((or a b) (let ((x a)) (if x x b))))) (or (not x) x) ! (or:0 (not:0 x:0) x:0) 26
(define-syntax or ; Hygienic macro in Scheme. (syntax-rules () ((or a b) (let ((x a)) (if x x b))))) (or (not x) x) ! (or:0 (not:0 x:0) x:0) ! (let:1 ((x:1 (not:0 x:0))) (if:1 x:1 x:1 x:0)) 27
(define-syntax or ; Hygienic macro in Scheme. (syntax-rules () ((or a b) (let ((x a)) (if x x b))))) (or (not x) x) ! (or:0 (not:0 x:0) x:0) ! (let:1 ((x:1 (not:0 x:0))) (if:1 x:1 x:1 x:0)) ! (let ((x.1 (not x))) (if x.1 x.1 x)) 28
(define-syntax or ; Hygienic macro in Scheme. (syntax-rules () ((or a b) (let ((x a)) (if x x b))))) (or (not x) x) ! (or:0 (not:0 x:0) x:0) ! (let:1 ((x:1 (not:0 x:0))) (if:1 x:1 x:1 x:0)) ! (let ((x.1 (not x))) (if x.1 x.1 x)) Dybvig, R.K., Hieb, R., Bruggeman, C.: Syntactic abstraction in Scheme. Lisp and Symbolic Computation 5(4) (1992) 295–326 29
; Preserve definitions. ; New syntax and data. (defmacro or (a b) (define-syntax or `(let ((x ,a)) (syntax-rules () (if x x ,b))) ((or a b) (let ((x a)) (if x x b))))) 30
; Preserve definitions. ; New syntax and data. (defmacro or (a b) (define-syntax or `(let ((x ,a)) (syntax-rules () (if x x ,b))) ((or a b) (let ((x a)) (if x x b))))) 31
; Preserve definitions. ; New syntax and data. (defmacro or (a b) (define-syntax or `(let ((x ,a)) (syntax-rules () (if x x ,b))) ((or a b) (let ((x a)) (if x x b))))) ; Preserve expansion. ; Hygienic expansion. (defthm excluded-middle (defthm excluded-middle (let ((x (not x))) (let ((x.1 (not x))) (if x x x))) (if x.1 x.1 x))) 32
; Preserve definitions. ; New syntax and data. (defmacro or (a b) (define-syntax or `(let ((x ,a)) (syntax-rules () (if x x ,b))) ((or a b) (let ((x a)) (if x x b))))) ; Preserve expansion. ; Hygienic expansion. (defthm excluded-middle (defthm excluded-middle (let ((x (not x))) (let ((x.1 (not x))) (if x x x))) (if x.1 x.1 x))) 33
; Preserve definitions. ; New syntax and data. (defmacro or (a b) (define-syntax or `(let ((x ,a)) (syntax-rules () (if x x ,b))) ((or a b) (let ((x a)) (if x x b))))) ; Preserve expansion. ; Hygienic expansion. (defthm excluded-middle (defthm excluded-middle (let ((x (not x))) (let ((x.1 (not x))) (if x x x))) (if x.1 x.1 x))) ; Preserve axioms. ; Model hygiene in ACL2. (defthm x=x (defthm x!=x (equal x:0 x:1)) (not (equal x:0 x:1))) 34
Recommend
More recommend