Changeset 4449


Ignore:
Timestamp:
10/18/03 22:33:08 (18 years ago)
Author:
piso
Message:

Work in progress.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/j/src/org/armedbear/lisp/compiler.lisp

    r4448 r4449  
    22;;;
    33;;; Copyright (C) 2003 Peter Graves
    4 ;;; $Id: compiler.lisp,v 1.53 2003-10-18 17:28:19 piso Exp $
     4;;; $Id: compiler.lisp,v 1.54 2003-10-18 22:33:08 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    145145    (setf compiled-body (compile-progn body))
    146146;;     (format t "compiled-body = ~S~%" compiled-body)
    147     (setf res (list* 'macrolet (reverse res) compiled-body))
     147;;     (setf res (list* 'macrolet (reverse res) compiled-body))
     148;;     res))
     149    (setf res (list* 'progn compiled-body))
    148150    res))
    149 ;;     (setf res (list* 'progn compiled-body))
    150 ;;     res))
    151151
    152152(defun compile-special (form)
     
    210210         (cons 'tagbody (compile-tagbody body))))
    211211      (LABELS
    212        (let ((locals (cadr form))
    213              (body (cddr form)))
    214           (append '(labels) (list (compile-locals locals)) (compile-progn body))))
     212;;        (format t "LABELS *local-macros* = ~S~%" *local-macros*)
     213       (let* ((locals (cadr form))
     214              (body (cddr form))
     215              (compiled-locals (compile-locals locals))
     216              (compiled-body (compile-progn body)))
     217;;          (format t "body          = ~S~%" body)
     218;;          (format t "compiled-body = ~S~%" compiled-body)
     219         (append '(labels) (list compiled-locals) compiled-body)))
    215220      (RETURN
    216221       (if (cdr form)
     
    262267;;             (format t "expansion = ~S~%" expansion)
    263268            (return-from compile-sexp expansion)))
    264         (unless (and (symbolp first) (fboundp first))
    265           (return-from compile-sexp form))
     269;;         (unless (and (symbolp first) (fboundp first))
     270;;           (return-from compile-sexp form))
    266271        (cond ((eq first 'LAMBDA)
    267272               (list* 'LAMBDA (second form)
    268273                      (mapcar #'compile-sexp (cddr form))))
    269               ((special-operator-p first)
     274              ((and (symbolp first) (special-operator-p first))
    270275               (compile-special form))
    271               ((macro-function first)
     276              ((and (symbolp first) (macro-function first))
    272277               (compile-sexp (expand-macro form)))
    273278              (t
Note: See TracChangeset for help on using the changeset viewer.