* Added basic identifier-syntax (one that does not recognize the

set! case).

src/ikarus.compiler.ss

@@ -12,7 +12,6 @@
     (ikarus fasl write))
 
 
-
 (define-syntax record-case
   (lambda (x)
     (define (enumerate fld* i)
@@ -5289,53 +5288,19 @@
 (define eval-core
   (lambda (x) ((compile-core-expr x))))
 
+;(include "libaltcogen.ss")
+
+
 )
 
 #!eof junk
 
 
-(define (compile-expr->code x)
-  (compile-core-expr->code
-    (parameterize ([assembler-output #f])
-      (expand x))))
 
-(define compile
-  (lambda (x)
-    (let ([code 
-           (if (code? x)
-               x
-               (compile-expr->code x))])
-      (let ([proc ($code->closure code)])
-        (proc)))))
-
-(define compile-file
-  (lambda (input-file output-file . rest)
-    (let ([ip (open-input-file input-file)]
-          [op (apply open-output-file output-file rest)])
-      (let f ()
-        (let ([x (read ip)])
-          (unless (eof-object? x)
-            (fasl-write (compile-expr->code x) op)
-            (f))))
-      (close-input-port ip)
-      (close-output-port op))))
-
-;(include "libaltcogen.ss")
 (define alt-cogen
   (lambda args
     (error 'alt-cogen "disabled for now")))
 
-(define alt-compile-file
-  (lambda (input-file output-file . rest)
-    (let ([ip (open-input-file input-file)]
-          [op (apply open-output-file output-file rest)])
-      (let f ()
-        (let ([x (read ip)])
-          (unless (eof-object? x)
-            (fasl-write (alt-compile-expr x) op)
-            (f))))
-      (close-input-port ip)
-      (close-output-port op))))
 
 
 

src/ikarus.syntax.ss

@@ -415,7 +415,7 @@
                (stx-error e "unbound identifier"))
              (case type
                [(lexical core-prim macro global local-macro
-                   global-macro displaced-lexical syntax)
+                 global-macro displaced-lexical syntax import)
                 (values type (binding-value b) id)]
                [else (values 'other #f #f)])))]
         [(syntax-pair? e)
@@ -427,7 +427,7 @@
                  (case type
                    [(define define-syntax core-macro begin macro
                       local-macro global-macro module set!
-                      let-syntax letrec-syntax)
+                      let-syntax letrec-syntax import)
                     (values type (binding-value b) id)]
                    [else
                     (values 'call #f #f)]))
@@ -783,6 +783,15 @@
              (bless `(letrec ([,f (lambda ,lhs* ,b . ,b*)])
                         (,f . ,rhs*)))
              (stx-error stx "invalid syntax"))])))
+  (define identifier-syntax-macro
+    (lambda (stx)
+      (syntax-match stx ()
+        [(_ expr) 
+         (bless `(lambda (x) 
+                   (syntax-case x ()
+                     [id (identifier? #'id) #',expr]
+                     [(id e* ...) (identifier? #'id) 
+                      (cons #',expr #'(e* ...))])))])))
   (define do-macro
     (lambda (stx)
       (define bind
@@ -1554,6 +1563,7 @@
            [(syntax-rules)  syntax-rules-macro]
            [(quasiquote)    quasiquote-macro]
            [(with-syntax)   with-syntax-macro]
+           [(identifier-syntax)   identifier-syntax-macro]
            [else (error 'macro-transformer "invalid macro ~s" x)])]
         [else (error 'core-macro-transformer "invalid macro ~s" x)])))
   (define (local-macro-transformer x)

src/libaltcogen.ss

@@ -469,8 +469,8 @@
      (make-seq (seq* e* ...) e)]))
 
 
-(include "pass-specify-rep.ss")
 
+(include "pass-specify-rep.ss")
 
 (define parameter-registers '(%edi)) 
 (define return-value-register '%eax)

src/makefile.ss

@@ -78,6 +78,7 @@
     [define-syntax     (define-syntax)]
     [module            (module)]
     [begin             (begin)]
+    [import            (import)]
     [set!              (set!)]
     [let-syntax        (let-syntax)]
     [letrec-syntax     (letrec-syntax)]
@@ -101,6 +102,7 @@
     [syntax-rules      (macro . syntax-rules)]
     [quasiquote        (macro . quasiquote)]
     [with-syntax       (macro . with-syntax)]
+    [identifier-syntax (macro . identifier-syntax)]
     [let               (macro . let)]
     [let*              (macro . let*)]
     [cond              (macro . cond)]
@@ -188,6 +190,7 @@
     [letrec-syntax    i r]
     [module           i cm]
     [begin            i r]
+    [import           i]
     [set!             i r]
     [foreign-call     i]
     [quote            i r]
@@ -210,6 +213,7 @@
     [quasiquote       i r]
     [with-syntax      i syncase]
     [let              i r]
+    [identifier-syntax i r]
     [let*             i r]
     [cond             i r]
     [do               i r]

src/pass-specify-rep.ss

@@ -29,11 +29,10 @@
     (putprop x cookie v))
   )
 
-
 (module (specify-representation)
   (import object-representation)
   (import primops)
-   (define-record PH
+  (define-record PH
     (interruptable? p-handler p-handled? v-handler v-handled? e-handler e-handled?))
   (define interrupt-handler
     (make-parameter (lambda () (error 'interrupt-handler "uninitialized"))))
@@ -179,10 +178,10 @@
   (define-syntax define-primop
     (lambda (x)
       (define (cogen-name stx name suffix)
-        (datum->syntax-object stx
+        (datum->syntax stx
           (string->symbol
             (format "cogen-~a-~a" suffix 
-                    (syntax-object->datum name)))))
+                    (syntax->datum name)))))
       (define (generate-handler name ctxt case*)
         (define (filter-cases case*)
           (syntax-case case* ()