Add parser logic to catch common mistake
parent
a5d5dfb0df
commit
55e777476c
|
@ -358,6 +358,18 @@ HELP: scan-word
|
|||
{ $errors "Throws an error if the token does not name a word, and does not parse as a number." }
|
||||
$parsing-note ;
|
||||
|
||||
HELP: invalid-slot-name
|
||||
{ $values { "name" string } }
|
||||
{ $description "Throws an " { $link invalid-slot-name } " error." }
|
||||
{ $error-description "Thrown by " { $link POSTPONE: TUPLE: } " and " { $link POSTPONE: ERROR: } " if a suspect token appears as a slot name." }
|
||||
{ $notes "The suspect tokens are chosen so that the following code raises this parse error, instead of silently greating a tuple with garbage slots:"
|
||||
{ $code
|
||||
"TUPLE: my-mistaken-tuple slot-a slot-b"
|
||||
""
|
||||
": some-word ( a b c -- ) ... ;"
|
||||
}
|
||||
} ;
|
||||
|
||||
HELP: unexpected
|
||||
{ $values { "want" "a " { $link word } " or " { $link f } } { "got" word } }
|
||||
{ $description "Throws an " { $link unexpected } " error." }
|
||||
|
|
|
@ -184,6 +184,9 @@ M: parse-error summary
|
|||
M: parse-error compute-restarts
|
||||
error>> compute-restarts ;
|
||||
|
||||
M: parse-error error-help
|
||||
error>> error-help ;
|
||||
|
||||
SYMBOL: use
|
||||
SYMBOL: in
|
||||
|
||||
|
@ -298,12 +301,35 @@ M: no-word-error summary
|
|||
] "" make note.
|
||||
] with each ;
|
||||
|
||||
ERROR: invalid-slot-name name ;
|
||||
|
||||
M: invalid-slot-name summary
|
||||
drop
|
||||
"Invalid slot name" ;
|
||||
|
||||
: (parse-tuple-slots) ( -- )
|
||||
#! This isn't meant to enforce any kind of policy, just
|
||||
#! to check for mistakes of this form:
|
||||
#!
|
||||
#! TUPLE: blahblah foo bing
|
||||
#!
|
||||
#! : ...
|
||||
scan {
|
||||
{ [ dup not ] [ unexpected-eof ] }
|
||||
{ [ dup { ":" "(" "<" } member? ] [ invalid-slot-name ] }
|
||||
{ [ dup ";" = ] [ drop ] }
|
||||
[ , (parse-tuple-slots) ]
|
||||
} cond ;
|
||||
|
||||
: parse-tuple-slots ( -- seq )
|
||||
[ (parse-tuple-slots) ] { } make ;
|
||||
|
||||
: parse-tuple-definition ( -- class superclass slots )
|
||||
CREATE-CLASS
|
||||
scan {
|
||||
{ ";" [ tuple f ] }
|
||||
{ "<" [ scan-word ";" parse-tokens ] }
|
||||
[ >r tuple ";" parse-tokens r> prefix ]
|
||||
{ "<" [ scan-word parse-tuple-slots ] }
|
||||
[ >r tuple parse-tuple-slots r> prefix ]
|
||||
} case 3dup check-slot-shadowing ;
|
||||
|
||||
ERROR: staging-violation word ;
|
||||
|
|
Loading…
Reference in New Issue