runtime/ps-runtime-lib.lisp

   1 ;;;; -*- encoding:utf-8 -*-
   2
   3 ;;; Copyright 2005 Manuel Odendahl
   4 ;;; Copyright 2005-2006 Edward Marco Baringer
   5 ;;; Copyright 2009-2011, 2018-2019 Vladimir Sedach
   6 ;;; Copyright 2019 Philipp Marek
   7
   8 ;;; SPDX-License-Identifier: BSD-3-Clause
   9
  10 (in-package #:parenscript)
  11
  12 ;;; Script of library functions you can include with your own code to
  13 ;;; provide standard Lisp functionality.
  14
  15 (defparameter *ps-lisp-library*
  16   '(progn
  17     (defun mapcar (fun &rest arrs)
  18       (let ((result-array (make-array)))
  19         (if (= 1 (length arrs))
  20             (dolist (element (aref arrs 0))
  21               ((@ result-array push) (fun element)))
  22             (dotimes (i (length (aref arrs 0)))
  23               (let ((args-array (mapcar (lambda (a) (aref a i)) arrs)))
  24                 ((@ result-array push) ((@ fun apply) fun args-array)))))
  25         result-array))
  26
  27     (defun map-into (fn arr)
  28       "Call FN on each element in ARR, replace element with the return value."
  29       (let ((idx 0))
  30         (dolist (el arr)
  31           (setf (aref arr idx) (fn el))
  32           (setf idx (1+ idx))))
  33       arr)
  34
  35     (defun map (fn arr)
  36       "Call FN on each element in ARR and return the returned values in a new array."
  37       ;; In newer versions of ECMAScript, this may call Array.map, too
  38       (let ((idx 0)
  39             (result (array)))
  40         (dolist (el arr)
  41           (setf (aref result idx) (fn el))
  42           (setf idx (1+ idx)))
  43         result))
  44
  45     (defun stringp (v)
  46       (string= (typeof v) "string"))
  47
  48     (defun characterp (v)
  49       (string= (typeof v) "string"))
  50
  51     (defun zerop (num)
  52       "Return whether NUM is zero."
  53       (= num 0))
  54
  55     (defun plusp (num)
  56       "Return whether NUM is positive."
  57       (> num 0))
  58
  59     (defun minusp (num)
  60       "Return whether NUM is negative."
  61       (< num 0))
  62
  63     (defun member (item arr)
  64       "Check if ITEM is a member of ARR."
  65       (dolist (el arr)
  66         (if (= el item)
  67             (return-from member true)))
  68       false)
  69
  70     (defun set-difference (arr arr-to-sub)
  71       "Return a new array with only those elements in ARR that are not in ARR-TO-SUB."
  72       (let ((idx 0)
  73             (result (array)))
  74         (dolist (el arr)
  75           (unless (member el arr-to-sub)
  76             (setf (aref result idx) el)
  77             (setf idx (1+ idx))))
  78         result))
  79
  80     (defun reduce (func list &optional init)
  81       (let* ((acc))
  82         (do* ((i (if (= (length arguments) 3) -1 0)
  83                  (1+ i))
  84               (acc (if (= (length arguments) 3) init (elt list 0))
  85                    (func acc (elt list i))))
  86              ((>= i (1- (length list)))))
  87         acc))
  88
  89     (defun nconc (arr &rest arrs)
  90     (when (and arr (> (length arr) 0))
  91       (loop :for other :in arrs :when (and other (> (length other) 0)) :do
  92         ((@ arr :splice :apply) arr
  93          (append (list (length arr) (length other)) other))))
  94     arr)))