Assorted corrections
svn: r7056
This commit is contained in:
parent
5001c51753
commit
fba51484af
|
@ -127,7 +127,7 @@
|
|||
#;(!!! (printf "seq ~a~n" name))
|
||||
(cond
|
||||
[(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)
|
||||
(builder (make-res null input name #f 0 #f #f))]
|
||||
[else
|
||||
|
@ -261,7 +261,9 @@
|
|||
rsts)])
|
||||
(fail-res input
|
||||
(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-may-use fails)) fails)))]
|
||||
[else correct-rsts]))]
|
||||
|
@ -427,8 +429,8 @@
|
|||
(define (compute-chance expected-length seen-length used-toks num-alts may-use sub-chance)
|
||||
(let* ([revised-expectation (+ (- used-toks seen-length) expected-length)]
|
||||
[possible-expectation (+ revised-expectation (max 0 (sub1 may-use)))]
|
||||
[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 (* (/ (+ may-use used-toks) possible-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))]
|
||||
[expected-sub probability-with-sub]
|
||||
[expected-no-sub probability-without-sub]
|
||||
|
@ -441,8 +443,8 @@
|
|||
(* (/ 1 num-alts) (/ 1 expected-length) sub-chance)))
|
||||
(cond
|
||||
[(and (zero? used-toks) (zero? may-use))
|
||||
(* (/ 1 expected-length) (/ 1 num-alts) sub-chance)]
|
||||
[(zero? used-toks) probability-with-sub]
|
||||
sub-chance #;(* (/ 1 expected-length) (/ 1 num-alts) sub-chance)]
|
||||
[(zero? used-toks) sub-chance #;probability-with-sub]
|
||||
[else
|
||||
#;(printf "compute-chance: args ~a ~a ~a ~a ~a ~a~n"
|
||||
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])
|
||||
(cond
|
||||
[(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
|
||||
(let ([ans
|
||||
(let loop ([curr-input input] [curr-src start-src])
|
||||
|
@ -562,7 +564,7 @@
|
|||
#;(!!! (printf "possible options are ~a~n" choice-names))
|
||||
(let ([sub-opts (sub1 (+ alts num-choices))])
|
||||
(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]
|
||||
[else
|
||||
#;(!!! (printf "choice ~a~n" name))
|
||||
|
|
|
@ -126,12 +126,17 @@
|
|||
[(and (> (length winners) 1)
|
||||
(<= (length winners) max-choice-depth))
|
||||
(let ([messages (map (lambda (f) (fail-type->message f null)) winners)])
|
||||
(collapse-message
|
||||
(add-to-message
|
||||
(msg (format "An error occured in the ~a. Possible errors were: ~n ~a"
|
||||
name
|
||||
(alternate-error-list (map err-msg messages))))
|
||||
name #f message-to-date)))]
|
||||
(cond
|
||||
[(identical-messages? messages)
|
||||
(collapse-message
|
||||
(add-to-message (car messages) name #f message-to-date))]
|
||||
[else
|
||||
(collapse-message
|
||||
(add-to-message
|
||||
(msg (format "An error occured in the ~a. Possible errors were: ~n ~a"
|
||||
name
|
||||
(alternate-error-list (map err-msg messages))))
|
||||
name #f message-to-date))]))]
|
||||
[else
|
||||
(fail-type->message
|
||||
(car winners)
|
||||
|
@ -169,12 +174,21 @@
|
|||
(> (length no-dup-names) 1)
|
||||
(> (length winners) 1))
|
||||
(let ([messages (map (lambda (f) (fail-type->message f null)) winners)])
|
||||
(collapse-message
|
||||
(add-to-message
|
||||
(msg (format "An error occured in this ~a, expected one of ~a. Possible errors were:~n~a"
|
||||
name (nice-list no-dup-names)
|
||||
(alternate-error-list (map err-msg messages))))
|
||||
name #f message-to-date)))]
|
||||
(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
|
||||
(add-to-message
|
||||
(msg (format "An error occured in this ~a, expected one of ~a. Possible errors were:~n~a"
|
||||
name (nice-list no-dup-names)
|
||||
(alternate-error-list (map err-msg messages))))
|
||||
name #f message-to-date))]))]
|
||||
[(and (> (length no-dup-names) max-choice-depth)
|
||||
(> (length winners) 1))
|
||||
(collapse-message
|
||||
|
@ -287,6 +301,11 @@
|
|||
(string-append (string-downcase (substring string 0 1))
|
||||
(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)
|
||||
(cond
|
||||
[(null? l) null]
|
||||
|
|
|
@ -166,7 +166,7 @@
|
|||
(define-syntaxes (eta)
|
||||
(values (syntax-rules ()
|
||||
[(_ 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))
|
||||
|
|
|
@ -206,7 +206,7 @@
|
|||
(choice (list base-t voidT) "method return"))
|
||||
|
||||
(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"))
|
||||
|
||||
(define (block repeat?)
|
||||
(sequence (O_BRACE (if repeat? (repeat-greedy (eta statement)) (eta statement)) C_BRACE)
|
||||
id "block statement"))
|
||||
(let ([body (if repeat? (repeat-greedy statement) statement)])
|
||||
(sequence (O_BRACE body C_BRACE) id "block statement")))
|
||||
|
||||
(define expression-stmt
|
||||
(sequence (expression SEMI_COLON) id "statement"))
|
||||
|
|
Loading…
Reference in New Issue
Block a user