extra/smalltalk/parser/parser.factor

   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 ;
   5 IN: smalltalk.parser
   6
   7 ! :mode=text:noTabs=true:
   8
   9 ! Based on http://chronos-st.blogspot.com/2007/12/smalltalk-in-one-page.html
  10
  11 ERROR: bad-number str ;
  12
  13 : check-number ( str -- n )
  14     >string dup string>number [ ] [ bad-number ] ?if ;
  15
  16 EBNF: parse-smalltalk
  17
  18 Character = .
  19 WhitespaceCharacter = (" " | "\t" | "\n" | "\r" )
  20 DecimalDigit = [0-9]
  21 Letter = [A-Za-z]
  22
  23 CommentCharacter = [^"] | '""' => [[ CHAR: " ]]
  24 Comment = '"' (CommentCharacter)*:s '"' => [[ s >string ast-comment boa ]]
  25
  26 OptionalWhiteSpace = (WhitespaceCharacter | Comment)*
  27 Whitespace = (WhitespaceCharacter | Comment)+
  28
  29 LetterOrDigit = DecimalDigit | Letter
  30 Identifier = (Letter | "_"):h (LetterOrDigit | "_")*:t => [[ { h t } flatten >string ]]
  31 Reference = Identifier => [[ ast-name boa ]]
  32
  33 ConstantReference =   "nil" => [[ nil ]]
  34                     | "false" => [[ f ]]
  35                     | "true" => [[ t ]]
  36 PseudoVariableReference =   "self" => [[ self ]]
  37                           | "super" => [[ super ]]
  38 ReservedIdentifier = PseudoVariableReference | ConstantReference
  39
  40 BindableIdentifier = Identifier
  41
  42 UnaryMessageSelector = Identifier
  43
  44 Keyword = Identifier:i ":" => [[ i ":" append ]]
  45
  46 KeywordMessageSelector = Keyword+ => [[ concat ]]
  47 BinarySelectorChar =   "~" | "!" | "@" | "%" | "&" | "*" | "-" | "+"
  48                      | "=" | "|" | "\" | "<" | ">" | "," | "?" | "/"
  49 BinaryMessageSelector = BinarySelectorChar+ => [[ concat ]]
  50
  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
  59                         DecimalIntegerLiteral
  60                         ("." => [[ CHAR: . ]] DecimalIntegerLiteral Exponent? | Exponent))
  61                         => [[ flatten check-number ]]
  62 Exponent = "e" => [[ CHAR: e ]] (OptionalMinus DecimalIntegerLiteral)?
  63
  64 CharacterLiteral = "$" Character:c => [[ c ]]
  65
  66 StringLiteral = "'" (StringLiteralCharacter | "''" => [[ CHAR: ' ]])*:s "'"
  67                 => [[ s >string ]]
  68 StringLiteralCharacter = [^']
  69
  70 SymbolInArrayLiteral =   KeywordMessageSelector
  71                        | UnaryMessageSelector
  72                        | BinaryMessageSelector
  73 SymbolLiteral = "#" (SymbolInArrayLiteral | StringLiteral):s => [[ s intern ]]
  74
  75 ArrayLiteral = (ObjectArrayLiteral | ByteArrayLiteral)
  76 ObjectArrayLiteral = "#" NestedObjectArrayLiteral:elts => [[ elts ]]
  77 NestedObjectArrayLiteral = "(" OptionalWhiteSpace
  78                            (LiteralArrayElement:h
  79                             (Whitespace LiteralArrayElement:e => [[ e ]])*:t
  80                             => [[ t h prefix ]]
  81                            )?:elts OptionalWhiteSpace ")" => [[ elts >array ]]
  82
  83 LiteralArrayElement =   Literal
  84                       | NestedObjectArrayLiteral
  85                       | SymbolInArrayLiteral
  86                       | ConstantReference
  87
  88 ByteArrayLiteral = "#[" OptionalWhiteSpace
  89                         (UnsignedIntegerLiteral:h
  90                          (Whitespace UnsignedIntegerLiteral:i => [[ i ]])*:t
  91                          => [[ t h prefix ]]
  92                         )?:elts OptionalWhiteSpace "]" => [[ elts >byte-array ]]
  93
  94 FormalBlockArgumentDeclaration = ":" BindableIdentifier:i => [[ i ]]
  95 FormalBlockArgumentDeclarationList =
  96                 FormalBlockArgumentDeclaration:h
  97                 (Whitespace FormalBlockArgumentDeclaration:v => [[ v ]])*:t
  98                 => [[ t h prefix ]]
  99
 100 BlockLiteral = "["
 101                 (OptionalWhiteSpace
 102                  FormalBlockArgumentDeclarationList:args
 103                  OptionalWhiteSpace
 104                  "|"
 105                  => [[ args ]]
 106                 )?:args
 107                 ExecutableCode:body
 108                 "]" => [[ args >array body <ast-block> ]]
 109
 110 Literal = (ConstantReference
 111                 | FloatingPointLiteral
 112                 | IntegerLiteral
 113                 | CharacterLiteral
 114                 | StringLiteral
 115                 | ArrayLiteral
 116                 | SymbolLiteral
 117                 | BlockLiteral)
 118
 119 NestedExpression = "(" Statement:s OptionalWhiteSpace ")" => [[ s ]]
 120 Operand =       Literal
 121                 | PseudoVariableReference
 122                 | Reference
 123                 | NestedExpression
 124
 125 UnaryMessage = OptionalWhiteSpace
 126                UnaryMessageSelector:s !(":")
 127                => [[ s { } ast-message boa ]]
 128
 129 BinaryMessage = OptionalWhiteSpace
 130                 BinaryMessageSelector:selector
 131                 OptionalWhiteSpace
 132                 (UnaryMessageSend | Operand):rhs
 133                 => [[ selector { rhs } ast-message boa ]]
 134
 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 ]]
 140
 141 Message = BinaryMessage | UnaryMessage | KeywordMessage
 142
 143 UnaryMessageSend = (UnaryMessageSend | Operand):lhs
 144               UnaryMessage:h
 145               (OptionalWhiteSpace ";" Message:m => [[ m ]])*:t
 146               => [[ lhs t h prefix >array <ast-cascade> ]]
 147
 148 BinaryMessageSend = (BinaryMessageSend | UnaryMessageSend | Operand):lhs
 149               BinaryMessage:h
 150               (OptionalWhiteSpace ";" Message:m => [[ m ]])*:t
 151               => [[ lhs t h prefix >array <ast-cascade> ]]
 152
 153 KeywordMessageSend = (BinaryMessageSend | UnaryMessageSend | Operand):lhs
 154               KeywordMessage:h
 155               (OptionalWhiteSpace ";" Message:m => [[ m ]])*:t
 156               => [[ lhs t h prefix >array <ast-cascade> ]]
 157
 158 Expression = OptionalWhiteSpace
 159              (KeywordMessageSend | BinaryMessageSend | UnaryMessageSend | Operand):e
 160              => [[ e ]]
 161
 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
 166
 167 MethodReturnOperator = OptionalWhiteSpace "^"
 168 FinalStatement = (MethodReturnOperator Statement:s => [[ s ast-return boa ]])
 169                  | Statement
 170
 171 LocalVariableDeclarationList = OptionalWhiteSpace "|" OptionalWhiteSpace
 172                 (BindableIdentifier:h
 173                  (Whitespace BindableIdentifier:b => [[ b ]])*:t
 174                  => [[ t h prefix ]]
 175                 )?:b OptionalWhiteSpace "|" => [[ b >array ast-local-variables boa ]]
 176
 177 EndStatement = "."
 178
 179 ExecutableCode = (LocalVariableDeclarationList)?:locals
 180                  (Statement:s OptionalWhiteSpace EndStatement => [[ s ]])*:h
 181                  (FinalStatement:t (EndStatement)? => [[ t ]])?:t
 182                  OptionalWhiteSpace
 183                  => [[ h t [ suffix ] when* locals [ prefix ] when* >array ]]
 184
 185 TopLevelForm = ExecutableCode => [[ <ast-sequence> ]]
 186
 187 UnaryMethodHeader = UnaryMessageSelector:selector
 188                   => [[ { selector { } } ]]
 189 BinaryMethodHeader = BinaryMessageSelector:selector OptionalWhiteSpace BindableIdentifier:identifier
 190                    => [[ { selector { identifier } } ]]
 191 KeywordMethodHeaderSegment = Keyword:keyword
 192                              OptionalWhiteSpace
 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
 197                | BinaryMethodHeader
 198                | UnaryMethodHeader
 199 MethodDeclaration = OptionalWhiteSpace "method" OptionalWhiteSpace MethodHeader:header
 200         OptionalWhiteSpace "["
 201         ExecutableCode:code
 202         "]"
 203         => [[ header first2 code <ast-method> ]]
 204
 205 ClassDeclaration = OptionalWhiteSpace "class" OptionalWhiteSpace Identifier:name
 206         OptionalWhiteSpace
 207         ("extends" OptionalWhiteSpace Identifier:superclass OptionalWhiteSpace => [[ superclass ]])?:superclass
 208         OptionalWhiteSpace "["
 209         (OptionalWhiteSpace LocalVariableDeclarationList:l => [[ l names>> ]])?:ivars
 210         (MethodDeclaration:h
 211          (OptionalWhiteSpace
 212           EndStatement
 213           OptionalWhiteSpace
 214           MethodDeclaration:m => [[ m ]])*:t (EndStatement)?
 215           => [[ t h prefix ]]
 216          )?:methods
 217         OptionalWhiteSpace "]"
 218         => [[ name superclass "Object" or ivars >array methods >array ast-class boa ]]
 219
 220 ForeignClassDeclaration = OptionalWhiteSpace "foreign"
 221                           OptionalWhiteSpace Identifier:name
 222                           OptionalWhiteSpace Literal:class
 223                           => [[ class name ast-foreign boa ]]
 224 End = !(.)
 225
 226 Program = TopLevelForm End
 227
 228 ;EBNF