! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: peg peg.ebnf smalltalk.ast sequences sequences.deep strings
math.parser kernel ;
IN: smalltalk.parser

! http://chronos-st.blogspot.com/2007/12/smalltalk-in-one-page.html

EBNF: parse-smalltalk

Character = .
WhitespaceCharacter = (" " | "\t" | "\n" | "\r" ) => [[ ignore ]]
DecimalDigit = [0-9]
Letter = [A-za-z]

CommentCharacter = [^"] | '""' => [[ CHAR: " ]]
Comment = '"' (CommentCharacter)*:s '"' => [[ s >string ast-comment boa ]]

OptionalWhiteSpace = (WhitespaceCharacter | Comment)* => [[ ignore swap remove ]]
Whitespace = (WhitespaceCharacter | Comment)+ => [[ ignore swap remove ]]

LetterOrDigit = DecimalDigit | Letter
Identifier = (Letter | "_"):h (LetterOrDigit | "_")*:t => [[ { h t } flatten >string ]]
Reference = Identifier

ConstantReference = 
                  "nil" => [[ ast-nil ]]
                | "false" => [[ f ]]
                | "true" => [[ t ]]
PseudoVariableReference = 
                  "self" => [[ ast-self ]]
                | "super" => [[ ast-super ]]
ReservedIdentifier = PseudoVariableReference | ConstantReference

BindableIdentifier = Identifier

UnaryMessageSelector = Identifier

Keyword = Identifier:i ":" => [[ i ":" append ]]

KeywordMessageSelector = Keyword+ => [[ concat ]]
BinarySelectorChar = "~" | "!" | "@" | "%" | "&" | "*" | "-" | "+" | "=" | "|" | "\" | "<" | ">" | "," | "?" | "/"
BinaryMessageSelector = BinarySelectorChar+ => [[ concat ]]

IntegerLiteral = ("-" UnsignedIntegerLiteral) => [[ flatten >string string>number ]]
UnsignedIntegerLiteral = Radix:r "r" BaseNIntegerLiteral:b => [[ b >string r base> ]]  | DecimalIntegerLiteral
DecimalIntegerLiteral = DecimalDigit+ => [[ >string string>number ]]
Radix = DecimalIntegerLiteral
BaseNIntegerLiteral = LetterOrDigit+
ScaledDecimalLiteral = "-"? DecimalIntegerLiteral ("." DecimalIntegerLiteral)? "s" DecimalIntegerLiteral?
FloatingPointLiteral = "-"? DecimalIntegerLiteral ("." DecimalIntegerLiteral Exponent? | Exponent)
Exponent = ("e" | "d" | "q") ("-"? DecimalIntegerLiteral)?
CharacterLiteral = "$" Character
StringLiteral = "'" (StringLiteralCharacter | "''") "'"
StringLiteralCharacter = [^']
SymbolInArrayLiteral = (UnaryMessageSelector | KeywordMessageSelector | BinaryMessageSelector)
SymbolLiteral = "#" (ConstantReference | SymbolInArrayLiteral | StringLiteral)
ArrayLiteral = (ObjectArrayLiteral | ByteArrayLiteral)
ObjectArrayLiteral = "#" NestedObjectArrayLiteral
NestedObjectArrayLiteral = "(" OptionalWhiteSpace (LiteralArrayElement (Whitespace LiteralArrayElement)*)? OptionalWhiteSpace ")"
LiteralArrayElement = Literal | NestedObjectArrayLiteral | SymbolInArrayLiteral | ConstantReference
ByteArrayLiteral = "#[" OptionalWhiteSpace (UnsignedIntegerLiteral (Whitespace UnsignedIntegerLiteral)*)? OptionalWhiteSpace "]"

FormalBlockArgumentDeclaration = ":" BindableIdentifier
FormalBlockArgumentDeclarationList = FormalBlockArgumentDeclaration (Whitespace FormalBlockArgumentDeclaration)*
BlockLiteral = "[" (OptionalWhiteSpace FormalBlockArgumentDeclarationList OptionalWhiteSpace "|")? ExecutableCode OptionalWhiteSpace "]"

Literal = ConstantReference 
                | IntegerLiteral 
                | ScaledDecimalLiteral 
                | FloatingPointLiteral 
                | CharacterLiteral 
                | StringLiteral 
                | SymbolLiteral 
                | ArrayLiteral 
                | BlockLiteral

NestedExpression = "(" Statement OptionalWhiteSpace ")"
Operand =       Literal 
                | Reference 
                | NestedExpression

UnaryMessage = UnaryMessageSelector
UnaryMessageChain = (OptionalWhiteSpace UnaryMessage)*
BinaryMessageOperand = Operand UnaryMessageChain
BinaryMessage = BinaryMessageSelector OptionalWhiteSpace BinaryMessageOperand
BinaryMessageChain = (OptionalWhiteSpace BinaryMessage)*
KeywordMessageArgument = BinaryMessageOperand BinaryMessageChain
KeywordMessageSegment = Keyword OptionalWhiteSpace KeywordMessageArgument
KeywordMessage = KeywordMessageSegment (OptionalWhiteSpace KeywordMessageSegment)*
MessageChain = 
                UnaryMessage UnaryMessageChain BinaryMessageChain (KeywordMessage)? 
                | BinaryMessage BinaryMessageChain (KeywordMessage)?
                | KeywordMessage
CascadedMessage = ";" OptionalWhiteSpace MessageChain
Expression = Operand (OptionalWhiteSpace MessageChain (OptionalWhiteSpace CascadedMessage)*)?

AssignmentOperation = OptionalWhiteSpace BindableIdentifier OptionalWhiteSpace ":="
Statement = (AssignmentOperation)* OptionalWhiteSpace Expression
MethodReturnOperator = OptionalWhiteSpace "^"
FinalStatement = (MethodReturnOperator)? Statement
LocalVariableDeclarationList = OptionalWhiteSpace "|" OptionalWhiteSpace (BindableIdentifier (Whitespace BindableIdentifier)*)? OptionalWhiteSpace "|"
ExecutableCode = (LocalVariableDeclarationList)? ((Statement OptionalWhiteSpace ".")* FinalStatement (".")?)?

UnaryMethodHeader = UnaryMessageSelector
BinaryMethodHeader = BinaryMessageSelector OptionalWhiteSpace BindableIdentifier
KeywordMethodHeaderSegment = Keyword OptionalWhiteSpace BindableIdentifier
KeywordMethodHeader = KeywordMethodHeaderSegment (Whitespace KeywordMethodHeaderSegment)*
MethodHeader = 
                UnaryMethodHeader 
                | BinaryMethodHeader 
                | KeywordMethodHeader
MethodDeclaration = OptionalWhiteSpace MethodHeader ExecutableCode End

End = !(.)
;EBNF