src/lib/ps-macro-lib.lisp

   1 (in-package :parenscript)
   2
   3 ;;; Handy utilities for doing common tasks found in many web browser
   4 ;;; JavaScript implementations
   5
   6 (defpsmacro do-set-timeout ((timeout) &body body)
   7   `(set-timeout (lambda () ,@body) ,timeout))
   8
   9 ;;; Arithmetic
  10
  11 (defmacro def-js-maths (&rest mathdefs)
  12   `(progn ,@(mapcar (lambda (def) (cons 'defpsmacro def)) mathdefs)))
  13
  14 (def-js-maths
  15     (max (&rest nums) `(*math.max ,@nums))
  16     (min (&rest nums) `(*math.min ,@nums))
  17     (floor (n &optional divisor) `(*math.floor ,(if divisor `(/ ,n ,divisor) n)))
  18     (ceiling (n &optional divisor) `(*math.ceil ,(if divisor `(/ ,n ,divisor) n)))
  19     (round (n &optional divisor) `(*math.round ,(if divisor `(/ ,n ,divisor) n)))
  20     (sin (n) `(*math.sin ,n))
  21     (cos (n) `(*math.cos ,n))
  22     (tan (n) `(*math.tan ,n))
  23     (asin (n) `(*math.asin ,n))
  24     (acos (n) `(*math.acos ,n))
  25     (atan (y &optional x) (if x `(*math.atan2 ,y ,x) `(*math.atan ,y)))
  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))
  32     (abs (n) `(*math.abs ,n))
  33     (evenp (n) `(not (oddp ,n)))
  34     (oddp (n) `(% ,n 2))
  35     (exp (n) `(*math.exp ,n))
  36     (expt (base power) `(*math.pow ,base ,power))
  37     (log (n &optional base)
  38       (or (and (null base) `(*math.log ,n))
  39           (and (numberp base) (= base 10) `(* (log ,n) *math.*log10e*))
  40           `(/ (log ,n) (log ,base))))
  41     (sqrt (n) `(*math.sqrt ,n))
  42     (random (&optional upto) (if upto
  43                                  `(floor (* ,upto (*math.random)))
  44                                  '(*math.random))))
  45
  46 ;;; Exception handling
  47
  48 (defpsmacro ignore-errors (&body body)
  49   `(try (progn ,@body) (:catch (e))))
  50
  51 ;;; Data structures
  52
  53 (defpsmacro length (a)
  54   `(.size ,a))
  55
  56 ;;; Misc
  57
  58 (defpsmacro null (x)
  59   `(= ,x nil))
  60
  61 (defpsmacro @ (obj &rest props)
  62   "Handy slot-value/aref composition macro."
  63   (if (null props)
  64       obj
  65       `(@ (slot-value
  66            ,(if (stringp obj) `($ ,obj) obj)
  67            ,(let ((prop (macroexpand (first props))))
  68                  (if (symbolp prop)
  69                      `',prop
  70                      prop)))
  71         ,@(cdr props))))
  72
  73 (defpsmacro concatenate (result-type &rest sequences)
  74   (assert (equal result-type ''string) () "Right now Parenscript 'concatenate' only support strings.")
  75   (cons '+ sequences))