Added src/lib/functional.lisp

This is a first element of an parenscript library. The contents of
this file is to be compiled with parenscript and the result js
included in the host environment in one way or another.

diff --git a/parenscript.asd b/parenscript.asd
index b221176..5c8135f 100644 (file)
--- a/parenscript.asd
+++ b/parenscript.asd
@@ -22,7 +22,9 @@
                              (:file "js" :depends-on ("package" "utils" "defgenerics"))
                              (:file "js-html" :depends-on ("package" "js" "utils"))
                              (:file "css" :depends-on ("package" "utils"))
-                             (:file "compile-js" :depends-on ("package" "js"))))))
+                             (:file "compile-js" :depends-on ("package" "js"))))
+               (:module :lib
+                :components ((:static-file "functional")))))
 
 (defmethod asdf:perform :after ((op asdf:load-op) (system (eql (asdf:find-system :parenscript)))) 
   (pushnew :parenscript cl:*features*))

diff --git a/src/js.lisp b/src/js.lisp
index 75af024..7836401 100644 (file)
--- a/src/js.lisp
+++ b/src/js.lisp
@@ -1110,37 +1110,6 @@ vice-versa.")
        (let ((,var (aref ,arrvar ,idx)))
          ,@body)))))
 
-(defjsmacro map-into (function array)
-  "Call FUNCTION on each element in ARRAY, replace element with the return value."
-  ;; be friendly to both (map-into 'foo array) and (map-into foo array) calls
-  (when (and (listp function)
-             (eq 'quote (first function)))
-    (setf function (eval function)))
-  (with-unique-js-names (arrvar idx fn)
-    `((lambda ()
-        (let ((,arrvar ,array)
-              (,fn ,function))
-          (do ((,idx 0 (1+ ,idx)))
-              ((>= ,idx (slot-value ,arrvar 'length)))
-            (setf (aref ,arrvar ,idx) (,fn (aref ,arrvar ,idx)))))
-        (return ,arrvar)))))
-
-(defjsmacro map (function array)
-  "Call FUNCTION on each element in ARRAY and return the returned values in a new array."
-  ;; be friendly to both (map 'foo array) and (map foo array) calls
-  (when (and (listp function)
-             (eq 'quote (first function)))
-    (setf function (eval function)))
-  (with-unique-js-names (arrvar result idx fn)
-    `((lambda ()
-        (let ((,arrvar ,array)
-              (,fn ,function)
-              (,result (make-array (slot-value ,arrvar 'length))))
-          (do ((,idx 0 (1+ ,idx)))
-              ((>= ,idx (slot-value ,arrvar 'length)))
-            (setf (aref ,result ,idx) (,fn (aref ,arrvar ,idx)))))
-        (return ,result)))))
-
 (defmethod js-to-statement-strings ((for js-for) start-pos)
   (let* ((init (dwim-join (mapcar #'(lambda (x)
                                      (dwim-join (list (list (symbol-to-js (first (var-names x))))

diff --git a/src/lib/functional.lisp b/src/lib/functional.lisp
new file mode 100644 (file)
index 0000000..5c1dfb2
--- /dev/null
+++ b/src/lib/functional.lisp
@@ -0,0 +1,64 @@
+(in-package :js)
+
+;; This file contains JS code and is meant to be compiled and included
+;; into the host environment in one way or another
+
+(defun map-into (fn arr)
+  "Call FN on each element in ARR, replace element with the return value."
+  (let ((idx 0))
+    (dolist (el arr)
+      (setf (aref arr idx) (fn el))
+      (setf idx (1+ idx))))
+  (return arr))
+
+(defun map (fn arr)
+  "Call FN on each element in ARR and return the returned values in a new array."
+  ;; This may call Array.map, too
+  (let ((idx 0)
+        (result (array)))
+    (dolist (el arr)
+      (setf (aref result idx) (fn el))
+      (setf idx (1+ idx)))
+    (return result)))
+
+(defun map-until (fn arr)
+  "Call FN on each element in ARR until it returns something. If so return that value."
+  (let ((result))
+    (dolist (el arr)
+      (setf result (fn el))
+      (unless (= result undefined)
+        (return result)))))
+
+(defun member (item arr)
+  "Check if ITEM is a member of ARR."
+  (dolist (el arr)
+    (if (= el item)
+        (return true)))
+  (return false))
+
+(defun append (arr1 arr2)
+  "Return a new array with the contents of ARR1 and ARR2. If ARR2 is not an array
+then append it as a member."
+  (let ((result (array))
+        (idx 0))
+    (dolist (el arr1)
+      (setf (aref result idx) el)
+      (setf idx (1+ idx)))
+    (unless (= arr2 undefined)
+      (if (instanceof arr2 *array)
+          (dolist (el arr2)
+            (setf (aref result idx) el)
+            (setf idx (1+ idx)))
+          (setf (aref result idx) arr2))))
+  (return result))
+
+(defun set-difference (arr arr-to-sub)
+  "Return a new array with only those elements in ARR that are not in ARR-TO-SUB."
+  (let ((idx 0)
+        (result (array)))
+    (dolist (el arr)
+      (unless (member el arr-to-sub)
+        (setf (aref result idx) el)
+        (setf idx (1+ idx))))
+    (return result)))
+