length [] = 0
length (x:xs) = 1 + (length xs)


|| ---------------------------------------------
|| PART III
||
|| Question 1.)

tokens :: [char]->[token]

token ::= LeftParen | RightParen | Quote | StringToken [char] | NumToken num | SymbolToken [char]

whitespace = [' ', '\n', '\t']
nonchunk = whitespace ++ ['(', ')', '"', ''']

tokens [] = []
tokens (  x  : xs ) =                   tokens xs, if member whitespace x
tokens ( '(' : xs ) = LeftParen       : tokens xs
tokens ( ')' : xs ) = RightParen      : tokens xs
tokens ( ''' : xs ) = Quote           : tokens xs
tokens ( '"' : xs )
      = StringToken str : tokens (drop (1 + (length str)) xs)
        where str = reverse (getString [] xs)
                    where getString sofar []             = error "error, unfinished string. tokens"
                          getString sofar ( '"' : rest ) = sofar
                          getString sofar (  x  : rest ) = getString (x:sofar) rest
tokens (  x  : xs ) = NumToken (numval chunk) : tokens (drop (length chunk) (x:xs)), if (looksLikeNum chunk)
                    = SymbolToken chunk       : tokens (drop (length chunk) (x:xs)), otherwise
                      where chunk = getChunk (x:xs)

looksLikeNum (x:y:xs) = True, if (digit x \/ x = '-') & (allDigits (y:xs))
                      = False, otherwise
looksLikeNum (xs) = allDigits xs

allDigits [] = True
allDigits (x:xs) = digit x & allDigits xs

getChunk [] = []
getChunk (x:xs) = x : getChunk xs, if (~(member nonchunk x))
getChunk (xs) = []


|| Question 2.)

expr ::= StringExpr [char] | NumberExpr num | ListExpr [expr] | SymbolExpr [char]

tokexpr ::= Tok token | Expr expr

parse :: [token]->[expr]

parse the_tokens = reverse (tokexpr_to_expr (psr [] the_tokens))

|| ---------------------------------------------
|| psr (parse shift reduce)  stack      input    newstack

psr :: [tokexpr]->[token]->[tokexpr]

|| reduce rules

psr (Tok (StringToken str) : stack) input = psr (Expr (StringExpr str) : stack) input
psr (Tok (SymbolToken str) : stack) input = psr (Expr (SymbolExpr str) : stack) input
psr (Tok (NumToken num   ) : stack) input = psr (Expr (NumberExpr num) : stack) input
psr (Tok RightParen        : stack) input
        = psr (Expr (ListExpr (tokexpr_to_expr lst)) : (drop (1 + (length lst)) stack)) input
          where lst = getList [] stack
                      where getList sofar [] = error "extra right paren. psr"
                            getList sofar (Tok LeftParen:xs) = sofar
                            getList sofar (x:xs) = getList (x:sofar) xs

psr (Expr x : Tok (Quote)  : stack) input
        = psr (Expr (ListExpr ((SymbolExpr "quote"):[x])):stack) input

|| if no reduce rules can be applied, then do a shift

psr stack (t:ts) = psr ((Tok t) : stack) ts

|| if no reduce rules can be applied and we have no more input, return

psr stack [] = stack

|| ---------------------------------------------
|| tokexpr_to_expr pattern matches only on expr

tokexpr_to_expr [] = []
tokexpr_to_expr (Expr e:xs) = e: tokexpr_to_expr xs
tokexpr_to_expr xs = error "error, can't convert token to expr. tokexpr_to_expr"

|| Question 3.)
||
|| ---------------------------------------------
|| scheme_read reads in a single Scheme expression

scheme_read :: [char]->expr

scheme_read (xs)
      = scheme_read_helper (parse (tokens xs))
        where scheme_read_helper (a:b:xs) = error "error, too many expressions. read"
              scheme_read_helper (x:xs) = x
              scheme_read_helper [] = error "error, too few expressions. read"