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

...

Browse Source 
original commit: b61ae9eddf4666edefac36632de7fa82e87016c5
This commit is contained in:
Robby Findler 2001-09-25 13:17:46 +00:00
parent 6401665067
commit ff23ceb36a
1 changed files with 8 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
collects/framework/specs.ss
View File

@ -20,7 +20,7 @@
(symbol? pos-blame))
(error 'contract "expected symbols as names for assigning blame, got: ~e and ~e"
neg-blame pos-blame))
(contract/internal type name pos-blame neg-blame)))])))
(contract/internal stx type name pos-blame neg-blame)))])))
(define-syntax contract/internal
(lambda (stx)
@ -30,7 +30,7 @@
[(null? (cdr lst)) null]
[else (cons (car lst) (all-but-last (cdr lst)))]))
(syntax-case stx ()
[(_ type name pos-blame neg-blame)
[(_ orig-stx type name pos-blame neg-blame)
(and (identifier? (syntax name))
(identifier? (syntax neg-blame))
(identifier? (syntax pos-blame)))
@ -42,8 +42,8 @@
(syntax
(if (procedure? name)
(lambda (ins ...)
(let ([out (name (contract doms ins neg-blame pos-blame) ...)])
(contract rng out pos-blame neg-blame)))
(let ([out (name (contract/internal orig-stx doms ins neg-blame pos-blame) ...)])
(contract/internal orig-stx rng out pos-blame neg-blame)))
(raise-error
pos-blame
"expected a procedure, got: ~e" name)))))]
@ -77,5 +77,7 @@
(equal? (syntax-object->datum (syntax ->))
(syntax-object->datum (car (syntax-e (syntax type))))))
(raise-syntax-error
'contract
"unknown contract specification" (syntax type))])]))))
#f
"unknown contract specification"
stx
(syntax type))])]))))