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

[math] add espt

Browse Source
This commit is contained in:
ben 2016-03-02 14:21:51 -05:00
parent 3dd29044de
commit 91bdd22abc
4 changed files with 37 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
math.rkt
View File

@ -7,6 +7,8 @@
+: -: *: /: +: -: *: /:
;; Same signature as the racket/base operators, ;; Same signature as the racket/base operators,
;; but try to simplify arguments during expansion. ;; but try to simplify arguments during expansion.
expt:
) )
(require (for-syntax (require (for-syntax
@ -43,6 +45,22 @@
(make-numeric-operator *) (make-numeric-operator *)
(make-numeric-operator /) (make-numeric-operator /)
(define-syntax (expt: stx)
(syntax-parse stx
[(_ e1 e2)
#:with e1+ (expand-expr #'e1)
#:with e2+ (expand-expr #'e2)
(let ([n1 (quoted-stx-value? #'e1+)]
[n2 (quoted-stx-value? #'e2+)])
(if (and (number? n1)
(number? n2))
(quasisyntax/loc stx #,(expt n1 n2))
(syntax/loc stx (expt e1+ e2+))))]
[_:id
(syntax/loc stx expt)]
[(_ e* ...)
(syntax/loc stx (expt e* ...))]))
;; ----------------------------------------------------------------------------- ;; -----------------------------------------------------------------------------
(define-for-syntax (division-by-zero stx) (define-for-syntax (division-by-zero stx)

4
math/no-colon.rkt
View File

@ -6,4 +6,6 @@
[+: +] [+: +]
[-: -] [-: -]
[*: *] [*: *]
[/: /])) [/: /]
[expt: expt]
))

2
test/math-fail.rkt
View File

@ -12,11 +12,13 @@
(ann (let ([n 2]) (-: 2 n)) Zero) (ann (let ([n 2]) (-: 2 n)) Zero)
(ann (let ([n 5]) (*: n 1/5 1)) One) (ann (let ([n 5]) (*: n 1/5 1)) One)
(ann (let ([n 4]) (/: n n)) One) (ann (let ([n 4]) (/: n n)) One)
(ann (let ([n 2]) (expt: 3 (-: n n))) One)
;; -- lambda => back to racket/base ;; -- lambda => back to racket/base
(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 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)
(ann ((lambda ([f : (-> Natural Natural Natural)]) (f 0 1)) expt:) Zero)
;; -- dividing by zero => caught statically ;; -- dividing by zero => caught statically
(/: 1 1 0) (/: 1 1 0)
(/: 1 1 (+: 4 -2 -2)) (/: 1 1 (+: 4 -2 -2))

14
test/math-pass.rkt
View File

@ -79,4 +79,18 @@
(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)
;; -- expt
(check-equal?
(ann (expt: 5 3) Index)
125)
(check-equal?
(ann (expt: 99 0) One)
1)
(check-equal?
(ann (expt: (+: 5 -5) 78) Zero)
0)
(check-equal?
(ann (expt: (*: 2 2) (expt: 2 2)) Index)
256)
) )