1 -- Copyright (c) 2000 Galois Connections, Inc.
    2 -- All rights reserved.  This software is distributed as
    3 -- free software under the license in the file "LICENSE",
    4 -- which is included in the distribution.
    5 
    6 module Parse where
    7 
    8 import Data.Char
    9 import Text.ParserCombinators.Parsec hiding (token)
   10 
   11 import Data
   12 
   13 
   14 program :: Parser Code
   15 -- entered onceprogram =
   16   do { whiteSpace
   17      ; ts <- tokenList
   18      ; eof
   19      ; return ts
   20      }
   21 
   22 tokenList :: Parser Code
   23 -- entered oncetokenList = many token <?> "list of tokens"
   24 
   25 token :: Parser GMLToken
   26 -- entered oncetoken =
   27        do { ts <- braces   tokenList          ; return (TBody ts) }
   28   <|>  do { ts <- brackets tokenList          ; return (TArray ts) }
   29   <|> (do { s  <- gmlString                   ; return (TString s) } <?> "string")
   30   <|> (do { t <- pident False                 ; return t }           <?> "identifier")
   31   <|> (do { char '/'   -- No whitespace after slash
   32           ; t <- pident True                  ; return t } <?> "binding identifier")
   33   <|> (do { n <- number                       ; return n } <?> "number")
   34 
   35 pident :: Bool -> Parser GMLToken
   36 -- entered 2 timespident rebind =
   37   do { id <- ident
   38      ; case (lookup id opTable) of
   39        Nothing -> if rebind then return (TBind id) else return (TId id)
   40        Just t  -> if rebind then error ("Attempted rebinding of identifier " ++ id) else return t
   41      }
   42 
   43 ident :: Parser String
   44 -- entered onceident = lexeme $
   45   do { l <- letter
   46      ; ls <- many (satisfy (\x -> isAlphaNum x || x == '-' || x == '_'))
   47      ; return (l:ls)
   48      }
   49 
   50 gmlString :: Parser String
   51 -- entered oncegmlString = lexeme $ between (char '"') (char '"') (many (satisfy (\x -> isPrint x && x /= '"')))
   52 
   53 -- Tests for numbers
   54 -- Hugs breaks on big exponents (> ~40)
   55 -- never enteredtest_number = "1234 -1234 1 -0 0" ++
   56               " 1234.5678 -1234.5678 1234.5678e12 1234.5678e-12 -1234.5678e-12" ++
   57               " -1234.5678e12 -1234.5678E-12 -1234.5678E12" ++
   58               " 1234e11 1234E33 -1234e33 1234e-33" ++
   59               " 123e 123.4e 123ee 123.4ee 123E 123.4E 123EE 123.4EE"
   60 
   61 
   62 -- Always int or real
   63 number :: Parser GMLToken
   64 -- entered oncenumber = lexeme $
   65   do { s <- optSign
   66      ; n <- decimal
   67      ;     do { string "."
   68               ; m <- decimal
   69               ; e <- option "" exponent'
   70               ; return (TReal (read (s ++ n ++ "." ++ m ++ e)))  -- FIXME: Handle error conditions
   71               }
   72        <|> do { e <- exponent'
   73               ; return (TReal (read (s ++ n ++ ".0" ++ e)))
   74               }
   75        <|> do { return (TInt (read (s ++ n))) }
   76      }
   77 
   78 exponent' :: Parser String
   79 -- entered onceexponent' = try $
   80   do { e <- oneOf "eE"
   81      ; s <- optSign
   82      ; n <- decimal
   83      ; return (e:s ++ n)
   84      }
   85 
   86 -- entered oncedecimal = many1 digit
   87 
   88 optSign :: Parser String
   89 -- entered onceoptSign = option "" (string "-")
   90 
   91 
   92 ------------------------------------------------------
   93 -- Library for tokenizing.
   94 
   95 -- entered oncebraces   p = between (symbol "{") (symbol "}") p
   96 -- entered oncebrackets p = between (symbol "[") (symbol "]") p
   97 
   98 -- entered 4 timessymbol name = lexeme (string name)
   99 
  100 -- entered 7 timeslexeme p = do{ x <- p; whiteSpace; return x  }
  101 
  102 -- entered oncewhiteSpace  = skipMany (simpleSpace <|> oneLineComment <?> "")
  103   where simpleSpace = skipMany1 (oneOf " \t\n\r\v")
  104         oneLineComment =
  105             do{ string "%"
  106               ; skipMany (noneOf "\n\r\v")
  107               ; return ()
  108               }
  109 
  110 
  111 ------------------------------------------------------------------------------
  112 
  113 rayParse :: String -> Code
  114 -- entered oncerayParse is = case (parse program "<stdin>" is) of
  115               Left err -> error (show err)
  116               Right x  -> x
  117 
  118 rayParseF :: String -> IO Code
  119 -- never enteredrayParseF file =
  120   do { r <- parseFromFile program file
  121      ; case r of
  122        Left err -> error (show err)
  123        Right x  -> return x
  124      }
  125 
  126 run :: String -> IO ()
  127 -- never enteredrun is = case (parse program "" is) of
  128          Left err -> print err
  129          Right x  -> print x
  130 
  131 runF :: IO ()
  132 -- never enteredrunF =
  133   do { r <- parseFromFile program "simple.gml"
  134      ; case r of
  135        Left err -> print err
  136        Right x  -> print x
  137      }