2486 lines
140 KiB
Scheme
2486 lines
140 KiB
Scheme
(module parse-error mzscheme
|
|
|
|
(require "lexer.ss" "general-parsing.ss"
|
|
"../parameters.ss"
|
|
(lib "etc.ss")
|
|
(lib "readerr.ss" "syntax")
|
|
(all-except (lib "lex.ss" "parser-tools") input-port))
|
|
|
|
(provide
|
|
find-beginner-error find-beginner-error-interactions find-beginner-error-expression find-beginner-error-type
|
|
find-intermediate-error find-intermediate-error-interactions find-intermediate-error-expression find-intermediate-error-type
|
|
find-advanced-error find-advanced-error-interactions find-advanced-error-expression find-advanced-error-type)
|
|
|
|
(define level (make-parameter 'beginner))
|
|
(define (beginner?) (eq? (level) 'beginner))
|
|
(define (intermediate?) (eq? (level) 'intermediate))
|
|
(define (advanced?) (eq? (level) 'advanced))
|
|
|
|
;find-error: symbol -> (-> (U void #t))
|
|
(define (find-error level-set)
|
|
(lambda ()
|
|
(level level-set)
|
|
(let ((getter ((lex-stream))))
|
|
(parse-program null (getter) 'start getter))))
|
|
|
|
;find-expression-error: symbol -> (-> (U void #t))
|
|
(define (find-expression-error level-set)
|
|
(lambda ()
|
|
(level level-set)
|
|
(let ((getter ((lex-stream))))
|
|
(parse-expression null (getter) 'start getter #f #f))))
|
|
|
|
;find-type-error: symbol -> (-> (U void #t))
|
|
(define (find-type-error level-set)
|
|
(lambda ()
|
|
(level level-set)
|
|
(let ((getter ((lex-stream))))
|
|
(parse-type null (getter) 'start getter))))
|
|
|
|
;find-beginner-error: -> (U void #t)
|
|
(define find-beginner-error (find-error 'beginner))
|
|
|
|
(define find-beginner-error-expression (find-expression-error 'beginner))
|
|
|
|
(define find-beginner-error-type (find-type-error 'beginner))
|
|
|
|
;find-beginner-error-interaction: -> (U bool or token)
|
|
;Should not return
|
|
(define (find-beginner-error-interactions)
|
|
(let* ((getter ((lex-stream)))
|
|
(first-tok (getter)))
|
|
(let ((returned-tok
|
|
(case (get-token-name (get-tok first-tok))
|
|
((EOF) #t)
|
|
((if return) (parse-statement null first-tok 'start getter #f #f #f))
|
|
;Taken from Intermediate to allow interaction to say int x = 4;
|
|
((IDENTIFIER)
|
|
(let ((next (getter)))
|
|
(if (id-token? (get-tok next))
|
|
(parse-field first-tok next 'start getter)
|
|
(parse-expression first-tok next 'name getter #f #f))))
|
|
(else
|
|
(if (prim-type? (get-tok first-tok))
|
|
(parse-field first-tok (getter) 'start getter)
|
|
(parse-expression null first-tok 'start getter #f #f))))))
|
|
|
|
(if (or (and (pair? returned-tok) (eof? (get-tok returned-tok))) (boolean? returned-tok))
|
|
returned-tok
|
|
(if (and (pair? returned-tok) (semi-colon? (get-tok returned-tok)))
|
|
(parse-error "';' is not allowed here" (get-start returned-tok) (get-end returned-tok))
|
|
(parse-error (format "Only 1 statement, expression, or definition is allowed, found extra input ~a"
|
|
(format-out (get-tok returned-tok)))
|
|
(get-start returned-tok) (get-end returned-tok)))))))
|
|
|
|
;find-intermediate-error: -> (U void #t)
|
|
(define find-intermediate-error (find-error 'intermediate))
|
|
|
|
;find-intermediate-error-expression: -> void
|
|
(define find-intermediate-error-expression (find-expression-error 'intermediate))
|
|
|
|
;find-intermediate-error-type: -> void
|
|
(define find-intermediate-error-type (find-type-error 'intermediate))
|
|
|
|
;find-error-interaction: -> (U bool or token)
|
|
;Should not return
|
|
(define (find-intermediate-error-interactions)
|
|
(let* ((getter ((lex-stream)))
|
|
(first-tok (getter)))
|
|
(level 'intermediate)
|
|
(let ((returned-tok
|
|
(case (get-token-name (get-tok first-tok))
|
|
((EOF) #t)
|
|
((if return O_BRACE) (parse-statement null first-tok 'start getter #t #f #f))
|
|
((IDENTIFIER)
|
|
(let ((next (getter)))
|
|
(if (id-token? (get-tok next))
|
|
(parse-statement first-tok next 'local getter #t #f #f)
|
|
(parse-expression first-tok next 'name getter #t #f))))
|
|
(else
|
|
(if (prim-type? (get-tok first-tok))
|
|
(parse-statement null first-tok 'start getter #t #f #f)
|
|
(parse-expression null first-tok 'start getter #t #f))))))
|
|
(if (or (and (pair? returned-tok) (eof? (get-tok returned-tok))) (boolean? returned-tok))
|
|
returned-tok
|
|
(if (and (pair? returned-tok) (semi-colon? (get-tok returned-tok)))
|
|
(parse-error "';' is not allowed here" (get-start returned-tok) (get-end returned-tok))
|
|
(parse-error (format "Only 1 statement or expression is allowed, found extra input ~a"
|
|
(format-out (get-tok returned-tok)))
|
|
(get-start returned-tok) (get-end returned-tok)))))))
|
|
|
|
;find-advanced-error: -> (U void #t)
|
|
(define (find-advanced-error)
|
|
(let ((getter ((lex-stream))))
|
|
(level 'advanced)
|
|
(parse-package null (getter) 'start getter)))
|
|
|
|
;find-advanced-error-expression: -> void
|
|
(define find-advanced-error-expression (find-expression-error 'advanced))
|
|
|
|
;find-advanced-error-type: -> void
|
|
(define find-advanced-error-type (find-type-error 'advanced))
|
|
|
|
;find-error-interaction: -> (U bool or token)
|
|
;Should not return
|
|
(define (find-advanced-error-interactions)
|
|
(let* ((getter ((lex-stream)))
|
|
(first-tok (getter)))
|
|
(level 'advanced)
|
|
(let ((returned-tok
|
|
(case (get-token-name (get-tok first-tok))
|
|
((EOF) #t)
|
|
((if return O_BRACE for do while break continue)
|
|
(parse-statement null first-tok 'start getter #t #f #f))
|
|
((IDENTIFIER)
|
|
(let ((next (getter)))
|
|
(if (id-token? (get-tok next))
|
|
(parse-statement first-tok next 'local getter #t #f #f)
|
|
(parse-expression first-tok next 'name getter #t #f))))
|
|
(else
|
|
(if (prim-type? (get-tok first-tok))
|
|
(parse-statement null first-tok 'start getter #t #f #f)
|
|
(parse-expression null first-tok 'start getter #t #f))))))
|
|
(if (or (and (pair? returned-tok) (eof? (get-tok returned-tok))) (boolean? returned-tok))
|
|
returned-tok
|
|
(if (and (pair? returned-tok) (semi-colon? (get-tok returned-tok)))
|
|
(parse-error "';' is not allowed here" (get-start returned-tok) (get-end returned-tok))
|
|
(parse-error (format "Only 1 statement or expression is allowed, found extra input ~a"
|
|
(format-out (get-tok returned-tok)))
|
|
(get-start returned-tok) (get-end returned-tok)))))))
|
|
|
|
;;-----------------------------------------------------------------------------------------------------------
|
|
;;Functions for parsing and reporting errors
|
|
|
|
;parse-error: string position position
|
|
(define (parse-error message start stop)
|
|
(raise-read-error message
|
|
(file-path)
|
|
(position-line start)
|
|
(position-col start)
|
|
(+ (position-offset start) (interactions-offset))
|
|
(- (position-offset stop)
|
|
(position-offset start))))
|
|
|
|
;token = (list lex-token position position)
|
|
(define get-tok position-token-token)
|
|
(define get-start position-token-start-pos)
|
|
(define (get-end token)
|
|
(if (or (eq? (get-token-name (get-tok token)) 'STRING_LIT)
|
|
(eq? (get-token-name (get-tok token)) 'STRING_ERROR))
|
|
(cadr (token-value (get-tok token)))
|
|
(position-token-end-pos token)))
|
|
|
|
;output-format: token bool -> string
|
|
(define format-out
|
|
(opt-lambda (tok [full? #t])
|
|
(cond
|
|
((separator? tok)
|
|
(case (get-token-name tok)
|
|
((O_BRACE) "{")
|
|
((C_BRACE) "}")
|
|
((O_PAREN) "(")
|
|
((C_PAREN) ")")
|
|
((O_BRACKET) "[")
|
|
((C_BRACKET) "]")
|
|
((SEMI_COLON) ";")
|
|
((COMMA) ",")
|
|
((PERIOD) ".")))
|
|
((eq? (get-token-name tok) 'OR) (if full? "operator ||" "||"))
|
|
((eq? (get-token-name tok) 'PIPE) (if full? "operator |" "||"))
|
|
((java-keyword? tok) (if full?
|
|
(format "reserved word ~a" (get-token-name tok)) (get-token-name tok)))
|
|
((id-token? tok) (if full? (format "identifier ~a" (token-value tok)) (token-value tok)))
|
|
((eq? (get-token-name tok) 'STRING_LIT) (if full? (format "string ~a" (car (token-value tok)))
|
|
(car (token-value tok))))
|
|
((eq? (get-token-name tok) 'NULL_LIT) (if full? "null value" "null"))
|
|
((eq? (get-token-name tok) 'TRUE_LIT) (if full? "boolean value true" "true"))
|
|
((eq? (get-token-name tok) 'FALSE_LIT) (if full? "boolean value false" "false"))
|
|
((literal-token? tok) (if full? (format "value ~a" (token-value tok)) (token-value tok)))
|
|
((eq? (get-token-name tok) 'STRING_ERROR)
|
|
(format "malformed string ~a" (car (token-value tok))))
|
|
((eq? (get-token-name tok) 'NUMBER_ERROR)
|
|
(format "malformed number ~a" (token-value tok)))
|
|
((eq? (get-token-name tok) 'OTHER_SPECIAL)
|
|
(parse-error "Found special which is not a legal character in ProfessorJ"
|
|
(cadr (token-value tok)) (caddr (token-value tok))))
|
|
((eq? (get-token-name tok) 'TEST_SUITE) (format "Test Suite Test"))
|
|
((eq? (get-token-name tok) 'INTERACTIONS_BOX) (format "Java Interactions Box"))
|
|
((eq? (get-token-name tok) 'EXAMPLE) (format "Java Example Box"))
|
|
((eq? (get-token-name tok) 'CLASS_BOX) (format "Java Class Box"))
|
|
(else (get-token-name tok)))))
|
|
|
|
;parse-package: token token symbol (-> token) -> void
|
|
(define (parse-package pre cur-tok state getter)
|
|
; (printf "parse-package state: ~a pre ~a cur-tok: ~a~n" state pre cur-tok)
|
|
(let* ((tok (get-tok cur-tok))
|
|
(tokN (get-token-name tok))
|
|
(srt (get-start cur-tok))
|
|
(end (get-end cur-tok))
|
|
(out (format-out tok))
|
|
(ps (if (null? pre) null (get-start pre)))
|
|
(pe (if (null? pre) null (get-end pre))))
|
|
(case state
|
|
((start)
|
|
(case tokN
|
|
((EOF) #t)
|
|
((package)
|
|
(let ((next (getter)))
|
|
(if (id-token? (get-tok next))
|
|
(let ((after-id (getter)))
|
|
(cond
|
|
((dot? (get-tok after-id))
|
|
(parse-package cur-tok (parse-name (getter) getter #f) 'semi-colon getter))
|
|
((semi-colon? (get-tok after-id))
|
|
(parse-program after-id (getter) 'start getter))
|
|
(else
|
|
(parse-error
|
|
(format "'package' must have a name followed by ';'. ~a ~a is not a legal name"
|
|
(format-out (get-tok next)) (format-out (get-tok after-id)))
|
|
(get-start next) (get-end after-id)))))
|
|
(parse-error (format "'package' must have a name followed by ';'. ~a is not allowed"
|
|
(format-out (get-tok next)))
|
|
srt (get-end next)))))
|
|
((IDENTIFIER)
|
|
(if (close-to-keyword? tok 'package)
|
|
(parse-error
|
|
(format "~a is close to 'package' but is either miscapitalized or mispelled" (token-value tok))
|
|
srt end)
|
|
(parse-program pre cur-tok 'start getter)))
|
|
(else
|
|
(parse-program pre cur-tok 'start getter))))
|
|
((semi-colon)
|
|
(case tokN
|
|
((EOF) (parse-error "'package' must have a name followed by a ';'" ps pe))
|
|
((SEMI_COLON) (parse-program cur-tok (getter) 'start getter))
|
|
(else (parse-error (format "'package' must have a name followed by a ';'. ~a is not allowed" out) ps end)))))))
|
|
|
|
|
|
;parse-program: token token symbol (-> token) -> (U void bool)
|
|
(define (parse-program pre cur-tok state getter)
|
|
;(printf "parse-program state: ~a pre: ~a cur-tok:~a~n" state pre cur-tok)
|
|
(let* ((tok (get-tok cur-tok))
|
|
(tokN (get-token-name tok))
|
|
(srt (get-start cur-tok))
|
|
(end (get-end cur-tok))
|
|
(out (format-out tok))
|
|
(ps (if (null? pre) null (get-start pre)))
|
|
(pe (if (null? pre) null (get-end pre))))
|
|
(case state
|
|
((start)
|
|
(case tokN
|
|
((EOF) #t)
|
|
((import)
|
|
(let ((next (getter)))
|
|
(if (id-token? (get-tok next))
|
|
(let ((after-id (getter)))
|
|
(cond
|
|
((dot? (get-tok after-id))
|
|
(parse-program cur-tok (parse-name (getter) getter #t) 'semi-colon getter))
|
|
((semi-colon? (get-tok after-id))
|
|
(parse-program after-id (getter) 'start getter))
|
|
(else
|
|
(parse-error
|
|
(format "'import' must have a name followed by ';'. ~a is not allowed"
|
|
(format-out (get-tok next)))
|
|
srt (get-end after-id)))))
|
|
(parse-error (format "'import' must have a name followed by ';'. ~a is not allowed" out)
|
|
srt (get-end next)))))
|
|
((IDENTIFIER)
|
|
(if (close-to-keyword? tok 'import)
|
|
(if (miscapitalized? tok "import")
|
|
(parse-error "keyword 'import' must be all lower-case letters, and here is not" srt end)
|
|
(parse-error
|
|
(format "~a is close to keyword 'import' but is mispelled" (token-value tok))
|
|
srt end))
|
|
(parse-definition pre cur-tok 'start getter)))
|
|
((INTERACTIONS_BOX TEST_SUITE) (parse-definition cur-tok (getter) 'start getter))
|
|
(else
|
|
(parse-definition pre cur-tok 'start getter))))
|
|
((semi-colon)
|
|
(case tokN
|
|
((EOF) (parse-error "'import' must have a name followed by a ';'" ps pe))
|
|
((SEMI_COLON) (parse-program cur-tok (getter) 'start getter))
|
|
((*)
|
|
(let ((after-star (getter)))
|
|
(cond
|
|
((semi-colon? (get-tok after-star)) (parse-program after-star (getter) 'start getter))
|
|
(else (parse-error (format "'import' must have a name followed by a ';'. ~a is not allowed"
|
|
(format-out (get-tok after-star))) ps (get-end after-star))))))
|
|
(else (parse-error (format "'import' must have a name followed by a ';'. ~a is not allowed" out) ps end)))))))
|
|
|
|
;parse-definition: token token symbol (-> token) -> void
|
|
(define (parse-definition pre cur-tok state getter)
|
|
;(printf "parse-definition state ~a pre: ~a cur-tok ~a~n" state pre cur-tok)
|
|
(let* ((tok (get-tok cur-tok))
|
|
(tokN (get-token-name tok))
|
|
(srt (get-start cur-tok))
|
|
(end (get-end cur-tok))
|
|
(out (format-out tok))
|
|
(ps (if (null? pre) null (get-start pre)))
|
|
(pe (if (null? pre) null (get-end pre))))
|
|
|
|
(case state
|
|
((start)
|
|
(case tokN
|
|
((EOF) #t)
|
|
((class) (parse-definition cur-tok (getter) 'class-id getter))
|
|
((abstract)
|
|
(if (beginner?)
|
|
(parse-error "Expected class or interface definition, 'abstract' not allowed here" srt end)
|
|
(let* ((next (getter))
|
|
(next-tok (get-tok next)))
|
|
(cond
|
|
((class? next-tok) (parse-definition cur-tok next state getter))
|
|
((eof? next-tok) (parse-error "abstract should be followed by class definition" srt end))
|
|
(else
|
|
(if (close-to-keyword? next-tok 'class)
|
|
(parse-error (format "expected 'class' after 'abstract', found ~a which is incorrectly spelled or capitalized"
|
|
(token-value next-tok))
|
|
srt
|
|
(get-end next))
|
|
(parse-error (format "abstract must be immediately followed by 'class' not ~a" (format-out next-tok))
|
|
srt
|
|
(get-end next))))))))
|
|
((interface)
|
|
;(if (or (intermediate?) (advanced?))
|
|
(parse-definition cur-tok (getter) 'interface-id getter)
|
|
;(parse-error (format "Expected class definition, found ~a which may not be written here" out) srt end)))
|
|
)
|
|
((public)
|
|
(if (advanced?)
|
|
(parse-definition cur-tok (getter) 'start getter)
|
|
(parse-error "Expected class definition, found 'public' which may not be written here" srt end)))
|
|
((INTERACTIONS_BOX TEST_SUITE CLASS_BOX) (parse-definition cur-tok (getter) 'start getter))
|
|
((import)
|
|
(parse-error "Expected class definition, found 'import', which may only appear at the top of a file" srt end))
|
|
((package)
|
|
(if (advanced?)
|
|
(parse-error "Expected class definition, found 'package' declaration. package must be the first item of a file" srt end)
|
|
(parse-error "Expected class definition, found 'package' which may not appear here" srt end)))
|
|
(else
|
|
(cond
|
|
((close-to-keyword? tok 'class)
|
|
(parse-error (format "expected 'class', found ~a which is incorrectly spelled or capitalized"
|
|
(token-value tok))
|
|
srt end))
|
|
((close-to-keyword? tok 'abstract)
|
|
(if (beginner?)
|
|
(parse-error (format "Excepted class or interface definition, found ~a" (token-value tok)) srt end)
|
|
(parse-error (format "Expected 'abstract class' or 'class', found ~a which is incorrectly spelled or capitalized"
|
|
(token-value tok))
|
|
srt end)))
|
|
((close-to-keyword? tok 'interface)
|
|
(parse-error (format "Expected 'interface' or 'class', found ~a which is incorrectly spelled or capitalized"
|
|
(token-value tok)) srt end))
|
|
((and (advanced?) (close-to-keyword? tok 'public))
|
|
(parse-error (string-append
|
|
(format
|
|
"Expected 'interface' or 'class'. Found ~a, which is close to 'public' which is allowed.~n"
|
|
(token-value tok))
|
|
"Check capitalization and spelling")
|
|
srt end))
|
|
((or (if-token? tok) (return-token? tok)
|
|
(and (advanced?) (or (for-token? tok) (while-token? tok) (do-token? tok))))
|
|
(parse-error (format "Expected class definition, found ~a. Statements must be in a method or interactions window" out)
|
|
srt end))
|
|
((prim-type? tok)
|
|
(parse-error (format "Expected class definition, found ~a. Fields and methods must be in a class body" out)
|
|
srt end))
|
|
((id-token? tok)
|
|
(parse-error (format "Expected class definition, found ~a. Fields, methods, and expressions may not be written here"
|
|
out) srt end))
|
|
(else
|
|
(parse-error (format "Expected class definition, found ~a which may not be written here" out)
|
|
srt end))))))
|
|
((class-id)
|
|
(case tokN
|
|
((EOF) (parse-error "'class' should be followed by a class name and body" ps pe))
|
|
((IDENTIFIER)
|
|
(let* ((next (getter))
|
|
(next-tok (get-tok next)))
|
|
(cond
|
|
((eof? next-tok) (parse-error (format "expected class body after ~a" (token-value tok)) srt end))
|
|
((and (extends? next-tok) (or (intermediate?) (advanced?)))
|
|
(parse-definition next (getter) 'extends getter))
|
|
((implements? next-tok)
|
|
(parse-definition next (getter) 'implements getter))
|
|
((o-brace? next-tok) (parse-definition cur-tok next 'class-body getter))
|
|
((and (or (intermediate?) (advanced?)) (close-to-keyword? next-tok 'extends) )
|
|
(parse-error (format "found ~a, which is similar to 'extends'" (token-value next-tok))
|
|
(get-start next) (get-end next)))
|
|
((close-to-keyword? next-tok 'implements)
|
|
(parse-error (format "found ~a, which is similar to 'implements'" (token-value next-tok))
|
|
(get-start next) (get-end next)))
|
|
((open-separator? next-tok)
|
|
(parse-error (format "expected { to begin class body, but found ~a" (format-out next-tok))
|
|
(get-start next) (get-end next)))
|
|
((c-brace? tok)
|
|
(parse-error (format "Class body must be opened with { before being closed, found ~a" out)
|
|
(get-start next) (get-end next)))
|
|
(else
|
|
(parse-error
|
|
(format "class name must be followed by ~a 'implements' or a { to start class body, found ~a"
|
|
(if (not (beginner?)) "'extends' clause or " "")
|
|
(format-out next-tok)) srt (get-end next))))))
|
|
(else
|
|
(if (java-keyword? tok)
|
|
(parse-error (format "class may not be called ~a as this is a reserved term" tokN) srt end)
|
|
(parse-error (format "expected a name for this class, given ~a" out) srt end)))))
|
|
((interface-id)
|
|
(case tokN
|
|
((EOF) (parse-error "'interface' should be followed by an interface name and body" ps pe))
|
|
((IDENTIFIER)
|
|
(let* ((next (getter))
|
|
(next-tok (get-tok next)))
|
|
(cond
|
|
((eof? next-tok) (parse-error (format "Expected interface body after ~a" (token-value tok)) srt end))
|
|
((extends? next-tok)
|
|
(if (beginner?)
|
|
(parse-error "Expected '{' to begin interface body, found 'extends' which is not allowed here"
|
|
(get-start next) (get-end next))
|
|
(parse-definition next (getter) 'iface-extends getter)))
|
|
((o-brace? next-tok) (parse-definition cur-tok next 'iface-body getter))
|
|
((close-to-keyword? next-tok 'extends)
|
|
(if (beginner?)
|
|
(parse-error (format "Expected '{' to begin interface body, ~a cannot appear here" (token-value next-tok))
|
|
(get-start next) (get-end next))
|
|
(parse-error (format "found ~a, which is similar to 'extends'" (token-value next-tok))
|
|
(get-start next) (get-end next))))
|
|
((open-separator? next-tok)
|
|
(parse-error (format "Expected { to begin interface body, but found ~a" (format-out next-tok))
|
|
(get-start next) (get-end next)))
|
|
((c-brace? next-tok)
|
|
(parse-error (format "Interface body must be opened with { before being closed, found ~a"
|
|
(format-out next-tok)) (get-start next) (get-end next)))
|
|
((implements? next-tok)
|
|
(parse-error "Interfaces may not implement other interfaces" ps (get-end next)))
|
|
(else
|
|
(parse-error (format "Interface name must be follwed by 'extends' or a { to start its body, found ~a"
|
|
(format-out next-tok)) srt (get-end next))))))
|
|
(else
|
|
(if (java-keyword? tok)
|
|
(parse-error (format "interface may not be called ~a, as this is a reserved term" tokN) srt end)
|
|
(parse-error (format "Expected a name for this interface, given ~a" out) srt end)))))
|
|
((extends)
|
|
(cond
|
|
((eof? tok) (parse-error "Expected parent class after extends" ps pe))
|
|
((id-token? tok)
|
|
;(if (beginner?)
|
|
; (parse-definition cur-tok (getter) 'class-body getter)
|
|
(let* ((next (getter))
|
|
(next-tok (get-tok next)))
|
|
(cond
|
|
((implements? next-tok) (parse-definition next (getter) 'implements getter))
|
|
((close-to-keyword? next-tok 'implements)
|
|
(parse-error (format "Expected 'implements', found ~a which is close to 'implements'" (token-value next-tok))
|
|
(get-start next) (get-end next)))
|
|
(else (parse-definition cur-tok next 'class-body getter)))))
|
|
((o-brace? tok) (parse-error "Expected a parent name after extends and before the class body starts" srt end))
|
|
((java-keyword? tok)
|
|
(parse-error (format "Expected a name after extends, found reserved word ~a" tokN) srt end))
|
|
(else (parse-error (format "extends must be followed by parent name, found ~a" out) ps end))))
|
|
;Intermediate
|
|
((implements)
|
|
(cond
|
|
((eof? tok) (parse-error "Expected implemented interface after implements, and class body" ps pe))
|
|
((id-token? tok)
|
|
(let* ((next (getter))
|
|
(next-tok (get-tok next)))
|
|
(cond
|
|
((eof? next-tok) (parse-error "Expected more implemented interfaces or class body" srt end))
|
|
((comma? next-tok)
|
|
(if (beginner?)
|
|
(parse-error "Only one interface may be implemented, found ',' which should not appear here"
|
|
(get-start next) (get-end next))
|
|
(parse-definition next (getter) 'implements-list getter)))
|
|
((o-brace? next-tok) (parse-definition cur-tok next 'class-body getter))
|
|
((id-token? next-tok)
|
|
(parse-error "Implemented interfaces must be separated by a comma" srt (get-end next)))
|
|
(else (parse-error (format "Expected more interfaces or the class body, found ~a" (format-out next-tok))
|
|
(get-start next) (get-end next))))))
|
|
((java-keyword? tok)
|
|
(parse-error (format "Expected an interface name, which may not be reserved word ~a" tokN) srt end))
|
|
(else (parse-error (format "Expected an interface name, found ~a" out) srt end))))
|
|
;Intermediate
|
|
((implements-list)
|
|
(cond
|
|
((eof? tok) (parse-error "Expected an interface name and class body" ps pe))
|
|
((id-token? tok)
|
|
(let* ((next (getter))
|
|
(next-tok (get-tok next)))
|
|
(cond
|
|
((eof? next-tok) (parse-error "Expected more interfaces or a class body" srt end))
|
|
((comma? next-tok) (parse-definition next (getter) 'implements-list getter))
|
|
((o-brace? next-tok) (parse-definition cur-tok next 'class-body getter))
|
|
((id-token? next-tok) (parse-error "Implemented interfaces must be separated by a comma" srt (get-end next)))
|
|
(else (parse-error (format "Expected more interfaces or the class body, found ~a" (format-out next-tok))
|
|
(get-start next) (get-end next))))))
|
|
((java-keyword? tok)
|
|
(parse-error (format "Expected an interface name for implements clause, found reserved term ~a" tokN) srt end))
|
|
((o-brace? tok)
|
|
(parse-error "Expected an additional interface after comma before { to start class body" ps end))
|
|
(else (parse-error (format "Expected an interface name, found ~a" out) srt end))))
|
|
;Intermediate
|
|
((iface-extends)
|
|
(cond
|
|
((eof? tok) (parse-error "Expected interface name to extend after extends, and interface body" ps pe))
|
|
((id-token? tok)
|
|
(let* ((next (getter))
|
|
(next-tok (get-tok next)))
|
|
(cond
|
|
((eof? next-tok) (parse-error "Expected more extended interfaces or interface body" srt end))
|
|
((comma? next-tok) (parse-definition next (getter) 'iface-extends-list getter))
|
|
((o-brace? next-tok) (parse-definition cur-tok next 'iface-body getter))
|
|
((implements? next-tok)
|
|
(parse-error "An interface may not implement other interfaces" (get-start next) (get-end next)))
|
|
((id-token? next-tok) (parse-error "Extended interfaces must be separated by a comma" srt (get-end next)))
|
|
(else
|
|
(parse-error (format "Expected more interfaces to extend of interface body, found ~a" (format-out next-tok))
|
|
(get-start next) (get-end next))))))
|
|
((java-keyword? tok)
|
|
(parse-error (format "Expected a name of an interface to extend, found reserved term ~a, which cannot be a name"
|
|
tokN) srt end))
|
|
(else
|
|
(parse-error (format "Expected a name of an interface to extend, found ~a" out) srt end))))
|
|
;Intermediate
|
|
((iface-extends-list)
|
|
(cond
|
|
((eof? tok) (parse-error "Expected interface name to extend after comma, and interface body" ps pe))
|
|
((id-token? tok)
|
|
(let* ((next (getter))
|
|
(next-tok (get-tok next)))
|
|
(cond
|
|
((eof? next-tok) (parse-error "Expected more interfaces or an interface body" srt end))
|
|
((comma? next-tok) (parse-definition next (getter) 'iface-extends-list getter))
|
|
((o-brace? next-tok) (parse-definition cur-tok next 'iface-body getter))
|
|
((id-token? next-tok) (parse-error "Extended interfaces must be separated by a comma" srt (get-end next)))
|
|
(else (parse-error (format "Expected more interfaces or the interface body, found ~a" (format-out next-tok))
|
|
(get-start next) (get-end next))))))
|
|
((java-keyword? tok)
|
|
(parse-error (format "Expected an interface name for extends clause, found reserved term ~a" tokN) srt end))
|
|
((o-brace? tok)
|
|
(parse-error "Expected an additional interface after comma before { to start interface body" ps end))
|
|
(else (parse-error (format "Expected an interface name, found ~a" out) srt end))))
|
|
((class-body)
|
|
(case tokN
|
|
((EOF) (parse-error (format "Expected class body to begin after ~a" (format-out (get-tok pre))) ps pe))
|
|
((O_BRACE) (parse-definition cur-tok (parse-members cur-tok (getter) 'start getter #f #f) 'class-body-end getter))
|
|
(else
|
|
(cond
|
|
((open-separator? tok)
|
|
(parse-error (format "expected { to begin class body, but found ~a" out) srt end))
|
|
((close-separator? tok)
|
|
(parse-error (format "Class body must be opened with { before being closed, found ~a" out) srt end))
|
|
(else
|
|
(parse-error (format "Expected { to start class body, found ~a" out) srt end))))))
|
|
((class-body-end)
|
|
(case tokN
|
|
((EOF) (parse-error "Expected a } to close class body" ps pe))
|
|
((C_BRACE)
|
|
(let ((next (getter)))
|
|
(if (c-brace? (get-tok next))
|
|
(parse-error "Unnecessary }, class body already closed" srt (get-end next))
|
|
(parse-definition cur-tok next 'start getter))))
|
|
(else (parse-error (format "Expected a } to close class body, found ~a" out) ps end))))
|
|
((iface-body)
|
|
(case tokN
|
|
((EOF) (parse-error (format "Expected interface body to begin after ~a" (format-out (get-tok pre))) ps pe))
|
|
((O_BRACE) (parse-definition cur-tok (parse-iface-body null (getter) 'start getter) 'iface-body-end getter))
|
|
(else
|
|
(cond
|
|
((open-separator? tok)
|
|
(parse-error (format "Expected { to begne interface body, but found ~a" out) srt end))
|
|
((close-separator? tok)
|
|
(parse-error (format "Interface body must be opened with { before being closed, found ~a" out) srt end))
|
|
(else (parse-error (format "Expected { to start interface body, found ~a" out) srt end))))))
|
|
((iface-body-end)
|
|
(case tokN
|
|
((EOF) (parse-error "Expected a } to close interface body" ps pe))
|
|
((C_BRACE)
|
|
(let ((next (getter)))
|
|
(if (c-brace? (get-tok next))
|
|
(parse-error "Unnecessary }, interface body is already closed" srt (get-end next))
|
|
(parse-definition cur-tok next 'start getter))))
|
|
(else (parse-error (format "Expected a } to close interface body, found ~a" out) ps end)))))))
|
|
|
|
;parse-type: token token symbol (->token) -> void
|
|
(define (parse-type pre cur state getter)
|
|
(let* ((tok (get-tok cur))
|
|
(kind (get-token-name tok))
|
|
(out (format-out tok))
|
|
(srt (get-start cur))
|
|
(end (get-end cur))
|
|
(ps (if (null? pre) null (get-start pre)))
|
|
(pe (if (null? pre) null (get-end pre))))
|
|
(case state
|
|
((start)
|
|
(cond
|
|
((eof? tok) (parse-error "Expected a type, found nothing" srt end))
|
|
((prim-type? tok) (parse-type cur (getter) 'end-or-array getter))
|
|
((id-token? tok) (parse-type cur (getter) 'qualified-or-array getter))
|
|
;I can do better here: expand close-to-keyword to specify close to which type of keyword
|
|
(else
|
|
(parse-error (format "Expected a type, found ~a, which is not the valid beginning of a type" out)
|
|
srt end))))
|
|
((end-or-array)
|
|
(cond
|
|
((dot? tok) (parse-error (format "'.' cannot follow primitive type ~a in a type declaration"
|
|
(format-out (get-tok pre))) ps end))
|
|
((and (advanced?) (o-bracket? tok))
|
|
(parse-type pre (getter) 'array-close getter))
|
|
(else
|
|
(parse-error
|
|
(format "Only one item may appear in a type declaration, ~a is a complete type, ~a maynot appear"
|
|
(format-out (get-tok pre)) out) ps end))))
|
|
((qualified-or-array)
|
|
(cond
|
|
((dot? tok)
|
|
(parse-error "This type declaration maynot contain a '.'" ps end))
|
|
((and (advanced?) (o-bracket? tok))
|
|
(parse-type pre (getter) 'array-close getter))
|
|
(else
|
|
(parse-error
|
|
(format "Only one item may appear in a type declaration, ~a appears to be a complete type, ~a maynot appear"
|
|
(format-out (get-tok pre)) out) ps end))))
|
|
((array-close)
|
|
(cond
|
|
((c-bracket? tok)
|
|
(let ((next (getter)))
|
|
(cond
|
|
((o-bracket? (get-tok next))
|
|
(parse-type next (getter) 'array-close getter))
|
|
(else
|
|
(parse-error
|
|
(format "Only one type may appear in a type declaration, ] appears to complete the type, ~a maynot appear"
|
|
(format-out (get-tok next)))
|
|
ps (get-end next))))))
|
|
(else
|
|
(parse-error
|
|
(format "Expected a ] to close the array type, found ~a, which maynot appear here" out) ps end)))))))
|
|
|
|
;parse-members: token token symbol (->token) boolean -> token
|
|
(define (parse-members pre cur state getter abstract-method? just-method?)
|
|
;(printf "parse-members: state ~a pre ~a current ~a~n" state pre cur)
|
|
(let* ((tok (get-tok cur))
|
|
(kind (get-token-name tok))
|
|
(out (format-out tok))
|
|
(srt (get-start cur))
|
|
(end (get-end cur))
|
|
(ps (if (null? pre) null (get-start pre)))
|
|
(pe (if (null? pre) null (get-end pre))))
|
|
|
|
(case state
|
|
((start)
|
|
(cond
|
|
((eof? tok) cur)
|
|
((and (c-brace? tok) (not just-method?)) cur)
|
|
((and (c-brace? tok) just-method?) (parse-error "Encountered extra }" srt end))
|
|
((and (or (intermediate?) (advanced?)) (abstract? tok))
|
|
(parse-members cur (getter) 'method getter #t just-method?))
|
|
((prim-type? tok) (parse-members cur (getter) 'method-or-field getter #f just-method?))
|
|
;Intermediate & Advanced
|
|
((and (or (intermediate?) (advanced?)) (void-token? tok)) (parse-members cur (getter) 'method-id getter #f just-method?))
|
|
((id-token? tok) (parse-members cur (getter) 'member getter #f just-method?))
|
|
;Advanced
|
|
((and (advanced?)
|
|
(or (public? tok) (private? tok) (protected? tok) (static? tok) (final? tok)))
|
|
(parse-members cur (getter) 'start getter #f just-method?))
|
|
;Advanced
|
|
((and (advanced?) (o-brace? tok))
|
|
(if (modifier-token? (get-tok pre))
|
|
(parse-error (format "Initilization body may not be preceeded with any modifier. Found ~a"
|
|
(format-out (get-tok pre))) ps end)
|
|
(parse-members cur (parse-statement pre cur 'start getter #t #f #f) 'start getter #f just-method?)))
|
|
(else
|
|
(parse-error
|
|
(format "Only fields, methods and a constructor may be within the class body, found ~a" out) srt end))))
|
|
((member)
|
|
(cond
|
|
((eof? tok) (parse-error "This class may not end here, class body still requires a }" ps pe))
|
|
((dot? tok)
|
|
(if (beginner?)
|
|
(parse-error "The name of a type or class may not contain a '.'" ps end)
|
|
(parse-members cur (parse-name (getter) getter #f) 'method-or-field getter abstract-method? just-method?)))
|
|
((id-token? tok) (parse-members pre cur 'method-or-field getter abstract-method? just-method?))
|
|
((o-paren? tok) (parse-members cur (getter) 'ctor-parms getter abstract-method? just-method?))
|
|
((c-paren? tok) (parse-error "( must precede ) in parameter list" srt end))
|
|
((and (advanced?) (o-bracket? tok))
|
|
(parse-members pre cur 'method-or-field getter abstract-method? just-method?))
|
|
((open-separator? tok)
|
|
(parse-error (format "( must be used to start parameter list, found ~a" out) srt end))
|
|
((prim-type? tok)
|
|
(parse-error
|
|
(format "methods and fields may not be named for primitive type ~a, which appears in the name position" kind)
|
|
srt end))
|
|
((java-keyword? tok)
|
|
(parse-error
|
|
(format "Expected a name for this field or method, ~a is a reserved word and cannot be the name" kind)
|
|
srt end))
|
|
(else (parse-error (format "Expected a name for this field or method, found ~a" out) srt end))))
|
|
((method-or-field)
|
|
(case kind
|
|
((EOF) (parse-error "Method or field must have a name, class body still requires a }" ps pe))
|
|
((IDENTIFIER)
|
|
(let* ((next (getter))
|
|
(n-tok (get-tok next))
|
|
(n-out (format-out n-tok))
|
|
(ne (get-end next)))
|
|
(cond
|
|
((eof? n-tok)
|
|
(parse-error "Method or field has not completed, class body still requires a }" srt end))
|
|
;Just ended a field
|
|
((semi-colon? n-tok) (parse-members next (getter) 'start getter #f just-method?))
|
|
;Intermediate and Advanced
|
|
((comma? n-tok)
|
|
(if (or (intermediate?) (advanced?))
|
|
(parse-members next (getter) 'field-list getter abstract-method? just-method?)
|
|
(parse-error (format "Expected an end to field ~a, fields end in ';', ',' is not allowed" (token-value tok))
|
|
srt ne)))
|
|
((and #;(or (intermediate?) (advanced?)) (teaching-assignment-operator? n-tok))
|
|
(let ((assign-exp (getter)))
|
|
(cond
|
|
((eof? (get-tok assign-exp))
|
|
(parse-error (format "Expected an expression to bind to ~a, and class body still needs a }"
|
|
(token-value tok)) srt end))
|
|
((and (advanced?) (o-brace? (get-tok assign-exp)))
|
|
(parse-members next (parse-array-init assign-exp (getter) 'start getter) 'field-init-end getter #f just-method?))
|
|
(else
|
|
(parse-members next (parse-expression null assign-exp 'start getter #f #f) 'field-init-end getter #f just-method?)))))
|
|
((o-paren? n-tok) (parse-members next (getter) 'method-parms getter abstract-method? just-method?))
|
|
((open-separator? n-tok)
|
|
(parse-error (format "Method parameters must begin with ( found ~a" n-out) srt ne))
|
|
((id-token? n-tok)
|
|
(if (and (id-token? (get-tok pre))
|
|
(close-to-keyword? (get-tok pre) 'abstract))
|
|
(parse-error
|
|
(string-append
|
|
(format "Incorrectly formed field or method declaration.~n")
|
|
(format
|
|
"~a is close to 'abstract' but miscapitalized or misspelled, and might make this a method declaration.~n"
|
|
(format-out (get-tok pre)))
|
|
"Otherwise, "
|
|
(if (or (intermediate?) (advanced?))
|
|
(format "Fields must be separated by commas, method paramters must be in ()s, ~a not allowed" n-out)
|
|
(format "Fields must be separatley declared, method paramters must be in ()s, ~a not allowed" n-out)))
|
|
ps ne)
|
|
(parse-error
|
|
(if (or (intermediate?) (advanced?))
|
|
(format "Fields must be separated by commas, method paramters must be in ()s, ~a not allowed" n-out)
|
|
(format "Fields must be separatley declared, method paramters must be in ()s, ~a not allowed" n-out))
|
|
srt ne)))
|
|
(else
|
|
(if (or (intermediate?) (advanced?))
|
|
(parse-error
|
|
(format "Expected ';' to end field or abstract method parameter list, found ~a" n-out) srt ne)
|
|
(parse-error
|
|
(format "Expected ';' to end field. Found ~a" n-out) srt ne))))))
|
|
(else
|
|
(if (and (advanced?) (o-bracket? tok))
|
|
(let* ((next (getter))
|
|
(next-tok (get-tok next)))
|
|
(cond
|
|
((eof? next-tok) (parse-error "Expected ] to end array type, and class still requires a }" srt end))
|
|
((c-bracket? next-tok) (parse-members next (getter) 'method-or-field getter abstract-method? just-method?))
|
|
((o-bracket? next-tok)
|
|
(parse-error "Array type may not have [[. A closing ] is required before beginning a new []"
|
|
srt (get-end next)))
|
|
(else
|
|
(parse-error (format "Array type is of the form type[]. ~a is not allowed" (format-out next-tok)) srt
|
|
(get-end next)))))
|
|
(parse-error
|
|
(if (java-keyword? tok)
|
|
(format "Expected a name for this field or method, cannot be named reserved word ~a" kind)
|
|
(format "Expected a name for this field or method, found ~a" out))
|
|
srt end)))))
|
|
;Intermediate
|
|
((field-list)
|
|
(case kind
|
|
((EOF) (parse-error "Expected an additional field name after comma, class body still requires a }" ps pe))
|
|
((IDENTIFIER)
|
|
(let* ((next (getter))
|
|
(n-tok (get-tok next))
|
|
(n-out (format-out n-tok))
|
|
(ne (get-end next)))
|
|
(cond
|
|
((eof? n-tok) (parse-error "Field has not completed, class body still requires a }" srt end))
|
|
((semi-colon? n-tok) (parse-members next (getter) 'start getter #f just-method?))
|
|
((comma? n-tok) (parse-members next (getter) 'field-list getter #f just-method?))
|
|
((teaching-assignment-operator? n-tok)
|
|
(let ((assign-exp (getter)))
|
|
(cond
|
|
((eof? (get-tok assign-exp))
|
|
(parse-error (format "Expected an expression to bind to ~a, and class body still needs a }"
|
|
(token-value tok)) srt end))
|
|
((and (advanced?) (o-brace? (get-tok assign-exp)))
|
|
(parse-members next (parse-array-init assign-exp (getter) 'start getter) 'field-init-end getter #f just-method?))
|
|
(else
|
|
(parse-members next (parse-expression null assign-exp 'start getter #f #f) 'field-init-end getter #f just-method?)))))
|
|
((id-token? n-tok)
|
|
(parse-error (format "Fields must be separated by commas, ~a not allowed" n-out) srt ne))
|
|
(else (parse-error (format "Expected ; to end field, or more field names, found ~a" n-out) srt ne)))))
|
|
(else
|
|
(parse-error
|
|
(if (java-keyword? tok)
|
|
(format "Expected a name for this field, cannot be named reseved word ~a" kind)
|
|
(format "Expected a name for this field, found ~a" out)) srt end))))
|
|
;Intermediate
|
|
((field-init-end)
|
|
(case kind
|
|
((EOF) (parse-error "Expected a ';' or comma after field, class body still requires a }" ps pe))
|
|
((COMMA) (parse-members cur (getter) 'field-list getter #f just-method?))
|
|
((SEMI_COLON) (parse-members cur (getter) 'start getter #f just-method?))
|
|
((IDENTIFIER) (parse-error (format "Fields must be separated by commas, ~a not allowed" out) srt end))
|
|
(else
|
|
(parse-error
|
|
(if (beginner?)
|
|
(format "Expected a ';' to end the field, found ~a" out)
|
|
(format "Expected a ; to end field, or more field names, found ~a" out)) srt end))))
|
|
((method)
|
|
(cond
|
|
((eof? tok) (parse-error "Expected method, and class body still requires a }" ps pe))
|
|
((or (prim-type? tok) (and (or (intermediate?) (advanced?)) (void-token? tok)))
|
|
(parse-members cur (getter) 'method-id getter abstract-method? just-method?))
|
|
((id-token? tok)
|
|
(let* ((next (getter))
|
|
(next-tok (get-tok next))
|
|
(next-kind (get-token-name next-tok))
|
|
(next-end (get-end next))
|
|
(next-start (get-start next)))
|
|
(cond
|
|
((eof? next-tok) (parse-error "Expected method name, and class body still requires a }" srt end))
|
|
((dot? next-tok)
|
|
(if (beginner?)
|
|
(parse-error "The name of a type or class may not contain '.'" srt next-end)
|
|
(parse-members next (parse-name (getter) getter #f) 'method-id getter abstract-method? just-method?)))
|
|
((o-paren? next-tok)
|
|
(parse-error "Declaration is similar to constructor, which cannot be abstract" ps next-end))
|
|
((semi-colon? next-tok)
|
|
(parse-error "Declaration is similar to a field, which cannot be abstract" ps next-end))
|
|
((id-token? next-tok) (parse-members cur next 'method-id getter abstract-method? just-method?))
|
|
((java-keyword? next-tok)
|
|
(parse-error
|
|
(format "Expected method name, found ~a which is reserved and cannot be a method's name" next-kind)
|
|
next-start next-end))
|
|
(else (parse-error (format "Expected a method name, found ~a" (format-out next-tok))
|
|
next-start next-end)))))
|
|
((java-keyword? tok)
|
|
(parse-error
|
|
(format "Expected return type of the method, reserved word ~a is not a type" kind) srt end))
|
|
(else (parse-error (format "Expected return type of a method, found ~a" out) srt end))))
|
|
((method-id)
|
|
(case kind
|
|
((EOF) (parse-error "Expected method name, and class body still requires a }" ps pe))
|
|
((IDENTIFIER)
|
|
(let* ((next (getter))
|
|
(next-tok (get-tok next))
|
|
(next-out (format-out next-tok))
|
|
(next-start (get-start next))
|
|
(next-end (get-end next)))
|
|
(cond
|
|
((eof? next-tok) (parse-error "Expected method body, and class body still requires a }" srt end))
|
|
((o-paren? next-tok) (parse-members next (getter) 'method-parms getter abstract-method? just-method?))
|
|
((c-paren? next-tok)
|
|
(parse-error "Expected a ( to start parameter list but encountered the closing )" next-start next-end))
|
|
((semi-colon? next-tok)
|
|
(parse-error "Declaration is similar to a field, which cannot be abstract" ps next-end))
|
|
((open-separator? next-tok)
|
|
(parse-error (format "Method parameter list is started by (, found ~a" next-out) next-start next-end))
|
|
(else (parse-error (format "Expected ( for parameter list, found ~a" next-out) next-start next-end)))))
|
|
(else
|
|
(if (java-keyword? tok)
|
|
(parse-error
|
|
(format "Expected method name, found ~a which is reserved and cannot be a method's name" kind)
|
|
srt end)
|
|
(parse-error (format "Expected method name, found ~a" out) srt end)))))
|
|
((ctor-parms)
|
|
(cond
|
|
((eof? tok) (parse-error "Expected constructor parameters, and class body still requires a }" ps pe))
|
|
((o-paren? tok)
|
|
(parse-error "Constructor parameter list already started, an additional ( is not needed" srt end))
|
|
((c-paren? tok)
|
|
(let* ((next (getter))
|
|
(next-tok (get-tok next))
|
|
(next-out (format-out next-tok))
|
|
(next-start (get-start next))
|
|
(next-end (get-end next)))
|
|
(cond
|
|
((eof? next-tok)
|
|
(parse-error "Expected constructor body, and class body still requires a }" srt end))
|
|
((c-paren? next-tok)
|
|
(parse-error "Constructor parameter list already closed, unneeded )" next-start next-end))
|
|
((o-brace? next-tok)
|
|
(parse-members next (parse-ctor-body null (getter) getter) 'ctor-end getter #f just-method?))
|
|
((open-separator? next-tok)
|
|
(parse-error (format "Constructor body begins with a {, found ~a" next-out) next-start next-end))
|
|
((semi-colon? next-tok)
|
|
(parse-error "Expected a constructor body, ; is only allowed for abstract methods" next-start next-end))
|
|
(else
|
|
(parse-error (format "Expected a constructor body, starting with {, found ~a" next-out) next-start next-end)))))
|
|
((or (prim-type? tok) (id-token? tok))
|
|
(let* ((next (getter))
|
|
(next-tok (get-tok next))
|
|
(next-start (get-start next))
|
|
(next-end (get-end next)))
|
|
(cond
|
|
((eof? next-tok)
|
|
(parse-error "Expected rest of parameter list, and class body still requires a }" srt end))
|
|
((comma? next-tok) (parse-error "Variable name must follow type before ," srt next-end))
|
|
((c-paren? next-tok) (parse-error "Variable name must follow type before )" srt next-end))
|
|
((id-token? next-tok)
|
|
(let* ((afterID (getter))
|
|
(afterID-tok (get-tok afterID)))
|
|
(cond
|
|
((eof? afterID-tok)
|
|
(parse-error "Expected rest of parameter list, and class body requires a }" next-start next-end))
|
|
((c-paren? afterID-tok) (parse-members next afterID 'ctor-parms getter #f just-method?))
|
|
((close-separator? afterID-tok)
|
|
(parse-error (format "Expected a ) to close parameter list, found ~a" (format-out afterID-tok))
|
|
(get-start afterID) (get-end afterID)))
|
|
((comma? afterID-tok)
|
|
(let* ((afterC (getter))
|
|
(afterC-tok (get-tok afterC)))
|
|
(cond
|
|
((eof? afterC-tok) (parse-error "Expected rest of parameter list, and class body requires a }"
|
|
(get-start afterID) (get-end afterID)))
|
|
((c-paren? afterC-tok)
|
|
(parse-error "Comma is unneeded before ) unless another variable is desired"
|
|
(get-start afterID) (get-end afterC)))
|
|
((comma? afterC-tok)
|
|
(parse-error "Parameter list should not have ,, Only one is needed"
|
|
(get-start afterID) (get-end afterC)))
|
|
(else (parse-members afterID afterC 'ctor-parms getter #f just-method?)))))
|
|
((or (prim-type? afterID-tok) (id-token? afterID-tok))
|
|
(parse-error (format "~a begins a new parameter. A , is needed in between parameters"
|
|
(if (prim-type? afterID-tok) (get-token-name afterID-tok) (token-value afterID-tok)))
|
|
next-start (get-end afterID)))
|
|
(else (parse-error (format "Expected , or ) in parameter list found ~a" (format-out afterID-tok))
|
|
(get-start afterID) (get-end afterID))))))
|
|
((java-keyword? next-tok)
|
|
(parse-error (format "Expected variable name after type, found reserved word ~a, which cannot be a name"
|
|
(get-token-name next-tok))
|
|
next-start next-end))
|
|
((and (advanced?) (o-bracket? next-tok))
|
|
(parse-members cur next 'array-type getter #f just-method?))
|
|
(else (parse-error (format "Expected new parameter name after type, found ~a" (format-out next-tok))
|
|
next-start next-end)))))
|
|
((java-keyword? tok)
|
|
(parse-error (format "Expected type name, reserved word ~a is not a type" kind) srt end))
|
|
(else (parse-error (format "Expected a parameter or ), found ~a" out) srt end))))
|
|
((array-type)
|
|
(case kind
|
|
((EOF) (parse-error "Expected remainder of constructor parameters" ps pe))
|
|
((O_BRACKET)
|
|
(let* ((next (getter))
|
|
(next-tok (get-tok next)))
|
|
(cond
|
|
((eof? next-tok) (parse-error "Expected remainder of array type" srt end))
|
|
((c-bracket? next-tok) (parse-members next (getter) 'array-type getter #f just-method?))
|
|
(else
|
|
(parse-error (format "Expected ']' to close array type, found ~a which is not allowed"
|
|
(format-out next-tok))
|
|
srt (get-end next))))))
|
|
((COMMA) (parse-error "Expected new paramter name after type, found ','" srt end))
|
|
((IDENTIFIER)
|
|
(let* ((next (getter))
|
|
(next-tok (get-tok next)))
|
|
(cond
|
|
((eof? next-tok) (parse-error "Expected ')' to close parameter list, or more parameters" srt end))
|
|
|
|
((comma? next-tok)
|
|
(let* ((afterC (getter))
|
|
(afterC-tok (get-tok afterC)))
|
|
(cond
|
|
((eof? afterC-tok) (parse-error "Expected rest of parameter list for constructor"
|
|
(get-start next) (get-end next)))
|
|
((c-paren? afterC-tok)
|
|
(parse-error "Comma is unneeded before ) unless another variable is desired"
|
|
(get-start next) (get-end afterC)))
|
|
((comma? afterC-tok)
|
|
(parse-error "Parameter list should not have ,, Only one is needed"
|
|
(get-start next) (get-end afterC)))
|
|
(else (parse-members next afterC 'ctor-parms getter #f just-method?)))))
|
|
((c-paren? next-tok) (parse-members cur next 'ctor-parms getter #f just-method?))
|
|
(else (parse-error (format "Expected ',' or ')' in parameters found ~a which is not allowed"
|
|
(format-out next-tok))
|
|
srt (get-end next))))))
|
|
(else
|
|
(parse-error (format "Expected parameter name after type, found ~a" out) srt end))))
|
|
((method-array-type)
|
|
(case kind
|
|
((EOF) (parse-error "Expected remainder of method parameters" ps pe))
|
|
((O_BRACKET)
|
|
(let* ((next (getter))
|
|
(next-tok (get-tok next)))
|
|
(cond
|
|
((eof? next-tok) (parse-error "Expected remainder of array type" srt end))
|
|
((c-bracket? next-tok) (parse-members cur (getter) 'method-array-type getter abstract-method? just-method?))
|
|
(else
|
|
(parse-error (format "Expected ']' to close array type, found ~a which is not allowed"
|
|
(format-out next-tok))
|
|
srt (get-end next))))))
|
|
((COMMA) (parse-error "Expected new paramter name after type, found ','" srt end))
|
|
((IDENTIFIER)
|
|
(let* ((next (getter))
|
|
(next-tok (get-tok next)))
|
|
(cond
|
|
((eof? next-tok) (parse-error "Expected ')' to close parameter list, or more parameters" srt end))
|
|
|
|
((comma? next-tok)
|
|
(let* ((afterC (getter))
|
|
(afterC-tok (get-tok afterC)))
|
|
(cond
|
|
((eof? afterC-tok) (parse-error "Expected rest of parameter list for method"
|
|
(get-start next) (get-end next)))
|
|
((c-paren? afterC-tok)
|
|
(parse-error "Comma is unneeded before ) unless another variable is desired"
|
|
(get-start next) (get-end afterC)))
|
|
((comma? afterC-tok)
|
|
(parse-error "Parameter list should not have ,, Only one is needed"
|
|
(get-start next) (get-end afterC)))
|
|
(else (parse-members next afterC 'method-parms getter abstract-method? just-method?)))))
|
|
((c-paren? next-tok) (parse-members cur next 'method-parms getter abstract-method? just-method?))
|
|
(else (parse-error (format "Expected ',' or ')' in parameters found ~a which is not allowed"
|
|
(format-out next-tok))
|
|
srt (get-end next))))))
|
|
(else
|
|
(parse-error (format "Expected parameter name after type, found ~a" out) srt end))))
|
|
((method-parms)
|
|
(cond
|
|
((eof? tok) (parse-error "Expceted method parameters, and class body still requires }" ps pe))
|
|
((o-paren? tok)
|
|
(parse-error "Method parameter list already started, an additional ( is not needed" srt end))
|
|
((c-paren? tok)
|
|
(let* ((next (getter))
|
|
(next-tok (get-tok next))
|
|
(next-out (format-out next-tok))
|
|
(next-start (get-start next))
|
|
(next-end (get-end next)))
|
|
(cond
|
|
((eof? next-tok)
|
|
(parse-error "Expected method body, and class body still requires a '}'" srt end))
|
|
((c-paren? next-tok)
|
|
(parse-error "Method parameter list already closed, unneeded ')'" next-start next-end))
|
|
((o-brace? next-tok)
|
|
(if abstract-method?
|
|
(parse-error "abstract methods may not have a body. Found '{' when ';' was expected" next-start next-end)
|
|
(parse-members next (if (or (intermediate?) (advanced?))
|
|
(parse-method-body null (getter) getter #f #f)
|
|
(parse-statement null (getter) 'start getter #f #f #f))
|
|
'method-end getter abstract-method? just-method?)))
|
|
((open-separator? next-tok)
|
|
(if abstract-method?
|
|
(parse-error (format "abstract methods should end with ';', found ~a" next-out) next-start next-end)
|
|
(parse-error (format "Method body begins with a '{', found ~a" next-out) next-start next-end)))
|
|
((semi-colon? next-tok)
|
|
(cond
|
|
((or (beginner?) (not abstract-method?))
|
|
(parse-error "Method must have a body, beginning with '{'. ';' not allowed" next-start next-end))
|
|
(else (parse-members next (getter) 'start getter #f just-method?))))
|
|
(else
|
|
(if abstract-method?
|
|
(parse-error (format "Expected a ';' to end abstract method, found ~a" next-out) next-start next-end)
|
|
(parse-error (format "Expected a method body, starting with '{', found ~a" next-out) next-start next-end))))))
|
|
((or (prim-type? tok) (id-token? tok))
|
|
(let* ((next (getter))
|
|
(next-tok (get-tok next))
|
|
(next-start (get-start next))
|
|
(next-end (get-end next)))
|
|
(cond
|
|
((eof? next-tok)
|
|
(parse-error "Expected rest of parameter list, and class body still requires a }" srt end))
|
|
((comma? next-tok) (parse-error "Variable name must follow type before ," srt next-end))
|
|
((c-paren? next-tok) (parse-error "Variable name must follow type before )" srt next-end))
|
|
((id-token? next-tok)
|
|
(let* ((afterID (getter))
|
|
(afterID-tok (get-tok afterID)))
|
|
(cond
|
|
((eof? afterID-tok)
|
|
(parse-error "Expected rest of parameter list, and class body requires a '}'" next-start next-end))
|
|
((c-paren? afterID-tok) (parse-members next afterID 'method-parms getter abstract-method? just-method?))
|
|
((comma? afterID-tok)
|
|
(let* ((afterC (getter))
|
|
(afterC-tok (get-tok afterC)))
|
|
(cond
|
|
((eof? afterC-tok) (parse-error "Expected rest of parameter list, and class body requires a '}'"
|
|
(get-start afterID) (get-end afterID)))
|
|
((c-paren? afterC-tok)
|
|
(parse-error "Comma is unneeded before ) unless another variable is desired"
|
|
(get-start afterID) (get-end afterC)))
|
|
((comma? afterC-tok)
|
|
(parse-error "Parameter list should not have ,, Only one is needed"
|
|
(get-start afterID) (get-end afterC)))
|
|
(else (parse-members afterID afterC 'method-parms getter abstract-method? just-method?)))))
|
|
((or (prim-type? afterID-tok) (id-token? afterID-tok))
|
|
(parse-error (format "~a begins a new parameter. A , is needed in between parameters"
|
|
(if (prim-type? afterID-tok) (get-token-name afterID-tok) (token-value afterID-tok)))
|
|
next-start (get-end afterID)))
|
|
(else (parse-error (format "Expected , or ) in parameter list found ~a" (format-out afterID-tok))
|
|
(get-start afterID) (get-end afterID))))))
|
|
((java-keyword? next-tok)
|
|
(parse-error (format "Expected variable name after type, found reserved word ~a, which cannot be a name"
|
|
(get-token-name next-tok))
|
|
next-start next-end))
|
|
((and (advanced?) (o-bracket? next-tok))
|
|
(parse-members cur next 'method-array-type getter abstract-method? just-method?))
|
|
(else (parse-error (format "Expected new parameter name after type, found ~a" (format-out next-tok))
|
|
next-start next-end)))))
|
|
((java-keyword? tok)
|
|
(parse-error (format "Expected type name, reserved word ~a is not a type" kind) srt end))
|
|
(else (parse-error (format "Expected a parameter or ), found ~a" (format-out tok)) srt end))))
|
|
((ctor-end)
|
|
(case kind
|
|
((EOF) (parse-error "Expected } to end constructor body, and class body still requires }" ps pe))
|
|
((C_BRACE) (parse-members cur (getter) 'start getter #f just-method?))
|
|
((if return)
|
|
(parse-error (format "Statements are not permitted in the constructor body, found ~a" kind) srt end))
|
|
(else (parse-error (format "Expected a } to end the constructor, found ~a" out) srt end))))
|
|
((method-end)
|
|
(case kind
|
|
((EOF) (parse-error "Expected } to end method body, and class body still requires }" ps pe))
|
|
((C_BRACE) (parse-members cur (getter) 'start getter #f just-method?))
|
|
(else
|
|
(parse-error (format "Expected 1 statement, and then } for method body. Found ~a instead of }" out)
|
|
srt end)))))))
|
|
|
|
;parse-array-init token token symbol (-> token) -> token
|
|
(define (parse-array-init pre cur-tok state getter)
|
|
;(printf "parse-array-init state ~a pre ~a cur-tok ~a~n" state pre cur-tok)
|
|
(let* ((tok (get-tok cur-tok))
|
|
(kind (get-token-name tok))
|
|
(out (format-out tok))
|
|
(start (get-start cur-tok))
|
|
(end (get-end cur-tok))
|
|
(ps (if (null? pre) null (get-start pre)))
|
|
(pe (if (null? pre) null (get-end pre))))
|
|
(case state
|
|
((start)
|
|
(case kind
|
|
((EOF) (parse-error "Expected expressions to create array or '}' to end it" ps pe))
|
|
((O_BRACE) (parse-array-init pre (parse-array-init cur-tok (getter) 'start getter) 'comma-or-end getter))
|
|
((C_BRACE) (getter))
|
|
((SEMI_COLON) (parse-error "Expected a '}' to close array before ending field" ps end))
|
|
(else (parse-array-init pre (parse-expression null cur-tok 'start getter #f #f) 'comma-or-end getter))))
|
|
((comma-or-end)
|
|
(case kind
|
|
((EOF) (parse-error "Expected ',' for more expressions of the array or '}' to end it" ps pe))
|
|
((C_BRACE) (getter))
|
|
((COMMA)
|
|
(let* ((next (getter))
|
|
(next-tok (get-tok next)))
|
|
(cond
|
|
((eof? next-tok) (parse-error "Expected further expressions for array" ps end))
|
|
((c-brace? next-tok) (parse-error "Expected further expressions for array after ',', not '}' to end it" ps
|
|
(get-end next)))
|
|
((o-brace? next-tok)
|
|
(parse-array-init pre (parse-array-init next (getter) 'start getter) 'comma-or-end getter))
|
|
(else
|
|
(parse-array-init pre (parse-expression null next 'start getter #f #f) 'comma-or-end getter)))))
|
|
(else
|
|
(parse-error (format "Items of the array must be separated by ',' or end with '}' to close the array. Found ~a" out)
|
|
ps end)))))))
|
|
|
|
;Beginner
|
|
;parse-field: token token symbol (->token) -> token
|
|
(define (parse-field pre cur-tok state getter)
|
|
(let* ((tok (get-tok cur-tok))
|
|
(kind (get-token-name tok))
|
|
(out (format-out tok))
|
|
(start (get-start cur-tok))
|
|
(end (get-end cur-tok))
|
|
(ps (if (null? pre) null (get-start pre)))
|
|
(pe (if (null? pre) null (get-end pre))))
|
|
(case state
|
|
((start)
|
|
(case kind
|
|
((EOF) (parse-error "Expected a name for this variable declaration" ps pe))
|
|
((IDENTIFIER) (parse-field cur-tok (getter) 'equals getter))
|
|
((=) (parse-error "Expected a name for this variable declaration inbetween the type and =" ps end))
|
|
(else
|
|
(if (java-keyword? tok)
|
|
(parse-error
|
|
(format "Expected a name for this declaration, reserved word ~a may not be the name" kind) start end)
|
|
(parse-error
|
|
(format "Expected a name for this declaration, found ~a" out) start end)))))
|
|
((equals)
|
|
(case kind
|
|
((=)
|
|
(let ((next (getter)))
|
|
(if (eof? (get-tok next))
|
|
(parse-error "Expected an expression for this declaration" start end)
|
|
(parse-field cur-tok (parse-expression cur-tok next 'start getter #f #f) 'end getter))))
|
|
((COMMA)
|
|
(parse-error "Expected an assignment of the given name to a value, found ',' which is not allowed here."
|
|
ps end))
|
|
((SEMI_COLON)
|
|
(parse-error "Expected an assignment of the given name to a value, found ';' which is not allowed here."
|
|
ps end))
|
|
(else
|
|
(parse-error (format "Expected an assignment of the given name to a value, found ~a" out) ps end))))
|
|
((end)
|
|
(case kind
|
|
((EOF) (parse-error "Declaration must end with a ';'" ps pe))
|
|
((SEMI_COLON) (getter))
|
|
(else
|
|
(parse-error (format "Expected an end to this declartion, found ~a" out) start end)))))))
|
|
;Intermediate
|
|
;parse-iface-body: token token symbol (->token) -> token
|
|
(define (parse-iface-body pre cur state getter)
|
|
(let* ((tok (get-tok cur))
|
|
(kind (get-token-name tok))
|
|
(out (format-out tok))
|
|
(srt (get-start cur))
|
|
(end (get-end cur))
|
|
(ps (if (null? pre) null (get-start pre)))
|
|
(pe (if (null? pre) null (get-end pre))))
|
|
(case state
|
|
((start)
|
|
(cond
|
|
((or (eof? tok) (c-brace? tok)) cur)
|
|
((and (not (beginner?)) (abstract? tok))
|
|
(parse-iface-body cur (getter) 'method-type getter))
|
|
((prim-type? tok) (parse-iface-body cur (getter) 'method-id getter))
|
|
((and (not (beginner?)) (void-token? tok))
|
|
(parse-iface-body cur (getter) 'method-id getter))
|
|
((id-token? tok) (parse-iface-body cur (getter) 'method-id getter))
|
|
(else
|
|
(parse-error
|
|
(format "Only methods may be within the interface body, found ~a" out) srt end))))
|
|
((method-type)
|
|
(cond
|
|
((eof? tok) (parse-error "Expected method, and interface body still requires a }" ps pe))
|
|
((prim-type? tok) (parse-iface-body cur (getter) 'method-id getter))
|
|
((and (not (beginner?)) (void-token? tok))
|
|
(parse-iface-body cur (getter) 'method-id getter))
|
|
((id-token? tok) (parse-iface-body cur (getter) 'method-id getter))
|
|
((java-keyword? tok)
|
|
(parse-error
|
|
(format "Expected return type of the method, reserved word ~a is not a type" kind) srt end))
|
|
(else (parse-error (format "Expected return type of a method, found ~a" out) srt end))))
|
|
((method-id)
|
|
(case kind
|
|
((EOF) (parse-error "Expected method name, and interface body still requires a }" ps pe))
|
|
((IDENTIFIER)
|
|
(let* ((next (getter))
|
|
(next-tok (get-tok next))
|
|
(next-out (format-out next-tok))
|
|
(next-start (get-start next))
|
|
(next-end (get-end next)))
|
|
(cond
|
|
((eof? next-tok) (parse-error "Expected method parameters, and interface body still requires a }" srt end))
|
|
((o-paren? next-tok) (parse-iface-body next (getter) 'parms getter))
|
|
((c-paren? next-tok)
|
|
(parse-error "Expected a ( to start parameter list but encountered the closing )" next-start next-end))
|
|
((semi-colon? next-tok)
|
|
(parse-error "Declaration is similar to a field, which maynot be in an interface" ps next-end))
|
|
((open-separator? next-tok)
|
|
(parse-error (format "Method parameter list is started by (, found ~a" next-out) next-start next-end))
|
|
(else (parse-error (format "Expected ( for parameter list, found ~a" next-out) next-start next-end)))))
|
|
((PERIOD)
|
|
(if (id-token? (get-tok pre))
|
|
(parse-iface-body cur (parse-name (getter) getter #f) 'method-id getter)
|
|
(parse-error (format "~a cannot be followed by '.'" (format-out pre)) ps end)))
|
|
((O_PAREN) (parse-error "Expected a method name before parameter list" ps end))
|
|
((SEMI_COLON) (parse-error "Declaration is similar to a field, which maynot be in an interface" ps end))
|
|
(else
|
|
(if (java-keyword? tok)
|
|
(parse-error
|
|
(format "Expected method name, found ~a which is reserved and cannot be a method's name" kind) srt end)
|
|
(parse-error (format "Expected method name, found ~a" out) srt end)))))
|
|
((parms)
|
|
(cond
|
|
((eof? tok) (parse-error "Expceted method parameters, and interface body still requires }" ps pe))
|
|
((o-paren? tok)
|
|
(parse-error "Method parameter list already started, an additional ( is not needed" srt end))
|
|
((c-paren? tok)
|
|
(let* ((next (getter))
|
|
(next-tok (get-tok next))
|
|
(next-out (format-out next-tok))
|
|
(next-start (get-start next))
|
|
(next-end (get-end next)))
|
|
(cond
|
|
((eof? next-tok) (parse-error "Expected a ';', and interface body still requires a }" srt end))
|
|
((c-paren? next-tok)
|
|
(parse-error "Method parameter list already closed, unneeded )" next-start next-end))
|
|
((o-brace? next-tok)
|
|
(parse-error "Method in interface maynot have a body" next-start next-end))
|
|
((semi-colon? next-tok) (parse-iface-body next (getter) 'start getter))
|
|
(else
|
|
(parse-error (format "Expected a ';', found ~a" next-out) next-start next-end)))))
|
|
((or (prim-type? tok) (id-token? tok))
|
|
(let* ((next (getter))
|
|
(next-tok (get-tok next))
|
|
(next-start (get-start next))
|
|
(next-end (get-end next)))
|
|
(cond
|
|
((eof? next-tok)
|
|
(parse-error "Expected rest of parameter list, and interface body still requires a }" srt end))
|
|
((comma? next-tok) (parse-error "Variable name must follow type before ," srt next-end))
|
|
((c-paren? next-tok) (parse-error "Variable name must follow type before )" srt next-end))
|
|
((id-token? next-tok)
|
|
(let* ((afterID (getter))
|
|
(afterID-tok (get-tok afterID))
|
|
(afterID-s (get-start afterID)))
|
|
(cond
|
|
((eof? afterID-tok)
|
|
(parse-error "Expected rest of parameter list, and interface body requires a }" next-start next-end))
|
|
((c-paren? afterID-tok) (parse-iface-body next afterID 'parms getter))
|
|
((comma? afterID-tok)
|
|
(let* ((afterC (getter))
|
|
(afterC-tok (get-tok afterC))
|
|
(afterC-end (get-end afterC)))
|
|
(cond
|
|
((eof? afterC-tok)
|
|
(parse-error "Expected rest of parameter list, and class body requires a }" afterID-s afterC-end))
|
|
((c-paren? afterC-tok)
|
|
(parse-error "Comma is unneeded before ) unless another variable is desired" afterID-s afterC-end))
|
|
((comma? afterC-tok)
|
|
(parse-error "Parameter list should not have ',,' Only one is needed" afterID-s afterC-end))
|
|
(else (parse-iface-body afterID afterC 'parms getter)))))
|
|
((or (prim-type? afterID-tok) (id-token? afterID-tok))
|
|
(parse-error (format "~a begins a new parameter. A , is needed in between parameters"
|
|
(if (prim-type? afterID-tok) (get-token-name afterID-tok) (token-value afterID-tok)))
|
|
next-start (get-end afterID)))
|
|
(else (parse-error (format "Expected , or ) in parameter list found ~a" (format-out afterID-tok))
|
|
afterID-s (get-end afterID))))))
|
|
((java-keyword? next-tok)
|
|
(parse-error (format "Expected variable name after type, found reserved word ~a, which cannot be a name"
|
|
(get-token-name next-tok))
|
|
next-start next-end))
|
|
(else (parse-error (format "Expected new parameter name after type, found ~a" (format-out next-tok))
|
|
next-start next-end)))))
|
|
((java-keyword? tok)
|
|
(parse-error (format "Expected type name, reserved word ~a is not a type" kind) srt end))
|
|
(else (parse-error (format "Expected a parameter or ), found ~a" (format-out tok)) srt end)))))))
|
|
|
|
;parse-type: token (-> token) bool -> token
|
|
(define (parse-name cur-tok getter star-ok?)
|
|
(let* ((tok (get-tok cur-tok))
|
|
(kind (get-token-name tok))
|
|
(start (get-start cur-tok))
|
|
(stop (get-end cur-tok)))
|
|
(case kind
|
|
((IDENTIFIER)
|
|
(let ((next-tok (getter)))
|
|
(if (dot? (get-tok next-tok))
|
|
(parse-name (getter) getter star-ok?)
|
|
next-tok)))
|
|
((PERIOD) (parse-error "It is not allowed to have two .s, only one is necessary" start stop))
|
|
((*)
|
|
(if star-ok?
|
|
cur-tok
|
|
(parse-error "A name may not contain a *" start stop)))
|
|
(else
|
|
(cond
|
|
((eq? 'this kind)
|
|
(parse-error "'this' cannot occur after a '.', only before" start stop))
|
|
((java-keyword? tok)
|
|
(parse-error (format "Expected name after '.', found reserved word ~a, which may not appear here" kind)
|
|
start stop))
|
|
(else
|
|
(parse-error (format "Expected name after '.', found ~a" (format-out tok)) start stop)))))))
|
|
|
|
;parse-ctor-body: token token (->token) -> token
|
|
(define (parse-ctor-body pre cur-tok getter)
|
|
(case (get-token-name (get-tok cur-tok))
|
|
((EOF C_BRACE) cur-tok)
|
|
((super)
|
|
(if (beginner?)
|
|
(parse-error "Constructor may only initialize the fields of this class. Found super, which is not allowed"
|
|
(get-start cur-tok) (get-end cur-tok))
|
|
(parse-ctor-call cur-tok (getter) 'start getter)))
|
|
((this)
|
|
(cond
|
|
((advanced?) (parse-ctor-call cur-tok (getter) 'start getter))
|
|
((intermediate?) (parse-method-body pre cur-tok getter #t #f))
|
|
((beginner?) (parse-beginner-ctor-body null cur-tok 'start getter))))
|
|
(else
|
|
(if (beginner?)
|
|
(parse-beginner-ctor-body null cur-tok 'start getter)
|
|
(parse-method-body pre cur-tok getter #t #f)))))
|
|
|
|
;parse-ctor-call: token token symbol -> token
|
|
(define (parse-ctor-call pre cur-tok state getter)
|
|
(let* ((tok (get-tok cur-tok))
|
|
(kind (get-token-name tok))
|
|
(out (format-out tok))
|
|
(start (get-start cur-tok))
|
|
(end (get-end cur-tok))
|
|
(ps (if (null? pre) null (get-start pre)))
|
|
(pe (if (null? pre) null (get-end pre))))
|
|
(case state
|
|
((start)
|
|
(case kind
|
|
((O_PAREN) (parse-ctor-call cur-tok (getter) 'ctor-args getter))
|
|
((PERIOD)
|
|
(let* ((next (getter))
|
|
(next-tok (get-tok next))
|
|
(ne (get-end next)))
|
|
(cond
|
|
((id-token? next-tok)
|
|
(parse-method-body pre (parse-statement next (getter) 'assign-or-call getter #t #t #f) getter #t #f))
|
|
((java-keyword? next-tok)
|
|
(parse-error (format "Expected identifier after '.', found reserved word ~a" (get-token-name next-tok))
|
|
start ne))
|
|
(else
|
|
(parse-error (format "Expected identifer after '.', found ~a" (format-out next-tok)) start ne)))))
|
|
(else (parse-error (format "~a cannot be used here" (get-token-name pre)) ps end))))
|
|
((ctor-args)
|
|
(case kind
|
|
((EOF) (parse-error "Expected constructor arguments or )" ps pe))
|
|
((C_PAREN)
|
|
(let ((next (getter)))
|
|
(if (semi-colon? (get-tok next))
|
|
; (getter)
|
|
(if (beginner?)
|
|
(parse-beginner-ctor-body null (getter) 'start getter)
|
|
(parse-method-body next (getter) getter #t #t))
|
|
(parse-error (format "Expected a ';' after constructor call, found ~a" (format-out (get-tok next)))
|
|
start (get-end next)))))
|
|
(else
|
|
(parse-ctor-call cur-tok (parse-expression pre cur-tok 'start getter #f #f) 'more-args getter))))
|
|
((more-args)
|
|
(case kind
|
|
((EOF) (parse-error "Expected constructor arguments or )" ps pe))
|
|
((C_PAREN) (parse-ctor-call pre cur-tok 'ctor-args getter))
|
|
((COMMA)
|
|
(let ((next (getter)))
|
|
(if (comma? (get-tok next))
|
|
(parse-error "Found ',,' Only one comma is needed to separate arguments" start (get-end next))
|
|
(parse-ctor-call cur-tok (parse-expression cur-tok next 'start getter #f #f) 'more-args getter))))
|
|
(else
|
|
(if (close-separator? tok)
|
|
(parse-error (format "Expected ) to close constructor arguments, found ~a" out) start end)
|
|
(parse-error (format "A ',' is required between constructor arguments, found ~a" out) start end))))))))
|
|
|
|
|
|
;Beginner
|
|
;parse-beginner-ctor-body: token token symbol (-> token) -> token
|
|
(define (parse-beginner-ctor-body pre cur-tok state getter)
|
|
(let* ((tok (get-tok cur-tok))
|
|
(kind (get-token-name tok))
|
|
(out (format-out tok))
|
|
(start (get-start cur-tok))
|
|
(end (get-end cur-tok))
|
|
(ps (if (null? pre) null (get-start pre)))
|
|
(pe (if (null? pre) null (get-end pre))))
|
|
(case state
|
|
((start)
|
|
(case kind
|
|
((C_BRACE EOF) cur-tok)
|
|
((super)
|
|
(parse-error
|
|
(format "~a~n~a"
|
|
"Calling the parent's constructor must be the first action of a constructor,"
|
|
"and maynot appear here")
|
|
start end))
|
|
((this)
|
|
(let* ((next (getter))
|
|
(next-tok (get-tok next))
|
|
(ns (get-start next))
|
|
(ne (get-end next)))
|
|
(cond
|
|
((eof? next-tok)
|
|
(parse-error "Expected rest of field initialization, constructor and class need }" start end))
|
|
((dot? next-tok)
|
|
(let* ((afterD (getter))
|
|
(afterD-tok (get-tok afterD))
|
|
(ae (get-end afterD)))
|
|
(cond
|
|
((id-token? afterD-tok) (parse-beginner-ctor-body afterD (getter) 'assign-op getter))
|
|
((java-keyword? afterD-tok)
|
|
(parse-error (format "Expected identifier after '.', found reserved word ~a" (get-token-name afterD-tok))
|
|
ns ae))
|
|
(else
|
|
(parse-error (format "Expected identifer after '.', found ~a" (format-out afterD-tok)) ns ae)))))
|
|
(else (parse-error (format "Expected this.Field, found ~a instead of '.'" (format-out next-tok)) ns ne)))))
|
|
((IDENTIFIER)
|
|
(let ((next (getter)))
|
|
(if (dot? (get-tok next))
|
|
(parse-beginner-ctor-body next (parse-name (getter) getter #f) 'assign-op getter)
|
|
(parse-beginner-ctor-body cur-tok next 'assign-op getter))))
|
|
(else
|
|
(if (java-keyword? tok)
|
|
(parse-error (format "Expected name, found reserved word ~a" kind) start end)
|
|
(parse-error (format "Expected name, found ~a" out) start end)))))
|
|
((assign-op)
|
|
(case kind
|
|
((EOF) (parse-error "Expected rest of field initialization (=), constructor and class need }" ps pe))
|
|
((=)
|
|
(let ((next (getter)))
|
|
(if (eof? (get-tok next))
|
|
(parse-error "Expected an expression after = for field initialization" start end)
|
|
(parse-beginner-ctor-body cur-tok (parse-expression null next 'start getter #f #f) 'assign-end getter))))
|
|
(else (parse-error (format "Expected = to be used in initializing the field, found ~a" out) start end))))
|
|
((assign-end)
|
|
(cond
|
|
((eof? tok) (parse-error "Expected a ; to end field intialization, constructor and class need }" ps pe))
|
|
((semi-colon? tok) (parse-beginner-ctor-body cur-tok (getter) 'start getter))
|
|
(else (parse-error (format "Expected a ; to end field initialization, found ~a" out) start end)))))))
|
|
|
|
|
|
;Intermediate
|
|
;parse-method-body: token token (->token) bool bool-> token
|
|
(define (parse-method-body pre cur-tok getter ctor? call-seen?)
|
|
; (printf "parse-method-body pre ~a cur-tok ~a~n" pre cur-tok)
|
|
(case (get-token-name (get-tok cur-tok))
|
|
((C_BRACE EOF) cur-tok)
|
|
(else (parse-method-body pre
|
|
(parse-statement pre cur-tok 'start getter #t ctor? call-seen?)
|
|
getter ctor? call-seen?))))
|
|
|
|
;Intermediate - addition of parameter id-ok?
|
|
;parse-statement: token token symbol (->token) bool bool bool-> token
|
|
(define (parse-statement pre cur-tok state getter id-ok? ctor? super-seen?)
|
|
(let* ((tok (get-tok cur-tok))
|
|
(kind (get-token-name tok))
|
|
(out (format-out tok))
|
|
(start (get-start cur-tok))
|
|
(end (get-end cur-tok))
|
|
(ps (if (null? pre) null (get-start pre)))
|
|
(pe (if (null? pre) null (get-end pre))))
|
|
(case state
|
|
((start)
|
|
(case kind
|
|
((if) (parse-statement cur-tok (getter) 'if getter id-ok? ctor? super-seen?))
|
|
((return)
|
|
(let ((next (getter)))
|
|
(cond
|
|
((eof? (get-tok next))
|
|
(parse-error (if (or (advanced?) (intermediate?) )
|
|
"Expected rest of return"
|
|
"Expected expression for return")
|
|
start end))
|
|
((and (or (advanced?) (intermediate?)) (semi-colon? (get-tok next))) (getter))
|
|
(else (parse-statement cur-tok (parse-expression null next 'start getter #f #f)
|
|
'return getter id-ok? ctor? super-seen?)))))
|
|
((IDENTIFIER)
|
|
(if (beginner?)
|
|
(parse-error
|
|
(let ((v (token-value tok)))
|
|
(cond
|
|
((close-to-keyword? tok 'if)
|
|
(format "Expected 'if', found ~a which is perhaps miscapitalized or spelled" v))
|
|
((close-to-keyword? tok 'return)
|
|
(format "Expected 'return', found ~a which is perhaps miscapitalized or spelled" v))
|
|
(else
|
|
(format "Expected a statement, found ~a. Statements begin with 'if' or 'return'" out))))
|
|
start end)
|
|
(let* ((next (getter))
|
|
(next-tok (get-tok next)))
|
|
(cond
|
|
((dot? next-tok)
|
|
(parse-statement next (parse-name (getter) getter #f) 'statement-or-var getter id-ok? ctor? super-seen?))
|
|
((literal-token? next-tok)
|
|
(parse-error
|
|
(if (close-to-keyword? tok 'return)
|
|
(string-append
|
|
(format "~a ~a is not the correct beginning of a statement. ~a is similar to 'return'~n"
|
|
(token-value tok) (format-out next-tok #f) (token-value tok))
|
|
"Check spelling and capitalization")
|
|
(format "It is an error to have ~a ~a as a statement" out (format-out next-tok #f)))
|
|
start (get-end next)))
|
|
((this? next-tok)
|
|
(parse-error
|
|
(if (close-to-keyword? tok 'return)
|
|
(string-append
|
|
(format "'~a this' is not the correct beginning of a statement. ~a is similar to 'return'~n"
|
|
(token-value tok) (token-value tok))
|
|
"Check spelling and capitalization")
|
|
(format "It is an error to have '~a this' as a statement" out))
|
|
start (get-end next)))
|
|
(else
|
|
(parse-statement cur-tok next 'statement-or-var getter id-ok? ctor? super-seen?))))))
|
|
(else
|
|
(when (beginner?)
|
|
(parse-error (format "Expected a statement, found ~a. Statements begin with 'if' or 'return'" out) start end))
|
|
;Intermediate cases
|
|
(case kind
|
|
;From ctor-beginner-body
|
|
((this super)
|
|
(let* ((next (getter))
|
|
(next-tok (get-tok next))
|
|
(ns (get-start next))
|
|
(ne (get-end next)))
|
|
(cond
|
|
;Intermediate error change
|
|
((eof? next-tok) (parse-error (format "Expected ~a.name, unexpected end" kind) start end))
|
|
((dot? next-tok)
|
|
(let* ((afterD (getter))
|
|
(afterD-tok (get-tok afterD))
|
|
(ae (get-end afterD)))
|
|
(cond
|
|
;Intermediate changed next state
|
|
((id-token? afterD-tok)
|
|
(parse-statement afterD (getter) 'assign-or-call getter id-ok? ctor? super-seen?))
|
|
((java-keyword? afterD-tok)
|
|
(parse-error (format "Expected identifier after '.', found reserved word ~a" (get-token-name afterD-tok))
|
|
ns ae))
|
|
(else
|
|
(parse-error (format "Expected identifer after '.', found ~a" (format-out afterD-tok)) ns ae)))))
|
|
((o-paren? next-tok)
|
|
(cond
|
|
((and ctor? super-seen?)
|
|
(parse-error (format "Expected ~a.name, found ~a instead of '.'" kind (format-out next-tok)) ns ne))
|
|
(ctor?
|
|
(parse-error (string-append (format "~a() calls must be the first item of the constructor body.~n" kind)
|
|
(format "Or a name was expected to complete ~a.name constructrion." kind))
|
|
start ne))
|
|
(else
|
|
(parse-error (string-append (format "~a() calls may only appear in the constructor" kind)
|
|
(format "Or a name was expected to complete ~a.name construction." kind))
|
|
start ne))))
|
|
(else (parse-error (format "Expected ~a.name, found ~a instead of '.'" kind (format-out next-tok)) ns ne)))))
|
|
;Intermediate
|
|
((new) (parse-statement cur-tok (parse-expression cur-tok (getter) 'alloc-start getter #f #f)
|
|
'end-exp getter id-ok? ctor? super-seen?))
|
|
;Intermediate
|
|
((O_PAREN)
|
|
(parse-statement cur-tok
|
|
(parse-expression cur-tok (parse-expression cur-tok (getter) 'start getter #f #f)
|
|
'c-paren getter #f #f)
|
|
'end-exp getter id-ok? ctor? super-seen?))
|
|
;Intermediate
|
|
((O_BRACE)
|
|
(parse-statement cur-tok (parse-method-body cur-tok (getter) getter ctor? super-seen?)
|
|
'c-brace getter #t ctor? super-seen?))
|
|
;Intermediate - changed wholly
|
|
(else
|
|
(cond
|
|
((prim-type? tok) (parse-statement cur-tok (getter) 'local getter id-ok? ctor? super-seen?))
|
|
;Advanced
|
|
((and (advanced?) (for-token? tok))
|
|
(parse-statement cur-tok (getter) 'for getter id-ok? ctor? super-seen?))
|
|
((and (advanced?) (do-token? tok))
|
|
(parse-statement cur-tok (getter) 'do getter id-ok? ctor? super-seen?))
|
|
((and (advanced?) (while-token? tok))
|
|
(parse-statement cur-tok (getter) 'while getter id-ok? ctor? super-seen?))
|
|
((and (advanced?) (or (break-token? tok) (continue-token? tok)))
|
|
(parse-statement cur-tok (getter) 'break-continue getter id-ok? ctor? super-seen?))
|
|
((java-keyword? tok)
|
|
(parse-error (format "Expected name, found reserved word ~a" kind) start end))
|
|
(else
|
|
(parse-error (format "Expected statement, found ~a, which cannot begin a statement" out) start end))))))))
|
|
((if)
|
|
(case kind
|
|
((EOF) (parse-error "Expected conditional test for 'if'" ps pe))
|
|
((O_PAREN)
|
|
(let ((next (getter)))
|
|
(if (eof? (get-tok next))
|
|
(parse-error (format "Expected conditional expression for 'if'") start end)
|
|
(parse-statement cur-tok (parse-expression null next 'start getter #f #f)
|
|
'if-then getter id-ok? ctor? super-seen?))))
|
|
(else
|
|
(parse-error (format "Conditional expression for 'if' must be started with '(', found ~a" out) start end))))
|
|
((if-then)
|
|
(case kind
|
|
((EOF)
|
|
(if (advanced?)
|
|
(parse-error "Expected ')' to close conditional for 'if'" ps pe)
|
|
(parse-error "Expected ')' to close conditional for 'if', and then and else statements for 'if'" ps pe)))
|
|
((C_PAREN)
|
|
(let* ((next (getter))
|
|
(next-tok (get-tok next)))
|
|
(cond
|
|
((eof? next-tok) (parse-error "Expected statement for then branch of 'if'" start end))
|
|
((c-paren? next-tok)
|
|
(parse-error "Conditional expression already closed, extra ')' found" start (get-end next)))
|
|
(else (parse-statement cur-tok (parse-statement null next 'start getter #f ctor? super-seen?)
|
|
'if-else getter id-ok? ctor? super-seen?)))))
|
|
(else
|
|
(parse-error
|
|
(format "Conditional expression for 'if' must be in parens, did not find ')', found ~a" out) ps end))))
|
|
((if-else)
|
|
(case kind
|
|
((EOF)
|
|
(if (advanced?) cur-tok (parse-error "Expected 'else' for 'if' statement" ps pe)))
|
|
((else) (parse-statement null (getter) 'start getter #f ctor? super-seen?))
|
|
(else
|
|
(if (advanced?)
|
|
cur-tok
|
|
(parse-error
|
|
(if (and (id-token? tok) (close-to-keyword? tok 'else))
|
|
(format "Expected 'else' for 'if', found ~a, which might be mispelled or miscapitalized"
|
|
(token-value tok))
|
|
(format "Expected 'else' for 'if', found ~a" out))
|
|
start end)))))
|
|
((return)
|
|
(case kind
|
|
((EOF) (parse-error "Expected ';' to end 'return' statement" ps pe))
|
|
((SEMI_COLON) (getter))
|
|
(else (parse-error (format "Expected ';' to end 'return' statement, found ~a" out) start end))))
|
|
;Intermediate & Advanced
|
|
((statement-or-var)
|
|
(case kind
|
|
((EOF) (parse-error "Expected remainder of statement" ps pe))
|
|
((IDENTIFIER) (parse-statement pre cur-tok 'local getter id-ok? ctor? super-seen?))
|
|
(else (parse-statement pre cur-tok 'assign-or-call getter id-ok? ctor? super-seen?))))
|
|
;Intermediate
|
|
((assign-or-call)
|
|
(case kind
|
|
((EOF) (parse-error "Expected remainder of assignment or call" ps pe))
|
|
((=)
|
|
;From Assignment
|
|
(let ((next (getter)))
|
|
(if (eof? (get-tok next))
|
|
(parse-error "Expected an expression after '=' for assignment" start end)
|
|
(parse-statement cur-tok
|
|
(parse-expression null next 'start getter #f #f) 'assign-end getter id-ok? ctor? super-seen?))))
|
|
((PERIOD)
|
|
(let ((next (getter)))
|
|
(cond
|
|
((eof? (get-tok next)) (parse-error "Expected a name after '.'" start end))
|
|
((id-token? (get-tok next))
|
|
(parse-statement next (getter) 'assign-or-call getter id-ok? ctor? super-seen?))
|
|
(else
|
|
(parse-error (format "Expected a name after '.', ~a is not a valid name" (format-out (get-tok next)))
|
|
start (get-end next))))))
|
|
((O_PAREN) (parse-statement cur-tok (parse-expression pre cur-tok 'method-call-args getter #f #t)
|
|
'end-exp getter id-ok? ctor? super-seen?))
|
|
(else
|
|
(cond
|
|
((and (advanced?) (eq? kind 'O_BRACKET))
|
|
(let* ((next (getter))
|
|
(next-tok (get-tok next)))
|
|
(if (eof? next-tok)
|
|
(parse-error "Expected an index for array" start end)
|
|
(let* ((afterOB (parse-expression cur-tok next 'start getter #f #f))
|
|
(afterOB-tok (get-tok afterOB)))
|
|
(if (eof? afterOB-tok)
|
|
(parse-error "Expected a ']' to end array index" start (get-end afterOB))
|
|
(parse-statement afterOB (getter) 'assign-or-call getter id-ok? ctor? super-seen?))))))
|
|
((advanced?)
|
|
(parse-statement pre cur-tok 'unary-check getter id-ok? ctor? super-seen?))
|
|
(else
|
|
(parse-error (format "Expected assignment or method call, found ~a, which is not valid for a statement" out)
|
|
start end))))))
|
|
((assignment)
|
|
(case kind
|
|
((EOF) (parse-error "Expected remainder of assignment" ps pe))
|
|
((=)
|
|
;From Assignment
|
|
(let ((next (getter)))
|
|
(if (eof? (get-tok next))
|
|
(parse-error "Expected an expression after '=' for assignment" start end)
|
|
(parse-statement cur-tok
|
|
(parse-expression null next 'start getter #f #f) 'assign-end getter id-ok? ctor? super-seen?))))
|
|
((O_BRACKET)
|
|
(let* ((next (getter))
|
|
(next-tok (get-tok next)))
|
|
(if (eof? next-tok)
|
|
(parse-error "Expected an index for array" start end)
|
|
(let* ((afterOB (parse-expression cur-tok next 'start getter #f #f))
|
|
(afterOB-tok (get-tok afterOB)))
|
|
(if (eof? afterOB-tok)
|
|
(parse-error "Expected a ']' to end array index" start (get-end afterOB))
|
|
(parse-statement afterOB (getter) 'assignment getter id-ok? ctor? super-seen?))))))
|
|
(else
|
|
(parse-error (format "Expected assignment, found ~a, which is not valid for a statement" out)
|
|
start end))))
|
|
;Intermediate - from Assignment, error messages changed
|
|
((assign-end)
|
|
(cond
|
|
((eof? tok) (parse-error "Expected a ';' to end assignment" ps pe))
|
|
((semi-colon? tok) (getter))
|
|
(else (parse-error (format "Expected a ';' to end assignment, found ~a" out) start end))))
|
|
((unary-check)
|
|
(let ((pre-out (token-value (get-tok pre))))
|
|
(case kind
|
|
((EOF) (parse-error "Expected remainder of statement" ps pe))
|
|
((++ --)
|
|
(let* ((next (getter))
|
|
(next-tok (get-tok next)))
|
|
(cond
|
|
((eof? next-tok)
|
|
(parse-error (format "Expected a ';' to end ~a~a" pre-out kind) ps end))
|
|
((semi-colon? next-tok) (getter))
|
|
(else
|
|
(parse-error (format "Expected a ';' to end ~a~a, found ~a" pre-out kind (format-out next-tok))
|
|
ps (get-end next))))))
|
|
(else (parse-error (format "Expected a statement ~a ~a is not the valid start of a statement"
|
|
pre-out out) ps end)))))
|
|
;Intermediate
|
|
((end-exp)
|
|
(case kind
|
|
((EOF) (parse-error "Expected ';' or rest of statement" ps pe))
|
|
((PERIOD)
|
|
(let ((next (getter)))
|
|
(cond
|
|
((id-token? (get-tok next)) (parse-statement next (getter) 'assign-or-call getter id-ok? ctor? super-seen?))
|
|
(else
|
|
(parse-error (format "Expected a name after '.', found ~a" (format-out (get-tok next)))
|
|
ps (get-end next))))))
|
|
((SEMI_COLON) (getter))
|
|
(else
|
|
(parse-error (format "Expected ';' or rest of statement, found ~a" out) ps end))))
|
|
;Intermediate
|
|
((c-brace)
|
|
(case kind
|
|
((EOF) (parse-error "Expected a '}' to close '{'" ps pe))
|
|
((C_BRACE) (getter))
|
|
(else (parse-error (format "Expected a '}' to close open '{', found ~a" out) start end))))
|
|
;Intermediate
|
|
((local)
|
|
(unless id-ok?
|
|
(parse-error
|
|
(if (advanced?)
|
|
"Found apparent variable declaration directly in an 'if', 'for', 'while', or 'do'. Varaibles declarations must be in blocks"
|
|
"Found apparent variable declaration directly in an 'if', variable declarations must be in blocks")
|
|
ps end))
|
|
(case kind
|
|
((EOF) (parse-error "Variable declaration requires a name" start end))
|
|
((IDENTIFIER)
|
|
(let* ((next (getter))
|
|
(n-tok (get-tok next))
|
|
(n-out (format-out n-tok))
|
|
(ne (get-end next)))
|
|
(cond
|
|
((eof? n-tok) (parse-error "Variable declaration has not completed" start end))
|
|
;Just ended a local field
|
|
((semi-colon? n-tok) (getter))
|
|
((comma? n-tok) (parse-statement next (getter) 'local-list getter #t ctor? super-seen?))
|
|
((teaching-assignment-operator? n-tok)
|
|
(let ((assign-exp (getter)))
|
|
(cond
|
|
((eof? (get-tok assign-exp))
|
|
(parse-error (format "Expected an expression to bind to ~a" (token-value tok)) start end))
|
|
((and (advanced?) (o-brace? (get-tok assign-exp)))
|
|
(parse-statement next (parse-array-init assign-exp (getter) 'start getter) 'local-init-end getter #t ctor?
|
|
super-seen?))
|
|
(else
|
|
(parse-statement next (parse-expression null assign-exp 'start getter #f #f)
|
|
'local-init-end getter #t ctor? super-seen?)))))
|
|
((id-token? n-tok)
|
|
(parse-error (format "Variables must be separated by commas, ~a not allowed" n-out) start ne))
|
|
(else (parse-error (format "Expected ';' or more variables, found ~a" n-out) start ne)))))
|
|
(else
|
|
(cond
|
|
((and (advanced?) (o-bracket? tok))
|
|
(let* ((next (getter))
|
|
(n-tok (get-tok next)))
|
|
(cond
|
|
((c-bracket? n-tok)
|
|
(parse-statement next (getter) 'local getter id-ok? ctor? super-seen?))
|
|
((o-bracket? n-tok)
|
|
(parse-error "Array types may not have [[. A closing ] is necessary before opening a new [" start
|
|
(get-end next)))
|
|
(else (parse-error (format "Array types are of form type[]. ~a is not allowed" (format-out n-tok))
|
|
start (get-end next))))))
|
|
((teaching-assignment-operator? tok)
|
|
(parse-error (format "Expected a type and name before ~a, found ~a ~a"
|
|
kind (format-out (get-tok pre)) kind)
|
|
ps end))
|
|
(else (parse-error
|
|
(if (java-keyword? tok)
|
|
(format "Expected a name for this variable, cannot be named reserved word ~a" kind)
|
|
(format "Expected a name for this variable, found ~a" out)) start end))))))
|
|
;Intermediate
|
|
((local-list)
|
|
(case kind
|
|
((EOF) (parse-error "Expected an additional variable after comma" ps pe))
|
|
((IDENTIFIER)
|
|
(let* ((next (getter))
|
|
(n-tok (get-tok next))
|
|
(n-out (format-out n-tok))
|
|
(ne (get-end next)))
|
|
(cond
|
|
((eof? n-tok) (parse-error "Variable is not complete" start end))
|
|
((semi-colon? n-tok) (getter))
|
|
((comma? n-tok) (parse-statement next (getter) 'local-list getter id-ok? ctor? super-seen?))
|
|
((teaching-assignment-operator? n-tok)
|
|
(let ((assign-exp (getter)))
|
|
(if (eof? (get-tok assign-exp))
|
|
(parse-error (format "Expected an expression to bind to ~a" (token-value tok)) start end)
|
|
(parse-statement next (parse-expression null assign-exp 'start getter #f #f)
|
|
'local-init-end getter id-ok? ctor? super-seen?))))
|
|
((id-token? n-tok)
|
|
(parse-error (format "Variables must be separated by commas, ~a not allowed" n-out) start ne))
|
|
(else (parse-error (format "Expected ';' or more variables, found ~a" n-out) start ne)))))
|
|
(else
|
|
(parse-error
|
|
(if (java-keyword? tok)
|
|
(format "Expected a name for this variable, cannot be named reseved word ~a" kind)
|
|
(format "Expected a name for this variable, found ~a" out)) start end))))
|
|
;Intermediate
|
|
((local-init-end)
|
|
(case kind
|
|
((EOF) (parse-error "Expected a ';' or ',' after variable" ps pe))
|
|
((COMMA) (parse-statement cur-tok (getter) 'local-list getter id-ok? ctor? super-seen?))
|
|
((SEMI_COLON) (getter))
|
|
((IDENTIFIER) (parse-error (format "Variables must be separated by commas, ~a not allowed" out) start end))
|
|
(else (parse-error (format "Expected a ';' to end variable, or more variables, found ~a" out) start end))))
|
|
;Advanced
|
|
((for)
|
|
(case kind
|
|
((EOF) (parse-error "Expected a '(' to begin 'for'" ps pe))
|
|
((O_PAREN)
|
|
(parse-statement cur-tok (parse-for cur-tok (getter) 'start getter ctor? super-seen?)
|
|
'start getter #f ctor? super-seen?))
|
|
(else
|
|
(parse-error (format "Expected a '(' to begin 'for'. Found ~a which is not allowed" out) start end))))
|
|
;Advanced
|
|
((do)
|
|
(case kind
|
|
((EOF) (parse-error "Expeceted a statement and condition for 'do'" ps pe))
|
|
(else (parse-statement pre (parse-statement pre cur-tok 'start getter #f ctor? super-seen?)
|
|
'do-while getter id-ok? ctor? super-seen?))))
|
|
;Advanced
|
|
((do-while)
|
|
(case kind
|
|
((EOF) (parse-error "Expected 'while' and condition for 'do'" ps pe))
|
|
((while)
|
|
(let* ((next (getter))
|
|
(next-tok (get-tok next)))
|
|
(cond
|
|
((eof? next-tok)
|
|
(parse-error "Expected a condition beginning with '(' for 'while' portion of 'do'" ps end))
|
|
((o-paren? next-tok)
|
|
(let* ((afterO (getter))
|
|
(afterO-tok (get-tok afterO)))
|
|
(cond
|
|
((eof? afterO-tok)
|
|
(parse-error "Expected a condition expression after '('" (get-start next) (get-end next)))
|
|
((c-paren? afterO-tok) (getter))
|
|
(else
|
|
(parse-statement afterO (parse-expression null afterO 'start getter #f #f) 'do-while-close
|
|
getter id-ok? ctor? super-seen?)))))
|
|
(else
|
|
(parse-error
|
|
(format "Expected a condition beginning with '(' for 'while' portion of 'do'. Found ~a"
|
|
(format-out next-tok)) start (get-end next))))))
|
|
(else
|
|
(parse-error (format "Expected 'while' for 'do'. Found ~a which is not allowed here" out) start end))))
|
|
;Advanced
|
|
((do-while-close)
|
|
(case kind
|
|
((EOF) (parse-error "Expected ')' to close condition of 'do'" ps pe))
|
|
((C_PAREN)
|
|
(let ((next (getter)))
|
|
(cond
|
|
((eof? (get-tok next)) (parse-error "Expected ';' to close 'do'" ps end))
|
|
((semi-colon? (get-tok next)) (getter))
|
|
(else
|
|
(parse-error (format "Expected ';' to end 'do'. Found ~a which is not allowed" (format-out (get-tok next)))
|
|
(get-start next) (get-end next))))))
|
|
(else
|
|
(parse-error (format "Expected ')' to close condition of 'do'. Found ~a which is not allowed" out) ps end))))
|
|
;Advanced
|
|
((while)
|
|
(case kind
|
|
((EOF) (parse-error "Expected a '(' to begin while condition" ps pe))
|
|
((O_PAREN)
|
|
(let* ((next (getter))
|
|
(next-tok (get-tok next)))
|
|
(cond
|
|
((eof? next-tok) (parse-error "Expected a ')' or an expression for while condition" ps end))
|
|
((c-paren? next-tok)
|
|
(parse-statement next (getter) 'start getter #f ctor? super-seen?))
|
|
(else
|
|
(parse-statement cur-tok (parse-expression null next 'start getter #f #f)
|
|
'while-close getter id-ok? ctor? super-seen?)))))
|
|
(else (parse-error (format "Expected a '(' to begin while condition, found ~a" out) ps end))))
|
|
;Advanced
|
|
((while-close)
|
|
(case kind
|
|
((EOF) (parse-error "Expected a ')' to end while condition" ps pe))
|
|
((C_PAREN) (parse-statement cur-tok (getter) 'start getter #f ctor? super-seen?))
|
|
(else (parse-error (format "Expected a ')' to end while condition, found ~a" out) ps end))))
|
|
;Advanced
|
|
((break-continue)
|
|
(case kind
|
|
((EOF) (parse-error "Expected a ';'" ps pe))
|
|
((SEMI_COLON) (getter))
|
|
(else (parse-error (format "Expected a ';' to end ~a. Found ~a which is not allowed here"
|
|
(token-name (get-tok pre)) out)
|
|
ps end))))
|
|
)))
|
|
|
|
;parse-for: token token state (->token) bool bool -> token
|
|
(define (parse-for pre cur-tok state getter ctor? super-seen?)
|
|
(let* ((tok (get-tok cur-tok))
|
|
(kind (get-token-name tok))
|
|
(out (format-out tok))
|
|
(start (get-start cur-tok))
|
|
(end (get-end cur-tok))
|
|
(ps (if (null? pre) null (get-start pre)))
|
|
(pe (if (null? pre) null (get-end pre))))
|
|
;(printf "parse-for: state ~a pre ~a cur-tok ~a~n" state pre cur-tok)
|
|
(case state
|
|
((start)
|
|
(cond
|
|
((prim-type? tok)
|
|
(parse-for pre
|
|
(parse-statement cur-tok (getter) 'local getter #t ctor? super-seen?)
|
|
'past-inits getter ctor? super-seen?))
|
|
((id-token? tok)
|
|
(parse-for pre cur-tok 'init-or-expr getter ctor? super-seen?))
|
|
((semi-colon? tok)
|
|
(parse-for cur-tok (getter) 'past-inits getter ctor? super-seen?))
|
|
(else (parse-for pre
|
|
(parse-expression pre cur-tok 'start getter #f #f)
|
|
'statement-expr-first getter ctor? super-seen?))))
|
|
((init-or-expr)
|
|
(case kind
|
|
((EOF) (parse-error "Expected remainder of 'for'" ps pe))
|
|
((PERIOD)
|
|
(parse-for pre (parse-name (getter) getter #f) 'init-or-expr getter ctor? super-seen?))
|
|
((IDENTIFIER)
|
|
(parse-for pre (parse-statement cur-tok (getter) 'local getter #t ctor? super-seen?)
|
|
'past-inits getter ctor? super-seen?))
|
|
(else
|
|
(parse-for pre (parse-expression pre cur-tok 'start getter #f #f)
|
|
'statement-expr-first getter ctor? super-seen?))))
|
|
((statement-expr-first)
|
|
(case kind
|
|
((EOF) (parse-error "Expected remainder of 'for'" ps pe))
|
|
((COMMA) (parse-for cur-tok (parse-expression cur-tok (getter) 'start getter #f #f) 'statement-expr-first
|
|
getter ctor? super-seen?))
|
|
((SEMI_COLON)
|
|
(parse-for cur-tok (getter) 'past-inits getter ctor? super-seen?))
|
|
(else
|
|
(parse-error (format "Expected a ',' or ';' for list of statement expressions in 'for'. Found ~a" out)
|
|
start end))))
|
|
((past-inits)
|
|
(case kind
|
|
((EOF) (parse-error "Expected a conditional expression for 'for'" ps pe))
|
|
#;((SEMI_COLON)
|
|
(parse-for cur-tok (getter) 'past-condition getter ctor? super-seen?))
|
|
(else
|
|
(parse-for cur-tok (parse-expression pre cur-tok 'start getter #f #f)
|
|
'end-condition getter ctor? super-seen?)
|
|
#;(let ((next (getter)))
|
|
(cond
|
|
((eof? (get-tok next)) (parse-error "Expected the rest of 'for'" start end))
|
|
((semi-colon? (get-tok next)) (parse-for cur-tok next 'end-condition getter
|
|
ctor? super-seen?))
|
|
(else (parse-for cur-tok (parse-expression cur-tok next 'start getter #f #f)
|
|
'end-condition getter ctor? super-seen?)))))))
|
|
((end-condition)
|
|
(case kind
|
|
((EOF) (parse-error "Expected a ';' to end the condition portion of 'for'" ps pe))
|
|
((SEMI_COLON) (parse-for cur-tok (getter) 'past-condition getter ctor? super-seen?))
|
|
(else
|
|
(parse-error (format "Expected a ';' to end the condition portion of 'for', found ~a" out) start end))))
|
|
((past-condition)
|
|
(case kind
|
|
((EOF) (parse-error "Expected a ')' to end the pre-statement portion of 'for'" ps pe))
|
|
((C_PAREN) (getter))
|
|
(else
|
|
(parse-for pre (parse-expression pre cur-tok 'start getter #f #f)
|
|
'statement-expr-snd getter ctor? super-seen?))))
|
|
((statement-expr-snd)
|
|
(case kind
|
|
((EOF) (parse-error "Expected a ')' to end the pre-statement portion of 'for'" ps pe))
|
|
((C_PAREN) (getter))
|
|
((COMMA)
|
|
(let ((next (getter)))
|
|
(if (eof? (get-tok next))
|
|
(parse-error "Expected an expression after ','" start end)
|
|
(parse-for cur-tok (parse-expression cur-tok next 'start getter #f #f)
|
|
'statement-expr-snd getter ctor? super-seen?))))
|
|
(else (parse-error (format "Expected a ')' or a ','. Found ~a which is not allowed" out) start end))))
|
|
)))
|
|
|
|
;parse-expression: token token state (->token) bool bool -> token
|
|
(define (parse-expression pre cur-tok state getter statement-ok? stmt-exp?)
|
|
;(printf "parse-expression state ~a pre ~a cur-tok ~a statement-ok? ~a stmt-exp? ~a ~n"
|
|
; state pre cur-tok statement-ok? stmt-exp?)
|
|
(let* ((tok (get-tok cur-tok))
|
|
(kind (get-token-name tok))
|
|
(out (format-out tok))
|
|
(start (get-start cur-tok))
|
|
(end (get-end cur-tok))
|
|
(ps (if (null? pre) null (get-start pre)))
|
|
(pe (if (null? pre) null (get-end pre))))
|
|
;(printf "kind ~a~n" kind)
|
|
(case state
|
|
((start)
|
|
(case kind
|
|
((EOF) (parse-error "Expected an expression" ps pe))
|
|
((~ ! -) (parse-expression cur-tok
|
|
(parse-expression cur-tok (getter) 'start getter #f #f)
|
|
'op-or-end getter statement-ok? stmt-exp?))
|
|
((+)
|
|
(if (or (advanced?) (intermediate?))
|
|
(parse-expression cur-tok (parse-expression cur-tok (getter) 'start getter #f stmt-exp?)
|
|
'op-or-end getter statement-ok? stmt-exp?)
|
|
(parse-error "Expected an expression, + cannot begin an expression" start end)))
|
|
;Advanced
|
|
((++ --)
|
|
(if (advanced?)
|
|
(parse-expression cur-tok
|
|
(parse-expression cur-tok (getter) 'start getter #f #f)
|
|
'dot-op-or-end getter statement-ok? stmt-exp?)
|
|
(parse-error (format "Expected an expression, ~a is not the valid beginning of an expression" out)
|
|
start end)))
|
|
((NULL_LIT)
|
|
(if (or (advanced?) (intermediate?))
|
|
(parse-expression cur-tok (getter) 'dot-op-or-end getter statement-ok? stmt-exp?)
|
|
(parse-error "Expected an expression. null may not be used here" start end)))
|
|
((TRUE_LIT FALSE_LIT STRING_LIT CHAR_LIT INTEGER_LIT
|
|
LONG_LIT FLOAT_LIT DOUBLE_LIT this)
|
|
(parse-expression cur-tok (getter) 'dot-op-or-end getter statement-ok? stmt-exp?))
|
|
((super)
|
|
(if (beginner?)
|
|
(parse-error "An expression may not begin with reserved word 'super'" start end)
|
|
(parse-expression cur-tok (getter) 'dot-op-or-end getter statement-ok? stmt-exp?)))
|
|
((O_PAREN)
|
|
(if (or (advanced?) (intermediate?))
|
|
(parse-expression cur-tok (getter) 'cast-or-parened getter statement-ok? stmt-exp?)
|
|
(parse-expression cur-tok (parse-expression cur-tok (getter) 'start getter #f #f)
|
|
'c-paren getter statement-ok? stmt-exp?)))
|
|
((new) (parse-expression cur-tok (getter) 'alloc-start getter statement-ok? stmt-exp?))
|
|
((IDENTIFIER) (parse-expression cur-tok (getter) 'name getter statement-ok? stmt-exp?))
|
|
((STRING_ERROR)
|
|
(if (eq? 'STRING_NEWLINE (get-token-name (caddr (token-value tok))))
|
|
(parse-error (format "A string must be contained all on one line, and end in '~a'" #\") start end)
|
|
(parse-error (format "String must end with '~a', which is not found" #\") start end)))
|
|
(else
|
|
(parse-error (format "Expected an expression, ~a is not the valid beginning of an expression" out) start end))))
|
|
;Advanced
|
|
((op-or-end)
|
|
(if stmt-exp?
|
|
(cond
|
|
((and (advanced?) (unary-end? tok)) (getter))
|
|
(else cur-tok))
|
|
(cond
|
|
((bin-operator? tok)
|
|
(parse-expression cur-tok (getter) 'start getter #f stmt-exp?))
|
|
((and (advanced?) (unary-end? tok))
|
|
(parse-expression cur-tok (getter) 'op-or-end getter statement-ok? stmt-exp?))
|
|
((and (advanced?) (if-exp? tok))
|
|
(parse-expression cur-tok (parse-expression cur-tok (getter) 'start getter #f stmt-exp?)
|
|
'if-exp-colon getter #f stmt-exp?))
|
|
((and (advanced?) (o-bracket? tok))
|
|
(parse-expression cur-tok (getter) 'array-acc getter statement-ok? stmt-exp?))
|
|
((and (or (advanced?) (intermediate?)) (instanceof-token? tok))
|
|
(parse-expression cur-tok (getter) 'instanceof getter #f stmt-exp?))
|
|
(else cur-tok))))
|
|
((dot-op-or-end)
|
|
(cond
|
|
((dot? tok)
|
|
(let* ((next (getter))
|
|
(next-tok (get-tok next))
|
|
(name (get-token-name next-tok))
|
|
(ns (get-start next))
|
|
(ne (get-end next)))
|
|
(cond
|
|
((id-token? next-tok)
|
|
(let ((afterID (getter)))
|
|
(cond
|
|
((o-paren? (get-tok afterID))
|
|
(parse-expression next afterID 'method-call-args getter statement-ok? stmt-exp?))
|
|
((teaching-assignment-operator? (get-tok afterID))
|
|
(parse-expression next (parse-expression afterID (getter) 'start getter #f #f)
|
|
'assign-end getter statement-ok? stmt-exp?))
|
|
(else (parse-expression next afterID 'dot-op-or-end getter statement-ok? stmt-exp?)))))
|
|
((eq? 'this name)
|
|
(parse-error "Expected a name, 'this' may not appear after a dot" ns ne))
|
|
((java-keyword? next-tok)
|
|
(parse-error (format "Expected a name, reserved name ~a may not be a name" name) ns ne))
|
|
(else (parse-error (format "Expected a name, found ~a" (format-out next-tok)) ns ne)))))
|
|
(stmt-exp? (parse-expression pre cur-tok 'op-or-end getter #f stmt-exp?))
|
|
((bin-operator? tok) (parse-expression cur-tok (getter) 'start getter #f stmt-exp?))
|
|
;Advanced
|
|
((and (advanced?) (unary-end? tok)) (parse-expression cur-tok (getter) 'op-or-end getter statement-ok? stmt-exp?))
|
|
((and (advanced?) (if-exp? tok))
|
|
(parse-expression cur-tok (parse-expression cur-tok (getter) 'start getter #f #f) 'if-exp-colon getter #f stmt-exp?))
|
|
((and (advanced?) (o-bracket? tok)) (parse-expression cur-tok (getter) 'array-acc getter statement-ok? stmt-exp?))
|
|
((and (or (advanced?) (intermediate?)) (instanceof-token? tok)) (parse-expression cur-tok (getter) 'instanceof getter #f stmt-exp?))
|
|
(else cur-tok)))
|
|
;Advanced
|
|
((array-acc)
|
|
(cond
|
|
((eof? tok) (parse-error "Expected expression for accessing array" start end))
|
|
((c-bracket? tok)
|
|
(parse-error "Expected an expression for accessing array, inbetween [ and ]" ps end))
|
|
(else (parse-expression pre
|
|
(parse-expression pre cur-tok 'start getter #f #f)
|
|
'c-bracket getter statement-ok? stmt-exp?))))
|
|
;Advanced
|
|
((c-bracket)
|
|
(case kind
|
|
((EOF) (parse-error "Expected ] to end array access" ps pe))
|
|
((C_BRACKET)
|
|
(let ((next (getter)))
|
|
(if (teaching-assignment-operator? (get-tok next))
|
|
(parse-expression next (parse-expression next (getter) 'start getter #f #f)
|
|
'assign-end getter statement-ok? stmt-exp?)
|
|
(parse-expression cur-tok next 'dot-op-or-end getter statement-ok? stmt-exp?))))
|
|
(else (parse-error (format "Expected ] to end array access. Found ~a" out) ps end))))
|
|
;Advanced
|
|
((c-bracket-empty-ok)
|
|
(case kind
|
|
((EOF) (parse-error "Expected ] to end array size specification" ps pe))
|
|
((C_BRACKET)
|
|
(let ((next (getter)))
|
|
(if (o-bracket? (get-tok next))
|
|
(let ((afterOB (getter)))
|
|
(if (c-bracket? (get-tok afterOB))
|
|
(parse-expression next afterOB 'c-bracket-empty getter statement-ok? stmt-exp?)
|
|
(parse-expression next (parse-expression next afterOB 'start getter #f stmt-exp?)
|
|
'c-bracket-empty-ok getter statement-ok? stmt-exp?)))
|
|
(parse-expression cur-tok next 'dot-op-or-end getter statement-ok? stmt-exp?))))
|
|
(else
|
|
(parse-error (format "Expected ] to end array size specification. Found ~a" out) ps end))))
|
|
;Advanced
|
|
((c-bracket-empty)
|
|
(case kind
|
|
((EOF) (parse-error "Expected ] to end array specification" ps pe))
|
|
((C_BRACKET)
|
|
(let ((next (getter)))
|
|
(if (o-bracket? (get-tok next))
|
|
(parse-expression next (getter) 'c-bracket-empty getter statement-ok? stmt-exp?)
|
|
(parse-expression cur-tok next 'dot-op-or-end getter statement-ok? stmt-exp?))))
|
|
(else (parse-error (format "Expected ] to end array specification. Found ~a" out) ps end))))
|
|
;Intermediate
|
|
((cast-or-parened)
|
|
(cond
|
|
((eof? tok) (parse-error "Expected a name or expression and a )" ps pe))
|
|
((prim-type? tok) (parse-expression pre (getter) 'cast getter statement-ok? stmt-exp?))
|
|
((id-token? tok) (parse-expression pre (getter) 'cast-or-parened-close getter statement-ok? stmt-exp?))
|
|
(else (parse-expression pre (parse-expression pre cur-tok 'start getter #f #f)
|
|
'c-paren getter statement-ok? stmt-exp?))))
|
|
;Intermediate
|
|
((cast)
|
|
(cond
|
|
((eof? tok) (parse-error "cast must have close paren and additional expression" ps pe))
|
|
((c-paren? tok) (parse-expression cur-tok (getter) 'start getter #f stmt-exp?))
|
|
((and (advanced?) (o-bracket? tok))
|
|
(let ((next (getter)))
|
|
(cond
|
|
((eof? (get-tok next)) (parse-error "cast to array must have ]" start end))
|
|
((c-bracket? (get-tok next)) (parse-expression next (getter) 'cast getter statement-ok? stmt-exp?))
|
|
(else (parse-error (format "cast to array must have ]. ~a is not allowed" (format-out (get-tok next)))
|
|
start (get-end next))))))
|
|
(else (parse-error (format "cast must have close paren, found ~a instead" out) ps end))))
|
|
;Intermediate
|
|
((cast-or-parened-close)
|
|
(cond
|
|
((eof? tok) (parse-error "Expected a ')'" ps pe))
|
|
((c-paren? tok)
|
|
(let* ((next (getter))
|
|
(next-tok (get-tok next)))
|
|
(case (get-token-name next-tok)
|
|
((~ ! - + TRUE_LIT FALSE_LIT STRING_LIT CHAR_LIT INTEGER_LIT
|
|
LONG_LIT FLOAT_LIT DOUBLE_LIT this O_PAREN new IDENTIFIER)
|
|
(parse-expression cur-tok next 'start getter #f stmt-exp?))
|
|
((super)
|
|
(if (beginner?)
|
|
(parse-error "Reserved word 'super' maynot appear in an expression"
|
|
(get-start next) (get-end next))
|
|
(parse-expression cur-tok next 'start getter #f stmt-exp?)))
|
|
((NULL_LIT)
|
|
(if (or (advanced?) (intermediate?))
|
|
(parse-expression cur-tok next 'start getter #f stmt-exp?)
|
|
(parse-expression cur-tok next 'dot-op-or-end getter #f stmt-exp?)))
|
|
(else (parse-expression cur-tok next 'dot-op-or-end getter #f stmt-exp?)))))
|
|
((and (advanced?) (o-bracket? tok))
|
|
(let* ((next (getter))
|
|
(next-tok (get-tok next)))
|
|
(cond
|
|
((eof? (get-tok next))
|
|
(parse-error "cast to array must have ], array access must have expression" start end))
|
|
((c-bracket? (get-tok next)) (parse-expression next (getter) 'cast getter statement-ok? stmt-exp?))
|
|
(else (parse-expression cur-tok
|
|
(parse-expression cur-tok next 'array-acc getter #f stmt-exp?)
|
|
'c-paren getter statement-ok? stmt-exp?)))))
|
|
(else (parse-expression pre (parse-expression pre cur-tok 'name getter #f #f) 'c-paren getter statement-ok? stmt-exp?))))
|
|
; (else (parse-error (format "Expected a ')', found ~a" out) ps end))))
|
|
((c-paren)
|
|
(cond
|
|
((eof? tok) (parse-error "Expected a )" ps pe))
|
|
((c-paren? tok) (parse-expression cur-tok (getter) 'dot-op-or-end getter statement-ok? stmt-exp?))
|
|
(else (parse-error (format "Expression in parens must have an operator or a close paren, found ~a instead" out) ps end))))
|
|
;Advanced
|
|
((instanceof)
|
|
(cond
|
|
((eof? tok) (parse-error "Expected a type for instanceof" ps pe))
|
|
((id-token? tok)
|
|
(let ((next (getter)))
|
|
(if (dot? (get-tok next))
|
|
(parse-expression next (parse-name (getter) getter #f) 'instanceof-array getter statement-ok? stmt-exp?)
|
|
(parse-expression cur-tok next 'op-or-end getter statement-ok? stmt-exp?))))
|
|
((prim-type? tok) (parse-expression cur-tok (getter) 'instanceof-array getter statement-ok? stmt-exp?))
|
|
((java-keyword? tok)
|
|
(parse-error (format "Expected a type for instanceof comparison, found ~a which is not the name of a type" out)
|
|
start end))
|
|
(else (parse-error (format "Expected a type for instanceof comparison. Found ~a" out) start end))))
|
|
;Advanced
|
|
((instanceof-array)
|
|
(case kind
|
|
((O_BRACE)
|
|
(if (intermediate?)
|
|
(parse-error "'[' may not follow the name of a type" start end)
|
|
(let ((next (getter)))
|
|
(if (c-brace? (get-tok next))
|
|
(parse-expression next (getter) 'instanceof-array getter statement-ok? stmt-exp?)
|
|
(parse-error (format "Array types are of the form type[], expected ] found ~a"
|
|
(format-out (get-tok next)))
|
|
start (get-end next))))))
|
|
(else (parse-expression pre cur-tok 'op-or-end getter statement-ok? stmt-exp?))))
|
|
;Advanced
|
|
((if-exp-colon)
|
|
(cond
|
|
((eof? tok) (parse-error "Expected a :" ps pe))
|
|
((colon? tok)
|
|
(parse-expression cur-tok (parse-expression cur-tok (getter) 'start getter #f #f)
|
|
'op-or-end getter statement-ok? stmt-exp?))
|
|
(else (parse-error (format "Expected a : found ~a" out) start end))))
|
|
((alloc-start)
|
|
(cond
|
|
((eof? tok)
|
|
(parse-error (if (advanced?)
|
|
"Expected a class name or primitive type for allocation"
|
|
"Expected a class name for allocation") ps pe))
|
|
((id-token? tok)
|
|
(let* ((next (getter))
|
|
(next-tok (get-tok next)))
|
|
(cond
|
|
((eof? next-tok)
|
|
(if (advanced?)
|
|
(parse-error "Expected constructor arguments for class allocation or size for array" start end)
|
|
(parse-error "Expected constructor arguments for class allocation" start end)))
|
|
;Advanced
|
|
((dot? next-tok)
|
|
(cond
|
|
((beginner?)
|
|
(parse-error "Expected (argument, ...) for an object creation, '.' may not appear here"
|
|
(get-start next) (get-end next)))
|
|
((advanced?)
|
|
(parse-expression cur-tok (parse-name (getter) getter #f) 'alloc-open getter statement-ok? stmt-exp?))
|
|
(else
|
|
(parse-expression cur-tok (parse-name (getter) getter #f) 'class-args-start getter statement-ok? stmt-exp?))))
|
|
((o-paren? next-tok) (parse-expression cur-tok next 'class-args-start getter statement-ok? stmt-exp?))
|
|
;Advanced
|
|
((and (advanced?) (o-bracket? next-tok))
|
|
(parse-expression next (getter) 'array-size getter statement-ok? stmt-exp?))
|
|
((c-paren? next-tok)
|
|
(parse-error (format "Expected ( to begin constructor arguments for ~a" out) (get-start pre) end))
|
|
((open-separator? next-tok)
|
|
(parse-error (format
|
|
(if (advanced?)
|
|
"Expected ( to begin constructor arguments, or [ to begin array size, found ~a"
|
|
"Expected ( to begin constructor arguments, found ~a") (format-out next-tok))
|
|
(get-start next) (get-end next)))
|
|
(else
|
|
;Advanced
|
|
(parse-error
|
|
(format (if (advanced?)
|
|
"Expected constructor arguments in parens or array size in []s, found ~a"
|
|
"Expected constructor arguments in parens, found ~a")
|
|
(format-out next-tok)) (get-start pre) (get-end next))))))
|
|
;Advanced
|
|
((and (advanced?) (prim-type? tok))
|
|
(let* ((next (getter))
|
|
(next-tok (get-tok next)))
|
|
(cond
|
|
((eof? next-tok) (parse-error "Expected a size for the array" start end))
|
|
((o-bracket? next-tok)
|
|
(parse-expression next (getter) 'array-size getter statement-ok? stmt-exp?))
|
|
(else (parse-error (format "Expected a [ to begin array size, found ~a" (format-out next-tok))
|
|
start (get-end next))))))
|
|
((java-keyword? tok)
|
|
;Advanced
|
|
(parse-error (format
|
|
(if (advanced?)
|
|
"Expected a class name or primitive type, reserved word ~a is neither"
|
|
"Expected a class name, reserved word ~a is not a class") kind) start end))
|
|
(else
|
|
(parse-error (format (if (advanced?)
|
|
"Expected a class name or primitive type, found ~a"
|
|
"Expected a class name, found ~a") out) start end))))
|
|
;Advanced
|
|
((alloc-open)
|
|
(case kind
|
|
((EOF) (parse-error "Expected a ( to begin constructor arguments or [ to specify array size" ps pe))
|
|
((O_PAREN) (parse-expression pre cur-tok 'class-args-start getter statement-ok? stmt-exp?))
|
|
((O_BRACKET) (parse-expression cur-tok (getter) 'array-size getter statement-ok? stmt-exp?))
|
|
(else (parse-error (format "Expected a ( to begin constructor arguments or [ to specify size, found ~a" out)
|
|
ps end))))
|
|
;Advanced
|
|
((array-size)
|
|
(case kind
|
|
((EOF) (parse-error "Expected a size for the array" ps pe))
|
|
((C_BRACKET) (parse-error "Array allocation must have an expresion for its size. Found ]" ps end))
|
|
(else
|
|
(parse-expression pre (parse-expression pre cur-tok 'start getter #f stmt-exp?)
|
|
'c-bracket-empty-ok getter statement-ok? stmt-exp?))))
|
|
((class-args-start)
|
|
(case kind
|
|
((EOF) (parse-error "Expected constructor arguments starting with (" ps pe))
|
|
((O_PAREN)
|
|
(let* ((next (getter))
|
|
(next-tok (get-tok next)))
|
|
(cond
|
|
((eof? next-tok) (parse-error "Expected constructor arguments or )" start end))
|
|
((c-paren? next-tok) (parse-expression next (getter) 'dot-op-or-end getter statement-ok? stmt-exp?))
|
|
(else (parse-expression next (parse-expression cur-tok next 'start getter #f #f)
|
|
'class-args getter statement-ok? stmt-exp?)))))
|
|
(else (parse-error (format "Expected constructor arguments, starting with (, found ~a" out) start end))))
|
|
((class-args)
|
|
(case kind
|
|
((EOF) (parse-error "Expected constructor arguments or )" ps pe))
|
|
((C_PAREN) (parse-expression cur-tok (getter) 'dot-op-or-end getter statement-ok? stmt-exp?))
|
|
((COMMA)
|
|
(let ((next (getter)))
|
|
(if (comma? (get-tok next))
|
|
(parse-error "Found ',,' Only one comma is needed to separate arguments" start (get-end next))
|
|
(parse-expression cur-tok (parse-expression cur-tok next 'start getter #f stmt-exp?)
|
|
'class-args getter statement-ok? stmt-exp?))))
|
|
(else
|
|
(if (close-separator? tok)
|
|
(parse-error (format "Expected ) to close constructor arguments, found ~a" out) start end)
|
|
(parse-error (format "A ',' is required between expressions in a constructor call, found ~a" out) start end)))))
|
|
((name)
|
|
(case kind
|
|
((PERIOD) (parse-expression cur-tok (parse-name (getter) getter #f) 'name getter statement-ok? stmt-exp?))
|
|
((O_PAREN) (parse-expression pre cur-tok 'method-call-args getter statement-ok? stmt-exp?))
|
|
((=) (parse-expression cur-tok (parse-expression cur-tok (getter) 'start getter #f stmt-exp?)
|
|
'assign-end getter statement-ok? stmt-exp?))
|
|
((C_BRACKET) cur-tok)
|
|
(else (parse-expression pre cur-tok 'op-or-end getter statement-ok? stmt-exp?))))
|
|
((method-call-args)
|
|
(case kind
|
|
((EOF) (parse-error "Expected method arguments starting with (" ps pe))
|
|
((O_PAREN)
|
|
(let ((next-tok (getter)))
|
|
(cond
|
|
((eof? (get-tok next-tok)) (parse-error "Expected method arguments or )" start end))
|
|
((c-paren? (get-tok next-tok))
|
|
(let ((after-c (getter)))
|
|
(if (and statement-ok? (or (advanced?) (intermediate?) (semi-colon? (get-tok after-c))))
|
|
(getter)
|
|
(parse-expression next-tok after-c 'dot-op-or-end getter statement-ok? stmt-exp?))))
|
|
(else (parse-expression cur-tok (parse-expression cur-tok next-tok 'start getter #f stmt-exp?)
|
|
'method-args getter statement-ok? stmt-exp?)))))
|
|
(else (parse-error (format "Expected method arguments in parens, found ~a" out) start end))))
|
|
((method-args)
|
|
(case kind
|
|
((EOF) (parse-error "Expected method arguments or )" ps pe))
|
|
((C_PAREN)
|
|
(let ((after-c (getter)))
|
|
(if (and statement-ok? (or (advanced?) (intermediate?) (semi-colon? (get-tok after-c))))
|
|
(getter)
|
|
(parse-expression cur-tok after-c 'dot-op-or-end getter statement-ok? stmt-exp?))))
|
|
((COMMA)
|
|
(let ((next (getter)))
|
|
(if (comma? (get-tok next))
|
|
(parse-error "Found ',,' Only one comma is needed to separate arguments" start (get-end next))
|
|
(parse-expression cur-tok (parse-expression cur-tok next 'start getter #f stmt-exp?)
|
|
'method-args getter statement-ok? stmt-exp?))))
|
|
(else
|
|
(if (close-separator? tok)
|
|
(parse-error (format "Expected ) to close method arguments, found ~a" out) start end)
|
|
(parse-error (format "A ',' is required between expression in a method call, found ~a" out) start end)))))
|
|
((assign-end)
|
|
(cond
|
|
((and statement-ok? (semi-colon? tok)) (getter))
|
|
((and statement-ok? (eof? tok))
|
|
(parse-error "Assignment must end with a ';'" ps end))
|
|
(statement-ok?
|
|
(parse-error (format "Assignment must end with a ';'. Found ~a" out) start end))
|
|
((beginner?) (parse-error "Fields may not be set in this position, only expressions are permitted here" ps end))
|
|
(else (parse-error "Assignment is not permitted in this position. Only expressions are permitted here" ps end)))))))
|
|
)
|
|
|
|
|