; The list of pattern-action pairs.
(define type-inference-p/a-list '( ))

; Useful accessors for dealing with chunks of Scheme code.
(define first car)
(define second cadr)
(define third caddr)

(define (param-list f) (cdr (second f)) )
(define (body f) (third f))

; Return types inferred for the parameters of the given function.
(define (inferred-types f)
  (expr-inferred-types 
    (body f) 
    'any 
    (map (lambda (symbol) (list symbol 'any)) (param-list f)) ) )

; Return types inferred for the symbols in the symbol list
; in the given expression (which is itself of type expr-type).
; Do this by querying the rule data base to find the rule that
; matches the expression, and then applying that rule to process
; the subexpressions.
(define (expr-inferred-types expr expr-type symbol-list)
  (define (loop p/a-list)
    (cond
      ((null? p/a-list) #f)
      ((matches? (pattern (car p/a-list)) expr)
       ((action (car p/a-list))
        (substitutions-in-to-match (pattern (car p/a-list)) expr) 
        symbol-list) )
      (else (loop (cdr p/a-list))) ) )
  (if (not (list? expr))
    (if (assoc expr symbol-list)
      (augmented symbol-list expr expr-type)
      symbol-list)
    (loop type-inference-p/a-list) ) )

; Return the result of including the given type requirement for the given symbol
; in the symbol list. 
(define (augmented symbol-list symbol type)
  (if (eq? symbol (first (car symbol-list)))
    ; We found the symbol in the table.
    ; Incorporate its current type requirement into the type information 
    ; already seen.
    (cons 
      (list symbol (type-sum type (second (car symbol-list))))
      (cdr symbol-list))
    (cons 
      (car symbol-list) 
      (augmented (cdr symbol-list) symbol type) ) ) )

; Return the result of resolving the two argument types.
;   x+x = x
;   any+x = x+any = x
;   number+integer = integer+number = number
;   x+y = CONFLICT
(define (type-sum new-type old-type)
  (cond
    ((eq? new-type old-type) new-type)
    ((eq? new-type 'any) old-type)
    ((eq? old-type 'any) new-type)
    ((and (eq? new-type 'number) (eq? old-type 'integer)) 'integer)
    ((and (eq? new-type 'integer) (eq? old-type 'number)) 'integer)
    (else 'CONFLICT) ) )