#lang typed/racket/base

(provide (all-defined-out))


(define-type OperandDomain (U 'number
                              'string
                              'box
                              'list
                              'pair
                              'any))


;; The following are primitives that the compiler knows about:
(define-type KernelPrimitiveName (U '+
                                    '-
                                    '*
                                    '/
                                    'add1
                                    'sub1
                                    '<
                                    '<=
                                    '=
                                    '>
                                    '>=
                                    'cons
                                    'car
                                    'cdr
                                    'list
                                    'null?
                                    'not
                                    'eq?
                                    ))
(define-predicate KernelPrimitiveName? KernelPrimitiveName)



(: kernel-primitive-expected-operand-types (KernelPrimitiveName Natural -> (Listof OperandDomain)))
;; Given a primitive and the number of arguments, produces the list of expected domains.
;; TODO: do something more polymorphic.
(define (kernel-primitive-expected-operand-types prim arity)
  (cond
    [(eq? prim '+)
     (build-list arity (lambda (i) 'number))]

    [(eq? prim '-)
     (unless (> arity 0)
       (error '- "expects at least one argument, given ~a" arity))
     (build-list arity (lambda (i) 'number))]

    [(eq? prim '*)
     (build-list arity (lambda (i) 'number))]

    [(eq? prim '/)
     (unless (> arity 0)
       (error '/ "expects at least one argument, given ~a" arity))
     (build-list arity (lambda (i) 'number))]

    [(eq? prim 'add1)
     (unless (= arity 1)
       (error 'add1 "expects exactly one argument, given ~a" arity))
     (list 'number)]
    
    [(eq? prim 'sub1)
     (unless (= arity 1)
       (error 'sub1 "expects exactly one argument, given ~a" arity))
     (list 'number)]
    
    [(eq? prim '<)
     (build-list arity (lambda (i) 'number))]
    
    [(eq? prim '<=)
     (build-list arity (lambda (i) 'number))]
    
    [(eq? prim '=)
     (build-list arity (lambda (i) 'number))]
    
    [(eq? prim '>)
     (build-list arity (lambda (i) 'number))]
    
    [(eq? prim '>=)
     (build-list arity (lambda (i) 'number))]

    [(eq? prim 'cons)
     (unless (= arity 2)
       (error 'cons "expects exactly two arguments, given ~a" arity))
     (list 'any 'any)]

    [(eq? prim 'car)
     (unless (= arity 1)
       (error 'car "expects exactly one argument, given ~a" arity))
     (list 'pair)]
    
    [(eq? prim 'cdr)
     (unless (= arity 1)
       (error 'cdr "expects exactly one argument, given ~a" arity))
     (list 'pair)]
    
    [(eq? prim 'list)
     (build-list arity (lambda (i) 'any))]
    
    [(eq? prim 'null?)
     (unless (= arity 1)
       (error 'null? "expects exactly one argument, given ~a" arity))
     (list 'any)]

    [(eq? prim 'not)
     (unless (= arity 1)
       (error 'not "expects exactly one argument, given ~a" arity))
     (list 'any)]

    [(eq? prim 'eq?)
     (unless (= arity 2)
       (error 'eq? "expects exactly two arguments, given ~a" arity))
     (list 'any 'any)]))