;;;; mother modular generic compiler project
; (c)2001,2002/GPL Oskar Schirmer <oskar@scara.com>
; see file COPYING for GPL license details

; finite automaton scanner description for pascal
; according to K. Jensen, N. Wirth, "Pascal User Manual and Report",
;   ISBN 0-387-90144-2, ISBN 3-540-90144-2

(finite-automaton
  '(
    (initial
      ((#\space #\newline #\tab #\return #\page)
                    #f get  #f initial     #f)
      ((#\A . #\Z) #t  get pos word        #f)
      ((#\a . #\z) up  get pos word        #f)
      ((#\0 . #\9) #t  get pos number      #f)
      (#\.          #f get pos period      #f)
      (#\,          #f get pos initial     comma)
      (#\;          #f get pos initial     semicolon)
      (#\:          #f get pos colon       #f)
      (#\<         #t  get pos less        #f)
      (#\>         #t  get pos greater     #f)
      (#\=         #t  get pos initial     compare)
      ((#\+ #\-)   #t  get pos initial     add)
      ((#\* #\/)   #t  get pos initial     mul)
      (#\^          #f get pos initial     pointer)
      (#\'          #f get pos quote       #f)
      (#\(          #f get pos lparen      #f)
      (#\)          #f get pos initial     rparen)
      (#\[          #f get pos initial     lbracket)
      (#\]          #f get pos initial     rbracket)
      (#\{          #f get  #f lbrace      #f)
      (else         #f  #f  #f #f          #f)
    )
    (word
      ((#\A . #\Z) #t  get  #f word        #f)
      ((#\a . #\z) up  get  #f word        #f)
      ((#\0 . #\9) #t  get  #f word        #f)
      (else         #f  #f  #f initial     word)
    )
    (number
      ((#\0 . #\9) #t  get  #f number      #f)
      (#\.          #f get  #f numberdot   #f)
      (#\E         #t  get  #f realexpon   #f)
      ((#\A . #\Z) #t   #f  #f error       "error in constant (50)")
      ((#\a . #\z) #t   #f  #f error       "error in constant (50)")
      (else         #f  #f  #f initial     integer)
    )
    (numberdot
      (#\.          #f  #f  #f period_numb integer)
      ((#\0 . #\9) #\.  #f  #f realdecimal #f)
      (else        #\.  #f  #f initial
                               "error in real constant: digit expected (201)")
    )
    (realdecimal
      ((#\0 . #\9) #t  get  #f realdecimal #f)
      (#\E         #t  get  #f realexpon   #f)
      ((#\A . #\Z) #t   #f  #f initial "error in constant (50)")
      ((#\a . #\z) #t   #f  #f initial "error in constant (50)")
      (else         #f  #f  #f initial     number)
    )
    (realexpon
      ((#\+ #\-)   #t  get  #f realexpon2  #f)
      (else         #f  #f  #f realexpon2  #f)
    )
    (realexpon2
      ((#\0 . #\9) #t  get  #f realexpon3  #f)
      (else        #t   #f  #f initial
                               "error in real constant: digit expected (201)")
    )
    (realexpon3
      ((#\0 . #\9) #t  get  #f realexpon3  #f)
      ((#\A . #\Z) #t   #f  #f initial "error in constant (50)")
      ((#\a . #\z) #t   #f  #f initial "error in constant (50)")
      (else         #f  #f  #f initial     number)
    )
    (period_numb
      (else         #f get pos initial     twodots)
    )
    (period
      (#\.          #f get  #f initial     twodots)
      (else         #f  #f  #f initial     period)
    )
    (colon
      (#\=          #f get  #f initial     be)
      (else         #f  #f  #f initial     colon)
    )
    (less
      ((#\= #\>)   #t  get  #f initial     compare)
      (else         #f  #f  #f initial     compare)
    )
    (greater
      (#\=         #t  get  #f initial     compare)
      (else         #f  #f  #f initial     compare)
    )
    (quote
      (#\'          #f get  #f quoteend    #f)
      (#\newline   #t   #f  #f initial
                          "string constant must not exceed source line (202)")
      (else        #t  get  #f quote       #f)
    )
    (quoteend
      (#\'         #t  get  #f quote       #f)
      (else         #f  #f  #f initial     string)
    )
    (lparen
      (#\*          #f get  #f commentp    #f)
      (else         #f  #f  #f initial     lparen)
    )
    (commentp
      (#\*          #f get  #f commentp2   #f)
      (else         #f get  #f commentp    #f)
    )
    (commentp2
      (#\)          #f get  #f initial     #f)
      (#\*          #f get  #f commentp2   #f)
      (else         #f get  #f commentp    #f)
    )
    (lbrace
      (#\}          #f get  #f initial     #f)
      (else         #f get  #f lbrace      #f)
    )
  )
)

