Commit | Line | Data |
---|---|---|
97eb9b75 | 1 | (in-package :parenscript) |
3eb7802d VS |
2 | |
3 | ;;; Handy utilities for doing common tasks found in many web browser | |
4 | ;;; JavaScript implementations | |
5 | ||
4a987e2b | 6 | (defpsmacro do-set-timeout ((timeout) &body body) |
3eb7802d VS |
7 | `(set-timeout (lambda () ,@body) ,timeout)) |
8 | ||
9 | ;;; Arithmetic | |
10 | ||
11 | (defmacro def-js-maths (&rest mathdefs) | |
4a987e2b | 12 | `(progn ,@(mapcar (lambda (def) (cons 'defpsmacro def)) mathdefs))) |
3eb7802d VS |
13 | |
14 | (def-js-maths | |
3eb7802d | 15 | (max (&rest nums) `(*math.max ,@nums)) |
9b89687a TC |
16 | (min (&rest nums) `(*math.min ,@nums)) |
17 | (floor (n &optional divisor) `(*math.floor ,(if divisor `(/ ,n ,divisor) n))) | |
31ad390e | 18 | (ceiling (n &optional divisor) `(*math.ceil ,(if divisor `(/ ,n ,divisor) n))) |
9b89687a | 19 | (round (n &optional divisor) `(*math.round ,(if divisor `(/ ,n ,divisor) n))) |
3eb7802d VS |
20 | (sin (n) `(*math.sin ,n)) |
21 | (cos (n) `(*math.cos ,n)) | |
22 | (tan (n) `(*math.tan ,n)) | |
3eb7802d | 23 | (asin (n) `(*math.asin ,n)) |
9b89687a | 24 | (acos (n) `(*math.acos ,n)) |
e7ae4979 | 25 | (atan (y &optional x) (if x `(*math.atan2 ,y ,x) `(*math.atan ,y))) |
a1abb4e4 TC |
26 | (sinh (n) `((lambda (x) (return (/ (- (exp x) (exp (- x))) 2))) ,n)) |
27 | (cosh (n) `((lambda (x) (return (/ (+ (exp x) (exp (- x))) 2))) ,n)) | |
28 | (tanh (n) `((lambda (x) (return (/ (- (exp x) (exp (- x))) (+ (exp x) (exp (- x)))))) ,n)) | |
29 | (asinh (n) `((lambda (x) (return (log (+ x (sqrt (1+ (* x x))))))) ,n)) | |
30 | (acosh (n) `((lambda (x) (return (* 2 (log (+ (sqrt (/ (1+ x) 2)) (sqrt (/ (1- x) 2))))))) ,n)) | |
31 | (atanh (n) `((lambda (x) (return (/ (- (log (+ 1 x)) (log (- 1 x))) 2))) ,n)) | |
8b9d8bc7 TC |
32 | (1+ (n) `(+ ,n 1)) |
33 | (1- (n) `(- ,n 1)) | |
9b89687a TC |
34 | (abs (n) `(*math.abs ,n)) |
35 | (evenp (n) `(not (oddp ,n))) | |
36 | (oddp (n) `(% ,n 2)) | |
3eb7802d | 37 | (exp (n) `(*math.exp ,n)) |
9b89687a | 38 | (expt (base power) `(*math.pow ,base ,power)) |
9a2c0f23 TC |
39 | (log (n &optional base) |
40 | (or (and (null base) `(*math.log ,n)) | |
41 | (and (numberp base) (= base 10) `(* (log ,n) *math.*log10e*)) | |
42 | `(/ (log ,n) (log ,base)))) | |
a7b7afae | 43 | (sqrt (n) `(*math.sqrt ,n)) |
3eb7802d VS |
44 | (random (&optional upto) (if upto |
45 | `(floor (* ,upto (*math.random))) | |
9b89687a | 46 | '(*math.random)))) |
854b1c7e | 47 | |
5288d666 | 48 | (define-ps-symbol-macro pi *math.*pi*) |
11fd716c | 49 | |
854b1c7e VS |
50 | ;;; Exception handling |
51 | ||
4a987e2b | 52 | (defpsmacro ignore-errors (&body body) |
854b1c7e | 53 | `(try (progn ,@body) (:catch (e)))) |
2e51aff5 | 54 | |
c72e87d8 VS |
55 | ;;; Data structures |
56 | ||
06ed0d3a VS |
57 | (defpsmacro [] (&rest args) |
58 | `(array ,@(mapcar (lambda (arg) | |
59 | (if (and (consp arg) (not (equal '[] (car arg)))) | |
60 | (cons '[] arg) | |
61 | arg)) | |
62 | args))) | |
63 | ||
c72e87d8 | 64 | (defpsmacro length (a) |
3366794f | 65 | `(@ ,a length)) |
c72e87d8 | 66 | |
2e51aff5 VS |
67 | ;;; Misc |
68 | ||
69 | (defpsmacro null (x) | |
70 | `(= ,x nil)) | |
c72e87d8 | 71 | |
83a26b36 DG |
72 | (defpsmacro undefined (x) |
73 | `(=== undefined ,x)) | |
74 | ||
75 | (defpsmacro defined (x) | |
76 | `(not (undefined ,x))) | |
77 | ||
c72e87d8 VS |
78 | (defpsmacro @ (obj &rest props) |
79 | "Handy slot-value/aref composition macro." | |
7ac25d0d VS |
80 | (if props |
81 | `(@ (slot-value ,obj ,(if (symbolp (car props)) `',(car props) (car props))) ,@(cdr props)) | |
82 | obj)) | |
d5c9059a VS |
83 | |
84 | (defpsmacro concatenate (result-type &rest sequences) | |
85 | (assert (equal result-type ''string) () "Right now Parenscript 'concatenate' only support strings.") | |
86 | (cons '+ sequences)) | |
1937c30a VS |
87 | |
88 | (defmacro concat-string (&rest things) | |
bb8ba95a | 89 | "Like concatenate but prints all of its arguments." |
1937c30a VS |
90 | `(format nil "~@{~A~}" ,@things)) |
91 | ||
92 | (defpsmacro concat-string (&rest things) | |
93 | (cons '+ things)) | |
94 | ||
ce44c98c VS |
95 | (defpsmacro elt (array index) |
96 | `(aref ,array ,index)) | |
f61db7bb DG |
97 | |
98 | (defpsmacro with-lambda (() &body body) | |
99 | "Wraps BODY in a lambda so that it can be treated as an expression." | |
100 | `((lambda () ,@body))) | |
83a26b36 DG |
101 | |
102 | (defpsmacro stringp (x) | |
103 | `(= (typeof ,x) "string")) | |
104 | ||
105 | (defpsmacro numberp (x) | |
106 | `(= (typeof ,x) "number")) | |
107 | ||
108 | (defpsmacro functionp (x) | |
109 | `(= (typeof ,x) "function")) | |
110 | ||
111 | (defpsmacro objectp (x) | |
112 | `(= (typeof ,x) "object")) | |
113 | ||
114 | (defpsmacro memoize (fn-expr) | |
115 | (destructuring-bind (defun fn-name (arg) &rest fn-body) | |
116 | fn-expr | |
117 | (declare (ignore defun)) | |
118 | (with-ps-gensyms (table value compute-fn) | |
119 | `(let ((,table {})) | |
120 | (defun ,compute-fn (,arg) ,@fn-body) | |
121 | (defun ,fn-name (,arg) | |
122 | (let ((,value (aref ,table ,arg))) | |
123 | (when (null ,value) | |
124 | (setf ,value (,compute-fn ,arg)) | |
125 | (setf (aref ,table ,arg) ,value)) | |
126 | (return ,value))))))) | |
127 | ||
128 | (defpsmacro append (arr1 &rest arrs) | |
129 | (if arrs | |
130 | `((@ ,arr1 :concat) ,@arrs) | |
131 | arr1)) | |
132 | ||
133 | (defpsmacro apply (fn &rest args) | |
134 | (let ((arglist (if (> (length args) 1) | |
135 | `(append (list ,@(butlast args)) ,(car (last args))) | |
136 | (first args)))) | |
137 | `((@ ,fn :apply) this ,arglist))) | |
138 | ||
139 | (defpsmacro destructuring-bind (vars expr &body body) | |
140 | ;; a simple implementation that for now only supports flat lists | |
141 | (let* ((arr (if (complex-js-expr-p expr) (ps-gensym) expr)) | |
142 | (n -1) | |
143 | (bindings | |
144 | (append (unless (equal arr expr) `((,arr ,expr))) | |
145 | (mapcar (lambda (var) `(,var (aref ,arr ,(incf n)))) vars)))) | |
146 | `(let ,bindings ,@body))) |