sources/main

   1 trylon main
   2
   3 the-compiler = nil
   4
   5 main: arguments
   6         return-value = 0
   7         try
   8                 # Parse the arguments.
   9                 file-names = List new
  10                 compile-symbols = List new
  11                 do-lex-test = false
  12                 do-coke-lexer-test = false
  13                 do-words-lexer-test = false
  14                 do-lines-lexer-test = false
  15                 for arg in arguments tail
  16                         if arg starts-with: "--"
  17                                 compile-symbols append: (arg substr: 2)
  18                                 if arg == "--lex-test"
  19                                         do-lex-test = true
  20                                 else if arg == "--test-coke-lexer"
  21                                         do-coke-lexer-test = true
  22                                 else if arg == "--test-words-lexer"
  23                                         do-words-lexer-test = true
  24                                 else if arg == "--test-lines-lexer"
  25                                         do-lines-lexer-test = true
  26                                 else if arg == "--verbose"
  27                                         # Allowed.
  28                                 else
  29                                         throw MessageException new: ("Unknown option: " + arg)
  30                         else
  31                                 file-names append: arg
  32
  33                 if do-lex-test
  34                         for arg in arguments tail tail
  35                                 lex-test: arg
  36                 else if do-coke-lexer-test
  37                         for arg in arguments tail tail
  38                                 test-coke-lexer: arg
  39                 else if do-words-lexer-test
  40                         for arg in arguments tail tail
  41                                 test-words-lexer: arg
  42                 else if do-lines-lexer-test
  43                         for arg in arguments tail tail
  44                                 test-lines-lexer: arg
  45
  46                 else
  47                         return-value = Compiler compile: compile-symbols
  48
  49         catch Exception
  50                 print-line: exception message
  51                 return 1
  52
  53         return return-value
  54
  55
  56 iff in-trylid
  57         run-command-line
  58                 CommandLine new run
  59
  60
  61 status-reporter
  62         return the-compiler status-reporter
  63
  64 debug: message
  65         iff debugging
  66                 print-line: message
  67
  68 log: message
  69         status-reporter report: message
  70 log-indent
  71         status-reporter indent
  72 log-unindent
  73         status-reporter unindent
  74
  75
  76 iff !in-trylid
  77         class Expression
  78                 field tuple
  79
  80                 create: num-items
  81                         tuple = Tuple new: num-items
  82
  83                 class-fn with: value
  84                         expr = Expression new: 1
  85                         expr at: 0 put: value
  86                         return expr
  87
  88                 class-fn with: value-1 with: value-2
  89                         expr = Expression new: 2
  90                         expr at: 0 put: value-1
  91                         expr at: 1 put: value-2
  92                         return expr
  93
  94                 class-fn with: value-1 with: value-2 with: value-3
  95                         expr = Expression new: 3
  96                         expr at: 0 put: value-1
  97                         expr at: 1 put: value-2
  98                         expr at: 2 put: value-3
  99                         return expr
 100
 101                 class-fn with: value-1 with: value-2 with: value-3 with: value-4
 102                         expr = Expression new: 4
 103                         expr at: 0 put: value-1
 104                         expr at: 1 put: value-2
 105                         expr at: 2 put: value-3
 106                         expr at: 3 put: value-4
 107                         return expr
 108
 109                 class-fn        --
 110                         with: value-1 with: value-2 with: value-3 with: value-4 with: value-5
 111                         expr = Expression new: 5
 112                         expr at: 0 put: value-1
 113                         expr at: 1 put: value-2
 114                         expr at: 2 put: value-3
 115                         expr at: 3 put: value-4
 116                         expr at: 4 put: value-5
 117                         return expr
 118
 119                 at: index put: value
 120                         tuple at: index put: value
 121
 122                 at: index
 123                         return tuple at: index
 124
 125                 iterator
 126                         return tuple iterator
 127
 128                 num-items
 129                         return tuple num-items
 130
 131                 emit: stream
 132                         reporter = nil
 133                         iff debug-emission
 134                                 reporter = the-compiler status-reporter
 135                                 reporter report: "("
 136                                 reporter indent
 137
 138                         if num-items == 2 && (this at: 0) == 'quote'
 139                                 value = this at: 1
 140                                 if (value is-a: InternedString)
 141                                         c = value first-character
 142                                   if (c < `A`) || (c >= `{`) || (c == `[`) || (c == `]`)
 143                                                 # Special-case non-alpha symbols.
 144                                                 stream write: "['\""
 145                                                 stream write: value string
 146                                                 stream write: "\" asSymbol]"
 147                                                 return
 148                                 stream write: "'"
 149                                 emit-value: value on: stream
 150                                 iff debug-emission
 151                                         reporter unindent
 152                                 return
 153
 154                         else if num-items >= 3 && (this at: 0) == 'send' &&     --
 155                                 ((this at: 1) is-a: Expression) &&      --
 156                                                         ((this at: 1) at: 0) == 'quote'
 157                                 stream write: "["
 158                                 emit-value: (this at: 2) on: stream
 159                                 stream write: " "
 160                                 emit-value: ((this at: 1) at: 1) on: stream
 161                                 index = 3
 162                                 while index < num-items
 163                                         stream write: " "
 164                                         emit-value: (this at: index) on: stream
 165                                         index += 1
 166                                 stream write: "]"
 167                                 return
 168
 169                         stream write: "("
 170                         done-one = false
 171                         for value in tuple
 172                                 if done-one
 173                                         stream write: " "
 174                                 else
 175                                         done-one = true
 176                                 emit-value: value on: stream
 177                         stream write: ")"
 178
 179                         iff debug-emission
 180                                 reporter unindent
 181                                 reporter report: ")"
 182
 183                 emit-value: value on: stream
 184                         if (value is-a: String) && !(value is-a: Symbol)
 185                                 stream write: "\""
 186                                 stream write: value
 187                                 stream write: "\""
 188                         else if value is-a: Expression
 189                                 value emit: stream
 190                         else
 191                                 stream write: value string
 192
 193 iff in-trylid
 194         class Expression
 195                 superclass Pepsi Expression
 196
 197                 new: size
 198                         return super new: size asInteger
 199
 200                 num-items
 201                         return this size int
 202
 203                 at: index
 204                         return super at: index asInteger
 205
 206                 at: index put: value
 207                         super at: index asInteger put: value
 208
 209                 emit: stream
 210                         reporter = nil
 211                         iff debug-emission
 212                                 reporter = the-compiler status-reporter
 213                                 reporter report: "("
 214                                 reporter indent
 215
 216                         if num-items == 2 && (this at: 0) == 'quote'
 217                                 value = this at: 1
 218                                 if (value is-a: Pepsi Symbol)
 219                                         c = value string first-character
 220                                   if (c < `A`) || (c >= `{`) || (c == `[`) || (c == `]`)
 221                                                 # Special-case non-alpha symbols.
 222                                                 stream write: "['\""
 223                                                 stream write: value string
 224                                                 stream write: "\" asSymbol]"
 225                                                 return
 226                                 stream write: "'"
 227                                 emit-value: value on: stream
 228                                 iff debug-emission
 229                                         reporter unindent
 230                                 return
 231
 232                         if num-items >= 3 && (this at: 0) == 'send' &&  --
 233                                  ((this at: 1) is-a: Expression) &&     --
 234                            ((this at: 1) at: 0) == 'quote'
 235                                 stream write: "["
 236                                 emit-value: (this at: 2) on: stream
 237                                 stream write: " "
 238                                 emit-value: ((this at: 1) at: 1) on: stream
 239                                 index = 3
 240                                 while index < num-items
 241                                         stream write: " "
 242                                         emit-value: (this at: index) on: stream
 243                                         index += 1
 244                                 stream write: "]"
 245                                 return
 246
 247                         stream write: "("
 248                         index = 0
 249                         while index < num-items
 250                                 if index > 0
 251                                         stream write: " "
 252                                 emit-value: (this at: index) on: stream
 253                                 index += 1
 254                         stream write: ")"
 255
 256                         iff debug-emission
 257                                 reporter unindent
 258                                 reporter report: ")"
 259
 260                 emit-value: value on: stream
 261                         if value is-a: String
 262                                 stream write: "\""
 263                                 stream write: value
 264                                 stream write: "\""
 265                         else if value is-a: Expression
 266                                 value emit: stream
 267                         else
 268                                 stream write: value string
 269
 270
 271 iff !in-trylid
 272         class InternedString
 273                 field string
 274
 275                 create: string
 276                         this string = string
 277
 278                 fn == string
 279                         return this string == string
 280
 281                 fn first-character
 282                         return string first-character
 283
 284
 285 extend String
 286         intern
 287                 iff !in-trylid
 288                         return InternedString new: this
 289                 iff in-trylid
 290                         return this asSymbol
 291
 292
 293 # Test.
 294
 295 lex-test: filename
 296         try
 297                 lexer = Compiler Lexer new: (File new: filename) contents
 298                 loop
 299                         token = lexer next-token
 300                         print: token type
 301                         if token text && !token text is-empty
 302                                 print: ": "
 303                                 print: token text
 304                         print-line
 305                         if token type == 'eof'
 306                                 break
 307         catch Exception
 308                 print-line: "Error: " + exception message
 309
 310
 311 test-coke-lexer: filename
 312         try
 313                 lines = List new
 314                 for line in (File new: filename) contents lines
 315                         lines append: line
 316                 lexer = Compiler CokeLexer new: lines
 317                 loop
 318                         expr = lexer next-expr
 319                         if expr == nil
 320                                 break
 321                         dump-expr: expr level: 0
 322                         print-line
 323         catch Exception
 324                 print-line: "Error: " + exception message
 325
 326
 327 dump-expr: expr level: level
 328         print: ("                                   " substr: 0 length: level)
 329         if expr is-a: Expression
 330                 print-line: "Expression (" + expr num-items string + ")"
 331                 for item in expr
 332                         dump-expr: item level: level + 1
 333         else if expr is-a: String
 334                 print-line: "\"" + expr + "\""
 335         else
 336                 print-line: expr string
 337
 338
 339 test-words-lexer: filename
 340         try
 341                 for line in (File new: filename) contents lines
 342                         lexer = Compiler WordsLexer new: line
 343                         while !lexer is-done
 344                                 print-line: lexer next
 345         catch Exception
 346                 print-line: "Error: " + exception message
 347
 348
 349 test-lines-lexer: filename
 350         try
 351                 lexer = Compiler LinesLexer new: (File new: filename) contents
 352                 lines = lexer lex
 353                 dump-lines: lines level: 0
 354         catch Exception
 355                 print-line: "Error: " + exception message
 356
 357
 358 dump-lines: lines level: level
 359         for line in lines
 360                 print: level string
 361                 print: "> "
 362                 print-line: line text
 363                 if line block
 364                         dump-lines: line block level: level + 1
 365
 366
 367
 368 # Copyright 2007 Steve Folta.  See the License file.
 369