#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) " & " )))