extra/smalltalk/parser/parser.factor

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