← Back to branch summary

~ubuntu-branches/ubuntu/precise/ghc/precise

« back to all changes in this revision

Viewing changes to libraries/hpc/tests/raytrace/Parse.hs

  • Committer: Bazaar Package Importer
  • Author(s): Joachim Breitner
  • Date: 2011-01-17 12:49:24 UTC
  • Revision ID: james.westby@ubuntu.com-20110117124924-do1pym1jlf5o636m
Tags: upstream-7.0.1
Import upstream version 7.0.1

Show diffs side-by-side

added added

removed removed

Lines of Context:
libraries/hpc/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
     }