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-59-gde9f


From: Daniel Kraft
Subject: [Guile-commits] GNU Guile branch, elisp, updated. release_1-9-0-59-gde9f26b
Date: Tue, 14 Jul 2009 19:18:35 +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=de9f26b5f0f8a9229302407d3002224f121ed491

The branch, elisp has been updated
       via  de9f26b5f0f8a9229302407d3002224f121ed491 (commit)
       via  285277590d6aca22a08b9fe4fa103e45c57e8505 (commit)
       via  d10c572e38a888e4f999c7f3229781e53b9a74ec (commit)
       via  44362a1086b778efb47b7c64a8ed38db5f82d0ae (commit)
      from  1e018f6c67ace062330467a7fcc98c2fde58505a (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 de9f26b5f0f8a9229302407d3002224f121ed491
Author: Daniel Kraft <address@hidden>
Date:   Tue Jul 14 21:18:07 2009 +0200

    Implemented defconst, defvar, defun special forms for elisp.
    
    * module/language/elisp/README: Document this.
    * module/language/elisp/compile-tree-il.scm: Implement 
defconst/defvar/defun.

commit 285277590d6aca22a08b9fe4fa103e45c57e8505
Merge: 1e018f6c67ace062330467a7fcc98c2fde58505a 
d10c572e38a888e4f999c7f3229781e53b9a74ec
Author: Daniel Kraft <address@hidden>
Date:   Tue Jul 14 20:20:03 2009 +0200

    Merge branch 'master' of git://git.savannah.gnu.org/guile into elisp

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

Summary of changes:
 libguile/vm-i-scheme.c                    |   16 ++++----
 module/language/elisp/README              |    8 ++--
 module/language/elisp/compile-tree-il.scm |   57 ++++++++++++++++++++++++++---
 test-suite/tests/asm-to-bytecode.test     |   41 +++++++++++++++------
 4 files changed, 92 insertions(+), 30 deletions(-)

diff --git a/libguile/vm-i-scheme.c b/libguile/vm-i-scheme.c
index 5de39a2..7fd35e7 100644
--- a/libguile/vm-i-scheme.c
+++ b/libguile/vm-i-scheme.c
@@ -281,7 +281,7 @@ VM_DEFINE_INSTRUCTION (108, slot_set, "slot-set", 0, 3, 0)
 
 VM_DEFINE_FUNCTION (109, vector_ref, "vector-ref", 2)
 {
-  long i;
+  long i = 0;
   ARGS2 (vect, idx);
   if (SCM_LIKELY (SCM_I_IS_VECTOR (vect)
                   && SCM_I_INUMP (idx)
@@ -294,7 +294,7 @@ VM_DEFINE_FUNCTION (109, vector_ref, "vector-ref", 2)
 
 VM_DEFINE_INSTRUCTION (110, vector_set, "vector-set", 0, 3, 0)
 {
-  long i;
+  long i = 0;
   SCM vect, idx, val;
   POP (val); POP (idx); POP (vect);
   if (SCM_LIKELY (SCM_I_IS_VECTOR (vect)
@@ -346,7 +346,7 @@ BV_REF_WITH_ENDIANNESS (f64, ieee_double)
 
 #define BV_FIXABLE_INT_REF(stem, fn_stem, type, size)                   \
 {                                                                       \
-  long i;                                                               \
+  long i = 0;                                                           \
   ARGS2 (bv, idx);                                                      \
   VM_VALIDATE_BYTEVECTOR (bv);                                          \
   if (SCM_LIKELY (SCM_I_INUMP (idx)                                     \
@@ -361,7 +361,7 @@ BV_REF_WITH_ENDIANNESS (f64, ieee_double)
 
 #define BV_INT_REF(stem, type, size)                                    \
 {                                                                       \
-  long i;                                                               \
+  long i = 0;                                                           \
   ARGS2 (bv, idx);                                                      \
   VM_VALIDATE_BYTEVECTOR (bv);                                          \
   if (SCM_LIKELY (SCM_I_INUMP (idx)                                     \
@@ -380,7 +380,7 @@ BV_REF_WITH_ENDIANNESS (f64, ieee_double)
 
 #define BV_FLOAT_REF(stem, fn_stem, type, size)                         \
 {                                                                       \
-  long i;                                                               \
+  long i = 0;                                                           \
   ARGS2 (bv, idx);                                                      \
   VM_VALIDATE_BYTEVECTOR (bv);                                          \
   if (SCM_LIKELY (SCM_I_INUMP (idx)                                     \
@@ -454,7 +454,7 @@ BV_SET_WITH_ENDIANNESS (f64, ieee_double)
 
 #define BV_FIXABLE_INT_SET(stem, fn_stem, type, min, max, size)         \
 {                                                                       \
-  long i, j;                                                            \
+  long i = 0, j = 0;                                                    \
   SCM bv, idx, val; POP (val); POP (idx); POP (bv);                     \
   VM_VALIDATE_BYTEVECTOR (bv);                                          \
   if (SCM_LIKELY (SCM_I_INUMP (idx)                                     \
@@ -472,7 +472,7 @@ BV_SET_WITH_ENDIANNESS (f64, ieee_double)
 
 #define BV_INT_SET(stem, type, size)                                    \
 {                                                                       \
-  long i;                                                               \
+  long i = 0;                                                           \
   SCM bv, idx, val; POP (val); POP (idx); POP (bv);                     \
   VM_VALIDATE_BYTEVECTOR (bv);                                          \
   if (SCM_LIKELY (SCM_I_INUMP (idx)                                     \
@@ -487,7 +487,7 @@ BV_SET_WITH_ENDIANNESS (f64, ieee_double)
 
 #define BV_FLOAT_SET(stem, fn_stem, type, size)                         \
 {                                                                       \
-  long i;                                                               \
+  long i = 0;                                                           \
   SCM bv, idx, val; POP (val); POP (idx); POP (bv);                     \
   VM_VALIDATE_BYTEVECTOR (bv);                                          \
   if (SCM_LIKELY (SCM_I_INUMP (idx)                                     \
diff --git a/module/language/elisp/README b/module/language/elisp/README
index e7da303..fe31d1c 100644
--- a/module/language/elisp/README
+++ b/module/language/elisp/README
@@ -14,6 +14,7 @@ Already implemented:
   * let, let*
   * lambda expressions, function calls using list notation
   * some built-ins (mainly numbers/arithmetic)
+  * defconst, defvar, defun
 
 Especially still missing:
   * other progX forms, will be done in macros
@@ -23,7 +24,6 @@ Especially still missing:
   * real elisp reader instead of Scheme's
   * set, makunbound, boundp functions
   * macros
-  * more built-ins
-  * funcall and apply
-  * fset & friends
-  * defvar, defun
+  * more general built-ins
+  * funcall and apply functions
+  * fset & friends, defalias functions
diff --git a/module/language/elisp/compile-tree-il.scm 
b/module/language/elisp/compile-tree-il.scm
index 05134d4..19ca5ae 100644
--- a/module/language/elisp/compile-tree-il.scm
+++ b/module/language/elisp/compile-tree-il.scm
@@ -35,11 +35,10 @@
               props))))
 
 
-; Value to use for Elisp's nil and t.
+; Values to use for Elisp's nil and t.
 
-; FIXME: Use real nil.
-(define (nil-value loc) (make-const loc #f))
-(define (t-value loc) (make-const loc #t))
+(define (nil-value loc) (make-const loc (@ (language elisp runtime) 
nil-value)))
+(define (t-value loc) (make-const loc (@ (language elisp runtime) t-value)))
 
 
 ; Modules that contain the value and function slot bindings.
@@ -201,6 +200,10 @@
 ; clear and better than creating a lot of nested let's.
 
 (define (compile-lambda loc args body)
+  (if (not (list? args))
+    (error "expected list for argument-list" args))
+  (if (null? body)
+    (error "function body might not be empty"))
   (call-with-values
     (lambda ()
       (split-lambda-arguments loc args))
@@ -264,6 +267,21 @@
       (else (make-void loc)))))
 
 
+; Handle the common part of defconst and defvar, that is, checking for a 
correct
+; doc string and arguments as well as maybe in the future handling the 
docstring
+; somehow.
+
+(define (handle-var-def loc sym doc)
+  (cond
+    ((not (symbol? sym)) (report-error loc "expected symbol, got" sym))
+    ((> (length doc) 1) (report-error loc "too many arguments to defvar"))
+    ((and (not (null? doc)) (not (string? (car doc))))
+     (report-error loc "expected string as third argument of defvar, got"
+                   (car doc)))
+    ; TODO: Handle doc string if present.
+    (else #t)))
+
+
 ; Compile a symbol expression.  This is a variable reference or maybe some
 ; special value like nil.
 
@@ -341,6 +359,24 @@
                (make-lexical-ref loc 'condition var)
                (iterate (cdr tail))))))))
 
+    ((defconst ,sym ,value . ,doc)
+     (if (handle-var-def loc sym doc)
+       (make-sequence loc
+         (list (set-variable! loc sym value-slot (compile-expr value))
+               (make-const loc sym)))))
+
+    ((defvar ,sym) (make-const loc sym))
+    ((defvar ,sym ,value . ,doc)
+     (if (handle-var-def loc sym doc)
+       (make-sequence loc
+         (list (make-conditional loc
+                 (call-primitive loc 'eq?
+                                 (make-module-ref loc runtime 'void #t)
+                                 (reference-variable loc sym value-slot))
+                 (set-variable! loc sym value-slot (compile-expr value))
+                 (make-void loc))
+               (make-const loc sym)))))
+
     ; Build a set form for possibly multiple values.  The code is not 
formulated
     ; tail recursive because it is clearer this way and large lists of symbol
     ; expression pairs are very unlikely.
@@ -420,11 +456,20 @@
 
     ; Either (lambda ...) or (function (lambda ...)) denotes a 
lambda-expression
     ; that should be compiled.
-    ((lambda ,args . ,body) (guard (not (null? body)))
+    ((lambda ,args . ,body)
      (compile-lambda loc args body))
-    ((function (lambda ,args . ,body)) (guard (not (null? body)))
+    ((function (lambda ,args . ,body))
      (compile-lambda loc args body))
 
+    ; Build a lambda and also assign it to the function cell of some symbol.
+    ((defun ,name ,args . ,body)
+     (if (not (symbol? name))
+       (error "expected symbol as function name" name)
+       (make-sequence loc
+         (list (set-variable! loc name function-slot
+                              (compile-lambda loc args body))
+               (make-const loc name)))))
+
     (('quote ,val)
      (make-const loc val))
 
diff --git a/test-suite/tests/asm-to-bytecode.test 
b/test-suite/tests/asm-to-bytecode.test
index 1c2a599..01ba846 100644
--- a/test-suite/tests/asm-to-bytecode.test
+++ b/test-suite/tests/asm-to-bytecode.test
@@ -15,6 +15,7 @@
 ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 
USA
 
 (define-module (test-suite tests asm-to-bytecode)
+  #:use-module (rnrs bytevector)
   #:use-module (test-suite lib)
   #:use-module (system vm instruction)
   #:use-module (language assembly compile-bytecode))
@@ -45,6 +46,14 @@
               (lambda ()
                 (equal? v y)))))
 
+(define (u32->u8-list x)
+  ;; Return a 4 uint8 list corresponding to the host's native representation
+  ;; of X, a uint32.
+  (let ((bv (make-bytevector 4)))
+    (bytevector-u32-native-set! bv 0 x)
+    (bytevector->u8-list bv)))
+
+
 (with-test-prefix "compiler"
   (with-test-prefix "asm-to-bytecode"
 
@@ -75,22 +84,30 @@
     (comp-test '(load-keyword "qux")
                (vector 'load-keyword 0 0 3 (char->integer #\q) (char->integer 
#\u)
                        (char->integer #\x)))
-    
-    ;; fixme: little-endian test.
+
     (comp-test '(load-program 3 2 1 0 () 3 #f (make-int8 3) (return))
-               (vector 'load-program 3 2 1 0 3 0 0 0 0 0 0 0
-                       (instruction->opcode 'make-int8) 3
-                       (instruction->opcode 'return)))
+               (list->vector
+                `(load-program
+                  3 2 1 0            ;; nargs, nrest, nlocs, nexts
+                  ,@(u32->u8-list 3) ;; len
+                  ,@(u32->u8-list 0) ;; metalen
+                  make-int8 3
+                  return)))
 
-    ;; fixme: little-endian test.
     (comp-test '(load-program 3 2 1 0 () 3
                               (load-program 3 2 1 0 () 3
                                             #f
                                             (make-int8 3) (return))
                               (make-int8 3) (return))
-               (vector 'load-program 3 2 1 0 3 0 0 0 (+ 3 12) 0 0 0
-                       (instruction->opcode 'make-int8) 3
-                       (instruction->opcode 'return)
-                       3 2 1 0 3 0 0 0 0 0 0 0
-                       (instruction->opcode 'make-int8) 3
-                       (instruction->opcode 'return)))))
+               (list->vector
+                `(load-program
+                  3 2 1 0                   ;; nargs, nrest, nlocs, nexts
+                  ,@(u32->u8-list 3)        ;; len
+                  ,@(u32->u8-list (+ 3 12)) ;; metalen
+                  make-int8 3
+                  return
+                  3 2 1 0                   ;; nargs, nrest, nlocs, nexts
+                  ,@(u32->u8-list 3)        ;; len
+                  ,@(u32->u8-list 0)        ;; metalen
+                  make-int8 3
+                  return)))))


hooks/post-receive
-- 
GNU Guile




reply via email to

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