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

parsing case-lam

Browse Source
This commit is contained in:
Danny Yoo 2011-05-10 00:46:57 -04:00
parent 2312a9f7d2
commit 5b816c4a64
2 changed files with 49 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
parse-bytecode-5.1.1.rkt
View File

@ -378,11 +378,23 @@
[else [else
(string->symbol (format "~s" name))])] (string->symbol (format "~s" name))])]
[else [else
(error "lam name neither symbol nor vector: ~e" name)])) 'unknown
;; The documentation says that the name must be a symbol or vector, but I'm seeing cases
;; where it returns the empty list when there's no information available.
]))
(define (parse-case-lam exp) (define (parse-case-lam exp)
(error 'fixmecaselam)) (match exp
[(struct case-lam (name clauses))
(let ([case-lam-label (make-lam-label)])
(make-CaseLam (extract-lam-name name)
(map (lambda (l) (parse-lam l (make-lam-label)))
clauses)
case-lam-label))]))
(define (parse-let-one expr) (define (parse-let-one expr)
(match expr (match expr

35
test-parse-bytecode-5.1.1.rkt
View File

@ -2,6 +2,7 @@
(require compiler/zo-parse (require compiler/zo-parse
rackunit rackunit
racket/match
(for-syntax racket/base) (for-syntax racket/base)
"parse-bytecode-5.1.1.rkt" "parse-bytecode-5.1.1.rkt"
"lexical-structs.rkt" "lexical-structs.rkt"
@ -262,6 +263,40 @@
(make-App (make-PrimitiveKernelValue 'current-continuation-marks) '())))) (make-App (make-PrimitiveKernelValue 'current-continuation-marks) '()))))
(begin (reset-lam-label-counter!/unit-testing)
(check-true (match (run-my-parse #'(case-lambda))
[(struct Top ((struct Prefix (list))
(struct CaseLam ((? LamPositionalName?) (list) 'lamEntry1))))
#t])))
(begin (reset-lam-label-counter!/unit-testing)
(check-true (match (run-my-parse #'(case-lambda [(x) x]
[(x y) x]
[(x y) y]))
[(struct Top ((struct Prefix (list))
(struct CaseLam ((? LamPositionalName?)
(list (struct Lam ((? LamPositionalName?)
1
#f
(struct LocalRef ('0 '#f))
'()
'lamEntry2))
(struct Lam ((? LamPositionalName?)
2
#f
(struct LocalRef ('0 '#f))
'()
'lamEntry3))
(struct Lam ((? LamPositionalName?)
2
#f
(struct LocalRef ('1 '#f))
'()
'lamEntry4)))
'lamEntry1))))
#t])))
;; make sure we don't see an infinite loop ;; make sure we don't see an infinite loop
#;(run-zo-parse #'(letrec ([g (lambda () (g))]) #;(run-zo-parse #'(letrec ([g (lambda () (g))])
(g))) (g)))