arithmetic.egi

;;;;;
;;;;;
;;;;; 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 <Apply ** (map from-math-expr {x n})>))
          (/ 1 (** x (neg n))))
        (to-math-expr <Apply ** (map from-math-expr {x n})>)))))

(define $**'
  (lambda [$x $n]
    (if (rational? n)
      (if (gte? n 0)
        (if (integer? n)
          (power' x n)
          (to-math-expr' <Apply ** (map from-math-expr {x n})>))
        (/' 1 (**' x (neg n))))
      (to-math-expr' <Apply ** (map from-math-expr {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]
      {[[<term $a $xs> <term $b $ys>]
        (* (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)]})))