lib/cl-conses2.lisp

   1 (in-package #:avm2-compiler)
   2
   3 ;;; higher level functions from conses dictionary
   4 ;;; (mainly things that need iteration constructs)
   5 ;;;
   6 ;;; not all match CL semantics very closely yet...
   7
   8 (let ((*symbol-table* *cl-symbol-table*))
   9
  10   ;; Function SUBLIS, NSUBLIS
  11
  12   ;; Function SUBST, SUBST-IF, SUBST-IF-NOT, NSUBST, NSUBST-IF, NSUBST-IF-NOT
  13
  14   ;; Function TREE-EQUAL
  15
  16   ;; fixme: write iterative version of copy-list
  17   (swf-defun copy-list (list)
  18     (%flet (do-copy (list)
  19              (if (consp list)
  20                  (cons (car list) (do-copy (cdr list)))
  21                  list))
  22       (if (not (listp list))
  23           (%type-error "COPY-LIST" list)
  24           (call-%flet do-copy list))))
  25
  26   ;; LIST, LIST* implemented as a special form for now due to lack of &rest
  27
  28   (swf-defun list-length (list)
  29     (let ((fast list)
  30           (length 0))
  31       (dolist (slow list)
  32         (when (endp fast) (return  length))
  33         (when (endp (cdr fast)) (return  (+ length 1)))
  34         (when (and (eq fast slow) (> length 0)) (return nil))
  35         (%set-local fast (cddr fast)))))
  36
  37   ;; LISTP in cl-conses
  38
  39   ;; Function MAKE-LIST
  40
  41   ;; PUSH, POP in cl-conses
  42
  43   ;; FIRST - TENTH in cl-conses
  44
  45   (swf-defmemfun nth (n list)
  46     (car (dotimes (x n list)
  47            (%set-local list (cdr list)))))
  48
  49   ;; ENDP, NULL, NCONC in cl-conses
  50
  51
  52 )