;;; misc.scm -- random other transformations done during CFN processing
 ;;;
 ;;; author :  Sandra Loosemore
 ;;; date   :  27 Feb 1992
 ;;;
 ;;; This file contains specialized CFN walkers that implement rewrite rules
 ;;; for list-exp, sequence-xxx, list-comp, section-l, and section-r.
 
 
 ;;; Turn list-exps into cons chains.
 
 (define-walker-method cfn list-exp (object)
   (do-cfn-list-exp (list-exp-exps object)))
 
 (define (do-cfn-list-exp exps)
   (if (null? exps)
       ;; Make a con-ref for []
       (**con/def (core-symbol "Nil"))
       ;; Otherwise make an app of :
       (let ((first  (cfn-ast-1 (car exps)))
 	    (rest   (do-cfn-list-exp (cdr exps))))
 	(**app (**con/def (core-symbol ":")) first rest))))
 	
 
 ;;; Sections get turned into lambda expressions.
 
 (define-walker-method cfn section-l (object)
   (let ((def   (create-temp-var 'section-arg)))
     (**lambda/pat
       (list (**var-pat/def def))
       (**app (cfn-ast-1 (section-l-op object))
              (**var/def def)
 	     (cfn-ast-1 (section-l-exp object))))))
 
 (define-walker-method cfn section-r (object)
   (let ((def   (create-temp-var 'section-arg)))
     (**lambda/pat
       (list (**var-pat/def def))
       (**app (cfn-ast-1 (section-r-op object))
 	     (cfn-ast-1 (section-r-exp object))
              (**var/def def)))))
 
 
 
 ;;; Do list comprehensions.
 ;;; rewrite in terms of build and foldr so that we can apply
 ;;; deforestation techniques later.
 
 (define-walker-method cfn list-comp (object)
   (let ((c   (create-temp-var 'c))
 	(n   (create-temp-var 'n)))
     (cfn-ast-1
       (**app (**var/def (core-symbol "build"))
 	     (**lambda/pat
 	       (list (**var-pat/def c) (**var-pat/def n))
 	       (do-cfn-list-comp
 		 (list-comp-exp object) (list-comp-quals object) c n))))))
 
 (define (do-cfn-list-comp exp quals c n)
   (if (null? quals)
       (**app (**var/def c) exp (**var/def n))
       (let ((qual  (car quals)))
 	(if (is-type? 'qual-generator qual)
 	    (do-cfn-list-comp-generator exp qual (cdr quals) c n)
 	    (do-cfn-list-comp-filter exp qual (cdr quals) c n)))))
 
 (define (do-cfn-list-comp-filter exp qual quals c n)
   (**if (qual-filter-exp qual)
 	(do-cfn-list-comp exp quals c n)
 	(**var/def n)))
 
 (define (do-cfn-list-comp-generator exp qual quals c n)
   (let ((gen-pat  (qual-generator-pat qual))
 	(gen-exp  (qual-generator-exp qual))
 	(l        (create-temp-var 'list))
 	(b        (create-temp-var 'rest)))
     (**app (**var/def (core-symbol "foldr"))
 	   (**lambda/pat
 	     (list (**var-pat/def l) (**var-pat/def b))
 	     (**case (**var/def l)
 		     (list (**alt/simple
 			    gen-pat
 			    (do-cfn-list-comp exp quals c b))
 			   (**alt/simple
 			    (**wildcard-pat)
 			    (**var/def b)))))
 	   (**var/def n)
 	   gen-exp)))
 
 ;;; Placeholders just get eliminated
 
 (define-walker-method cfn dict-placeholder (object)
   (if (eq? (dict-placeholder-exp object) '#f)
       (error "Type checker screwed a dict placeholder object ~s." object)
       (cfn-ast-1 (dict-placeholder-exp object))))
 
 (define-walker-method cfn method-placeholder (object)
   (if (eq? (method-placeholder-exp object) '#f)
       (error "Type checker screwed a method placeholder object ~s." object)
       (cfn-ast-1 (method-placeholder-exp object))))
 
 (define-walker-method cfn recursive-placeholder (object)
   (if (eq? (recursive-placeholder-exp object) '#f)
       (error "Type checker screwed a recursive placeholder object ~s." object)
       (cfn-ast-1 (recursive-placeholder-exp object))))
 
 (define-walker-method cfn cast (object)
   (cfn-ast-1 (cast-exp object)))
 
 ;;; Eliminate saved old expressions
 
 (define-walker-method cfn save-old-exp (object)
   (cfn-ast-1 (save-old-exp-new-exp object)))