(defpackage :c99-parser
  (:use :cl :nyala))

(in-package :c99-parser)

(defun parse-c99 (input)
  (parse (input)
    (:conflict-resolver elk::glr-resolver)
    (:driver elk::glr-driver)
    ;;
    (translation-unit
     -> translation-unit external-declaration
     -> external-declaration)
    (external-declaration
     -> declaration
     -> function-definition
     )
    (function-definition
     -> declaration-specifiers declarator (? declaration-list) compound-statement)
    (declaration-specifiers
     -> function-specifier (? declaration-specifiers)
     -> type-qualifier (? declaration-specifiers)
     -> type-specifier (? declaration-specifiers)
     -> storage-class-specifier (? declaration-specifiers))
    (storage-class-specifier
     -> "register"
     -> "auto"
     -> "static"
     -> "extern"
     -> "typedef")
    (type-specifier
     -> typedef-name
     -> enum-specifier
     -> struct-or-union-specifier
     -> "_Complex"
     -> "_Bool"
     -> "unsigned"
     -> "signed"
     -> "double"
     -> "float"
     -> "long"
     -> "int"
     -> "short"
     -> "char"
     -> "void")
    (struct-or-union-specifier
     -> struct-or-union :identifier
     -> struct-or-union (? :identifier) "{" struct-declaration-list "}")
    (struct-or-union
     -> "union"
     -> "struct")
    (struct-declaration-list
     -> struct-declaration-list struct-declaration
     -> struct-declaration)
    (struct-declaration
     -> specifier-qualifier-list struct-declarator-list ";")
    (specifier-qualifier-list
     -> type-qualifier (? specifier-qualifier-list)
     -> type-specifier (? specifier-qualifier-list))
    (type-qualifier
     -> "volatile"
     -> "restrict"
     -> "const")
    (struct-declarator-list
     -> struct-declarator-list "," struct-declarator
     -> struct-declarator)
    (struct-declarator
     -> (? declarator) ":" constant-expression
     -> declarator)
    (declarator
     -> (? pointer) direct-declarator)
    (pointer
     -> "*" (? type-qualifier-list) pointer
     -> "*" (? type-qualifier-list))
    (type-qualifier-list
     -> type-qualifier-list type-qualifier
     -> type-qualifier)
    (direct-declarator
     -> direct-declarator "(" (? identifier-list) ")"
     -> direct-declarator "(" parameter-type-list ")"
     -> direct-declarator "[" (? type-qualifier-list) "*" "]"
     -> direct-declarator "[" type-qualifier-list "static" assignment-expression "]"
     -> direct-declarator "[" "static" (? type-qualifier-list) assignment-expression "]"
     -> direct-declarator "[" (? type-qualifier-list) (? assignment-expression) "]"
     -> "(" declarator ")"
     -> :identifier)
    (identifier-list
     -> :identifier
     -> identifier-list "," :identifier)

    ;; Statements
    (compound-statement
     -> "{" (? block-item-list) "}")
    (block-item-list
     -> block-item-list block-item
     -> block-item)
    (block-item
     -> statement
     -> declaration)
    (statement
     -> jump-statement
     -> iteration-statement
     -> selection-statement
     -> expression-statement
     -> compound-statement
     -> labeled-statement)
    (labeled-statement
     -> "default" ":" statement
     -> "case" constant-expression ":" statement
     -> :identifier ":" statement)
    (expression-statement
     -> (? expression) ";")
    (selection-statement
     -> "switch" "(" expression ")" statement
     -> "if" "(" expression ")" statement "else" statement
     -> "if" "(" expression ")" statement)
    (iteration-statement
     -> "for" "(" declaration (? expression) ";" (? expression) ")" statement
     -> "for" "(" (? expression) ";" (? expression) ";" (? expression) ")" statement
     -> "do" statement "while" "(" expression ")" ";"
     -> "while" "(" expression ")" statement)
    (jump-statement
     -> "return" (? expression) ";"
     -> "break" ";"
     -> "continue" ";"
     -> "goto" :identifier ";")

    ;; Expressions
    (expression
     -> expression "," assignment-expression
     -> assignment-expression)
    (argument-expression-list
     -> argument-expression-list "," assignment-expression
     -> assignment-expression)
    (constant-expression
     -> conditional-expression)
    (assignment-expression
     -> unary-expression assignment-operator assignment-expression
     -> conditional-expression)
    (conditional-expression
     -> logical-or-expression "?" expression ":" conditional-expression
     -> logical-or-expression)
    (logical-or-expression
     -> logical-or-expression "||" logical-and-expression
     -> logical-and-expression)
    (logical-and-expression
     -> logical-and-expression "&&" inclusive-or-expression
     -> inclusive-or-expression)
    (inclusive-or-expression
     -> inclusive-or-expression "|" exclusive-or-expression
     -> exclusive-or-expression)
    (exclusive-or-expression
     -> exclusive-or-expression "^" and-expression
     -> and-expression)
    (and-expression
     -> and-expression "&" equality-expression
     -> equality-expression)
    (equality-expression
     -> equality-expression "!=" relational-expression
     -> equality-expression "==" relational-expression
     -> relational-expression)
    (relational-expression
     -> relational-expression ">=" shift-expression
     -> relational-expression "<=" shift-expression
     -> relational-expression ">" shift-expression
     -> relational-expression "<" shift-expression
     -> shift-expression)
    (shift-expression
     -> shift-expression ">>" additive-expression
     -> shift-expression "<<" additive-expression
     -> additive-expression)
    (additive-expression
     -> additive-expression "-" multiplicative-expression
     -> additive-expression "+" multiplicative-expression
     -> multiplicative-expression)
    (multiplicative-expression
     -> multiplicative-expression "%" cast-expression
     -> multiplicative-expression "/" cast-expression
     -> multiplicative-expression "*" cast-expression
     -> cast-expression)
    (cast-expression
     -> "(" type-name ")" cast-expression
     -> unary-expression)
    (unary-expression
     -> "sizeof" "(" type-name ")"
     -> "sizeof" unary-expression
     -> unary-operator cast-expression
     -> "--" unary-expression
     -> "++" unary-expression
     -> postfix-expression)
    (postfix-expression
     -> "(" type-name ")" "{" initializer-list "," "}"
     -> "(" type-name ")" "{" initializer-list "}"
     -> postfix-expression "--"
     -> postfix-expression "++"
     -> postfix-expression "->" :identifier
     -> postfix-expression "." :identifier
     -> postfix-expression "(" (? argument-expression-list) ")"
     -> postfix-expression "[" expression "]"
     -> primary-expression)
    (primary-expression
     -> "(" expression ")"
     -> :literal
     -> :identifier)


    (type-name
     -> specifier-qualifier-list (? abstract-declarator))
    (abstract-declarator
     -> (? pointer) direct-abstract-declarator
     -> pointer)
    (direct-abstract-declarator
     -> (? direct-abstract-declarator) "(" (? parameter-type-list) ")"
     -> (? direct-abstract-declarator) "[" "*" "]"
     -> (? direct-abstract-declarator) "[" type-qualifier-list "static" assignment-expression "]"
     -> (? direct-abstract-declarator) "[" "static" (? type-qualifier-list) assignment-expression "]"
     -> (? direct-abstract-declarator) "[" (? type-qualifier-list) (? assignment-expression) "]"
     -> "(" abstract-declarator ")")
    (parameter-type-list
     -> parameter-list "," "..."
     -> parameter-list)
    (parameter-list
     -> parameter-list "," parameter-declaration
     -> parameter-declaration)
    (parameter-declaration
     -> declaration-specifiers (? abstract-declarator)
     -> declaration-specifiers declarator)
    (initializer-list
     -> initializer-list "," (? designation) initializer
     -> (? designation) initializer)
    (designation
     -> designator-list "=")
    (designator-list
     -> designator-list designator
     -> designator)
    (designator
     -> "." :identifier
     -> "[" constant-expression "]")

    (initializer
     -> "{" initializer-list "," "}"
     -> "{" initializer-list "}"
     -> assignment-expression)
    (unary-operator
     -> "!"
     -> "~"
     -> "-"
     -> "+"
     -> "*"
     -> "&")
    (assignment-operator
     -> "|="
     -> "^="
     -> "&="
     -> ">>="
     -> "<<="
     -> "-="
     -> "+="
     -> "%="
     -> "/="
     -> "*="
     -> "=")
    (enum-specifier
     -> "enum" :identifier
     -> "enum" (? :identifier) "{" enumerator-list "," "}"
     -> "enum" (? :identifier) "{" enumerator-list "}")
    (enumerator-list
     -> enumerator-list "," enumerator
     -> enumerator)
    (enumerator
     -> :identifier "=" constant-expression
     -> :identifier)
    (function-specifier
     -> "inline")
    (declaration-list
     -> declaration-list declaration
     -> declaration)
    (declaration
     -> declaration-specifiers (? init-declarator-list) ";")
    (init-declarator-list
     -> init-declarator-list "," init-declarator
     -> init-declarator)
    (init-declarator
     -> declarator "=" initializer
     -> declarator)

    (typedef-name
     -> :identifier)
    ;; 
    ;; ==== Lexical Grammar ===================================================
    ;; 
    (= idchar (or "[_$@a-zA-Z0-9]"
                  (and #\\ #\u "[0-9a-fA-F]{4}")
                  (and #\\ #\U "[0-9a-fA-F]{8}")))
    (= idstart (- idchar "[0-9]"))
    ;;
    (:identifier
     -> (and idstart (* idchar))
     => (intern $$))

    (:literal
     -> "[0-9]+"
     => (parse-integer $$))
    ;; Preprocessing numbers
    (:literal -> (and (? #\.) "[0-9]"
                      (* (or idchar
                             #\.
                             (and #\' idchar)
                             (and "[eEpP][-+]"))))
              => $$)
    (:literal
     -> (and #\" (* (or (- t #\" #\Newline #\\) (and #\\ t))) #\")
     => $$)
    (:literal
     -> (and #\" (* (or (- t #\" #\Newline #\\) (and #\\ t))))
     => (clex2:lex-error "Unterminated string literal"))
    (:literal
     -> (and #\' (* (or (- t #\' #\Newline #\\) (and #\\ t))) #\')
     => $$)
    (:literal
     -> (and #\' (* (or (- t #\' #\Newline #\\) (and #\\ t))))
     => (clex2:lex-error "Unterminated character literal"))
    ;; Comments
    (-> (and '"//" ".*"))
    (-> (and '"/*" (- (* t) (and (* t) '"*/" (* t))) '"*/"))
    (-> (and '"/*" (- (* t) (and (* t) '"*/" (* t))))
     => (clex2:lex-error "Unterminated comment"))
    ;; This is too coarse but gets the job done
    (-> (and '"#" ".*"))
    ;; White space
    (-> (* (or #\space #\tab #\return #\newline #\page #.(code-char 11)))) ))