"Combining" in parenthesis
[darcs-mirror-sem_syn.git] / Parser.hs
1 module Parser (parseProgram, parseExpression, parseFile, parseString) where
2
3 import Text.ParserCombinators.Parsec
4 import qualified Text.ParserCombinators.Parsec.Token as Tk
5 import Text.ParserCombinators.Parsec.Language
6
7 import AST
8
9 varId :: Parser String
10 varId = do { c <- lower
11            ; cs <- many (alphaNum <|> char '_')
12            ; return $ (c:cs) }
13
14 conId :: Parser String
15 conId = do { c <- upper 
16            ; cs <- many (alphaNum <|> char '_')
17            ; return $ (c:cs) }
18
19 number :: Parser Int
20 number = do { cs <- many1 digit
21             ; return $ read cs }
22
23 myLexer = Tk.makeTokenParser 
24             $ emptyDef {
25                     commentStart = "{-"
26                   , commentEnd   = "-}"
27                   , commentLine  = "--"           
28                   , reservedNames = ["let", "in","case","data","type"]
29                  }
30
31 parens = Tk.parens myLexer
32 symbol = Tk.symbol myLexer
33 comma  = Tk.comma myLexer
34 lexeme = Tk.lexeme myLexer
35 reserved = Tk.reserved myLexer
36 whiteSpace = Tk.whiteSpace myLexer
37
38
39 cnv f s = case f s of
40             Left  err -> Left $ show err
41             Right r   -> Right $ r 
42
43 parseProgram = 
44     (parse pProg "")
45
46 parseExpression = 
47     (parse pExp "")
48
49
50 parseString s = 
51     parseProgram s 
52
53
54 parseFile filename =
55     return . parseProgram =<< readFile filename
56
57
58 pProg = do { whiteSpace
59            ; ds <- many (lexeme pDecl)
60            ; return $ assignIDsAST (AST ds) }
61
62
63 pDecl = do { pos <- getPosition 
64             ; fName <- lexeme varId 
65             ; ps    <- parens (pPats)
66             ; symbol "=" 
67             ; e     <- pExp
68             ; return $ Decl (Name fName) FTUndet ps e }
69
70
71 pPats = sepBy pPat comma 
72
73
74 pPat = do { pos <- getPosition 
75           ; do { c <- lexeme conId                
76                ; ps <- option [] $ parens pPats 
77                ; return $ PCon Nothing TUndet (Name c) ps }
78             <|> 
79             do { c <- lexeme $ number
80                ; return $ PCon Nothing TUndet (Name $show c) [] }
81             <|>
82             do { c <- lexeme varId
83                ; return $ PVar Nothing TUndet (Name c) }
84             <|>
85             do { _ <- string "("
86                ; p <- pPat 
87                ; _ <- string ")" 
88                ; return p } }
89
90
91 pTExp = do { whiteSpace
92            ; pos <- getPosition
93            ; do { c  <- lexeme conId
94                 ; es <- option [] $ parens (sepBy (pTExp) comma)
95                 ; return $ ECon Nothing TUndet (Name c) es }
96              <|>
97              do { c <- lexeme $ number
98                 ; return $ ECon Nothing TUndet (Name $ show c) [] }
99              <|>
100              do { c <- lexeme varId 
101                 ; do { es <- parens (sepBy (pArg) comma) 
102                      ; return $ EFun Nothing TUndet (Name c) es }
103                   <|>
104                   do { return $ EVar Nothing TUndet (Name c) } } 
105              <|> 
106              do { _ <- string "("
107                 ; c <- pTExp 
108                 ; _ <- string ")" 
109                 ; return c }}
110
111 pExp = do { whiteSpace
112           ; pos <- getPosition
113           ; do { c  <- lexeme conId
114                ; es <- option [] $ parens (sepBy (pExp) comma)
115                ; return $ ECon Nothing TUndet (Name c) es }
116             <|>
117             do { c <- lexeme $ number
118                ; return $ ECon Nothing TUndet (Name $ show c) [] }
119             <|>
120             do { c <- lexeme varId 
121                ; do { es <- parens (sepBy (pExp) comma) 
122                     ; return $ EFun Nothing TUndet (Name c) es }
123                  <|>
124                  do { return $ EVar Nothing TUndet (Name c) } } 
125             <|> 
126             do { _ <- string "("
127                ; e <- pExp
128                ; _ <- string ")"
129                ; return e }
130           }
131
132
133 pArg = do { pos <- getPosition
134           ; c <- lexeme varId
135           ; return $ EVar Nothing TUndet (Name c)} 
136
137