Create a gist now

Instantly share code, notes, and snippets.

@tfeb /boe.rkt
Last active Dec 18, 2015

Boolean operator equivalence
#lang racket
;;;; Compare boolean operators for equivalence
;;; The purpose of this was to see if I could write a reasonably hairy
;;; macro in Racket without the result being incomprehensible. I can,
;;; although it is probably not very idiomatic Racket.
(require (for-syntax (only-in racket/syntax format-id
current-syntax-context wrong-syntax)))
(provide boe-report-failure?
(module+ test
;; for raco test
(require rackunit))
(module+ main
;; for racket boe.rkt
(require macro-debugger/expand))
(define boe-report-failure? (make-parameter #f))
(define-syntax (boolean-operators-equivalent? stx)
;; Given the names of two boolean operators and a list of argument
;; names, expand to a form which tests that they are equivalent, by
;; evaluating the with arguments bound to all the combinations of #t
;; and #f, and also checking that they evaluate the same arguments
;; in each case.
(parameterize ([current-syntax-context stx])
(syntax-case stx ()
[(_ o1 o2 (v ...))
(let* ([vars (syntax->list #'(v ...))]
[nvars (length vars)])
;; This check could be a guard, but we need the bindings
;; anyway, so.
(for ([var vars])
(unless (identifier? var)
(wrong-syntax var "not an identifier")))
;; vars is now a list of identifiers, and nvars is how many
;; there are. We need to construct syntax for check
;; variables for each var and and operator, as well as
;; construct 2^n and a list of bit numbers.] This is being
;; fairly fast and loose: it turns out that various things
;; get automagically converted into syntax objects, and I
;; have not cared about the context for numbers (what is
;; it?). In general I am a bit confused about what the
;; context should be here, but it clearly should *not* be
;; stx.
(with-syntax ([(o1c ...) (for/list ([v vars])
(format-id #'boe "~a-1-eval-count" v))]
[(o2c ...) (for/list ([v vars])
(format-id #'boe "~a-2-eval-count" v))]
[2^n (expt 2 nvars)]
[(b ...) (for/list ([i nvars]) i)])
;; And now just write the pattern we want. '...' is pretty
;; clever, it turns out
#'(for/and ([c 2^n])
(let ([v (bitwise-bit-set? c b)] ...)
(let ([o1c 0] ...)
(let ([o2c 0] ...)
(or (and (eq? (o1 (begin (set! o1c (+ o1c 1)) v) ...)
(o2 (begin (set! o2c (+ o2c 1)) v) ...))
(= o1c o2c) ...)
(when (boe-report-failure?)
(eprintf "Not equivalent:~% ~a~% ~a~%"
(list 'o1 `(,v ,o1c) ...)
(list 'o2 `(,v ,o2c) ...)))
(wrong-syntax #'else "expecting o1 o2 (a1 ...)")])))
(module+ test
;; Some basic tests
(parameterize ([boe-report-failure? #t])
(boolean-operators-equivalent? if if (test then else)))
(define-syntax-rule (if/broken test then else)
(or (and test then) else))
(boolean-operators-equivalent? if if/broken (test then else)))
(define-syntax-rule (if/working test then else)
(let ([r test])
(or (and r then)
(and (not r) else))))
(boolean-operators-equivalent? if if/working (test then else)))))
(module+ main
;; Running this as a script just prints some expansions (well, one
;; expansion).
(define examples
(list #'(boolean-operators-equivalent? if if/working (test then else))))
(define macros (list #'boolean-operators-equivalent?))
(for ([e examples])
(pretty-write (syntax->datum e))
(displayln "->")
(pretty-write (syntax->datum (expand-only e macros)))))

This comment has been minimized.

Show comment
Hide comment

tfeb commented Dec 18, 2015

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment