suzanne.soy/trivial
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

[math] catch division-by-zero statically

Browse Source
This commit is contained in:
ben 2016-03-01 11:30:06 -05:00
parent 3ffd93b6f1
commit 8614607033
3 changed files with 18 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
math.rkt
View File

@ -24,12 +24,12 @@
(syntax-parser (syntax-parser
[(_ f:id) [(_ f:id)
#:with f: (format-id #'f "~a:" (syntax-e #'f)) #:with f: (format-id #'f "~a:" (syntax-e #'f))
#'(define-syntax f: #'(define-syntax (f: stx)
(syntax-parser (syntax-parse stx
[(g e* (... ...)) [(g e* (... ...))
#:with e+* (for/list ([e (in-list (syntax->list #'(e* (... ...))))]) #:with e+* (for/list ([e (in-list (syntax->list #'(e* (... ...))))])
(expand-expr e)) (expand-expr e))
(let ([e++ (reduce/op f (syntax->list #'e+*))]) (let ([e++ (reduce/op f (syntax->list #'e+*) #:src stx)])
(if (list? e++) (if (list? e++)
(quasisyntax/loc #'g (f #,@e++)) (quasisyntax/loc #'g (f #,@e++))
(quasisyntax/loc #'g #,e++)))] (quasisyntax/loc #'g #,e++)))]
@ -45,14 +45,17 @@
;; ----------------------------------------------------------------------------- ;; -----------------------------------------------------------------------------
(define-for-syntax (division-by-zero stx)
(raise-syntax-error '/ "division by zero" stx))
;; Simplify a list of expressions using an associative binary operator. ;; Simplify a list of expressions using an associative binary operator.
;; Return either: ;; Return either:
;; - A numeric value ;; - A numeric value
;; - A list of syntax objects, to be spliced back in the source code ;; - A list of syntax objects, to be spliced back in the source code
(define-for-syntax (reduce/op op e*) (define-for-syntax (reduce/op op expr* #:src stx)
(let loop ([prev #f] ;; (U #f Number), candidate for reduction (let loop ([prev #f] ;; (U #f Number), candidate for reduction
[acc '()] ;; (Listof Syntax), irreducible arguments [acc '()] ;; (Listof Syntax), irreducible arguments
[e* e*]) ;; (Listof Syntax), arguments to process [e* expr*]) ;; (Listof Syntax), arguments to process
(if (null? e*) (if (null? e*)
;; then: finished, return a number (prev) or list of expressions (acc) ;; then: finished, return a number (prev) or list of expressions (acc)
(if (null? acc) (if (null? acc)
@ -65,7 +68,8 @@
(if prev (if prev
;; Watch for division-by-zero ;; Watch for division-by-zero
(if (and (zero? v) (eq? / op)) (if (and (zero? v) (eq? / op))
(loop v (cons prev acc) (cdr e*)) (division-by-zero stx)
;(loop v (cons prev acc) (cdr e*))
(loop (op prev v) acc (cdr e*))) (loop (op prev v) acc (cdr e*)))
(loop v acc (cdr e*))) (loop v acc (cdr e*)))
;; else: save value in acc ;; else: save value in acc

11
test/math-fail.rkt
View File

@ -17,8 +17,9 @@
(ann ((lambda ([f : (-> Natural Natural Integer)]) (f 0 0)) -:) Zero) (ann ((lambda ([f : (-> Natural Natural Integer)]) (f 0 0)) -:) Zero)
(ann ((lambda ([f : (-> Natural Natural Natural)]) (f 0 0)) *:) Zero) (ann ((lambda ([f : (-> Natural Natural Natural)]) (f 0 0)) *:) Zero)
(ann ((lambda ([f : (-> Natural Natural Exact-Rational)]) (f 0 0)) /:) Zero) (ann ((lambda ([f : (-> Natural Natural Exact-Rational)]) (f 0 0)) /:) Zero)
;; -- dividing by zero => fall back to racket/base ;; -- dividing by zero => caught statically
(ann (/: 1 1 0) One) (/: 1 1 0)
(/: 1 1 (+: 4 -2 -2))
))) )))
;; ----------------------------------------------------------------------------- ;; -----------------------------------------------------------------------------
@ -27,11 +28,11 @@
(require (require
rackunit) rackunit)
(define (format-eval stx) (define (math-eval stx)
(lambda () ;; For `check-exn` (lambda () ;; For `check-exn`
(compile-syntax stx))) (compile-syntax stx)))
(for ([rkt (in-list TEST-CASE*)]) (for ([rkt (in-list TEST-CASE*)])
(check-exn #rx"format::|Type Checker" (check-exn #rx"/:|Type Checker"
(format-eval rkt))) (math-eval rkt)))
) )

6
test/math-pass.rkt
View File

@ -50,10 +50,6 @@
(check-equal? (ann (/: 0 1 2 3 4) Zero) 0) (check-equal? (ann (/: 0 1 2 3 4) Zero) 0)
(check-equal? (ann (/: 9 9) One) 1) (check-equal? (ann (/: 9 9) One) 1)
;; We do not catch this statically
(check-exn exn:fail:contract?
(lambda () (/: 3 0)))
(check-equal? (check-equal?
(ann ((lambda ([f : (-> Integer Integer Exact-Rational)]) (f 1 1)) /:) Real) (ann ((lambda ([f : (-> Integer Integer Exact-Rational)]) (f 1 1)) /:) Real)
1) 1)
@ -82,7 +78,5 @@
(check-equal? (ann (let ([n 5]) (*: n 1/5 1)) Exact-Rational) 1) (check-equal? (ann (let ([n 5]) (*: n 1/5 1)) Exact-Rational) 1)
(check-equal? (ann (let ([n 5]) (*: 3 n (+: -1 2))) Natural) 15) (check-equal? (ann (let ([n 5]) (*: 3 n (+: -1 2))) Natural) 15)
(check-equal? (ann (let ([n 4]) (/: n n)) Positive-Exact-Rational) 1) (check-equal? (ann (let ([n 4]) (/: n n)) Positive-Exact-Rational) 1)
(check-exn #rx"division by zero"
(lambda () (ann (/: 0 0) Zero))) ;; Same for racket/base
) )