;;; $Id: lambda-if-exp-examples.scm,v 1.3 2006/01/05 22:24:09 leavens Exp $

(module lambda-if-exp-examples (lib "typedscm.ss" "typedscm")

(provide count-var-exps sum all-var-exps append-all subst-var-exps)

(require (lib "lambda-if-exp.scm" "lib342"))

(deftype count-var-exps (-> (expression) number))
(define count-var-exps
  (lambda (exp)
    ;; ENSURES: result is the number of <var-exp>s in exp
    (cond
     ((var-exp? exp) 1)
     ((quote-exp? exp) 0)
     ((lambda-exp? exp) (count-var-exps (lambda-exp->body exp)))
     ((if-exp? exp) (+ (count-var-exps (if-exp->test-exp exp))
                       (count-var-exps (if-exp->true-exp exp))
                       (count-var-exps (if-exp->false-exp exp))))
     ((app-exp? exp) (+ (count-var-exps (app-exp->rator exp))
                        (sum (map count-var-exps (app-exp->rands exp)))))
     (else (error "count-var-exps, should not happen, syntax error: " exp)))))

(deftype sum (-> ((list-of number)) number))
(define sum
  (lambda (lon)
    (if (null? lon)
        0
        (+ (car lon) (sum (cdr lon))))))

(deftype all-var-exps (-> (expression) (list-of symbol)))
(define all-var-exps
  (lambda (exp)
    ;; ENSURES: result is a list of all the var-exps in exp
    ;;          (this list may contain duplicate occurrences of symbols).
    (cond
     ((var-exp? exp) (list (var-exp->id exp)))
     ((quote-exp? exp) '())
     ((lambda-exp? exp) (all-var-exps (lambda-exp->body exp)))
     ((if-exp? exp) (append (all-var-exps (if-exp->test-exp exp))
                            (all-var-exps (if-exp->true-exp exp))
                            (all-var-exps (if-exp->false-exp exp))))
     ((app-exp? exp) (append
                      (all-var-exps (app-exp->rator exp))
                      (append-all (map all-var-exps (app-exp->rands exp)))))
     (else (error "all-var-exps, should not happen, syntax error: " exp)))))


(deftype append-all (-> ((list-of (list-of symbol))) (list-of symbol)))
(define append-all
  (lambda (lls)
    (if (null? lls)
        '()
        (append (car lls) (append-all (cdr lls))))))

(deftype subst-var-exps 
  (-> (symbol symbol expression) expression))
(define subst-var-exps
  (lambda (new old exp)
    ;; ENSURES: result is the same expression as exp, but with all var-exps
    ;;          that are the same as old replaced by new.
    (cond
     ((var-exp? exp)
      (if (eq? old (var-exp->id exp))
          (var-exp new)
          exp))           ; equal & slower: (var-exp (var-exp->id exp))
     ((quote-exp? exp)
      exp)                ; equal & slower: (quote-exp (quote-exp->symbol exp))
     ((lambda-exp? exp)
      (lambda-exp
       (lambda-exp->ids exp)
       (subst-var-exps new old (lambda-exp->body exp))))
     ((if-exp? exp)
      (if-exp (subst-var-exps new old (if-exp->test-exp exp))
               (subst-var-exps new old (if-exp->true-exp exp))
               (subst-var-exps new old (if-exp->false-exp exp))))
     ((app-exp? exp)
      (app-exp
       (subst-var-exps new old (app-exp->rator exp))
       (map (lambda (e) (subst-var-exps new old e)) (app-exp->rands exp))))
     (else (error "subst-var-exps, should not happen, syntax error: " exp)))))

) ;; end module