lib/cl-conses.lisp

   1 (in-package #:avm2-compiler)
   2
   3 ;;; implement functions/macros from CL package
   4 ;;;
   5 ;;; most probably don't match CL semantics very closely yet...
   6
   7 ;;; conses dictionary (14.2)
   8 ;;;
   9 ;;; not sure what best internal rep for conses is,
  10 ;;;  could use anonymous object
  11 ;;;  2 element array
  12 ;;;  instances of named class
  13 ;;;  ?
  14 ;;;
  15 ;;;  named class is probably easiest to recognize for type checking
  16 ;;;    so trying that first
  17 ;;;  anon object with car and cdr properties might also be nice, and
  18 ;;;    just allow any object with those to be used as a 'cons', but
  19 ;;;    wouldn't match CL sematics very well
  20 (let ((*symbol-table* *cl-symbol-table*))
  21   ;; todo: probably should figure out how to make this final/sealed/etc.
  22   (def-swf-class cons-type "cons" object (%car %cdr)
  23                  ((a b)
  24                   (%set-property this %car a)
  25                   (%set-property this %cdr b)))
  26
  27   (swf-defmemfun cons (a b)
  28     (%asm (:find-property-strict cons-type)
  29           (:get-local-1)
  30           (:get-local-2)
  31           (:construct-prop cons-type 2)))
  32
  33   (swf-defmemfun car (a)
  34     (if (eq a :null)
  35         :null
  36         (%asm (:get-local-1)
  37               (:get-property %car))))
  38
  39   (swf-defmemfun cdr (a)
  40     (if (eq a :null)
  41         :null
  42         (if (%typep a cons-type)
  43             (%asm (:get-local-1)
  44                   (:get-property %cdr))
  45             (%error "type-error: unknown type cdr"))))
  46
  47   (swf-defmemfun consp (a)
  48     (%typep a cons-type))
  49
  50   (swf-defmemfun listp (a)
  51     (or (%typep a cons-type) (eq a nil)))
  52
  53   (swf-defmemfun endp (a)
  54     (if (eq a nil)
  55         t
  56         (if (consp a)
  57             nil
  58             (%error "type-error: arg not a list in ENDP"))))
  59
  60   ;; fixme: implement pop according to spec
  61   (swf-defmacro pop (a)
  62     `(progn
  63        (%asm (:comment "pop") (:push-null))
  64        (prog1
  65           (car ,a)
  66         (%set-local ,a (cdr ,a)))))
  67
  68 )