suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix with-syntax

Browse Source
This commit is contained in:
Jon Rafkind 2010-07-24 14:48:40 -06:00
parent 02e87cdc0c
commit eeaf6b4981
6 changed files with 66 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
collects/honu/core/main.rkt
View File

@ -1,24 +1,26 @@
#lang racket/base
(require (for-syntax scheme/base))
(require (for-syntax racket/base))
(require (for-meta 2 racket/base))
(require racket/class)
(require "private/honu-typed-scheme.ss"
(require "private/honu-typed-scheme.rkt"
;; "private/honu.ss"
"private/parse.ss"
(for-syntax "private/literals.ss")
(for-syntax "private/honu-typed-scheme.ss")
(for-syntax "private/parse.ss")
(for-syntax "private/literals.rkt")
(for-syntax "private/honu-typed-scheme.rkt")
(for-syntax "private/parse.rkt")
(for-syntax "private/canonical.rkt")
syntax/parse
(for-syntax syntax/parse)
"private/literals.ss"
"private/syntax.ss"
"private/more.ss"
(for-template scheme/base)
"private/literals.rkt"
"private/syntax.rkt"
"private/more.rkt"
(for-template racket/base)
(for-template "private/literals.rkt")
(for-syntax "private/more.ss")
(for-syntax "private/syntax.ss")
(for-syntax "private/macro.ss")
(for-syntax "private/more.rkt")
(for-syntax "private/syntax.rkt")
(for-syntax "private/macro.rkt")
"private/macro.ss")
(define test-x-class
@ -34,6 +36,11 @@
(define (sql4) #f)
(define (sql5) #f)
(define-for-syntax (syntax-to-string stx)
(format "original '~a' - ~a" (syntax->datum stx) (to-honu-string stx)))
(define (cheetos1) 5)
(define-syntax (honu-struct stx)
(syntax-parse stx
[(_ name (my-field ...))
@ -71,6 +78,10 @@
#;
(rename-out [honu-print print])
(for-syntax (rename-out [syntax-to-string syntax_to_string]))
(for-syntax cheetos)
cheetos1
#%top
;; sql nonsense
@ -83,6 +94,8 @@
;; end sql
#%datum
(for-template #%datum)
datum->syntax
#%top-interaction
(for-syntax #%datum
display

15
collects/honu/core/private/macro.rkt
View File

@ -1,4 +1,4 @@
#lang scheme/base
#lang racket/base
(require "honu-typed-scheme.ss"
"literals.rkt"
@ -7,7 +7,7 @@
syntax/parse
(for-syntax macro-debugger/emit)
(for-meta 2 macro-debugger/emit
scheme/base)
racket/base)
(for-meta -3
(only-in "literals.rkt" (#%parens literal-parens)))
#;
@ -18,7 +18,7 @@
"syntax.ss"
"literals.rkt"
"honu-typed-scheme.ss"
scheme/base
racket/base
syntax/parse
syntax/stx
scheme/pretty
@ -515,14 +515,15 @@
(values
#;
(with-syntax ([(real-out (... ...)) #'(code ...)])
(let ([result (honu-unparsed-begin #'(real-out (... ...)))])
(let ([result (let ()
(honu-unparsed-begin #'(real-out (... ...))))])
(lambda () result)))
(begin
#;
(emit-remark "Do macro transformer" (quote-syntax (code ...)))
(emit-remark "Do macro transformer" (quote-syntax (pattern.code ...)))
#;
(printf "Macro transformer `~a'\n" (syntax->datum (quote-syntax (code ...))))
(let ([result (honu-unparsed-begin pattern.code ...)])
(let ([result (let ()
(honu-unparsed-begin pattern.code ...))])
(lambda ()
(emit-remark "Excuting macro " (symbol->string 'name))
result)))

2
collects/honu/core/private/more.rkt
View File

@ -28,7 +28,7 @@
(datum->syntax lexical consed lexical))
(define (replace-commas stuff)
(printf "Replace commas with: ~a\n" (syntax->datum stuff))
;; (printf "Replace commas with: ~a\n" (syntax->datum stuff))
(syntax-parse stuff #:literals (ellipses-comma ellipses-comma*)
[((ellipses-comma* z ...) thing blah ...)
#;

3
collects/honu/core/private/parse.rkt
View File

@ -741,3 +741,6 @@
rest*)))))
(with-syntax ([(out ...) (reverse parsed)])
#'(begin out ...)))
(define (cheetos) 1)
; (define cheetos "foo")

24
collects/honu/private/common.honu
View File

@ -1,19 +1,35 @@
#lang honu/core
require (forSyntax "with.honu");
require (forSyntax "function.honu");
provide print;
macro print ()
{ _ (value:expression); } { syntax(display(value_result); newline();); }
{ _ value:expression_comma ... ; } { syntax({display(value_result); newline();} ...); }
{ _ value:expression_comma ... ; } { syntax({display(value_result);} ...); }
provide check_expect;
provide expect;
keywords expect;
macro check_expect (expect) { _ check:expression expect expected:expression ; }
{ syntax({ checked = check_result;
{
function bar(g){
g + 1
}
function foo(){
cheetos()
}
// withSyntax [check_raw bar(2)]{
withSyntax [check_raw syntax_to_string(syntax(check);)]{
// withSyntax [check_raw syntax_to_string(1)]{
// withSyntax [check_raw foo()]{
// withSyntax [check_raw 1]{
syntax({checked = check_result;
out = expected_result;
if (checked != out){
print "Expected ", out, " but got ", checked;
}});}
// print "Expected ", out, " but got ", checked, " (", check_raw, ")";
print "Expected ", out, " but got ", checked, " (", check_raw, ")";
}});
};
}

11
collects/honu/private/with.honu
View File

@ -4,6 +4,13 @@ provide withSyntax;
macro withSyntax () {
_ [variable:identifier expr:expression] { b ... /* body:statement */ }; } {
#sx scheme:syntax #sx(with-syntax ([variable expr_result]) (honu-unparsed-begin b ...))
// applySchemeSyntax(#sx(real-syntax (with-syntax ([variable expr_result]) (honu-unparsed-begin b ...))))
#sx scheme:syntax #sx
(with-syntax ([variable_result (datum->syntax (real-syntax expr) expr_result
(real-syntax expr)
(real-syntax expr))])
(honu-unparsed-begin b ...))
}
// applySchemeSyntax(#sx(real-syntax (with-syntax ([variable_result expr_result]) (honu-unparsed-begin b ...))))