#lang racket
(provide op+ op- op* op/ op**  op.. op-- op&)
;;------------------------------------
(require "mpost-variable.rkt")
(require "mpost-utils.rkt")
(require "mpost-type-funs.rkt")
(define op-same-type
  (type-or (type-> 'numeric 'numeric 'numeric)
           (type-> 'pair 'pair 'pair)
           (type-> 'color 'color 'color)))
(define (op-numeric-x-type x)
  (type-or (type-> 'numeric x x)
           (type-> x 'numeric x)))
(def-exp (op+ x . xs)
  ((fold/type op-same-type))
  (apply (op-concat " + ") x xs))
(def-exp (op- x . xs)
  ((fold/type op-same-type))
  (apply (op-concat " - ") x xs))
(define op-type* (apply type-or 
                        (map op-numeric-x-type '(numeric pair color))))
(def-exp (op* x . xs)
  ((fold/type op-type*))
  (apply (op-concat " * ") x xs))
(def-exp (op/ x . xs)
  ((fold/type op-type*))
  (apply (op-concat " / ") x xs))
(def-exp (op** x y)
  ((type-> 'numeric 'numeric 'numeric))
  (to-string (list x "**" y)))
(define (type-op-- . xs)
  (if (for/and ((x (in-list xs)))
               (or (eq? x 'pair)
                   (eq? x 'path))) 
      (list 'path) #f))
(def-exp (op-- x . xs)
  (type-op--)
  (apply (op-concat " -- ") x xs))
(def-exp (op.. x . xs)
  (type-op--)
  (apply (op-concat " .. ") x xs))
(def-exp (op& x . xs)
  ((fold/type (type-or (type-> 'string 'string 'string)
                       (type-> 'path 'path 'path))))
  (to-string (string-join (cons x xs) " & "  )))