* working on librarifying syntax.ss

src/libcompile.ss

@@ -1293,6 +1293,7 @@
      (make-bind lhs* rhs* (mk-mvcall body c))]
     [else (error 'mk-mvcall "invalid producer ~s" (unparse p))]))
 
+
 (define (copy-propagate x)
   (define who 'copy-propagate)
   (define the-void (make-primcall 'void '()))
@@ -5293,6 +5294,16 @@
   (lambda (x)
     ((current-eval) x)))
 
+(primitive-set! 'compile-time-core-eval
+  (make-parameter 
+    (lambda (x) 
+      (parameterize ([current-expand (lambda (x) x)])
+        (compile-expr x)))
+    (lambda (f)
+      (unless (procedure? f) 
+        (error 'compile-time-core-eval "~s is not a procedure" f))
+      f)))
+
 
 )
 

src/libtoplevel.ss

@@ -88,6 +88,8 @@
     string->number exact->inexact
     flonum? flonum->string string->flonum
     sin cos atan sqrt
+    chi-top-library
+    compile-time-core-eval
     ))
 
 (define (system-primitives)
@@ -231,7 +233,10 @@
        (load script)
        (exit 0)]
       [else
-       (printf "Ikarus Scheme (Build ~a)\n" "NO TIME STRING")
+       (let ()
+         (define-syntax compile-time-string
+           (lambda (x) (date-string)))
+         (printf "Ikarus Scheme (Build ~a)\n" (compile-time-string)))
        ;(printf "Ikarus Scheme (Build ~a)\n" (compile-time-date-string))
        (display "Copyright (c) 2006-2007 Abdulaziz Ghuloum\n\n")
        (command-line-arguments args)

src/makefile.ss

@@ -100,6 +100,8 @@
 
     flonum? flonum->string string->flonum
     sin cos atan sqrt
+
+    chi-top-library compile-time-core-eval
     ))
 
 (define system-primitives
@@ -228,7 +230,7 @@
 (whack-system-env #t)
 
 (define scheme-library-files
-  '(  ["libhandlers.ss"   "libhandlers.fasl"  p0 onepass]
+  '(["libhandlers.ss"   "libhandlers.fasl"  p0 onepass]
     ["libcontrol.ss"   "libcontrol.fasl"  p0 onepass]
     ["libcollect.ss"    "libcollect.fasl"   p0 onepass]
     ["librecord.ss"     "librecord.fasl"    p0 onepass]

src/psyntax-7.1.ss

@@ -586,6 +586,10 @@
   (lambda (x)
     (eval `(,noexpand ,x))))
 
+(define compile-time-eval-hook
+  (lambda (x)
+    (eval `(,noexpand ,x))))
+
 (define define-top-level-value-hook
   (lambda (sym val)
     (top-level-eval-hook
@@ -2050,9 +2054,11 @@
                                     (else (error 'sc-expand-internal "unexpected module binding type ~s" t)))))
                             (loop bs))))))))))))
 
-
-(include "syntax.ss")
-
+(define chi-top-library
+  (let ()
+    (include "syntax.ss")
+    (primitive-set! 'chi-top-library library-expander)
+    library-expander))
 
 (define id-set-diff
   (lambda (exports defs)
@@ -3079,6 +3085,7 @@
      ))
 
 
+
 ;;; core transformers
 
 (global-extend 'local-syntax 'letrec-syntax #t)