translation.ss

#lang scheme/base

(provide Scheme->Mathematica
         Mathematica->Scheme)

(define (translate table)
  (lambda (exp)
    (let ((op (hash-ref table (car exp) #f)))
      (cond ((symbol? op)
             (cons op (cdr exp)))
            ((procedure? op)
             (apply op (cdr exp)))
            (else
             exp)))))

(define Scheme->Mathematica
  (translate
   (make-immutable-hasheqv
    `((* . Times)
      (- . ,(case-lambda
              ((x) `(Minus ,x))
              ((x . y) `(Subtract ,x (Plus ,@y)))))
      (+ . Plus)
      (/ . Divide)
      (< . Less)
      (<= . LessEqual)
      (= . Equal)
      (> . Greater)
      (>= . GreaterEqual)
      (abs . Abs)
      (acos . ArcCos)
      (and . And)
      (angle . Arg)
      (asin . ArcSin)
      (atan . ArcTan)
      (begin . CompoundExpression)
      (ceiling . Ceiling)
      (cos . Cos)
      (denominator . Denominator)
      (exp . Exp)
      (expt . Power)
      (floor . Floor)
      (gcd . GCD)
      (if . If)
      (imag-part . Im)
      (lcm . LCM)
      (list . List)
      (log . Log)
      (magnitude . Abs)
      (max . Max)
      (min . Min)
      (modulo . Mod)
      (negative? . Negative)
      (not . Not)
      (number? . NumberQ)
      (numerator . Numerator)
      (odd? . OddQ)
      (or . Or)
      (positive? . Positive)
      (quotient . Quotient)
      (rationalize . Rationalize)
      (round . Round)
      (sin . Sin)
      (sqrt . Sqrt)
      (tan . Tan)
      (truncate . IntegerPart)))))

(define Mathematica->Scheme
  (translate
   (make-immutable-hasheqv
    `((Times . *)
      (Plus . +)
      (Less . <)
      (LessEqual . <=)
      (Equal . =)
      (Greater . >)
      (GreaterEqual . >=)
      (ArcCos . acos)
      (And . and)
      (Arg . angle)
      (ArcSin . asin)
      (ArcTan . atan)
      (CompoundExpression . begin)
      (Ceiling . ceiling)
      (Cos . cos)
      (Denominator . denominator)
      (DirectedInfinity . ,(lambda (z)
                             (case z
                               ((1) +inf.0)
                               ((-1) -inf.0)
                               (else `(DirectedInfinity ,z)))))
      (Exp . exp)
      (Power . expt)
      (Floor . floor)
      (GCD . gcd)
      (If . if)
      (Im . imag-part)
      (LCM . lcm)
      (List . ,vector)
      (Log . log)
      (Abs . magnitude)
      (Max . max)
      (Min . min)
      (Mod . modulo)
      (Negative . negative?)
      (Not . not)
      (NumberQ . number?)
      (Numerator . numerator)
      (OddQ . odd?)
      (Or . or)
      (Positive . positive?)
      (Quotient . quotient)
      (Rationalize . rationalize)
      (Round . round)
      (Sin . sin)
      (Sqrt . sqrt)
      (Tan . tan)
      (IntegerPart . truncate)
      (Rational . ,/)
      (Complex . ,make-rectangular)))))