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

Assorted corrections

Browse Source 
svn: r7056
This commit is contained in:
Kathy Gray 2007-08-08 14:49:47 +00:00
parent 5001c51753
commit fba51484af
4 changed files with 45 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
collects/combinator-parser/private-combinator/combinator.scm
View File

@ -127,7 +127,7 @@
#;(!!! (printf "seq ~a~n" name)) #;(!!! (printf "seq ~a~n" name))
(cond (cond
[(eq? input return-name) name] [(eq? input return-name) name]
#;[(hash-table-get memo-table input #f) (hash-table-get memo-table input)] [(hash-table-get memo-table input #f) (hash-table-get memo-table input)]
[(null? sub-list) [(null? sub-list)
(builder (make-res null input name #f 0 #f #f))] (builder (make-res null input name #f 0 #f #f))]
[else [else
@ -261,7 +261,9 @@
rsts)]) rsts)])
(fail-res input (fail-res input
(make-options-fail (make-options-fail
(rank-choice (map fail-type-chance fails)) #f seq-name (rank-choice (map fail-type-chance fails))
last-src
seq-name
(rank-choice (map fail-type-used fails)) (rank-choice (map fail-type-used fails))
(rank-choice (map fail-type-may-use fails)) fails)))] (rank-choice (map fail-type-may-use fails)) fails)))]
[else correct-rsts]))] [else correct-rsts]))]
@ -427,8 +429,8 @@
(define (compute-chance expected-length seen-length used-toks num-alts may-use sub-chance) (define (compute-chance expected-length seen-length used-toks num-alts may-use sub-chance)
(let* ([revised-expectation (+ (- used-toks seen-length) expected-length)] (let* ([revised-expectation (+ (- used-toks seen-length) expected-length)]
[possible-expectation (+ revised-expectation (max 0 (sub1 may-use)))] [possible-expectation (+ revised-expectation (max 0 (sub1 may-use)))]
[probability-with-sub (* (/ (+ may-use used-toks) possible-expectation) (/ 1 num-alts))] #;[probability-with-sub (* (/ (+ may-use used-toks) possible-expectation) (/ 1 num-alts))]
#;[probability-with-sub (* (/ (add1 used-toks) revised-expectation) (/ 1 num-alts))] [probability-with-sub (* (/ (add1 used-toks) revised-expectation) (/ 1 num-alts))]
[probability-without-sub (* (/ used-toks revised-expectation) (/ 1 num-alts))] [probability-without-sub (* (/ used-toks revised-expectation) (/ 1 num-alts))]
[expected-sub probability-with-sub] [expected-sub probability-with-sub]
[expected-no-sub probability-without-sub] [expected-no-sub probability-without-sub]
@ -441,8 +443,8 @@
(* (/ 1 num-alts) (/ 1 expected-length) sub-chance))) (* (/ 1 num-alts) (/ 1 expected-length) sub-chance)))
(cond (cond
[(and (zero? used-toks) (zero? may-use)) [(and (zero? used-toks) (zero? may-use))
(* (/ 1 expected-length) (/ 1 num-alts) sub-chance)] sub-chance #;(* (/ 1 expected-length) (/ 1 num-alts) sub-chance)]
[(zero? used-toks) probability-with-sub] [(zero? used-toks) sub-chance #;probability-with-sub]
[else [else
#;(printf "compute-chance: args ~a ~a ~a ~a ~a ~a~n" #;(printf "compute-chance: args ~a ~a ~a ~a ~a ~a~n"
expected-length seen-length used-toks num-alts may-use sub-chance) expected-length seen-length used-toks num-alts may-use sub-chance)
@ -497,7 +499,7 @@
(opt-lambda (input [start-src (list 1 0 1 0)] [alts 1]) (opt-lambda (input [start-src (list 1 0 1 0)] [alts 1])
(cond (cond
[(eq? input return-name) repeat-name] [(eq? input return-name) repeat-name]
#;[(hash-table-get memo-table input #f) (hash-table-get memo-table input)] [(hash-table-get memo-table input #f) (hash-table-get memo-table input)]
[else [else
(let ([ans (let ([ans
(let loop ([curr-input input] [curr-src start-src]) (let loop ([curr-input input] [curr-src start-src])
@ -562,7 +564,7 @@
#;(!!! (printf "possible options are ~a~n" choice-names)) #;(!!! (printf "possible options are ~a~n" choice-names))
(let ([sub-opts (sub1 (+ alts num-choices))]) (let ([sub-opts (sub1 (+ alts num-choices))])
(cond (cond
#;[(hash-table-get memo-table input #f) (hash-table-get memo-table input)] [(hash-table-get memo-table input #f) (hash-table-get memo-table input)]
[(eq? input return-name) name] [(eq? input return-name) name]
[else [else
#;(!!! (printf "choice ~a~n" name)) #;(!!! (printf "choice ~a~n" name))

23
collects/combinator-parser/private-combinator/errors.scm
View File

@ -126,12 +126,17 @@
[(and (> (length winners) 1) [(and (> (length winners) 1)
(<= (length winners) max-choice-depth)) (<= (length winners) max-choice-depth))
(let ([messages (map (lambda (f) (fail-type->message f null)) winners)]) (let ([messages (map (lambda (f) (fail-type->message f null)) winners)])
(cond
[(identical-messages? messages)
(collapse-message
(add-to-message (car messages) name #f message-to-date))]
[else
(collapse-message (collapse-message
(add-to-message (add-to-message
(msg (format "An error occured in the ~a. Possible errors were: ~n ~a" (msg (format "An error occured in the ~a. Possible errors were: ~n ~a"
name name
(alternate-error-list (map err-msg messages)))) (alternate-error-list (map err-msg messages))))
name #f message-to-date)))] name #f message-to-date))]))]
[else [else
(fail-type->message (fail-type->message
(car winners) (car winners)
@ -169,12 +174,21 @@
(> (length no-dup-names) 1) (> (length no-dup-names) 1)
(> (length winners) 1)) (> (length winners) 1))
(let ([messages (map (lambda (f) (fail-type->message f null)) winners)]) (let ([messages (map (lambda (f) (fail-type->message f null)) winners)])
(cond
[(identical-messages? messages)
(collapse-message
(add-to-message (car messages) #f #f
(add-to-message
(msg (format "An error occured in this ~a, expected one of ~a."
name (nice-list no-dup-names))
name #f message-to-date))))]
[else
(collapse-message (collapse-message
(add-to-message (add-to-message
(msg (format "An error occured in this ~a, expected one of ~a. Possible errors were:~n~a" (msg (format "An error occured in this ~a, expected one of ~a. Possible errors were:~n~a"
name (nice-list no-dup-names) name (nice-list no-dup-names)
(alternate-error-list (map err-msg messages)))) (alternate-error-list (map err-msg messages))))
name #f message-to-date)))] name #f message-to-date))]))]
[(and (> (length no-dup-names) max-choice-depth) [(and (> (length no-dup-names) max-choice-depth)
(> (length winners) 1)) (> (length winners) 1))
(collapse-message (collapse-message
@ -287,6 +301,11 @@
(string-append (string-downcase (substring string 0 1)) (string-append (string-downcase (substring string 0 1))
(substring string 1 (string-length string)))) (substring string 1 (string-length string))))
(define (identical-messages? msgs)
(andmap (lambda (err) (equal? (err-msg (car msgs))
(err-msg err)))
(cdr msgs)))
(define (remove-dups l n) (define (remove-dups l n)
(cond (cond
[(null? l) null] [(null? l) null]

2
collects/combinator-parser/private-combinator/parser-sigs.ss
View File

@ -166,7 +166,7 @@
(define-syntaxes (eta) (define-syntaxes (eta)
(values (syntax-rules () (values (syntax-rules ()
[(_ f) [(_ f)
(opt-lambda (x [c 1]) (f x c))]))) (opt-lambda (x [s (list 0 1 0 1)] [o 1]) (f x s o))])))
)) ))
(define-signature parser^ (parser)) (define-signature parser^ (parser))

6
collects/profj/comb-parsers/parser-units.scm
View File

@ -206,7 +206,7 @@
(choice (list base-t voidT) "method return")) (choice (list base-t voidT) "method return"))
(define (array-type base-t) (define (array-type base-t)
(sequence (base-t (repeat (sequence (O_BRACKET C_BRACKET) id "array type"))) "type")) (sequence (base-t (repeat (sequence (O_BRACKET C_BRACKET) id "array type"))) id "type"))
) )
@ -440,8 +440,8 @@
(sequence (super O_PAREN (comma-sep expression "arguments") C_PAREN SEMI_COLON) id)) "super constructor call")) (sequence (super O_PAREN (comma-sep expression "arguments") C_PAREN SEMI_COLON) id)) "super constructor call"))
(define (block repeat?) (define (block repeat?)
(sequence (O_BRACE (if repeat? (repeat-greedy (eta statement)) (eta statement)) C_BRACE) (let ([body (if repeat? (repeat-greedy statement) statement)])
id "block statement")) (sequence (O_BRACE body C_BRACE) id "block statement")))
(define expression-stmt (define expression-stmt
(sequence (expression SEMI_COLON) id "statement")) (sequence (expression SEMI_COLON) id "statement"))