;;;;; ;;;;; ;;;;; Arithmetic Operation ;;;;; ;;;;; (define $to-math-expr (macro [$arg] (math-normalize (apply to-math-expr' arg)))) (define $+' (cambda $xs (foldl b.+' (car xs) (cdr xs)))) (define $-' (cambda $xs (foldl b.-' (car xs) (cdr xs)))) (define $*' (cambda $xs (foldl b.*' (car xs) (cdr xs)))) (define $/' b./') (define $.' (cambda $xs (foldl b..' (car xs) (cdr xs)))) (define $b.+ (macro [$x1 $x2] (math-normalize (b.+' x1 x2)))) (define $b.- (macro [$x1 $x2] (math-normalize (b.-' x1 x2)))) (define $b.* (macro [$x1 $x2] (math-normalize (b.*' x1 x2)))) (define $b./ (macro [$x1 $x2] (math-normalize (b./' x1 x2)))) (define $b.. (macro [$x1 $x2] (math-normalize (b..' x1 x2)))) (define $+ (cambda $xs (foldl b.+ (car xs) (cdr xs)))) (define $- (cambda $xs (foldl b.- (car xs) (cdr xs)))) (define $* (cambda $xs (foldl b.* (car xs) (cdr xs)))) (define $/ b./) (define $. (cambda $xs (foldl b.. (car xs) (cdr xs)))) (define $sum (lambda [$xs] (foldl + 0 xs))) (define $sum' (lambda [$xs] (foldl +' 0 xs))) (define $product (lambda [$xs] (foldl * 1 xs))) (define $product' (lambda [$xs] (foldl *' 1 xs))) (define $power (lambda [$x $n] (foldl * 1 (take n (repeat1 x))))) (define $power' (lambda [$x $n] (foldl *' 1 (take n (repeat1 x))))) (define $** (lambda [$x $n] (if (eq? x e) (exp n) (if (rational? n) (if (gte? n 0) (if (integer? n) (power x n) (to-math-expr )) (/ 1 (** x (neg n)))) (to-math-expr ))))) (define $**' (lambda [$x $n] (if (rational? n) (if (gte? n 0) (if (integer? n) (power' x n) (to-math-expr' )) (/' 1 (**' x (neg n)))) (to-math-expr' )))) (define $gcd (cambda $xs (foldl b.gcd (car xs) (cdr xs)))) (define $gcd' (cambda $xs (foldl b.gcd' (car xs) (cdr xs)))) (define $b.gcd (lambda [$x $y] (match [x y] [term-expr term-expr] {[[ ] (* (b.gcd' (abs a) (abs b)) (foldl *' 1 (map 2#(**' %1 %2) (AC.intersect xs ys))))]}))) (define $b.gcd' (lambda [$x $y] (match [x y] [integer integer] {[[,0 _] y] [[_ ,0] x] [[_ ?(gte? $ x)] (b.gcd' (modulo y x) x)] [[_ _] (b.gcd' y x)]})))