From: David Vázquez <davazp@gmail.com>
Date: Thu, 25 Apr 2013 12:29:51 +0000 (+0100)
Subject: Move more code to print.lisp and read.lisp
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=349f052a1db4f9891ae600a31ed7f2bdd3db54b3;p=jscl.git

Move more code to print.lisp and read.lisp
---

diff --git a/boot.lisp b/boot.lisp
index fe5fb66..1663ec4 100644
--- a/boot.lisp
+++ b/boot.lisp
@@ -844,3 +844,13 @@
 
 (defun get-universal-time ()
   (+ (get-unix-time) 2208988800))
+
+(defun concat (&rest strs)
+  (!reduce #'concat-two strs :initial-value ""))
+
+
+(defun values-list (list)
+  (values-array (list-to-vector list)))
+
+(defun values (&rest args)
+  (values-list args))
diff --git a/compat.lisp b/compat.lisp
index c9680c3..f51fc27 100644
--- a/compat.lisp
+++ b/compat.lisp
@@ -43,3 +43,6 @@
 
 (defun aset (array idx value)
   (setf (aref array idx) value))
+
+(defun concat (&rest strs)
+  (apply #'concatenate 'string strs))
diff --git a/ecmalisp.lisp b/ecmalisp.lisp
index 4bb93ea..c1f20d4 100644
--- a/ecmalisp.lisp
+++ b/ecmalisp.lisp
@@ -18,382 +18,15 @@
 
 #+common-lisp
 (eval-when (:load-toplevel :compile-toplevel :execute)
-  (load "compat"))
-
-;;; At this point, no matter if Common Lisp or ecmalisp is compiling
-;;; from here, this code will compile on both. We define some helper
-;;; functions now for string manipulation and so on. They will be
-;;; useful in the compiler, mostly.
-
-(defvar *newline* (string (code-char 10)))
-
-#+ecmalisp
-(defun concat (&rest strs)
-  (!reduce #'concat-two strs :initial-value ""))
-#+common-lisp
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (defun concat (&rest strs)
-    (apply #'concatenate 'string strs)))
-
-(defmacro concatf (variable &body form)
-  `(setq ,variable (concat ,variable (progn ,@form))))
-
-;;; This couple of helper functions will be defined in both Common
-;;; Lisp and in Ecmalisp.
-(defun ensure-list (x)
-  (if (listp x)
-      x
-      (list x)))
-
-(defun !reduce (func list &key initial-value)
-  (if (null list)
-      initial-value
-      (!reduce func
-               (cdr list)
-               :initial-value (funcall func initial-value (car list)))))
-
-;;; Concatenate a list of strings, with a separator
-(defun join (list &optional (separator ""))
-  (cond
-    ((null list)
-     "")
-    ((null (cdr list))
-     (car list))
-    (t
-     (concat (car list)
-             separator
-             (join (cdr list) separator)))))
-
-(defun join-trailing (list &optional (separator ""))
-  (if (null list)
-      ""
-      (concat (car list) separator (join-trailing (cdr list) separator))))
-
-(defun mapconcat (func list)
-  (join (mapcar func list)))
-
-(defun vector-to-list (vector)
-  (let ((list nil)
-	(size (length vector)))
-    (dotimes (i size (reverse list))
-      (push (aref vector i) list))))
-
-(defun list-to-vector (list)
-  (let ((v (make-array (length list)))
-	(i 0))
-    (dolist (x list v)
-      (aset v i x)
-      (incf i))))
-
-(defmacro awhen (condition &body body)
-  `(let ((it ,condition))
-     (when it ,@body)))
-
-#+ecmalisp
-(progn
-  (defun values-list (list)
-    (values-array (list-to-vector list)))
-
-  (defun values (&rest args)
-    (values-list args)))
-
-(defun integer-to-string (x)
-  (cond
-    ((zerop x)
-     "0")
-    ((minusp x)
-     (concat "-" (integer-to-string (- 0 x))))
-    (t
-     (let ((digits nil))
-       (while (not (zerop x))
-         (push (mod x 10) digits)
-         (setq x (truncate x 10)))
-       (mapconcat (lambda (x) (string (digit-char x)))
-		  digits)))))
-
-
-;;; Printer
-
-#+ecmalisp
-(progn
-  (defun prin1-to-string (form)
-    (cond
-      ((symbolp form)
-       (multiple-value-bind (symbol foundp)
-           (find-symbol (symbol-name form) *package*)
-         (if (and foundp (eq symbol form))
-             (symbol-name form)
-             (let ((package (symbol-package form))
-                   (name (symbol-name form)))
-               (concat (cond
-                         ((null package) "#")
-                         ((eq package (find-package "KEYWORD")) "")
-                         (t (package-name package)))
-                       ":" name)))))
-      ((integerp form) (integer-to-string form))
-      ((stringp form) (concat "\"" (escape-string form) "\""))
-      ((functionp form)
-       (let ((name (oget form "fname")))
-         (if name
-             (concat "#<FUNCTION " name ">")
-             (concat "#<FUNCTION>"))))
-      ((listp form)
-       (concat "("
-               (join-trailing (mapcar #'prin1-to-string (butlast form)) " ")
-               (let ((last (last form)))
-                 (if (null (cdr last))
-                     (prin1-to-string (car last))
-                     (concat (prin1-to-string (car last)) " . " (prin1-to-string (cdr last)))))
-               ")"))
-      ((arrayp form)
-       (concat "#" (if (zerop (length form))
-                       "()"
-                       (prin1-to-string (vector-to-list form)))))
-      ((packagep form)
-       (concat "#<PACKAGE " (package-name form) ">"))
-      (t
-       (concat "#<javascript object>"))))
-
-  (defun write-line (x)
-    (write-string x)
-    (write-string *newline*)
-    x)
-
-  (defun warn (string)
-    (write-string "WARNING: ")
-    (write-line string))
-
-  (defun print (x)
-    (write-line (prin1-to-string x))
-    x))
-
-
-
-;;;; Reader
-
-;;; The Lisp reader, parse strings and return Lisp objects. The main
-;;; entry points are `ls-read' and `ls-read-from-string'.
-
-(defun make-string-stream (string)
-  (cons string 0))
-
-(defun %peek-char (stream)
-  (and (< (cdr stream) (length (car stream)))
-       (char (car stream) (cdr stream))))
-
-(defun %read-char (stream)
-  (and (< (cdr stream) (length (car stream)))
-       (prog1 (char (car stream) (cdr stream))
-         (rplacd stream (1+ (cdr stream))))))
-
-(defun whitespacep (ch)
-  (or (char= ch #\space) (char= ch #\newline) (char= ch #\tab)))
-
-(defun skip-whitespaces (stream)
-  (let (ch)
-    (setq ch (%peek-char stream))
-    (while (and ch (whitespacep ch))
-      (%read-char stream)
-      (setq ch (%peek-char stream)))))
-
-(defun terminalp (ch)
-  (or (null ch) (whitespacep ch) (char= #\) ch) (char= #\( ch)))
-
-(defun read-until (stream func)
-  (let ((string "")
-        (ch))
-    (setq ch (%peek-char stream))
-    (while (and ch (not (funcall func ch)))
-      (setq string (concat string (string ch)))
-      (%read-char stream)
-      (setq ch (%peek-char stream)))
-    string))
-
-(defun skip-whitespaces-and-comments (stream)
-  (let (ch)
-    (skip-whitespaces stream)
-    (setq ch (%peek-char stream))
-    (while (and ch (char= ch #\;))
-      (read-until stream (lambda (x) (char= x #\newline)))
-      (skip-whitespaces stream)
-      (setq ch (%peek-char stream)))))
-
-(defun %read-list (stream)
-  (skip-whitespaces-and-comments stream)
-  (let ((ch (%peek-char stream)))
-    (cond
-      ((null ch)
-       (error "Unspected EOF"))
-      ((char= ch #\))
-       (%read-char stream)
-       nil)
-      ((char= ch #\.)
-       (%read-char stream)
-       (prog1 (ls-read stream)
-         (skip-whitespaces-and-comments stream)
-         (unless (char= (%read-char stream) #\))
-           (error "')' was expected."))))
-      (t
-       (cons (ls-read stream) (%read-list stream))))))
-
-(defun read-string (stream)
-  (let ((string "")
-        (ch nil))
-    (setq ch (%read-char stream))
-    (while (not (eql ch #\"))
-      (when (null ch)
-        (error "Unexpected EOF"))
-      (when (eql ch #\\)
-        (setq ch (%read-char stream)))
-      (setq string (concat string (string ch)))
-      (setq ch (%read-char stream)))
-    string))
-
-(defun read-sharp (stream)
-  (%read-char stream)
-  (ecase (%read-char stream)
-    (#\'
-     (list 'function (ls-read stream)))
-    (#\( (list-to-vector (%read-list stream)))
-    (#\: (make-symbol (string-upcase (read-until stream #'terminalp))))
-    (#\\
-     (let ((cname
-            (concat (string (%read-char stream))
-                    (read-until stream #'terminalp))))
-       (cond
-         ((string= cname "space") (char-code #\space))
-         ((string= cname "tab") (char-code #\tab))
-         ((string= cname "newline") (char-code #\newline))
-         (t (char-code (char cname 0))))))
-    (#\+
-     (let ((feature (read-until stream #'terminalp)))
-       (cond
-         ((string= feature "common-lisp")
-          (ls-read stream)              ;ignore
-          (ls-read stream))
-         ((string= feature "ecmalisp")
-          (ls-read stream))
-         (t
-          (error "Unknown reader form.")))))))
-
-;;; Parse a string of the form NAME, PACKAGE:NAME or
-;;; PACKAGE::NAME and return the name. If the string is of the
-;;; form 1) or 3), but the symbol does not exist, it will be created
-;;; and interned in that package.
-(defun read-symbol (string)
-  (let ((size (length string))
-        package name internalp index)
-    (setq index 0)
-    (while (and (< index size)
-                (not (char= (char string index) #\:)))
-      (incf index))
-    (cond
-      ;; No package prefix
-      ((= index size)
-       (setq name string)
-       (setq package *package*)
-       (setq internalp t))
-      (t
-       ;; Package prefix
-       (if (zerop index)
-           (setq package "KEYWORD")
-           (setq package (string-upcase (subseq string 0 index))))
-       (incf index)
-       (when (char= (char string index) #\:)
-         (setq internalp t)
-         (incf index))
-       (setq name (subseq string index))))
-    ;; Canonalize symbol name and package
-    (when (not (eq package "JS"))
-      (setq name (string-upcase name)))
-    (setq package (find-package package))
-    ;; TODO: PACKAGE:SYMBOL should signal error if SYMBOL is not an
-    ;; external symbol from PACKAGE.
-    (if (or internalp
-            (eq package (find-package "KEYWORD"))
-            (eq package (find-package "JS")))
-        (intern name package)
-        (find-symbol name package))))
-
-
-(defun !parse-integer (string junk-allow)
-  (block nil
-    (let ((value 0)
-          (index 0)
-          (size (length string))
-          (sign 1))
-      ;; Leading whitespace
-      (while (and (< index size)
-                  (whitespacep (char string index)))
-        (incf index))
-      (unless (< index size) (return (values nil 0)))
-      ;; Optional sign
-      (case (char string 0)
-        (#\+ (incf index))
-        (#\- (setq sign -1)
-             (incf index)))
-      ;; First digit
-      (unless (and (< index size)
-                   (setq value (digit-char-p (char string index))))
-        (return (values nil index)))
-      (incf index)
-      ;; Other digits
-      (while (< index size)
-        (let ((digit (digit-char-p (char string index))))
-          (unless digit (return))
-          (setq value (+ (* value 10) digit))
-          (incf index)))
-      ;; Trailing whitespace
-      (do ((i index (1+ i)))
-          ((or (= i size) (not (whitespacep (char string i))))
-           (and (= i size) (setq index i))))
-      (if (or junk-allow
-              (= index size))
-          (values (* sign value) index)
-          (values nil index)))))
-
-#+ecmalisp
-(defun parse-integer (string &key junk-allowed)
-  (multiple-value-bind (num index)
-      (!parse-integer string junk-allowed)
-    (when num
-      (values num index)
-      (error "junk detected."))))
-
-(defvar *eof* (gensym))
-(defun ls-read (stream)
-  (skip-whitespaces-and-comments stream)
-  (let ((ch (%peek-char stream)))
-    (cond
-      ((or (null ch) (char= ch #\)))
-       *eof*)
-      ((char= ch #\()
-       (%read-char stream)
-       (%read-list stream))
-      ((char= ch #\')
-       (%read-char stream)
-       (list 'quote (ls-read stream)))
-      ((char= ch #\`)
-       (%read-char stream)
-       (list 'backquote (ls-read stream)))
-      ((char= ch #\")
-       (%read-char stream)
-       (read-string stream))
-      ((char= ch #\,)
-       (%read-char stream)
-       (if (eql (%peek-char stream) #\@)
-           (progn (%read-char stream) (list 'unquote-splicing (ls-read stream)))
-           (list 'unquote (ls-read stream))))
-      ((char= ch #\#)
-       (read-sharp stream))
-      (t
-       (let ((string (read-until stream #'terminalp)))
-	 (or (values (!parse-integer string nil))
-	     (read-symbol string)))))))
-
-(defun ls-read-from-string (string)
-  (ls-read (make-string-stream string)))
+  (load "compat")
+  (load "utils")
+  (load "print")
+  (load "read"))
 
+;; At this point, no matter if Common Lisp or ecmalisp is compiling
+;; from here, this code will compile on both. We define some helper
+;; functions now for string manipulation and so on. They will be
+;; useful in the compiler, mostly.
 
 ;;;; Compiler
 
@@ -2184,5 +1817,9 @@
           *block-counter* 0)
     (with-open-file (out "ecmalisp.js" :direction :output :if-exists :supersede)
       (write-string (read-whole-file "prelude.js") out)
-      (ls-compile-file "boot.lisp" out :print t)
-      (ls-compile-file "ecmalisp.lisp" out :print t))))
+      (dolist (file '("boot.lisp"
+                      "utils.lisp"
+                      "print.lisp"
+                      "read.lisp"
+                      "ecmalisp.lisp"))
+        (ls-compile-file file out :print t)))))
diff --git a/print.lisp b/print.lisp
new file mode 100644
index 0000000..f406a97
--- /dev/null
+++ b/print.lisp
@@ -0,0 +1,57 @@
+
+;;; Printer
+
+(defvar *newline* (string (code-char 10)))
+
+#+ecmalisp
+(progn
+  (defun prin1-to-string (form)
+    (cond
+      ((symbolp form)
+       (multiple-value-bind (symbol foundp)
+           (find-symbol (symbol-name form) *package*)
+         (if (and foundp (eq symbol form))
+             (symbol-name form)
+             (let ((package (symbol-package form))
+                   (name (symbol-name form)))
+               (concat (cond
+                         ((null package) "#")
+                         ((eq package (find-package "KEYWORD")) "")
+                         (t (package-name package)))
+                       ":" name)))))
+      ((integerp form) (integer-to-string form))
+      ((stringp form) (concat "\"" (escape-string form) "\""))
+      ((functionp form)
+       (let ((name (oget form "fname")))
+         (if name
+             (concat "#<FUNCTION " name ">")
+             (concat "#<FUNCTION>"))))
+      ((listp form)
+       (concat "("
+               (join-trailing (mapcar #'prin1-to-string (butlast form)) " ")
+               (let ((last (last form)))
+                 (if (null (cdr last))
+                     (prin1-to-string (car last))
+                     (concat (prin1-to-string (car last)) " . " (prin1-to-string (cdr last)))))
+               ")"))
+      ((arrayp form)
+       (concat "#" (if (zerop (length form))
+                       "()"
+                       (prin1-to-string (vector-to-list form)))))
+      ((packagep form)
+       (concat "#<PACKAGE " (package-name form) ">"))
+      (t
+       (concat "#<javascript object>"))))
+
+  (defun write-line (x)
+    (write-string x)
+    (write-string *newline*)
+    x)
+
+  (defun warn (string)
+    (write-string "WARNING: ")
+    (write-line string))
+
+  (defun print (x)
+    (write-line (prin1-to-string x))
+    x))
diff --git a/read.lisp b/read.lisp
new file mode 100644
index 0000000..e92be2f
--- /dev/null
+++ b/read.lisp
@@ -0,0 +1,224 @@
+;;;; Reader
+
+;;; The Lisp reader, parse strings and return Lisp objects. The main
+;;; entry points are `ls-read' and `ls-read-from-string'.
+
+(defun make-string-stream (string)
+  (cons string 0))
+
+(defun %peek-char (stream)
+  (and (< (cdr stream) (length (car stream)))
+       (char (car stream) (cdr stream))))
+
+(defun %read-char (stream)
+  (and (< (cdr stream) (length (car stream)))
+       (prog1 (char (car stream) (cdr stream))
+         (rplacd stream (1+ (cdr stream))))))
+
+(defun whitespacep (ch)
+  (or (char= ch #\space) (char= ch #\newline) (char= ch #\tab)))
+
+(defun skip-whitespaces (stream)
+  (let (ch)
+    (setq ch (%peek-char stream))
+    (while (and ch (whitespacep ch))
+      (%read-char stream)
+      (setq ch (%peek-char stream)))))
+
+(defun terminalp (ch)
+  (or (null ch) (whitespacep ch) (char= #\) ch) (char= #\( ch)))
+
+(defun read-until (stream func)
+  (let ((string "")
+        (ch))
+    (setq ch (%peek-char stream))
+    (while (and ch (not (funcall func ch)))
+      (setq string (concat string (string ch)))
+      (%read-char stream)
+      (setq ch (%peek-char stream)))
+    string))
+
+(defun skip-whitespaces-and-comments (stream)
+  (let (ch)
+    (skip-whitespaces stream)
+    (setq ch (%peek-char stream))
+    (while (and ch (char= ch #\;))
+      (read-until stream (lambda (x) (char= x #\newline)))
+      (skip-whitespaces stream)
+      (setq ch (%peek-char stream)))))
+
+(defun %read-list (stream)
+  (skip-whitespaces-and-comments stream)
+  (let ((ch (%peek-char stream)))
+    (cond
+      ((null ch)
+       (error "Unspected EOF"))
+      ((char= ch #\))
+       (%read-char stream)
+       nil)
+      ((char= ch #\.)
+       (%read-char stream)
+       (prog1 (ls-read stream)
+         (skip-whitespaces-and-comments stream)
+         (unless (char= (%read-char stream) #\))
+           (error "')' was expected."))))
+      (t
+       (cons (ls-read stream) (%read-list stream))))))
+
+(defun read-string (stream)
+  (let ((string "")
+        (ch nil))
+    (setq ch (%read-char stream))
+    (while (not (eql ch #\"))
+      (when (null ch)
+        (error "Unexpected EOF"))
+      (when (eql ch #\\)
+        (setq ch (%read-char stream)))
+      (setq string (concat string (string ch)))
+      (setq ch (%read-char stream)))
+    string))
+
+(defun read-sharp (stream)
+  (%read-char stream)
+  (ecase (%read-char stream)
+    (#\'
+     (list 'function (ls-read stream)))
+    (#\( (list-to-vector (%read-list stream)))
+    (#\: (make-symbol (string-upcase (read-until stream #'terminalp))))
+    (#\\
+     (let ((cname
+            (concat (string (%read-char stream))
+                    (read-until stream #'terminalp))))
+       (cond
+         ((string= cname "space") (char-code #\space))
+         ((string= cname "tab") (char-code #\tab))
+         ((string= cname "newline") (char-code #\newline))
+         (t (char-code (char cname 0))))))
+    (#\+
+     (let ((feature (read-until stream #'terminalp)))
+       (cond
+         ((string= feature "common-lisp")
+          (ls-read stream)              ;ignore
+          (ls-read stream))
+         ((string= feature "ecmalisp")
+          (ls-read stream))
+         (t
+          (error "Unknown reader form.")))))))
+
+;;; Parse a string of the form NAME, PACKAGE:NAME or
+;;; PACKAGE::NAME and return the name. If the string is of the
+;;; form 1) or 3), but the symbol does not exist, it will be created
+;;; and interned in that package.
+(defun read-symbol (string)
+  (let ((size (length string))
+        package name internalp index)
+    (setq index 0)
+    (while (and (< index size)
+                (not (char= (char string index) #\:)))
+      (incf index))
+    (cond
+      ;; No package prefix
+      ((= index size)
+       (setq name string)
+       (setq package *package*)
+       (setq internalp t))
+      (t
+       ;; Package prefix
+       (if (zerop index)
+           (setq package "KEYWORD")
+           (setq package (string-upcase (subseq string 0 index))))
+       (incf index)
+       (when (char= (char string index) #\:)
+         (setq internalp t)
+         (incf index))
+       (setq name (subseq string index))))
+    ;; Canonalize symbol name and package
+    (when (not (eq package "JS"))
+      (setq name (string-upcase name)))
+    (setq package (find-package package))
+    ;; TODO: PACKAGE:SYMBOL should signal error if SYMBOL is not an
+    ;; external symbol from PACKAGE.
+    (if (or internalp
+            (eq package (find-package "KEYWORD"))
+            (eq package (find-package "JS")))
+        (intern name package)
+        (find-symbol name package))))
+
+
+(defun !parse-integer (string junk-allow)
+  (block nil
+    (let ((value 0)
+          (index 0)
+          (size (length string))
+          (sign 1))
+      ;; Leading whitespace
+      (while (and (< index size)
+                  (whitespacep (char string index)))
+        (incf index))
+      (unless (< index size) (return (values nil 0)))
+      ;; Optional sign
+      (case (char string 0)
+        (#\+ (incf index))
+        (#\- (setq sign -1)
+             (incf index)))
+      ;; First digit
+      (unless (and (< index size)
+                   (setq value (digit-char-p (char string index))))
+        (return (values nil index)))
+      (incf index)
+      ;; Other digits
+      (while (< index size)
+        (let ((digit (digit-char-p (char string index))))
+          (unless digit (return))
+          (setq value (+ (* value 10) digit))
+          (incf index)))
+      ;; Trailing whitespace
+      (do ((i index (1+ i)))
+          ((or (= i size) (not (whitespacep (char string i))))
+           (and (= i size) (setq index i))))
+      (if (or junk-allow
+              (= index size))
+          (values (* sign value) index)
+          (values nil index)))))
+
+#+ecmalisp
+(defun parse-integer (string &key junk-allowed)
+  (multiple-value-bind (num index)
+      (!parse-integer string junk-allowed)
+    (when num
+      (values num index)
+      (error "junk detected."))))
+
+(defvar *eof* (gensym))
+(defun ls-read (stream)
+  (skip-whitespaces-and-comments stream)
+  (let ((ch (%peek-char stream)))
+    (cond
+      ((or (null ch) (char= ch #\)))
+       *eof*)
+      ((char= ch #\()
+       (%read-char stream)
+       (%read-list stream))
+      ((char= ch #\')
+       (%read-char stream)
+       (list 'quote (ls-read stream)))
+      ((char= ch #\`)
+       (%read-char stream)
+       (list 'backquote (ls-read stream)))
+      ((char= ch #\")
+       (%read-char stream)
+       (read-string stream))
+      ((char= ch #\,)
+       (%read-char stream)
+       (if (eql (%peek-char stream) #\@)
+           (progn (%read-char stream) (list 'unquote-splicing (ls-read stream)))
+           (list 'unquote (ls-read stream))))
+      ((char= ch #\#)
+       (read-sharp stream))
+      (t
+       (let ((string (read-until stream #'terminalp)))
+	 (or (values (!parse-integer string nil))
+	     (read-symbol string)))))))
+
+(defun ls-read-from-string (string)
+  (ls-read (make-string-stream string)))
diff --git a/utils.lisp b/utils.lisp
new file mode 100644
index 0000000..7ae519d
--- /dev/null
+++ b/utils.lisp
@@ -0,0 +1,89 @@
+;;; utils.lisp ---
+
+;; Copyright (C) 2012, 2013 David Vazquez
+;; Copyright (C) 2012 Raimon Grau
+
+;; This program is free software: you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation, either version 3 of the
+;; License, or (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+(defmacro concatf (variable &body form)
+  `(setq ,variable (concat ,variable (progn ,@form))))
+
+;;; This couple of helper functions will be defined in both Common
+;;; Lisp and in Ecmalisp.
+(defun ensure-list (x)
+  (if (listp x)
+      x
+      (list x)))
+
+(defun !reduce (func list &key initial-value)
+  (if (null list)
+      initial-value
+      (!reduce func
+               (cdr list)
+               :initial-value (funcall func initial-value (car list)))))
+
+;;; Concatenate a list of strings, with a separator
+(defun join (list &optional (separator ""))
+  (cond
+    ((null list)
+     "")
+    ((null (cdr list))
+     (car list))
+    (t
+     (concat (car list)
+             separator
+             (join (cdr list) separator)))))
+
+(defun join-trailing (list &optional (separator ""))
+  (if (null list)
+      ""
+      (concat (car list) separator (join-trailing (cdr list) separator))))
+
+(defun mapconcat (func list)
+  (join (mapcar func list)))
+
+(defun vector-to-list (vector)
+  (let ((list nil)
+	(size (length vector)))
+    (dotimes (i size (reverse list))
+      (push (aref vector i) list))))
+
+(defun list-to-vector (list)
+  (let ((v (make-array (length list)))
+	(i 0))
+    (dolist (x list v)
+      (aset v i x)
+      (incf i))))
+
+(defmacro awhen (condition &body body)
+  `(let ((it ,condition))
+     (when it ,@body)))
+
+#+ecmalisp
+(progn
+  )
+
+(defun integer-to-string (x)
+  (cond
+    ((zerop x)
+     "0")
+    ((minusp x)
+     (concat "-" (integer-to-string (- 0 x))))
+    (t
+     (let ((digits nil))
+       (while (not (zerop x))
+         (push (mod x 10) digits)
+         (setq x (truncate x 10)))
+       (mapconcat (lambda (x) (string (digit-char x)))
+		  digits)))))