  Copyright ( c ) 2000 Galois Connections , Inc.
-- All rights reserved.  This software is distributed as
-- free software under the license in the file "LICENSE",
-- which is included in the distribution.

module Parse where

import Data.Char
import Text.ParserCombinators.Parsec hiding (token)

import Data


program :: Parser Code
program =
  do { whiteSpace
     ; ts <- tokenList
     ; eof
     ; return ts
     }

tokenList :: Parser Code
tokenList = many token <?> "list of tokens"

token :: Parser GMLToken
token =
       do { ts <- braces   tokenList          ; return (TBody ts) }
  <|>  do { ts <- brackets tokenList          ; return (TArray ts) }
  <|> (do { s  <- gmlString                   ; return (TString s) } <?> "string")
  <|> (do { t <- pident False                 ; return t }           <?> "identifier")
  <|> (do { char '/'   -- No whitespace after slash
          ; t <- pident True                  ; return t } <?> "binding identifier")
  <|> (do { n <- number                       ; return n } <?> "number")

pident :: Bool -> Parser GMLToken
pident rebind =
  do { id <- ident
     ; case (lookup id opTable) of
       Nothing -> if rebind then return (TBind id) else return (TId id)
       Just t  -> if rebind then error ("Attempted rebinding of identifier " ++ id) else return t
     }

ident :: Parser String
ident = lexeme $
  do { l <- letter
     ; ls <- many (satisfy (\x -> isAlphaNum x || x == '-' || x == '_'))
     ; return (l:ls)
     }

gmlString :: Parser String
gmlString = lexeme $ between (char '"') (char '"') (many (satisfy (\x -> isPrint x && x /= '"')))

-- Tests for numbers
-- Hugs breaks on big exponents (> ~40)
test_number = "1234 -1234 1 -0 0" ++
              " 1234.5678 -1234.5678 1234.5678e12 1234.5678e-12 -1234.5678e-12" ++
              " -1234.5678e12 -1234.5678E-12 -1234.5678E12" ++
              " 1234e11 1234E33 -1234e33 1234e-33" ++
              " 123e 123.4e 123ee 123.4ee 123E 123.4E 123EE 123.4EE"


-- Always int or real
number :: Parser GMLToken
number = lexeme $
  do { s <- optSign
     ; n <- decimal
     ;     do { string "."
              ; m <- decimal
              ; e <- option "" exponent'
              ; return (TReal (read (s ++ n ++ "." ++ m ++ e)))  -- FIXME: Handle error conditions
              }
       <|> do { e <- exponent'
              ; return (TReal (read (s ++ n ++ ".0" ++ e)))
              }
       <|> do { return (TInt (read (s ++ n))) }
     }

exponent' :: Parser String
exponent' = try $
  do { e <- oneOf "eE"
     ; s <- optSign
     ; n <- decimal
     ; return (e:s ++ n)
     }

decimal = many1 digit

optSign :: Parser String
optSign = option "" (string "-")


------------------------------------------------------
-- Library for tokenizing.

braces   p = between (symbol "{") (symbol "}") p
brackets p = between (symbol "[") (symbol "]") p

symbol name = lexeme (string name)

lexeme p = do{ x <- p; whiteSpace; return x  }

whiteSpace  = skipMany (simpleSpace <|> oneLineComment <?> "")
  where simpleSpace = skipMany1 (oneOf " \t\n\r\v")
        oneLineComment =
            do{ string "%"
              ; skipMany (noneOf "\n\r\v")
              ; return ()
              }


------------------------------------------------------------------------------

rayParse :: String -> Code
rayParse is = case (parse program "<stdin>" is) of
              Left err -> error (show err)
              Right x  -> x

rayParseF :: String -> IO Code
rayParseF file =
  do { r <- parseFromFile program file
     ; case r of
       Left err -> error (show err)
       Right x  -> return x
     }

run :: String -> IO ()
run is = case (parse program "" is) of
         Left err -> print err
         Right x  -> print x

runF :: IO ()
runF =
  do { r <- parseFromFile program "simple.gml"
     ; case r of
       Left err -> print err
       Right x  -> print x
     }

 All rights reserved.  This software is distributed as
 free software under the license in the file "LICENSE",
 which is included in the distribution.
 No whitespace after slash
 Tests for numbers
 Hugs breaks on big exponents (> ~40)
 Always int or real
 FIXME: Handle error conditions
----------------------------------------------------
 Library for tokenizing.
----------------------------------------------------------------------------
  Copyright ( c ) 2000 Galois Connections , Inc.

module Parse where

import Data.Char
import Text.ParserCombinators.Parsec hiding (token)

import Data


program :: Parser Code
program =
  do { whiteSpace
     ; ts <- tokenList
     ; eof
     ; return ts
     }

tokenList :: Parser Code
tokenList = many token <?> "list of tokens"

token :: Parser GMLToken
token =
       do { ts <- braces   tokenList          ; return (TBody ts) }
  <|>  do { ts <- brackets tokenList          ; return (TArray ts) }
  <|> (do { s  <- gmlString                   ; return (TString s) } <?> "string")
  <|> (do { t <- pident False                 ; return t }           <?> "identifier")
          ; t <- pident True                  ; return t } <?> "binding identifier")
  <|> (do { n <- number                       ; return n } <?> "number")

pident :: Bool -> Parser GMLToken
pident rebind =
  do { id <- ident
     ; case (lookup id opTable) of
       Nothing -> if rebind then return (TBind id) else return (TId id)
       Just t  -> if rebind then error ("Attempted rebinding of identifier " ++ id) else return t
     }

ident :: Parser String
ident = lexeme $
  do { l <- letter
     ; ls <- many (satisfy (\x -> isAlphaNum x || x == '-' || x == '_'))
     ; return (l:ls)
     }

gmlString :: Parser String
gmlString = lexeme $ between (char '"') (char '"') (many (satisfy (\x -> isPrint x && x /= '"')))

test_number = "1234 -1234 1 -0 0" ++
              " 1234.5678 -1234.5678 1234.5678e12 1234.5678e-12 -1234.5678e-12" ++
              " -1234.5678e12 -1234.5678E-12 -1234.5678E12" ++
              " 1234e11 1234E33 -1234e33 1234e-33" ++
              " 123e 123.4e 123ee 123.4ee 123E 123.4E 123EE 123.4EE"


number :: Parser GMLToken
number = lexeme $
  do { s <- optSign
     ; n <- decimal
     ;     do { string "."
              ; m <- decimal
              ; e <- option "" exponent'
              }
       <|> do { e <- exponent'
              ; return (TReal (read (s ++ n ++ ".0" ++ e)))
              }
       <|> do { return (TInt (read (s ++ n))) }
     }

exponent' :: Parser String
exponent' = try $
  do { e <- oneOf "eE"
     ; s <- optSign
     ; n <- decimal
     ; return (e:s ++ n)
     }

decimal = many1 digit

optSign :: Parser String
optSign = option "" (string "-")



braces   p = between (symbol "{") (symbol "}") p
brackets p = between (symbol "[") (symbol "]") p

symbol name = lexeme (string name)

lexeme p = do{ x <- p; whiteSpace; return x  }

whiteSpace  = skipMany (simpleSpace <|> oneLineComment <?> "")
  where simpleSpace = skipMany1 (oneOf " \t\n\r\v")
        oneLineComment =
            do{ string "%"
              ; skipMany (noneOf "\n\r\v")
              ; return ()
              }



rayParse :: String -> Code
rayParse is = case (parse program "<stdin>" is) of
              Left err -> error (show err)
              Right x  -> x

rayParseF :: String -> IO Code
rayParseF file =
  do { r <- parseFromFile program file
     ; case r of
       Left err -> error (show err)
       Right x  -> return x
     }

run :: String -> IO ()
run is = case (parse program "" is) of
         Left err -> print err
         Right x  -> print x

runF :: IO ()
runF =
  do { r <- parseFromFile program "simple.gml"
     ; case r of
       Left err -> print err
       Right x  -> print x
     }
