conservatory
/
ikarus
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Fixed some of bug 186155: Incorrect syntax errors for define

This commit is contained in:
Abdulaziz Ghuloum 2008-01-27 19:12:20 -05:00
parent 7f971d710a
commit a43177d399
2 changed files with 38 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
scheme/ikarus.bytevectors.ss
View File

@ -73,7 +73,7 @@
(ikarus system $pairs)
(ikarus system $bytevectors))
(define (native-endianness) 'big) ;;; HARDCODED
(define (native-endianness) 'little) ;;; HARDCODED
(define ($bytevector-fill x i j fill)

62
scheme/psyntax.expander.ss
View File

@ -779,15 +779,17 @@
(apply body ls/false)
(syntax-match t (lits ...) cls* ...)))))))))))
(define parse-define
(lambda (x)
;;; FIXME: (define f) is not supported yet
(syntax-match x ()
((_ (id . fmls) b b* ...) (id? id)
(values id (cons 'defun (cons fmls (cons b b*)))))
(begin
(verify-formals fmls x)
(values id (cons 'defun (cons fmls (cons b b*))))))
((_ id val) (id? id)
(values id (cons 'expr val)))
((_ id) (id? id)
((_ id) (id? id)
(values id (cons 'expr (bless '(void))))))))
(define parse-define-syntax
@ -2630,33 +2632,43 @@
"attempt to assign to an unexportable variable"))
(else (stx-error e))))))))
(define (verify-formals fmls stx)
(syntax-match fmls ()
((x* ...)
(unless (valid-bound-ids? x*)
(invalid-fmls-error stx fmls)))
((x* ... . x)
(unless (valid-bound-ids? (cons x x*))
(invalid-fmls-error stx fmls)))
(_ (stx-error stx "invalid syntax"))))
(define chi-lambda-clause
(lambda (stx fmls body* r mr)
(syntax-match fmls ()
((x* ...)
(if (valid-bound-ids? x*)
(let ((lex* (map gen-lexical x*))
(lab* (map gen-label x*)))
(values
lex*
(chi-internal
(add-subst (make-full-rib x* lab*) body*)
(add-lexicals lab* lex* r)
mr)))
(invalid-fmls-error stx fmls)))
(begin
(verify-formals fmls stx)
(let ((lex* (map gen-lexical x*))
(lab* (map gen-label x*)))
(values
lex*
(chi-internal
(add-subst (make-full-rib x* lab*) body*)
(add-lexicals lab* lex* r)
mr)))))
((x* ... . x)
(if (valid-bound-ids? (cons x x*))
(let ((lex* (map gen-lexical x*)) (lab* (map gen-label x*))
(lex (gen-lexical x)) (lab (gen-label x)))
(values
(append lex* lex)
(chi-internal
(add-subst
(make-full-rib (cons x x*) (cons lab lab*))
body*)
(add-lexicals (cons lab lab*) (cons lex lex*) r)
mr)))
(invalid-fmls-error stx fmls)))
(begin
(verify-formals fmls stx)
(let ((lex* (map gen-lexical x*)) (lab* (map gen-label x*))
(lex (gen-lexical x)) (lab (gen-label x)))
(values
(append lex* lex)
(chi-internal
(add-subst
(make-full-rib (cons x x*) (cons lab lab*))
body*)
(add-lexicals (cons lab lab*) (cons lex lex*) r)
mr)))))
(_ (stx-error fmls "invalid syntax")))))
(define chi-lambda-clause*