blob: 931655c16e11099c536be53f01fe2ba623486471 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
|
-- 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 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
}
|
