Trailing Whitespace
[packages/hpc.git] / tests / raytrace / Parse.hs
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 Char
9 import Text.ParserCombinators.Parsec hiding (token)
10
11 import Data
12
13
14 program :: Parser Code
15 program =
16 do { whiteSpace
17 ; ts <- tokenList
18 ; eof
19 ; return ts
20 }
21
22 tokenList :: Parser Code
23 tokenList = many token <?> "list of tokens"
24
25 token :: Parser GMLToken
26 token =
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 pident 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 ident = 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 gmlString = lexeme $ between (char '"') (char '"') (many (satisfy (\x -> isPrint x && x /= '"')))
52
53 -- Tests for numbers
54 -- Hugs breaks on big exponents (> ~40)
55 test_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 number = 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 exponent' = try $
80 do { e <- oneOf "eE"
81 ; s <- optSign
82 ; n <- decimal
83 ; return (e:s ++ n)
84 }
85
86 decimal = many1 digit
87
88 optSign :: Parser String
89 optSign = option "" (string "-")
90
91
92 ------------------------------------------------------
93 -- Library for tokenizing.
94
95 braces p = between (symbol "{") (symbol "}") p
96 brackets p = between (symbol "[") (symbol "]") p
97
98 symbol name = lexeme (string name)
99
100 lexeme p = do{ x <- p; whiteSpace; return x }
101
102 whiteSpace = 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 rayParse is = case (parse program "<stdin>" is) of
115 Left err -> error (show err)
116 Right x -> x
117
118 rayParseF :: String -> IO Code
119 rayParseF 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 run is = case (parse program "" is) of
128 Left err -> print err
129 Right x -> print x
130
131 runF :: IO ()
132 runF =
133 do { r <- parseFromFile program "simple.gml"
134 ; case r of
135 Left err -> print err
136 Right x -> print x
137 }