###############################################################################
# Date:     Sat Feb 24 02:06:20 CST 2007
# Author:   John Quigley <jquigley@jquigley.com>
# Revision: $Id$
###############################################################################

Parser := Object clone do (

   operators := Map clone
   operators atPut( "(", true )
   operators atPut( ")", true )
   operators atPut( ",", true )
   operators atPut( "'", true )
   operators atPut( "`", true )
   operators atPut( ".", true )

   #---------------------------------------------------------------------------

   parseSexpr := method( expr, tokenList := parseTokens( expr )
      # XXX: DEBUG
      #tokenList foreach( token, writeln( "TOKEN: #{token}" interpolate ) )
      state     := list( 0, "" )
      sexprList := List clone

      while ( state at(1) isNil not,
         state = createSexpr( tokenList, state at(0) )
         if( state at(1) isNil, break, sexprList append(state at(1)) )
      )
      sexprList
   )

   #---------------------------------------------------------------------------

   createSexpr := method ( tokens, start,
      # if first token is a '(' expect a list
      firstToken := tokens at(start)

      if( firstToken isNil, return list(start, nil) )

      if( firstToken xtype == "LEFTPAREN" ) then (
         return createCons( tokens, start+1 )
      ) elseif ( firstToken xtype == "OP" ) then (
         retval := createSexpr( tokens, start+1 )
         return list( retval at(0), Sexpr cons(firstToken, retval at(1)) )
      ) else (
         return list( start+1, firstToken )
      )
   )

   #---------------------------------------------------------------------------

   createCons := method ( tokens, start,
      firstToken := tokens at(start)

      if( firstToken isNil ) then (
         Exception raise( "Token index #{start} is out of range" .. \
            "when creating CONS S-Expr" interpolate )
      )

      if( firstToken xtype == "OP" and firstToken lexeme == "." ) then (
         retval := createSexpr( tokens, start + 1 )
         if( tokens at(retval at(0)) isNil or
             tokens at(retval at(0)) xtype != "RIGHTPAREN" ) then (
            Exception raise( "The CDR part ending with #{tokens" .. \
               " at( retval at(0) - 1 ) lexeme} was not followed by a ')'" \
               interpolate )
         )
         return list( retval at(0) + 1, retval at(1) )
      ) elseif ( firstToken xtype == "RIGHTPAREN" ) then(
         return list( start + 1, Sexpr newAtom("nil") )
      ) else (
         car := createSexpr( tokens, start )
         cdr := createCons( tokens, car at(0) )
         return list( cdr at(0), Sexpr cons(car at(1), cdr at(1)) )
      )
   )
   
   #---------------------------------------------------------------------------

   parseTokens := method( expr,
      currentToken := Sequence clone
      sexpr        := Sexpr clone
      inString     := false
      isEscaping   := false
      tokens       := List clone

      for( idx, 0, expr size - 1,
         c := expr at(idx) asCharacter

         # seven main cases
         if( isEscaping ) then(
            # 1. escaping this character, whether in string or not
            currentToken appendSeq(c)
            isEscaping = false

         ) elseif ( c isEqualAnyCase("\\") ) then( 
            # 2. an escape character
            isEscaping = true

         ) elseif ( c isEqualAnyCase("\"") ) then(
            # 3. a quotation mark
            #
            # two sub-cases
            if(inString) then(
               # ending a string
               tokens append( sexpr newString(currentToken) )
               currentToken empty
               inString = false
            ) else (
               # starting a new string
               # if already in a token, finish it
               if( currentToken size > 0 ) then(
                  tokens append( sexpr newAtom(currentToken) ) )
               currentToken empty
               inString = true
            )

         ) elseif ( inString ) then( 
            # 4. inside a string, so just add the character
            currentToken appendSeq(c)

         ) elseif ( operators hasKey(c) ) then(
            # 5. special operator (and not inside a string)
            if( currentToken size > 0 ) then(
               tokens append( sexpr newAtom(currentToken) )
               currentToken empty
            )
            tokens append( sexpr newOperator(c) )

         # TODO: pcre used here?
         ) elseif ( c isEqualAnyCase(" ") or c isEqualAnyCase("\n") ) then(
            # 6. blank character, which will add to current token, if any
            if( currentToken size > 0 ) then(
               tokens append( sexpr newAtom(currentToken) )
               currentToken empty
            )

         ) else (
            # 7. a non-blank character being part of a symbol
            currentToken appendSeq(c) )
      )

      # add any trailing token
      if( currentToken size > 0 ) then(
         if( inString ) then(
            atom := sexpr newString(currentToken)
         ) else ( 
            atom := sexpr newAtom(currentToken)
         )
         tokens append( atom )
      )
      
      tokens
   )
)

# EOF