Create a gist now

Instantly share code, notes, and snippets.

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

What would you like to do?
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)))))

tfeb commented Dec 18, 2015

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