← Back to branch summary

~ubuntu-branches/ubuntu/intrepid/ecl/intrepid

« back to all changes in this revision

Viewing changes to src/cmp/cmpspecial.lsp

  • Committer: Bazaar Package Importer
  • Author(s): Peter Van Eynde
  • Date: 2007-04-09 11:51:51 UTC
  • mfrom: (1.1.3 upstream)
  • Revision ID: james.westby@ubuntu.com-20070409115151-ql8cr0kalzx1jmla
Tags: 0.9i-20070324-2
Upload to unstable. 

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/cmp/cmpspecial.lsp
71
71
          ((and (consp fun) (member (car fun) '(LAMBDA EXT::LAMBDA-BLOCK)))
72
72
           (cmpck (endp (cdr fun))
73
73
                  "The lambda expression ~s is illegal." fun)
74
 
           (let* ((name (when (eq (first fun) 'EXT::LAMBDA-BLOCK)
75
 
                          (or (first (setf fun (rest fun)))
76
 
                              (cmpwarn "LAMBDA-BLOCK has block name NIL~%Name will be ignored."))))
77
 
                  (fun (c1compile-function (rest fun) :name name))
78
 
                  (lambda-form (fun-lambda fun)))
79
 
             (make-c1form 'FUNCTION lambda-form 'CLOSURE lambda-form fun)))
 
74
           (let (name body)
 
75
             (if (eq (first fun) 'EXT::LAMBDA)
 
76
                 (setf name (gensym) body (rest fun))
 
77
                 (setf name (second fun) body (cddr fun)))
 
78
             (let* ((funob (c1compile-function body :name name))
 
79
                    (lambda-form (fun-lambda funob)))
 
80
               (setf (fun-ref-ccb funob) t)
 
81
               (compute-fun-closure-type funob)
 
82
               (make-c1form 'FUNCTION lambda-form 'CLOSURE lambda-form funob))))
80
83
          (t (cmperr "The function ~s is illegal." fun)))))
81
84
 
82
85
(defun c2function (kind funob fun)
129
132
  (let* ((env-var (env-var-name *env-lvl*))
130
133
         (expected-env-size (fun-env fun)))
131
134
    (if (< expected-env-size *env*)
132
 
        (format nil "nthcdr(~D,~A)" (- *env* expected-env-size) env-var)
 
135
        (format nil "ecl_nthcdr(~D,~A)" (- *env* expected-env-size) env-var)
133
136
        env-var)))
134
137
 
135
138
(defun wt-make-closure (fun &aux (cfun (fun-cfun fun)))