guile-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Guile-commits] GNU Guile branch, elisp, updated. release_1-9-0-68-gf614


From: Daniel Kraft
Subject: [Guile-commits] GNU Guile branch, elisp, updated. release_1-9-0-68-gf614ca1
Date: Sat, 18 Jul 2009 18:11:29 +0000

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=f614ca12cd83aaec77096aed9671aaa0bd51b695

The branch, elisp has been updated
       via  f614ca12cd83aaec77096aed9671aaa0bd51b695 (commit)
       via  7d1a978289c75efbb99684c4feb29dfb10cf1229 (commit)
      from  570c12aca7dcab2adb60bd56319dcfc3e0d6379b (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit f614ca12cd83aaec77096aed9671aaa0bd51b695
Author: Daniel Kraft <address@hidden>
Date:   Sat Jul 18 20:10:24 2009 +0200

    Implemented some important list built-ins.
    
    * module/language/elisp/runtime.scm: Updated/added convenience macros.
    * module/language/elisp/runtime/function-slot.scm: Implement list built-ins.
    * module/language/elisp/runtime/macro-slot.scm: Implement list built-ins.
    * test-suite/tests/elisp-compiler.test: Test the implemented built-ins.

commit 7d1a978289c75efbb99684c4feb29dfb10cf1229
Author: Daniel Kraft <address@hidden>
Date:   Sat Jul 18 18:38:42 2009 +0200

    Implemented unless, when and dotimes using built-in macros.
    
    * module/language/elisp/README: Document that.
    * module/language/elisp/runtime.scm: Defined built-in-macro macro.
    * module/language/elisp/runtime/macro-slot.scm: Implement unless, when, 
dotimes.
    * test-suite/tests/elisp-compiler.test: Test for those constructs.

-----------------------------------------------------------------------

Summary of changes:
 module/language/elisp/README                    |    9 +-
 module/language/elisp/runtime.scm               |   40 +++++-
 module/language/elisp/runtime/function-slot.scm |  149 ++++++++++++++++++++--
 module/language/elisp/runtime/macro-slot.scm    |   51 ++++++++-
 test-suite/tests/elisp-compiler.test            |  109 ++++++++++++++++-
 5 files changed, 324 insertions(+), 34 deletions(-)

diff --git a/module/language/elisp/README b/module/language/elisp/README
index 684677b..8068351 100644
--- a/module/language/elisp/README
+++ b/module/language/elisp/README
@@ -6,10 +6,10 @@ as status information.
 
 Already implemented:
   * progn
-  * if, cond
-  * and, or
+  * if, cond, when, unless
+  * not, and, or
   * referencing and setting (setq) variables
-  * while
+  * while, dotimes
   * let, let*
   * lambda expressions, function calls using list notation
   * some built-ins (mainly numbers/arithmetic)
@@ -19,8 +19,7 @@ Already implemented:
 
 Especially still missing:
   * other progX forms, will be done in macros
-  * where, unless, will be done in macros
-  * dolist, dotimes using macros
+  * dolist using macros
   * catch/throw, unwind-protect
   * real elisp reader instead of Scheme's
   * set, makunbound, boundp functions
diff --git a/module/language/elisp/runtime.scm 
b/module/language/elisp/runtime.scm
index afdf591..1ec5bb4 100644
--- a/module/language/elisp/runtime.scm
+++ b/module/language/elisp/runtime.scm
@@ -20,8 +20,8 @@
 ;;; Code:
 
 (define-module (language elisp runtime)
-  #:export (void nil-value t-value elisp-bool)
-  #:export-syntax (built-in-func))
+  #:export (void nil-value t-value elisp-bool runtime-error macro-error)
+  #:export-syntax (built-in-func built-in-macro prim))
 
 ; This module provides runtime support for the Elisp front-end.
 
@@ -38,6 +38,15 @@
 (define t-value #t)
 
 
+; Report an error during macro compilation, that means some special compilation
+; (syntax) error; or report a simple runtime-error from a built-in function.
+
+(define (macro-error msg . args)
+  (apply error msg args))
+
+(define runtime-error macro-error)
+
+
 ; Convert a scheme boolean to Elisp.
 
 (define (elisp-bool b)
@@ -46,9 +55,26 @@
     nil-value))
 
 
-; Define a predefined function; convenient macro for this task.
+; Define a predefined function or predefined macro for use in the function-slot
+; and macro-slot modules, respectively.
+
+(define-syntax built-in-func
+  (syntax-rules ()
+    ((_ name value)
+     (begin
+       (define-public name (make-fluid))
+       (fluid-set! name value)))))
+
+(define-syntax built-in-macro
+  (syntax-rules ()
+    ((_ name value)
+     (define-public name value))))
+
+
+; Call a guile-primitive that may be rebound for elisp and thus needs absolute
+; addressing.
 
-(define-macro (built-in-func name value)
-  `(begin
-     (define-public ,name (make-fluid))
-     (fluid-set! ,name ,value)))
+(define-syntax prim
+  (syntax-rules ()
+    ((_ sym args ...)
+     ((@ (guile) sym) args ...))))
diff --git a/module/language/elisp/runtime/function-slot.scm 
b/module/language/elisp/runtime/function-slot.scm
index db751d2..3b3cf3c 100644
--- a/module/language/elisp/runtime/function-slot.scm
+++ b/module/language/elisp/runtime/function-slot.scm
@@ -40,8 +40,7 @@
 (built-in-func floatp (lambda (num)
                         (elisp-bool (and (real? num)
                                          (or (inexact? num)
-                                             ((@ (guile) not)
-                                               (integer? num)))))))
+                                             (prim not (integer? num)))))))
 
 (built-in-func integerp (lambda (num)
                           (elisp-bool (and (exact? num)
@@ -53,35 +52,34 @@
 (built-in-func wholenump (lambda (num)
                            (elisp-bool (and (exact? num)
                                             (integer? num)
-                                            ((@ (guile) >=) num 0)))))
+                                            (prim >= num 0)))))
 
 (built-in-func zerop (lambda (num)
-                       (elisp-bool ((@ (guile) =) num 0))))
+                       (elisp-bool (prim = num 0))))
 
 
 ; Number comparisons.
 
 (built-in-func = (lambda (num1 num2)
-                   (elisp-bool ((@ (guile) =) num1 num2))))
+                   (elisp-bool (prim = num1 num2))))
 (built-in-func /= (lambda (num1 num2)
-                    (elisp-bool ((@ (guile) not) ((@ (guile) =) num1 num2)))))
+                    (elisp-bool (prim not (prim = num1 num2)))))
 
 (built-in-func < (lambda (num1 num2)
-                   (elisp-bool ((@ (guile) <) num1 num2))))
+                   (elisp-bool (prim < num1 num2))))
 (built-in-func <= (lambda (num1 num2)
-                    (elisp-bool ((@ (guile) <=) num1 num2))))
+                    (elisp-bool (prim <= num1 num2))))
 (built-in-func > (lambda (num1 num2)
-                   (elisp-bool ((@ (guile) >) num1 num2))))
+                   (elisp-bool (prim > num1 num2))))
 (built-in-func >= (lambda (num1 num2)
-                    (elisp-bool ((@ (guile) >=) num1 num2))))
+                    (elisp-bool (prim >= num1 num2))))
 
 (built-in-func max (lambda (. nums)
-                     ((@ (guile) apply) (@ (guile) max) nums)))
+                     (prim apply (@ (guile) max) nums)))
 (built-in-func min (lambda (. nums)
-                     ((@ (guile) apply) (@ (guile) min) nums)))
+                     (prim apply (@ (guile) min) nums)))
 
-(built-in-func abs (lambda (num)
-                     ((@ (guile) abs) num)))
+(built-in-func abs (@ (guile) abs))
 
 
 ; Number conversion.
@@ -114,6 +112,129 @@
 (built-in-func fround (@ (guile) round))
 
 
+; List predicates.
+
+(built-in-func consp
+  (lambda (el)
+    (elisp-bool (pair? el))))
+(built-in-func atomp
+  (lambda (el)
+    (elisp-bool (prim not (pair? el)))))
+
+(built-in-func listp
+  (lambda (el)
+    (elisp-bool (or (pair? el) (null? el)))))
+(built-in-func nlistp
+  (lambda (el)
+    (elisp-bool (and (prim not (pair? el))
+                     (prim not (null? el))))))
+
+(built-in-func null
+  (lambda (el)
+    (elisp-bool (null? el))))
+
+
+; Accessing list elements.
+
+(built-in-func car
+  (lambda (el)
+    (if (null? el)
+      nil-value
+      (prim car el))))
+(built-in-func cdr
+  (lambda (el)
+    (if (null? el)
+      nil-value
+      (prim cdr el))))
+
+(built-in-func car-safe
+  (lambda (el)
+    (if (pair? el)
+      (prim car el)
+      nil-value)))
+(built-in-func cdr-safe
+  (lambda (el)
+    (if (pair? el)
+      (prim cdr el)
+      nil-value)))
+
+(built-in-func nth
+  (lambda (n lst)
+    (if (negative? n)
+      (prim car lst)
+      (let iterate ((i n)
+                    (tail lst))
+        (cond
+          ((null? tail) nil-value)
+          ((zero? i) (prim car tail))
+          (else (iterate (prim 1- i) (prim cdr tail))))))))
+(built-in-func nthcdr
+  (lambda (n lst)
+    (if (negative? n)
+      lst
+      (let iterate ((i n)
+                    (tail lst))
+        (cond
+          ((null? tail) nil-value)
+          ((zero? i) tail)
+          (else (iterate (prim 1- i) (prim cdr tail))))))))
+
+
+; Building lists.
+
+(built-in-func cons (@ (guile) cons))
+(built-in-func list (@ (guile) list))
+(built-in-func make-list
+  (lambda (len obj)
+    (prim make-list len obj)))
+
+(built-in-func append (@ (guile) append))
+(built-in-func reverse (@ (guile) reverse))
+(built-in-func copy-tree (@ (guile) copy-tree))
+
+(built-in-func number-sequence
+  (lambda (from . rest)
+    (if (prim > (prim length rest) 2)
+      (runtime-error "too many arguments for number-sequence"
+                     (prim cdddr rest))
+      (if (null? rest)
+        `(,from)
+        (let ((to (prim car rest))
+              (sep (if (or (null? (prim cdr rest))
+                           (eq? nil-value (prim cadr rest)))
+                     1
+                     (prim cadr rest))))
+          (cond
+            ((or (eq? nil-value to) (prim = to from)) `(,from))
+            ((and (zero? sep) (prim not (prim = from to)))
+             (runtime-error "infinite list in number-sequence"))
+            ((prim < (prim * to sep) (prim * from sep)) '())
+            (else
+              (let iterate ((i (prim +
+                                  from
+                                  (prim * sep
+                                          (prim quotient
+                                            (prim abs (prim - to from))
+                                            (prim abs sep)))))
+                            (result '()))
+                (if (prim = i from)
+                  (prim cons i result)
+                  (iterate (prim - i sep) (prim cons i result)))))))))))
+
+
+; Changing lists.
+
+(built-in-func setcar
+  (lambda (cell val)
+    (prim set-car! cell val)
+    val))
+
+(built-in-func setcdr
+  (lambda (cell val)
+    (prim set-cdr! cell val)
+    val))
+
+
 ; Miscellaneous.
 
 (built-in-func not (lambda (x)
diff --git a/module/language/elisp/runtime/macro-slot.scm 
b/module/language/elisp/runtime/macro-slot.scm
index d17b6f4..9a4c52c 100644
--- a/module/language/elisp/runtime/macro-slot.scm
+++ b/module/language/elisp/runtime/macro-slot.scm
@@ -19,9 +19,58 @@
 
 ;;; Code:
 
-(define-module (language elisp runtime macro-slot))
+(define-module (language elisp runtime macro-slot)
+  #:use-module (language elisp runtime))
 
 ; This module contains the macro definitions of elisp symbols.  In contrast to
 ; the other runtime modules, those are used directly during compilation, of
 ; course, so not really in runtime.  But I think it fits well to the others
 ; here.
+
+
+; Define the conditionals when and unless as macros.
+
+(built-in-macro when
+  (lambda (condition . thens)
+    `(if ,condition (progn ,@thens) nil)))
+
+(built-in-macro unless
+  (lambda (condition . elses)
+    `(if ,condition nil (progn ,@elses))))
+
+
+; Define the dotimes and dolist iteration macros.
+; As the variable has to be bound locally for elisp, this needs to go through
+; the dynamic scoping fluid system.  So we can't speed these forms up by
+; implementing them directly in the compiler with just a lexical variable
+; anyways.
+
+(built-in-macro dotimes
+  (lambda (args . body)
+    (if (or (not (list? args))
+            (< (length args) 2)
+            (> (length args) 3))
+      (macro-error "invalid dotimes arguments" args)
+      (let ((var (car args))
+            (count (cadr args)))
+        (if (not (symbol? var))
+          (macro-error "expected symbol as dotimes variable"))
+        `(let ((,var 0))
+           (while (< ,var ,count)
+             ,@body
+             (setq ,var (1+ ,var)))
+           ,@(if (= (length args) 3)
+               (list (caddr args))
+               '()))))))
+
+
+; Pop off the first element from a list or push one to it.
+
+(built-in-macro pop
+  (lambda (list-name)
+    `(prog1 (car ,list-name)
+            (setq ,list-name (cdr ,list-name)))))
+
+(built-in-macro push
+  (lambda (new-el list-name)
+    `(setq ,list-name (cons ,new-el ,list-name))))
diff --git a/test-suite/tests/elisp-compiler.test 
b/test-suite/tests/elisp-compiler.test
index 1705a97..43a34d7 100644
--- a/test-suite/tests/elisp-compiler.test
+++ b/test-suite/tests/elisp-compiler.test
@@ -56,12 +56,24 @@
 
   (pass-if-equal "succeeding if" 1
     (if t 1 2))
-  (pass-if-equal "failing if" 3
-    (if nil
-      1
-      (setq a 2)
-      (setq a (1+ a))
-      a))
+  (pass-if "failing if"
+    (and (= (if nil
+              1
+              (setq a 2) (setq a (1+ a)) a)
+            3)
+         (equal (if nil 1) nil)))
+
+  (pass-if-equal "failing when" nil-value
+    (when nil 1 2 3))
+  (pass-if-equal "succeeding when" 42
+    (progn (setq a 0)
+           (when t (setq a 42) a)))
+
+  (pass-if-equal "failing unless" nil-value
+    (unless t 1 2 3))
+  (pass-if-equal "succeeding unless" 42
+    (progn (setq a 0)
+           (unless nil (setq a 42) a)))
 
   (pass-if-equal "empty cond" nil-value
     (cond))
@@ -101,7 +113,16 @@
            (while (<= i 5)
              (setq prod (* i prod))
              (setq i (1+ i)))
-           prod)))
+           prod))
+
+  (pass-if "dotimes"
+    (progn (setq a 0)
+           (setq count 100)
+           (setq b (dotimes (i count)
+                     (setq j (1+ i))
+                     (setq a (+ a j))))
+           (setq c (dotimes (i 10 42) nil))
+           (and (= a 5050) (equal b nil) (= c 42)))))
 
 
 ; Test handling of variables.
@@ -311,3 +332,77 @@
          (= (fceiling 1.2) 2.0) (= (fceiling -1.7) -1.0) (= (fceiling 1.0) 1.0)
          (= (ftruncate 1.6) 1.0) (= (ftruncate -1.7) -1.0)
          (= (fround 1.2) 1.0) (= (fround 1.7) 2.0) (= (fround -1.7) -2.0))))
+
+(with-test-prefix/compile "List Built-Ins"
+
+  (pass-if "consp and atomp"
+    (and (consp '(1 2 3)) (consp '(1 2 . 3)) (consp '(a . b))
+         (not (consp '())) (not (consp 1)) (not (consp "abc"))
+         (atomp 'a) (atomp '()) (atomp -1.5) (atomp "abc")
+         (not (atomp '(1 . 2))) (not (atomp '(1)))))
+  (pass-if "listp and nlistp"
+    (and (listp '(1 2 3)) (listp '(1)) (listp '()) (listp '(1 . 2))
+         (not (listp 'a)) (not (listp 42)) (nlistp 42)
+         (not (nlistp '())) (not (nlistp '(1 2 3))) (not (nlistp '(1 . 2)))))
+  (pass-if "null"
+    (and (null '()) (not (null 1)) (not (null '(1 2))) (not (null '(1 . 2)))))
+
+  (pass-if "car and cdr"
+    (and (equal (car '(1 2 3)) 1) (equal (cdr '(1 2 3)) '(2 3))
+         (equal (car '()) nil) (equal (cdr '()) nil)
+         (equal (car '(1 . 2)) 1) (equal (cdr '(1 . 2)) 2)
+         (null (cdr '(1)))))
+  (pass-if "car-safe and cdr-safe"
+    (and (equal (car-safe '(1 2)) 1) (equal (cdr-safe '(1 2)) '(2))
+         (equal (car-safe 5) nil) (equal (cdr-safe 5) nil)))
+
+  (pass-if "pop"
+    (progn (setq mylist '(a b c))
+           (setq value (pop mylist))
+           (and (equal value 'a)
+                (equal mylist '(b c)))))
+  (pass-if-equal "push" '(a b c)
+    (progn (setq mylist '(b c))
+           (push 'a mylist)))
+
+  (pass-if "nth and nthcdr"
+    (and (equal (nth -5 '(1 2 3)) 1) (equal (nth 3 '(1 2 3)) nil)
+         (equal (nth 0 '(1 2 3)) 1) (equal (nth 2 '(1 2 3)) 3)
+         (equal (nthcdr -5 '(1 2 3)) '(1 2 3))
+         (equal (nthcdr 4 '(1 2 3)) nil)
+         (equal (nthcdr 1 '(1 2 3)) '(2 3))
+         (equal (nthcdr 2 '(1 2 3)) '(3))))
+
+  (pass-if "cons, list and make-list"
+    (and (equal (cons 1 2) '(1 . 2)) (equal (cons 1 '(2 3)) '(1 2 3))
+         (equal (cons 1 '()) '(1))
+         (equal (list 'a) '(a)) (equal (list) '()) (equal (list 1 2) '(1 2))
+         (equal (make-list 3 42) '(42 42 42))
+         (equal (make-list 0 1) '())))
+  (pass-if "append"
+    (and (equal (append '(1 2) '(3 4) '(5)) '(1 2 3 4 5))
+         (equal (append '(1 2) 3) '(1 2 . 3))))
+  (pass-if "reverse"
+    (and (equal (reverse '(5 4 3 2 1)) '(1 2 3 4 5))
+         (equal (reverse '()) '())))
+  (pass-if "copy-tree"
+    (progn (setq mylist '(1 2 (3 4)))
+           (and (not (eq mylist (copy-tree mylist)))
+                (equal mylist (copy-tree mylist)))))
+
+  (pass-if "number-sequence"
+    (and (equal (number-sequence 5) '(5))
+         (equal (number-sequence 5 9) '(5 6 7 8 9))
+         (equal (number-sequence 5 9 3) '(5 8))
+         (equal (number-sequence 5 1 -2) '(5 3 1))
+         (equal (number-sequence 5 8 -1) '())
+         (equal (number-sequence 5 1) '())
+         (equal (number-sequence 5 5 0) '(5))))
+
+  (pass-if "setcar and setcdr"
+    (progn (setq pair '(1 . 2))
+           (setq copy pair)
+           (setq a (setcar copy 3))
+           (setq b (setcdr copy 4))
+           (and (= a 3) (= b 4)
+                (equal pair '(3 . 4))))))


hooks/post-receive
-- 
GNU Guile




reply via email to

[Prev in Thread] Current Thread [Next in Thread]