Changeset 8637


Ignore:
Timestamp:
02/26/05 02:51:00 (16 years ago)
Author:
piso
Message:

DUMP-LIST, DUMP-VECTOR, DUMP-STRUCTURE

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/j/src/org/armedbear/lisp/compile-file.lisp

    r8631 r8637  
    22;;;
    33;;; Copyright (C) 2004-2005 Peter Graves
    4 ;;; $Id: compile-file.lisp,v 1.60 2005-02-24 00:37:46 piso Exp $
     4;;; $Id: compile-file.lisp,v 1.61 2005-02-26 02:51:00 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    6060          (load-compiled-function classfile)))))
    6161
     62(defun dump-list (object stream)
     63  (write-char #\( stream)
     64  (loop
     65    (dump-object (car object) stream)
     66    (setf object (cdr object))
     67    (when (null object)
     68      (return))
     69    (when (> (charpos stream) 80)
     70      (terpri stream))
     71    (write-char #\space stream)
     72    (when (atom object)
     73      (write-char #\. stream)
     74      (write-char #\space stream)
     75      (dump-object object stream)
     76      (return)))
     77  (write-char #\) stream))
     78
     79(defun dump-vector (object stream)
     80  (write-string "#(" stream)
     81  (let ((length (length object)))
     82    (when (> length 0)
     83      (dotimes (i (1- length))
     84        (dump-object (aref object i) stream)
     85        (when (> (charpos stream) 80)
     86          (terpri stream))
     87        (write-char #\space stream))
     88      (dump-object (aref object (1- length)) stream))
     89    (write-char #\) stream)))
     90
     91(defun dump-structure (object stream)
     92  (multiple-value-bind (creation-form initialization-form)
     93      (make-load-form object)
     94    (write-string "#." stream)
     95    (if initialization-form
     96        (let* ((instance (gensym))
     97               load-form)
     98          (setf initialization-form
     99                (subst instance object initialization-form))
     100          (setf initialization-form
     101                (subst instance (list 'quote instance) initialization-form
     102                       :test #'equal))
     103          (setf load-form `(progn
     104                             (let ((,instance ,creation-form))
     105                               ,initialization-form
     106                               ,instance)))
     107          (dump-object load-form stream))
     108        (dump-object creation-form stream))))
     109
    62110(defun dump-object (object stream)
    63111  (cond ((consp object)
    64          (write-char #\( stream)
    65          (loop
    66            (dump-object (car object) stream)
    67            (setf object (cdr object))
    68            (when (null object)
    69              (return))
    70            (write-char #\space stream)
    71            (when (atom object)
    72              (write-char #\. stream)
    73              (write-char #\space stream)
    74              (dump-object object stream)
    75              (return)))
    76          (write-char #\) stream))
     112         (dump-list object stream))
     113        ((stringp object)
     114         (write object :stream stream))
     115        ((bit-vector-p object)
     116         (write object :stream stream))
     117        ((vectorp object)
     118         (dump-vector object stream))
    77119        ((structure-object-p object)
    78          (multiple-value-bind (creation-form initialization-form)
    79              (make-load-form object)
    80            (write-string "#." stream)
    81            (write `(prog1 ,creation-form ,initialization-form) :stream stream)))
     120         (dump-structure object stream))
    82121        (t
    83122         (write object :stream stream))))
     
    106145  (eval form)
    107146  (cond ((structure-object-p (third form))
    108          (format t "PROCESS-DEFCONSTANT calling MAKE-LOAD-FORM ...~%")
    109147         (multiple-value-bind (creation-form initialization-form)
    110148             (make-load-form (third form))
Note: See TracChangeset for help on using the changeset viewer.