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

20
math.rkt
View File

@ -24,12 +24,12 @@
(syntax-parser
[(_ f:id)
#:with f: (format-id #'f "~a:" (syntax-e #'f))
#'(define-syntax f:
(syntax-parser
#'(define-syntax (f: stx)
(syntax-parse stx
[(g e* (... ...))
#:with e+* (for/list ([e (in-list (syntax->list #'(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++)
(quasisyntax/loc #'g (f #,@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.
;; Return either:
;; - A numeric value
;; - A list of syntax objects, to be spliced back in the source code
(define-for-syntax (reduce/op op e*)
(let loop ([prev #f] ;; (U #f Number), candidate for reduction
[acc '()] ;; (Listof Syntax), irreducible arguments
[e* e*]) ;; (Listof Syntax), arguments to process
(define-for-syntax (reduce/op op expr* #:src stx)
(let loop ([prev #f] ;; (U #f Number), candidate for reduction
[acc '()] ;; (Listof Syntax), irreducible arguments
[e* expr*]) ;; (Listof Syntax), arguments to process
(if (null? e*)
;; then: finished, return a number (prev) or list of expressions (acc)
(if (null? acc)
@ -65,7 +68,8 @@
(if prev
;; Watch for division-by-zero
(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 v acc (cdr e*)))
;; 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 Natural)]) (f 0 0)) *:) Zero)
(ann ((lambda ([f : (-> Natural Natural Exact-Rational)]) (f 0 0)) /:) Zero)
;; -- dividing by zero => fall back to racket/base
(ann (/: 1 1 0) One)
;; -- dividing by zero => caught statically
(/: 1 1 0)
(/: 1 1 (+: 4 -2 -2))
)))
;; -----------------------------------------------------------------------------
@ -27,11 +28,11 @@
(require
rackunit)
(define (format-eval stx)
(define (math-eval stx)
(lambda () ;; For `check-exn`
(compile-syntax stx)))
(for ([rkt (in-list TEST-CASE*)])
(check-exn #rx"format::|Type Checker"
(format-eval rkt)))
(check-exn #rx"/:|Type Checker"
(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 (/: 9 9) One) 1)
;; We do not catch this statically
(check-exn exn:fail:contract?
(lambda () (/: 3 0)))
(check-equal?
(ann ((lambda ([f : (-> Integer Integer Exact-Rational)]) (f 1 1)) /:) Real)
1)
@ -82,7 +78,5 @@
(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 4]) (/: n n)) Positive-Exact-Rational) 1)
(check-exn #rx"division by zero"
(lambda () (ann (/: 0 0) Zero))) ;; Same for racket/base
)