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

fix if. add check_expect. add some comparison operators

Browse Source
This commit is contained in:
Jon Rafkind 2010-07-19 15:56:49 -06:00
parent 4ee161b296
commit 03562eb8e3
5 changed files with 41 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -54,9 +54,16 @@
(+ scheme:+)
(honu-/ /)
(honu-- -)
(honu-< <)
(honu-> >)
(honu->= >=)
(honu-<= <=)
(honu-== ==)
(honu-= =)
(honu-!= !=)
(honu-? ?)
(honu-: :)
(honu-and and)
(honu-comma |,|)
(honu-. |.|)
)
@ -107,7 +114,7 @@
(scheme-syntax schemeSyntax)
))
#%braces #%parens #%brackets
x
sqrt
true
false
display

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

@ -389,21 +389,31 @@ 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
[pattern (#%parens expr:expr)])
[pattern (#%parens expr:expression) #:with result #'expr.result])
(define-syntax-class block
[pattern (#%braces statement ...)
#:with line (parse-complete-block #'(statement ...))])
#:with line #'(honu-unparsed-begin statement ...)
#;
(parse-complete-block #'(statement ...))])
;; (printf "Original syntax ~a\n" (syntax->datum stx))
(syntax-parse stx
#:literals (else)
[(_ condition:paren-expr on-true:block else on-false:block . rest)
;; (printf "used if with else\n")
(let ([result #'(if condition.expr on-true.line on-false.line)])
(expression-result ctx result (syntax/loc #'rest rest)))]
(values
(lambda () result)
#'rest)
#;
(expression-result ctx result (syntax/loc #'rest rest)))]
[(_ condition:paren-expr on-true:block . rest)
;; (printf "used if with no else\n")
(let ([result #'(when condition.expr on-true.line)])
(expression-result ctx result #'rest))])))
(let ([result #'(when condition.result on-true.line)])
(values
(lambda () result)
#'rest)
#;
(expression-result ctx result #'rest))])))
#|
if (foo){

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

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

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

@ -306,7 +306,11 @@
;; the first set of operators is `expression-1'
(splicing-let-syntax ([sl (make-rename-transformer #'syntax-lambda)])
(infix-operators expression-1 expression-last
([honu-= (sl (left right) #'(= left right))]
([honu-and (sl (left right) #'(and left right))])
(
#;
[honu-= (sl (left right) #'(= left right))]
[honu-== (sl (left right) #'(equal? left right))]
[honu-+= (sl (left right) #'(+ left right))]
[honu--= (sl (left right) #'(- left right))]
[honu-*= (sl (left right) #'(* left right))]
@ -324,6 +328,7 @@
[honu->>> (sl (left right) #'(+ left right))]
[honu-< (sl (left right) #'(< left right))]
[honu-> (sl (left right) #'(> left right))]
[honu-!= (sl (left right) #'(not (equal? left right)))]
[honu-<= (sl (left right) #'(<= left right))]
[honu->= (sl (left right) #'(>= left right))])
([honu-+ (sl (left right) #'(+ left right))]

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

@ -5,3 +5,13 @@ provide print;
macro print ()
{ _ (value:expression); } { syntax(display(value_result); newline();); }
{ _ value:expression_comma ... ; } { syntax({display(value_result); newline();} ...); }
provide check_expect;
provide expect;
keywords expect;
macro check_expect (expect) { _ check:expression expect expected:expression ; }
{ syntax({ checked = check_result;
out = expected_result;
if (checked != out){
print "Expected ", out, " but got ", checked;
}});}