From a1e26dd01bcc26d3a5c93fffeac3420b92460c30 Mon Sep 17 00:00:00 2001 From: Jon Rafkind Date: Wed, 1 Sep 2010 09:28:10 -0600 Subject: [PATCH] try to fix infix macros --- collects/honu/core/private/debug.rkt | 2 +- collects/honu/core/private/honu-typed-scheme.rkt | 2 +- collects/honu/core/private/macro.rkt | 1 + collects/honu/core/private/parse.rkt | 9 ++++++--- 4 files changed, 9 insertions(+), 5 deletions(-) diff --git a/collects/honu/core/private/debug.rkt b/collects/honu/core/private/debug.rkt index 49f1314323..40baf40a26 100644 --- a/collects/honu/core/private/debug.rkt +++ b/collects/honu/core/private/debug.rkt @@ -4,7 +4,7 @@ (provide debug) -(define-for-syntax verbose? #f) +(define-for-syntax verbose? #t) (define-syntax (debug stx) (if verbose? (syntax-case stx () diff --git a/collects/honu/core/private/honu-typed-scheme.rkt b/collects/honu/core/private/honu-typed-scheme.rkt index fdd697fae2..a3fd23cbc9 100644 --- a/collects/honu/core/private/honu-typed-scheme.rkt +++ b/collects/honu/core/private/honu-typed-scheme.rkt @@ -1,4 +1,4 @@ -#lang scheme/base +#lang racket/base (require (rename-in typed-scheme (#%module-begin #%module-begin-typed-scheme))) (require (for-syntax scheme/base diff --git a/collects/honu/core/private/macro.rkt b/collects/honu/core/private/macro.rkt index cfc374204d..d550877545 100644 --- a/collects/honu/core/private/macro.rkt +++ b/collects/honu/core/private/macro.rkt @@ -497,6 +497,7 @@ (define-honu-syntax honu-infix-macro (lambda (stx ctx) + (debug "Infix macro!\n") (define-splicing-syntax-class patterns #:literal-sets ([cruft #:phase (syntax-local-phase-level)]) #; diff --git a/collects/honu/core/private/parse.rkt b/collects/honu/core/private/parse.rkt index b942ee0fc3..e1d87796a8 100644 --- a/collects/honu/core/private/parse.rkt +++ b/collects/honu/core/private/parse.rkt @@ -72,9 +72,12 @@ (debug "Transforming honu infix macro ~a\n" (stx-car stx)) (let-values ([(used rest) (transformer (introducer full-stx) context)]) - (debug "Result is ~a. Object position is ~a out of expression ~a\n" used (syntax-object-position full-stx (introducer rest)) (syntax->datum full-stx)) - (list (introducer rest) (syntax-object-position full-stx (introducer rest)) - (introducer (used)))))] + (let ([rest (introducer rest)] + [position + (sub1 (syntax-object-position full-stx (introducer rest)))] + [parsed (introducer (used))]) + (debug "Result is ~a. Object position is ~a out of expression ~a\n" parsed position (syntax->datum full-stx)) + (list rest position parsed))))] [else (fail)]))) (define-primitive-splicing-syntax-class (honu-transformer context)