more CL functions (mostly cons/list stuff)
[swf2.git] / lib / cl.lisp
blob9d0d7f68fae8ac0d740c33357636f61d35bf8a87
1 (in-package #:avm2-compiler)
3 ;;; implement functions/macros from CL package
4 ;;;
5 ;;; most probably don't match CL semantics very closely yet...
7 (let ((*symbol-table* *cl-symbol-table*))
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))
14 (swf-defmemfun 1- (a)
15 (- a 1))
17 (swf-defmemfun floor (number)
18 ;; todo implement optional divisor arg (need multiple values)
19 (flash::math.floor number))
21 #+nil(swf-defmemfun max (&rest numbers)
22 ;; fixme: need to figure out how to implement this...
23 (apply 'flash::math.max numbers))
25 #+nil(swf-defmemfun min (&rest numbers)
26 ;; fixme: need to figure out how to implement this...
27 (apply 'flash::math.min numbers))
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 (&rest rest)
37 (%asm (:get-lex "Math")
38 (:get-property "max")
39 (:push-null)
40 (:get-local 1)
41 (:call-property "apply" 2)))
43 (swf-defmemfun eq (a b)
44 (%asm (:get-local-1)
45 (:get-local-2)
46 (:strict-equals)))
48 (swf-defmemfun eql (a b)
49 (%asm (:get-local-1)
50 (:get-local-2)
51 (:equals)))
53 #+nil (swf-defmemfun error (datum &rest args) )
55 #+nil (swf-defmemfun typep (object type)
56 (%typep object type))
58 (swf-defmacro let* (bindings &body body)
59 `(let (,(car bindings))
60 ,@(if (cdr bindings)
61 `((let* ,(cdr bindings) ,@body))
62 body)))
65 ;;; from sicl:
66 ;;; sicl-conditionals.lisp: OR AND WHEN UNLESS COND CASE TYPECASE
67 ;;; sicl-iteration.lisp: DOLIST DOTIMES
69 ;; temporary hack until SETF is implemented
72 (swf-defmacro incf (place &optional (delta 1))
73 `(%set-local ,place (+ ,place ,delta)))
75 (swf-defun zerop (x)
76 (eql x 0))