Skip to content

Instantly share code, notes, and snippets.

@Metaxal
Last active December 18, 2015 08:59
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save Metaxal/5758394 to your computer and use it in GitHub Desktop.
Save Metaxal/5758394 to your computer and use it in GitHub Desktop.
Allowing for internal definitions in `and'
#lang racket
(require (for-syntax syntax/parse))
(define-syntax (and/def stx)
(syntax-parse stx
#:literals (define define-values)
[(_) #'#t]
[(_ [define-values (var:id ...) val:expr] rest ...)
#'(let-values ([(var ...) val])
(and/def rest ...))]
[(_ [define var:id val:expr] rest ...)
#'(let ([var val]) (and/def rest ...))]
[(_ val:expr)
#'val]
[(_ val:expr rest ...)
#'(and val (and/def rest ...))]
))
(module+ test
(require rackunit)
(check-equal? (and/def) #t)
(check-equal? (and/def 5) 5)
(check-equal? (and/def (rest '(a b c))) '(b c))
(check-equal? (and/def (define rest '(a b c)) rest) '(a b c))
(check-equal? (and/def #f 5) #f)
(check-equal? (and/def 3
(define-values (x y) (values 1 2))
y)
2)
)
(module+ main
(and/def 3
(define l '(a b))
l
(define-values (x y) (values 3 4))
x
(cons x l)))
#lang racket
(require (for-syntax syntax/parse))
(define-syntax (and/let stx)
(syntax-parse stx
[(_) #'#t]
[(_ #:let-values (var:id ...) val:expr rest ...)
#'(let-values ([(var ...) val])
(and/let rest ...))]
[(_ #:let var:id val:expr rest ...)
#'(let ([var val]) (and/let rest ...))]
[(_ val:expr)
#'val]
[(_ val:expr rest ...)
#'(and val (and/let rest ...))]
))
(module+ test
(require rackunit)
(check-equal? (and/let) #t)
(check-equal? (and/let 5) 5)
(check-equal? (and/let (rest '(a b c))) '(b c))
(check-equal? (and/let #:let rest '(a b c) rest) '(a b c))
(check-equal? (and/let #f 5) #f)
(check-equal? (and/let 3
#:let-values (x y) (values 1 2)
y)
2)
)
(module+ main
(and/let 3
#:let l '(a b)
l
#:let-values (x y) (values 3 4)
x
(cons x l)))
#lang racket
(define-syntax-rule (let/ec/check check body ...)
(let/ec return
(define (check v)
(unless v (return #f)))
body ...
))
(module+ main
(define (try-me x)
(let/ec/check check
(check x)
(define y (string->number x))
(check y)
(define z (member y '(1 2 3)))
(check z)
(cons 'a z)
))
(try-me "2")
)
@Metaxal
Copy link
Author

Metaxal commented Jun 11, 2013

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