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

fix condition. patterns can take literals

Browse Source
This commit is contained in:
Jon Rafkind 2010-08-02 12:13:26 -06:00
parent 29ed62021c
commit 86e7b98d65
7 changed files with 61 additions and 39 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -39,8 +39,6 @@
(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 ...))
@ -67,20 +65,20 @@
(honu-<= <=)
(honu-== ==)
(honu-= =)
(honu-literal literals)
(honu-!= !=)
(honu-? ?)
(honu-: :)
(honu-and and)
(honu-comma |,|)
(honu-. |.|)
(expression-comma expression_comma)
)
#;
(rename-out [honu-print print])
(for-syntax (rename-out [syntax-to-string syntax_to_string]))
(for-syntax cheetos)
cheetos1
#%top
@ -167,6 +165,7 @@
(honu-identifier identifier123)
(honu-require require)
(honu-for-syntax forSyntax)
(honu-for-template forTemplate)
(honu-syntax syntax)
(honu-pattern pattern)
(honu-keywords keywords)

11
collects/honu/core/private/honu-typed-scheme.rkt
View File

@ -389,6 +389,7 @@ Then, in the pattern above for 'if', 'then' would be bound to the following synt
(define-syntax-class expr
[pattern e])
(define-syntax-class paren-expr
#:literals (#%parens)
[pattern (#%parens expr:expression) #:with result #'expr.result])
(define-syntax-class block
[pattern (#%braces statement ...)
@ -399,8 +400,9 @@ Then, in the pattern above for 'if', 'then' would be bound to the following synt
(syntax-parse stx
#:literals (else)
[(_ condition:paren-expr on-true:block else on-false:block . rest)
;; (printf "Condition expr is ~a\n" #'condition.expr)
;; (printf "used if with else\n")
(let ([result #'(if condition.expr on-true.line on-false.line)])
(let ([result #'(if condition.result on-true.line on-false.line)])
(values
(lambda () result)
#'rest)
@ -548,10 +550,17 @@ if (foo){
#;
(datum->syntax body (cons #'for-syntax (cons #'spec #'()))
body body)])
(define-syntax-class for-template-form
#:literals (#%parens honu-for-template)
[pattern (#%parens honu-for-template spec)
#:with result
(datum->syntax #'spec (cons #'for-template (cons #'spec #'()))
#'spec #'spec)])
(define-syntax-class normal-form
[pattern x:str #:with result #'x])
(define-syntax-class form
[pattern x:for-syntax-form #:with result #'x.result]
[pattern x:for-template-form #:with result #'x.result]
[pattern x:normal-form #:with result #'x.result])
(syntax-parse body #:literals (semicolon)
[(_ form:form ... semicolon . rest)

5
collects/honu/core/private/literals.rkt
View File

@ -18,8 +18,11 @@
honu-&= honu-^= honu-\|= honu-<<= honu->>= honu->>>=
honu->> honu-<< honu->>> honu-< honu-> honu-<= honu->=
honu-!= honu-==
honu-literal
honu-? honu-: honu-comma honu-. #%braces #%brackets #%parens colon
honu-and
ellipses-comma ellipses-comma* ellipses-repeat honu-for-syntax)
ellipses-comma ellipses-comma* ellipses-repeat
honu-for-syntax
honu-for-template)
(define-literal-set cruft (#%parens #%brackets #%braces semicolon))

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

@ -435,8 +435,12 @@
(define-honu-syntax honu-pattern
(lambda (stx ctx)
(syntax-parse stx #:literal-sets ([cruft #:at stx])
#:literals (honu-literal)
;; #%parens #%brackets semicolon)
[(_ name (#%parens all-attributes:identifier ...) (#%brackets xpattern ...)
[(_ name
(~optional (~seq honu-literal (#%parens literals ...)))
(#%parens all-attributes:identifier ...)
(#%brackets xpattern ...)
semicolon . rest)
(define my-parens (datum->syntax #'name '#%parens #'name #'name))
(define (create-pattern stuff)
@ -444,15 +448,20 @@
(syntax/loc stuff (pattern (~seq fixed ...)))))
(values
(lambda ()
(with-syntax ([final-pattern (create-pattern #'(xpattern ...))]
#;
[parens (datum->syntax stx '#%parens stx)]
[parens (datum->syntax #'name '#%parens #'name #'name)])
(syntax/loc stx
(define-splicing-syntax-class name
#:literal-sets ([cruft #:at name])
#:attributes (all-attributes ...)
final-pattern))))
(if (attribute literals)
(with-syntax ([final-pattern (create-pattern #'(xpattern ...))])
(syntax/loc stx
(define-splicing-syntax-class name
#:literal-sets ([cruft #:at name])
#:literals (literals ...)
#:attributes (all-attributes ...)
final-pattern)))
(with-syntax ([final-pattern (create-pattern #'(xpattern ...))])
(syntax/loc stx
(define-splicing-syntax-class name
#:literal-sets ([cruft #:at name])
#:attributes (all-attributes ...)
final-pattern)))))
#'rest)])))
(define foobar 0)
@ -529,6 +538,7 @@
result)))
#'(rrest (... ...)))]
...
[else (raise-syntax-error 'name "bad syntax")]
))))))
#;
(with-syntax ([parsed (let-values ([(out rest*)

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

@ -85,7 +85,7 @@
(printf "Transforming honu macro ~a\n" (stx-car stx))
(let-values ([(used rest)
(transformer (introducer stx) context)])
(printf "Result is ~a. Object position is ~a\n" used (syntax-object-position stx (introducer rest)))
(printf "Result is ~a. Object position is ~a out of expression ~a\n" used (syntax-object-position stx (introducer rest)) (syntax->datum stx))
(list (introducer rest) (syntax-object-position stx (introducer rest))
(introducer (used)))))]
@ -196,7 +196,7 @@
[pattern (~seq x:honu-identifier) #:with result #'x.x])
(define-splicing-syntax-class (expression-last context)
#:literals (#%parens)
#:literals (#%parens honu-:)
#;
[pattern (~seq a 1 2 3 b 4 5 6)]
@ -210,6 +210,9 @@
(stx-car #'raw)
#'raw))]
[pattern (~seq (#%braces code:statement))
#:with result #'(begin code.result)]
[pattern (~seq (#%parens (~var e (expression-1 context)))) #:with result #'e.result]
[pattern (~seq (~var call (call context))) #:with result #'call.call]
[pattern (~seq (~var e (honu-transformer
@ -219,6 +222,7 @@
#:with result #'e.result
#:with rest #'e.rest]
[pattern (~seq x:number) #:with result (begin (printf "got a number ~a\n" #'x) #'x)]
[pattern (~seq honu-: id:honu-identifier) #:with result #''id.result]
[pattern (~seq x:str) #:with result #'x]
[pattern (~seq x:honu-identifier) #:with result #'x.x]
#;
@ -514,6 +518,7 @@
)
#:with result (apply-scheme-syntax (attribute x.result))
#:with rest #'x.rest]
#;
[pattern ((~var f (debug-here "statement1"))
(~var x (expression-top the-top-block-context)))
@ -553,7 +558,9 @@
#;
[pattern (~seq (~var expr honu-identifier) (~optional honu-comma))]
[pattern (~seq (~var expr (expression-1 the-expression-context)) (~optional honu-comma)) #:with result (apply-scheme-syntax #'expr.result)]
[pattern (~seq (~var expr (expression-1 the-expression-context))
(~optional honu-comma))
#:with result (apply-scheme-syntax #'expr.result)]
#;
[pattern ((~seq (~var expr (expression-1 the-expression-context)) (~optional honu-comma)) ...)])

9
collects/honu/main.rkt
View File

@ -14,12 +14,3 @@
"private/struct.honu"
"private/function.honu"
"private/common.honu")
#|
(racket:require "core/main.rkt"
"private/struct.honu"
"private/function.honu")
(racket:provide [all-from-out "core/main.rkt"])
(racket:provide [all-from-out "private/struct.honu"
"private/function.honu"])
|#

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

@ -2,29 +2,22 @@
require (forSyntax "with.honu");
require (forSyntax "function.honu");
require (forSyntax "patterns.honu");
require "keywords.honu";
provide print;
provide then;
macro print ()
{ _ (value:expression); } { syntax(display(value_result); newline();); }
{ _ value:expression_comma ... ; } { syntax({display(value_result);} ...); }
{ _ value:expression_comma ... ; } { syntax({display(value_result);} ... newline()); }
provide check_expect;
provide expect;
keywords expect;
macro check_expect (expect) { _ check:expression expect expected:expression ; }
{
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){
@ -33,3 +26,13 @@ macro check_expect (expect) { _ check:expression expect expected:expression ; }
}});
};
}
provide condition;
macro condition (){ _ clause:condition_clause rest ... ;}
{ syntax(if (clause_condition_result) {
clause_out_result
} else {
condition rest ... ;
}
); }
{ _ ; } { syntax(1;); }