lib/cl.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 (let ((*symbol-table* *cl-symbol-table*))
   8
   9   (swf-defmemfun random (a)
  10     ;;todo: return int for int args
  11     ;;fixme: don't seem to be able to set seeds, so can't do random-state arg
  12     (* (flash::math.random) a))
  13
  14   (swf-defmemfun 1- (a)
  15     (- a 1))
  16
  17   (swf-defmemfun floor (number)
  18     ;; todo implement optional divisor arg (need multiple values)
  19     (flash::math.floor number))
  20
  21   #+nil(swf-defmemfun max (&rest numbers)
  22     ;; fixme: need to figure out how to implement this...
  23          (apply 'flash::math.max numbers))
  24
  25   #+nil(swf-defmemfun min (&rest numbers)
  26     ;; fixme: need to figure out how to implement this...
  27          (apply 'flash::math.min numbers))
  28
  29
  30   (swf-defmemfun cos (radians)
  31     (flash::math.cos radians))
  32   (swf-defmemfun sin (radians)
  33     (flash::math.sin radians))
  34   (swf-defmemfun tan (radians)
  35     (flash::math.tan radians))
  36   (swf-defmemfun max (&arest rest)
  37     (%asm (:get-lex "Math")
  38           (:get-property "max")
  39           (:push-null)
  40           (:get-local 1)
  41           (:call-property "apply" 2)))
  42
  43   (swf-defmemfun eq (a b)
  44     (%asm (:get-local-1)
  45           (:get-local-2)
  46           (:strict-equals)))
  47
  48   (swf-defmemfun eql (a b)
  49     (%asm (:get-local-1)
  50           (:get-local-2)
  51           (:equals)))
  52
  53   #+nil  (swf-defmemfun error (datum &rest args) )
  54
  55   #+nil  (swf-defmemfun typep (object type)
  56     (%typep object type))
  57
  58   (swf-defmacro let* (bindings &body body)
  59     `(let (,(car bindings))
  60        ,@(if (cdr bindings)
  61              `((let* ,(cdr bindings) ,@body))
  62              body)))
  63
  64
  65 ;;; from sicl:
  66 ;;; sicl-conditionals.lisp: OR AND WHEN UNLESS COND CASE TYPECASE
  67 ;;; sicl-iteration.lisp: DOLIST DOTIMES
  68
  69 ;; temporary hack until SETF is implemented
  70
  71
  72   (swf-defmacro incf (place &optional (delta 1))
  73     `(%set-local ,place (+ ,place ,delta)))
  74
  75   (swf-defun zerop (x)
  76     (eql x 0))
  77 )