1 |
|
;;-*-Lisp-*- |
2 |
;;; CMPLET Let and Let*. |
;;; CMPLET Let and Let*. |
3 |
;;; |
;;; |
4 |
;; Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa |
;; Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa |
229 |
((eq (var-kind var) 'down) |
((eq (var-kind var) 'down) |
230 |
(or (si::fixnump (var-loc var)) (wfs-error))) |
(or (si::fixnump (var-loc var)) (wfs-error))) |
231 |
(t (setf (var-ref var) (vs-push)))) |
(t (setf (var-ref var) (vs-push)))) |
232 |
(case (var-kind var) |
(if (member (var-kind var) +c-local-var-types+) |
233 |
((FIXNUM CHARACTER LONG-FLOAT SHORT-FLOAT INTEGER) |
(push (list 'c2expr* (list 'var var nil) form) initials) |
234 |
(push (list 'c2expr* (list 'var var nil) form) initials)) |
(case (car form) |
|
(otherwise |
|
|
(case (car form) |
|
235 |
(LOCATION |
(LOCATION |
236 |
(if (can-be-replaced var body) |
(if (can-be-replaced var body) |
237 |
(progn (setf (var-kind var) 'REPLACED) |
(progn (setf (var-kind var) 'REPLACED) |
238 |
(setf (var-loc var) (caddr form))) |
(setf (var-loc var) (caddr form))) |
239 |
(push (list var (caddr form)) bindings))) |
(push (list var (caddr form)) bindings))) |
240 |
(VAR |
(VAR |
241 |
(let ((var1 (caaddr form))) |
(let ((var1 (caaddr form))) |
242 |
(declare (object var1)) |
(declare (object var1)) |
275 |
(list 'down (var-loc var))) |
(list 'down (var-loc var))) |
276 |
(t(push (list var) bindings) |
(t(push (list var) bindings) |
277 |
(list 'vs (var-ref var)))) |
(list 'vs (var-ref var)))) |
278 |
form) initials)) |
form) initials)))) |
279 |
))) |
(when (eq (var-kind var) 'SPECIAL) (push (var-name var) prev-ss)))) |
|
(when (eq (var-kind var) 'SPECIAL) (push (var-name var) prev-ss)) |
|
|
)) |
|
280 |
|
|
281 |
(setq block-p (write-block-open (nreverse used-vars))) |
(setq block-p (write-block-open (nreverse used-vars))) |
282 |
|
|
357 |
(push var used-vars)) |
(push var used-vars)) |
358 |
(cond (kind (setf (var-kind var) kind) |
(cond (kind (setf (var-kind var) kind) |
359 |
(setf (var-loc var) (cs-push (var-type var) t)))) |
(setf (var-loc var) (cs-push (var-type var) t)))) |
360 |
(if (member (var-kind var) |
(if (member (var-kind var) +c-local-var-types+) |
|
'(FIXNUM CHARACTER LONG-FLOAT SHORT-FLOAT INTEGER)) |
|
361 |
nil |
nil |
362 |
(case (car form) |
(case (car form) |
363 |
(LOCATION |
(LOCATION |
402 |
((null vl)) |
((null vl)) |
403 |
(setq var (car vl))(setq form (car fl)) |
(setq var (car vl))(setq form (car fl)) |
404 |
; (print (list (var-kind var) (car form))) |
; (print (list (var-kind var) (car form))) |
405 |
(case |
(cond |
406 |
(var-kind var) |
((eq (var-kind var) 'replaced)) |
407 |
((FIXNUM CHARACTER LONG-FLOAT SHORT-FLOAT OBJECT INTEGER) |
((member (var-kind var) +c-local-var-types+) |
408 |
(let ((*value-to-go* (list 'var var nil))) |
(let ((*value-to-go* (list 'var var nil))) |
409 |
(c2expr* form))) |
(c2expr* form))) |
|
(REPLACED ) |
|
410 |
(t |
(t |
411 |
(case |
(case |
412 |
(car form) |
(car form) |
441 |
(dolist** |
(dolist** |
442 |
(var vars) |
(var vars) |
443 |
(let ((kind (var-kind var))) |
(let ((kind (var-kind var))) |
444 |
(declare (object kind)) |
(when (or (eq kind 'object) (member kind +c-local-var-types+)) |
|
(when (member kind '(FIXNUM CHARACTER LONG-FLOAT SHORT-FLOAT OBJECT |
|
|
INTEGER)) |
|
445 |
(wt-nl) |
(wt-nl) |
446 |
(unless block-p (wt "{") (setq block-p t)) |
(unless block-p (wt "{") (setq block-p t)) |
447 |
(wt-var-decl var) |
(wt-var-decl var) |