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 }