get-module-bytecode hacks off the syntax portion of the bytecode, because we're seeing some weirdness. Thanks to Matthew Flatt for bringing the error report.

expand-out-images.rkt

@@ -202,12 +202,16 @@
        (define-values ids #,(on-expr #'expr)))]
     
     [(define-syntaxes ids expr)
-     (quasisyntax/loc stx 
+     #'(void)
-       (define-syntaxes ids #,(on-expr #'expr)))]
+     ;(quasisyntax/loc stx 
+     ;  (define-syntaxes ids #,(on-expr #'expr)))
+     ]
     
     [(define-values-for-syntax ids expr)
-     (quasisyntax/loc stx 
+     #'(void)
-       (define-values-for-syntax ids #,(on-expr #'expr)))]
+     ;(quasisyntax/loc stx 
+     ;  (define-values-for-syntax ids #,(on-expr #'expr)))
+     ]
     
     [else
      (on-expr stx)]))

get-module-bytecode.rkt

@@ -46,8 +46,12 @@
        (error 'get-module-bytecode)]))
 
   (with-handlers ([exn? (lambda (exn)
+                          ;(printf "error? ~s\n" (exn-message exn))
                           (define op (open-output-bytes))
-                          (write (alternative-f) op)
+                          ;(printf "trying alternative to get bytecode\n")
+                          (define bytecode (alternative-f))
+                          ;(printf "got the bytecode\n")
+                          (write bytecode op)
                           (get-output-bytes op))])
     (define op (open-output-bytes))
     (write compiled-code op)
@@ -57,10 +61,11 @@
 
 
 (define base-namespace
-  (lookup-language-namespace
+  (make-base-namespace))
-   #;'racket/base
+  ;(lookup-language-namespace
-   `(file ,(path->string kernel-language-path)))
+   ;;'racket/base
-   #;(make-base-namespace))
+   ;;`(file ,(path->string kernel-language-path)))
+   ;(make-base-namespace)))
 
 
 
@@ -82,8 +87,11 @@
 ;; get-compiled-code-from-port: input-port -> compiled-code
 ;; Compiles the source from scratch.
 (define (get-compiled-code-from-port ip)
+  ;(printf "get-compiled-code-from-port\n")
   (parameterize ([read-accept-reader #t]
                  [current-namespace base-namespace])
     (define stx (read-syntax (object-name ip) ip))
+    ;(printf "got stx; now expanding out the images\n")
     (define expanded-stx (expand-out-images stx))
+    ;(printf "now trying to compile the expanded syntax\n")
     (compile expanded-stx)))

tests/more-tests/nqueens.rkt

@@ -0,0 +1,40 @@
+#lang planet dyoo/whalesong/base
+;;; NQUEENS -- Compute number of solutions to 8-queens problem.
+;; 2006/08 -- renamed `try' to `try-it' to avoid Bigloo collision (mflatt)
+;; 2010/04 -- got rid of the one-armed id (stamourv)
+
+(define trace? #f)
+
+(define (nqueens n)
+
+  (define (one-to n)
+    (let loop ((i n) (l '()))
+      (if (= i 0) l (loop (- i 1) (cons i l)))))
+
+  (define (try-it x y z)
+    (if (null? x)
+      (if (null? y)
+        (begin (if trace? (begin (write z) (newline)) #t) 1)
+        0)
+      (+ (if (ok? (car x) 1 z)
+           (try-it (append (cdr x) y) '() (cons (car x) z))
+           0)
+         (try-it (cdr x) (cons (car x) y) z))))
+
+  (define (ok? row dist placed)
+    (if (null? placed)
+      #t
+      (and (not (= (car placed) (+ row dist)))
+           (not (= (car placed) (- row dist)))
+           (ok? row (+ dist 1) (cdr placed)))))
+
+  (try-it (one-to n) '() '()))
+
+(let loop ((n 1000 ;10000
+              )
+           (v 0))
+  (if (zero? n)
+      v
+      (loop (- n 1) (nqueens 8
+                             ; (if input 8 0)
+                             ))))