/[slime]/slime/swank.lisp
ViewVC logotype

Diff of /slime/swank.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.718 by heller, Fri Jun 4 07:30:05 2010 UTC revision 1.719 by heller, Fri Jun 4 07:30:26 2010 UTC
# Line 3290  DSPEC is a string and LOCATION a source Line 3290  DSPEC is a string and LOCATION a source
3290      (list (to-string name) loc)))      (list (to-string name) loc)))
3291    
3292    
3293    ;;;;; Lazy lists
3294    
3295    (defstruct (lcons (:constructor %lcons (car %cdr))
3296                      (:predicate lcons?))
3297      car
3298      (%cdr nil :type (or null lcons function))
3299      (forced? nil))
3300    
3301    (defmacro lcons (car cdr)
3302      `(%lcons ,car (lambda () ,cdr)))
3303    
3304    (defmacro lcons* (car cdr &rest more)
3305      (cond ((null more) `(lcons ,car ,cdr))
3306            (t `(lcons ,car (lcons* ,cdr ,@more)))))
3307    
3308    (defun lcons-cdr (lcons)
3309      (with-struct* (lcons- @ lcons)
3310        (cond ((@ forced?)
3311               (@ %cdr))
3312              (t
3313               (let ((value (funcall (@ %cdr))))
3314                 (setf (@ forced?) t
3315                       (@ %cdr) value))))))
3316    
3317    (defun llist-range (llist start end)
3318      (llist-take (llist-skip llist start) (- end start)))
3319    
3320    (defun llist-skip (lcons index)
3321      (do ((i 0 (1+ i))
3322           (l lcons (lcons-cdr l)))
3323          ((or (= i index) (null l))
3324           l)))
3325    
3326    (defun llist-take (lcons count)
3327      (let ((result '()))
3328        (do ((i 0 (1+ i))
3329             (l lcons (lcons-cdr l)))
3330            ((or (= i count)
3331                 (null l)))
3332          (push (lcons-car l) result))
3333        (nreverse result)))
3334    
3335    (defun iline (label value)
3336      `(:line ,label ,value))
3337    
3338    
3339  ;;;; Inspecting  ;;;; Inspecting
3340    
3341  (defvar *inspector-verbose* nil)  (defvar *inspector-verbose* nil)
# Line 3509  Return nil if there's no previous object Line 3555  Return nil if there's no previous object
3555      (reset-inspector)      (reset-inspector)
3556      (inspect-object (frame-var-value frame var))))      (inspect-object (frame-var-value frame var))))
3557    
 ;;;;; Lazy lists  
   
 (defstruct (lcons (:constructor %lcons (car %cdr))  
                   (:predicate lcons?))  
   car  
   (%cdr nil :type (or null lcons function))  
   (forced? nil))  
   
 (defmacro lcons (car cdr)  
   `(%lcons ,car (lambda () ,cdr)))  
   
 (defmacro lcons* (car cdr &rest more)  
   (cond ((null more) `(lcons ,car ,cdr))  
         (t `(lcons ,car (lcons* ,cdr ,@more)))))  
   
 (defun lcons-cdr (lcons)  
   (with-struct* (lcons- @ lcons)  
     (cond ((@ forced?)  
            (@ %cdr))  
           (t  
            (let ((value (funcall (@ %cdr))))  
              (setf (@ forced?) t  
                    (@ %cdr) value))))))  
   
 (defun llist-range (llist start end)  
   (llist-take (llist-skip llist start) (- end start)))  
   
 (defun llist-skip (lcons index)  
   (do ((i 0 (1+ i))  
        (l lcons (lcons-cdr l)))  
       ((or (= i index) (null l))  
        l)))  
   
 (defun llist-take (lcons count)  
   (let ((result '()))  
     (do ((i 0 (1+ i))  
          (l lcons (lcons-cdr l)))  
         ((or (= i count)  
              (null l)))  
       (push (lcons-car l) result))  
     (nreverse result)))  
   
 (defun iline (label value)  
   `(:line ,label ,value))  
   
3558  ;;;;; Lists  ;;;;; Lists
3559    
3560  (defmethod emacs-inspect ((o cons))  (defmethod emacs-inspect ((o cons))
# Line 3601  Return NIL if LIST is circular." Line 3602  Return NIL if LIST is circular."
3602    
3603  ;;;;; Hashtables  ;;;;; Hashtables
3604    
   
3605  (defun hash-table-to-alist (ht)  (defun hash-table-to-alist (ht)
3606    (let ((result '()))    (let ((result '()))
3607      (maphash #'(lambda (key value)      (maphash #'(lambda (key value)

Legend:
Removed from v.1.718  
changed lines
  Added in v.1.719

  ViewVC Help
Powered by ViewVC 1.1.5