; 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) ) )