[Guile-commits] GNU Guile branch, elisp, updated. release_1-9-0-63-g74c009d

[Daniel Kraft]

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=74c009dadc1e8f580727d2c85bf72ec90e82d15a

The branch, elisp has been updated
       via  74c009dadc1e8f580727d2c85bf72ec90e82d15a (commit)
       via  b6b9d59604aa320cf2bdb7d4934315febab3f6dc (commit)
      from  d158fa62ab818a9d60baa389e803aac32403a2de (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 74c009dadc1e8f580727d2c85bf72ec90e82d15a
Author: Daniel Kraft <address@hidden>
Date:   Thu Jul 16 15:23:38 2009 +0200

    Implemented macros in elisp compiler.
    
    * module/language/elisp/README: Document it.
    * module/language/elisp/compile-tree-il.scm: Implement defmacro and 
expansion.
    * module/language/elisp/runtime/macro-slot.scm: New module to keep 
definitions.
    * test-suite/Makefile.am: Add elisp-compiler.test to list of tests.
    * test-suite/tests/elisp-compiler.test: Basic macro tests.

commit b6b9d59604aa320cf2bdb7d4934315febab3f6dc
Author: Daniel Kraft <address@hidden>
Date:   Thu Jul 16 14:28:07 2009 +0200

    Extended test-suite to cover already implemented built-ins and fixed errors 
found.
    
    * module/language/elisp/runtime/function-slot.scm: Fixed errors in number 
preds.
    * test-suite/tests/elisp-compiler.test: Test built-ins already implemented.

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

Summary of changes:
 module/language/elisp/README                       |    5 +-
 module/language/elisp/compile-tree-il.scm          |   34 +++++++++++
 module/language/elisp/runtime/function-slot.scm    |   16 ++++-
 .../runtime/{value-slot.scm => macro-slot.scm}     |    7 ++-
 test-suite/Makefile.am                             |    1 +
 test-suite/tests/elisp-compiler.test               |   61 +++++++++++++++++++-
 6 files changed, 117 insertions(+), 7 deletions(-)
 copy module/language/elisp/runtime/{value-slot.scm => macro-slot.scm} (73%)

diff --git a/module/language/elisp/README b/module/language/elisp/README
index dbcac23..5f0b7c8 100644
--- a/module/language/elisp/README
+++ b/module/language/elisp/README
@@ -14,6 +14,7 @@ Already implemented:
   * lambda expressions, function calls using list notation
   * some built-ins (mainly numbers/arithmetic)
   * defconst, defvar, defun
+  * macros
 
 Especially still missing:
   * other progX forms, will be done in macros
@@ -22,10 +23,12 @@ Especially still missing:
   * catch/throw, unwind-protect
   * real elisp reader instead of Scheme's
   * set, makunbound, boundp functions
-  * macros
   * more general built-ins
   * funcall and apply functions
   * fset & friends, defalias functions
   * advice?
   * defsubst and inlining
   * real quoting
+  * need fluids for function bindings?
+  * recursive macros
+  * anonymous macros
diff --git a/module/language/elisp/compile-tree-il.scm 
b/module/language/elisp/compile-tree-il.scm
index 19ca5ae..cd0cc74 100644
--- a/module/language/elisp/compile-tree-il.scm
+++ b/module/language/elisp/compile-tree-il.scm
@@ -22,6 +22,7 @@
 (define-module (language elisp compile-tree-il)
   #:use-module (language tree-il)
   #:use-module (system base pmatch)
+  #:use-module (system base compile)
   #:export (compile-tree-il))
 
 
@@ -46,6 +47,7 @@
 (define runtime '(language elisp runtime))
 (define value-slot '(language elisp runtime value-slot))
 (define function-slot '(language elisp runtime function-slot))
+(define macro-slot '(language elisp runtime macro-slot))
 
 
 ; Build a call to a primitive procedure nicely.
@@ -282,6 +284,23 @@
     (else #t)))
 
 
+; Handle macro bindings.
+
+(define (is-macro? sym)
+  (module-defined? (resolve-interface macro-slot) sym))
+
+(define (define-macro! loc sym definition)
+  (let ((resolved (resolve-module macro-slot)))
+    (if (is-macro? sym)
+      (report-error loc "macro is already defined" sym)
+      (begin
+        (module-define! resolved sym definition)
+        (module-export! resolved (list sym))))))
+
+(define (get-macro sym)
+  (module-ref (resolve-module macro-slot) sym))
+
+
 ; Compile a symbol expression.  This is a variable reference or maybe some
 ; special value like nil.
 
@@ -470,9 +489,24 @@
                               (compile-lambda loc args body))
                (make-const loc name)))))
 
+    ; Define a macro (this is done directly at compile-time!).
+    ; FIXME: Recursive macros don't work!
+    ((defmacro ,name ,args . ,body)
+     (if (not (symbol? name))
+       (error "expected symbol as macro name" name)
+       (let* ((tree-il (compile-lambda loc args body))
+              (object (compile tree-il #:from 'tree-il #:to 'value)))
+         (define-macro! loc name object)
+         (make-const loc name))))
+
     (('quote ,val)
      (make-const loc val))
 
+    ; Macro calls are simply expanded and recursively compiled.
+    ((,macro . ,args) (guard (and (symbol? macro) (is-macro? macro)))
+     (let ((expander (get-macro macro)))
+       (compile-expr (apply expander args))))
+
     ; Function calls using (function args) standard notation; here, we have to
     ; take the function value of a symbol if it is one.  It seems that 
functions
     ; in form of uncompiled lists are not supported in this syntax, so we don't
diff --git a/module/language/elisp/runtime/function-slot.scm 
b/module/language/elisp/runtime/function-slot.scm
index c29de1e..2353419 100644
--- a/module/language/elisp/runtime/function-slot.scm
+++ b/module/language/elisp/runtime/function-slot.scm
@@ -30,16 +30,20 @@
 
 (built-in-func floatp (lambda (num)
                         (elisp-bool (and (real? num)
-                                         (not (integer? num))))))
+                                         (or (inexact? num)
+                                             ((@ (guile) not)
+                                               (integer? num)))))))
 
 (built-in-func integerp (lambda (num)
-                          (elisp-bool (integer? num))))
+                          (elisp-bool (and (exact? num)
+                                           (integer? num)))))
 
 (built-in-func numberp (lambda (num)
                          (elisp-bool (real? num))))
 
 (built-in-func wholenump (lambda (num)
-                           (elisp-bool (and (integer? num)
+                           (elisp-bool (and (exact? num)
+                                            (integer? num)
                                             ((@ (guile) >=) num 0)))))
 
 (built-in-func zerop (lambda (num)
@@ -99,3 +103,9 @@
 (built-in-func fceiling (@ (guile) ceiling))
 (built-in-func ftruncate (@ (guile) truncate))
 (built-in-func fround (@ (guile) round))
+
+
+; Miscellaneous.
+
+(built-in-func not (lambda (x)
+                     (if x nil-value t-value)))
diff --git a/module/language/elisp/runtime/value-slot.scm 
b/module/language/elisp/runtime/macro-slot.scm
similarity index 73%
copy from module/language/elisp/runtime/value-slot.scm
copy to module/language/elisp/runtime/macro-slot.scm
index 201813a..d17b6f4 100644
--- a/module/language/elisp/runtime/value-slot.scm
+++ b/module/language/elisp/runtime/macro-slot.scm
@@ -19,6 +19,9 @@
 
 ;;; Code:
 
-(define-module (language elisp runtime value-slot))
+(define-module (language elisp runtime macro-slot))
 
-; This module contains the value-slots of elisp symbols.
+; 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.
diff --git a/test-suite/Makefile.am b/test-suite/Makefile.am
index 7bfef16..17e5f1b 100644
--- a/test-suite/Makefile.am
+++ b/test-suite/Makefile.am
@@ -32,6 +32,7 @@ SCM_TESTS = tests/alist.test                  \
            tests/common-list.test              \
            tests/continuations.test            \
            tests/elisp.test                    \
+           tests/elisp-compiler.text           \
            tests/environments.test             \
            tests/eval.test                     \
            tests/exceptions.test               \
diff --git a/test-suite/tests/elisp-compiler.test 
b/test-suite/tests/elisp-compiler.test
index db604f3..677f14d 100644
--- a/test-suite/tests/elisp-compiler.test
+++ b/test-suite/tests/elisp-compiler.test
@@ -84,7 +84,10 @@
 
   (pass-if-equal "empty or" nil-value (or))
   (pass-if-equal "failing or" nil-value (or nil nil nil))
-  (pass-if-equal "succeeding or" 1 (or nil 1 nil 2 nil 3)))
+  (pass-if-equal "succeeding or" 1 (or nil 1 nil 2 nil 3))
+
+  (pass-if-equal "not true" nil-value (not 1))
+  (pass-if-equal "not false" t-value (not nil)))
 
 (with-test-prefix/compile "Iteration"
 
@@ -206,3 +209,59 @@
              (foo))
            (and (= 43 (bar 42))
                 (zerop a)))))
+
+
+; Macros.
+; =======
+
+(with-test-prefix/compile "Macros"
+
+  (pass-if-equal "defmacro value" 'magic-number
+    (defmacro magic-number () 42))
+
+  (pass-if-equal "macro expansion" 1
+    (progn (defmacro take-first (a b) a)
+           (take-first 1 (/ 1 0)))))
+
+
+; Test the built-ins.
+; ===================
+
+(with-test-prefix/compile "Number Built-Ins"
+
+  (pass-if "floatp"
+    (and (floatp 1.0) (not (floatp 1)) (not (floatp 'a))))
+  (pass-if "integerp"
+    (and (integerp 42) (integerp -2) (not (integerp 1.0))))
+  (pass-if "numberp"
+    (and (numberp 1.0) (numberp -2) (not (numberp 'a))))
+  (pass-if "wholenump"
+    (and (wholenump 0) (not (wholenump -2)) (not (wholenump 1.0))))
+  (pass-if "zerop"
+    (and (zerop 0) (zerop 0.0) (not (zerop 1))))
+
+  (pass-if "comparisons"
+    (and (= 1 1.0) (/= 0 1)
+         (< 1 2) (> 2 1) (>= 1 1) (<= 1 1)
+         (not (< 1 1)) (not (<= 2 1))))
+
+  (pass-if "max and min"
+    (and (= (max -5 2 4.0 1) 4.0) (= (min -5 2 4.0 1) -5)
+         (= (max 1) 1) (= (min 1) 1)))
+  (pass-if "abs"
+    (and (= (abs 1.0) 1.0) (= (abs -5) 5)))
+
+  (pass-if "float"
+    (and (= (float 1) 1) (= (float 5.5) 5.5)
+         (floatp (float 1))))
+
+  (pass-if-equal "basic arithmetic operators" -8.5
+    (+ (1+ 0) (1- 0) (- 5.5) (* 2 -2) (- 2 1)))
+  (pass-if "modulo"
+    (= (% 5 3) 2))
+
+  (pass-if "floating point rounding"
+    (and (= (ffloor 1.7) 1.0) (= (ffloor -1.2) -2.0) (= (ffloor 1.0) 1.0)
+         (= (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))))


hooks/post-receive
-- 
GNU Guile