Changeset 12104 in project

Timestamp:

10/02/08 20:08:20 (12 years ago)

Author:

felix winkelmann

Message:

fixed let-location expansion bug reported by Joerg Wittenberger

Location:

chicken/trunk

Files:

• TODO (modified) (4 diffs)
• compiler.scm (modified) (3 diffs)
• tests/compiler-tests.scm (modified) (1 diff)

chicken/trunk/TODO

@@ -1 +1 @@
 TODO for trunk                                          -*- Outline -*-
 
-* macros
+* expander
 ** at some stage disable debug-output in expand.scm
 
 * bugs
 ** compiler
-*** declarations that refer to identifiers may only be partially stripped
-    strip-syntax only declaration-specifier, not arguments
+*** lambda-lifting breaks in ##sys#read (r-spaces), reported by Joerg Wittenberger
+    in rev. 12103
 *** pre-optimization 
 **** changes call-sites and makes them invalid for later pre-optimization
-** macros
+** scheduler
+*** apply srfi
+** expander
 *** expansion of r5rs_pitfall 4.2 incorrect
     possibly due to a non-aliased implicit "begin" somewhere
@@ -40 +42 @@
 *** emit <sourcefile>.inline file with "-inline-global" (?)
 *** "-inline-global" slurps *.inline files include-path (?)
+*** would inline in other compilation units, but not in current (sort of confusing)
 ** remove "custom-declare" + stuff?
 
@@ -67 +70 @@
 * documentation
 ** document ("HI/LO") expander (-> wiki, internals)
+   will we ever have the time for that?
 ** document new .meta entries
    depends, test-depends
@@ -72 +76 @@
 * build
 ** chicken.texi needs to be regenerated
+** rules.make should really be generated by a script
 
 * syntax-error

chicken/trunk/compiler.scm

@@ -890 +890 @@
                                         (let ([type (second fv)]
                                               [tmp (gensym)] )
-                                          `(let ([,tmp ,(foreign-type-convert-argument val type)])
-                                             (##core#inline_update 
-                                              (,(third fv) ,type)
-                                              ,(foreign-type-check tmp type) ) ) ) ) )
+                                          (walk
+                                           `(let ([,tmp ,(foreign-type-convert-argument val type)])
+                                              (##core#inline_update 
+                                               (,(third fv) ,type)
+                                               ,(foreign-type-check tmp type) ) )
+                                           se #f))))
                                  ((assq var location-pointer-map)
                                   => (lambda (a)
                                        (let* ([type (third a)]
                                               [tmp (gensym)] )
-                                         `(let ([,tmp ,(foreign-type-convert-argument val type)])
-                                            (##core#inline_loc_update 
-                                             (,type)
-                                             ,(second a)
-                                             ,(foreign-type-check tmp type) ) ) ) ) )
+                                         (walk
+                                          `(let ([,tmp ,(foreign-type-convert-argument val type)])
+                                             (##core#inline_loc_update 
+                                              (,type)
+                                              ,(second a)
+                                              ,(foreign-type-check tmp type) ) )
+                                          se #f))))
                                  (else `(set! ,var ,val)))))
 
@@ -1323 +1327 @@
        ((not)
         (check-decl spec 1)
-        (case (strip (second spec))
+        (case (##sys#strip-syntax (second spec)) ; strip all
           [(standard-bindings)
            (if (null? (cddr spec))
@@ -1356 +1360 @@
                [(safe) (set! unsafe #t)]
                [else (compiler-warning 'syntax "illegal declaration specifier `~s'" id)]))]))
-       ((compile-syntax)
+       ((compile-syntax 
+         run-time-macros)               ; DEPRECATED
         (set! ##sys#enable-runtime-macros #t))
        ((block-global hide) 

chicken/trunk/tests/compiler-tests.scm

@@ -8 +8 @@
 
 (assert (not (##sys#symbol-has-toplevel-binding? 'foo#bar)))
+
+
+;;; rev. 12103 (reported by Joerg Wittenberger)
+;
+; - canonicalization of assignment to location didn't walk expansion recursively
+
+(define test-location
+ (let-location
+  ((again bool #f))
+  (lambda ()
+     ((foreign-lambda*
+       int
+       (((c-pointer bool) again))
+       "*again=1; return(1);")
+      (location again))
+     again)))
+
+(print (test-location))