;;;;;
;;;;;
;;;;; Arithmetic Operation
;;;;;
;;;;;
(define $to-math-expr (macro [$arg] (math-normalize b.+ 0 (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.+
(lambda [$x1 $x2]
(match [x1 x2] [math-expr math-expr]
{[[
]
(b./ (b.+ p1 q1) p2)]
[[_ _] (reduce-fraction (math-normalize b.+' x1 x2))]})))
(define $b.-
(lambda [$x1 $x2]
(match [x1 x2] [math-expr math-expr]
{[[
]
(b./ (b.- p1 q1) p2)]
[[_ _] (reduce-fraction (math-normalize b.-' x1 x2))]})))
(define $b.*
(lambda [$x1 $x2]
(reduce-fraction (math-normalize b.*' x1 x2))))
(define $b./
(lambda [$x1 $x2]
(reduce-fraction (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 $reduce-fraction
(lambda [$mexpr]
(match mexpr math-expr
{[
>
(let {[$d (capply gcd {@ts2 @ts1})]}
(/' (sum' (map (/' $ d) ts1)) (sum' (map (/' $ d) ts2))))]})))
(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)
(`** x n))
(/ 1 (** x (neg n))))
(`** x n)))))
(define $**'
(lambda [$x $n]
(if (eq? x e)
(exp n)
(if (rational? n)
(if (gte? n 0)
(if (integer? n)
(power' x n)
(`** x n))
(/' 1 (**' x (neg n))))
(`** x n)))))
(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]
{[[_ ,0] x]
[[,0 _] y]
[[ ]
(*' (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] x]
[[,0 _] y]
[[_ ?(gte? $ x)] (b.gcd' (modulo y x) x)]
[[_ _] (b.gcd' y x)]})))