diff --git a/src/ikarus.boot b/src/ikarus.boot index 6403e3a..a34a1b2 100644 Binary files a/src/ikarus.boot and b/src/ikarus.boot differ diff --git a/src/ikarus.compiler.ss b/src/ikarus.compiler.ss index 04bdd9e..a4e8f8f 100644 --- a/src/ikarus.compiler.ss +++ b/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)))) diff --git a/src/ikarus.syntax.ss b/src/ikarus.syntax.ss index b59e7f5..ec12f9d 100644 --- a/src/ikarus.syntax.ss +++ b/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) diff --git a/src/libaltcogen.ss b/src/libaltcogen.ss index fa16120..8cc721e 100644 --- a/src/libaltcogen.ss +++ b/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) diff --git a/src/makefile.ss b/src/makefile.ss index 3507c49..8034fbb 100755 --- a/src/makefile.ss +++ b/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] diff --git a/src/pass-specify-rep.ss b/src/pass-specify-rep.ss index cc0065c..804d2ef 100644 --- a/src/pass-specify-rep.ss +++ b/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* ()