1 ! Copyright (C) 2009 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: peg peg.ebnf smalltalk.ast sequences sequences.deep strings
4 math.parser kernel arrays byte-arrays math assocs accessors ;
7 ! :mode=text:noTabs=true:
9 ! Based on http://chronos-st.blogspot.com/2007/12/smalltalk-in-one-page.html
11 ERROR: bad-number str ;
13 : check-number ( str -- n )
14 >string dup string>number [ ] [ bad-number ] ?if ;
19 WhitespaceCharacter = (" " | "\t" | "\n" | "\r" )
23 CommentCharacter = [^"] | '""' => [[ CHAR: " ]]
24 Comment = '"' (CommentCharacter)*:s '"' => [[ s >string ast-comment boa ]]
26 OptionalWhiteSpace = (WhitespaceCharacter | Comment)*
27 Whitespace = (WhitespaceCharacter | Comment)+
29 LetterOrDigit = DecimalDigit | Letter
30 Identifier = (Letter | "_"):h (LetterOrDigit | "_")*:t => [[ { h t } flatten >string ]]
31 Reference = Identifier => [[ ast-name boa ]]
33 ConstantReference = "nil" => [[ nil ]]
36 PseudoVariableReference = "self" => [[ self ]]
37 | "super" => [[ super ]]
38 ReservedIdentifier = PseudoVariableReference | ConstantReference
40 BindableIdentifier = Identifier
42 UnaryMessageSelector = Identifier
44 Keyword = Identifier:i ":" => [[ i ":" append ]]
46 KeywordMessageSelector = Keyword+ => [[ concat ]]
47 BinarySelectorChar = "~" | "!" | "@" | "%" | "&" | "*" | "-" | "+"
48 | "=" | "|" | "\\" | "<" | ">" | "," | "?" | "/"
49 BinaryMessageSelector = BinarySelectorChar+ => [[ concat ]]
51 OptionalMinus = ("-" => [[ CHAR: - ]])?
52 IntegerLiteral = (OptionalMinus:m UnsignedIntegerLiteral:i) => [[ i m [ neg ] when ]]
53 UnsignedIntegerLiteral = Radix:r "r" BaseNIntegerLiteral:b => [[ b >string r base> ]]
54 | DecimalIntegerLiteral => [[ check-number ]]
55 DecimalIntegerLiteral = DecimalDigit+
56 Radix = DecimalIntegerLiteral => [[ check-number ]]
57 BaseNIntegerLiteral = LetterOrDigit+
58 FloatingPointLiteral = (OptionalMinus
60 ("." => [[ CHAR: . ]] DecimalIntegerLiteral Exponent? | Exponent))
61 => [[ flatten check-number ]]
62 Exponent = "e" => [[ CHAR: e ]] (OptionalMinus DecimalIntegerLiteral)?
64 CharacterLiteral = "$" Character:c => [[ c ]]
66 StringLiteral = "'" (StringLiteralCharacter | "''" => [[ CHAR: ' ]])*:s "'"
68 StringLiteralCharacter = [^']
70 SymbolInArrayLiteral = KeywordMessageSelector
71 | UnaryMessageSelector
72 | BinaryMessageSelector
73 SymbolLiteral = "#" (SymbolInArrayLiteral | StringLiteral):s => [[ s intern ]]
75 ArrayLiteral = (ObjectArrayLiteral | ByteArrayLiteral)
76 ObjectArrayLiteral = "#" NestedObjectArrayLiteral:elts => [[ elts ]]
77 NestedObjectArrayLiteral = "(" OptionalWhiteSpace
78 (LiteralArrayElement:h
79 (Whitespace LiteralArrayElement:e => [[ e ]])*:t
81 )?:elts OptionalWhiteSpace ")" => [[ elts >array ]]
83 LiteralArrayElement = Literal
84 | NestedObjectArrayLiteral
85 | SymbolInArrayLiteral
88 ByteArrayLiteral = "#[" OptionalWhiteSpace
89 (UnsignedIntegerLiteral:h
90 (Whitespace UnsignedIntegerLiteral:i => [[ i ]])*:t
92 )?:elts OptionalWhiteSpace "]" => [[ elts >byte-array ]]
94 FormalBlockArgumentDeclaration = ":" BindableIdentifier:i => [[ i ]]
95 FormalBlockArgumentDeclarationList =
96 FormalBlockArgumentDeclaration:h
97 (Whitespace FormalBlockArgumentDeclaration:v => [[ v ]])*:t
102 FormalBlockArgumentDeclarationList:args
108 "]" => [[ args >array body <ast-block> ]]
110 Literal = (ConstantReference
111 | FloatingPointLiteral
119 NestedExpression = "(" Statement:s OptionalWhiteSpace ")" => [[ s ]]
121 | PseudoVariableReference
125 UnaryMessage = OptionalWhiteSpace
126 UnaryMessageSelector:s !(":")
127 => [[ s { } ast-message boa ]]
129 BinaryMessage = OptionalWhiteSpace
130 BinaryMessageSelector:selector
132 (UnaryMessageSend | Operand):rhs
133 => [[ selector { rhs } ast-message boa ]]
135 KeywordMessageSegment = Keyword:k OptionalWhiteSpace (BinaryMessageSend | UnaryMessageSend | Operand):arg => [[ { k arg } ]]
136 KeywordMessage = OptionalWhiteSpace
137 KeywordMessageSegment:h
138 (OptionalWhiteSpace KeywordMessageSegment:s => [[ s ]])*:t
139 => [[ t h prefix unzip [ concat ] dip ast-message boa ]]
141 Message = BinaryMessage | UnaryMessage | KeywordMessage
143 UnaryMessageSend = (UnaryMessageSend | Operand):lhs
145 (OptionalWhiteSpace ";" Message:m => [[ m ]])*:t
146 => [[ lhs t h prefix >array <ast-cascade> ]]
148 BinaryMessageSend = (BinaryMessageSend | UnaryMessageSend | Operand):lhs
150 (OptionalWhiteSpace ";" Message:m => [[ m ]])*:t
151 => [[ lhs t h prefix >array <ast-cascade> ]]
153 KeywordMessageSend = (BinaryMessageSend | UnaryMessageSend | Operand):lhs
155 (OptionalWhiteSpace ";" Message:m => [[ m ]])*:t
156 => [[ lhs t h prefix >array <ast-cascade> ]]
158 Expression = OptionalWhiteSpace
159 (KeywordMessageSend | BinaryMessageSend | UnaryMessageSend | Operand):e
162 AssignmentOperation = OptionalWhiteSpace BindableIdentifier:i
163 OptionalWhiteSpace ":=" OptionalWhiteSpace => [[ i ast-name boa ]]
164 AssignmentStatement = AssignmentOperation:a Statement:s => [[ a s ast-assignment boa ]]
165 Statement = ClassDeclaration | ForeignClassDeclaration | AssignmentStatement | Expression
167 MethodReturnOperator = OptionalWhiteSpace "^"
168 FinalStatement = (MethodReturnOperator Statement:s => [[ s ast-return boa ]])
171 LocalVariableDeclarationList = OptionalWhiteSpace "|" OptionalWhiteSpace
172 (BindableIdentifier:h
173 (Whitespace BindableIdentifier:b => [[ b ]])*:t
175 )?:b OptionalWhiteSpace "|" => [[ b >array ast-local-variables boa ]]
179 ExecutableCode = (LocalVariableDeclarationList)?:locals
180 (Statement:s OptionalWhiteSpace EndStatement => [[ s ]])*:h
181 (FinalStatement:t (EndStatement)? => [[ t ]])?:t
183 => [[ h t [ suffix ] when* locals [ prefix ] when* >array ]]
185 TopLevelForm = ExecutableCode => [[ <ast-sequence> ]]
187 UnaryMethodHeader = UnaryMessageSelector:selector
188 => [[ { selector { } } ]]
189 BinaryMethodHeader = BinaryMessageSelector:selector OptionalWhiteSpace BindableIdentifier:identifier
190 => [[ { selector { identifier } } ]]
191 KeywordMethodHeaderSegment = Keyword:keyword
193 BindableIdentifier:identifier => [[ { keyword identifier } ]]
194 KeywordMethodHeader = KeywordMethodHeaderSegment:h (Whitespace KeywordMethodHeaderSegment:s => [[ s ]])*:t
195 => [[ t h prefix unzip [ concat ] dip 2array ]]
196 MethodHeader = KeywordMethodHeader
199 MethodDeclaration = OptionalWhiteSpace "method" OptionalWhiteSpace MethodHeader:header
200 OptionalWhiteSpace "["
203 => [[ header first2 code <ast-method> ]]
205 ClassDeclaration = OptionalWhiteSpace "class" OptionalWhiteSpace Identifier:name
207 ("extends" OptionalWhiteSpace Identifier:superclass OptionalWhiteSpace => [[ superclass ]])?:superclass
208 OptionalWhiteSpace "["
209 (OptionalWhiteSpace LocalVariableDeclarationList:l => [[ l names>> ]])?:ivars
214 MethodDeclaration:m => [[ m ]])*:t (EndStatement)?
217 OptionalWhiteSpace "]"
218 => [[ name superclass "Object" or ivars >array methods >array ast-class boa ]]
220 ForeignClassDeclaration = OptionalWhiteSpace "foreign"
221 OptionalWhiteSpace Identifier:name
222 OptionalWhiteSpace Literal:class
223 => [[ class name ast-foreign boa ]]
226 Program = TopLevelForm End