[hoc-cvs] hoc/InterfaceGenerator Parser.hs,1.1.1.1,1.2

[Wolfgang T. <wth...@us...>]

Update of /cvsroot/hoc/hoc/InterfaceGenerator
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv6387/InterfaceGenerator

Modified Files:
	Parser.hs 
Log Message:
Parse some constant integer expressions for enum declarations.
(For now, it just supports the << operator).


Index: Parser.hs
===================================================================
RCS file: /cvsroot/hoc/hoc/InterfaceGenerator/Parser.hs,v
retrieving revision 1.1.1.1
retrieving revision 1.2
diff -u -d -r1.1.1.1 -r1.2
--- Parser.hs	27 Oct 2003 16:48:20 -0000	1.1.1.1
+++ Parser.hs	31 Mar 2005 20:48:18 -0000	1.2
@@ -2,10 +2,12 @@
 
 import Data.Maybe(catMaybes, isJust)
 import Data.Char(ord)
+import Data.Bits(shiftL)
 
 import Text.ParserCombinators.Parsec
 import Text.ParserCombinators.Parsec.Token
 import Text.ParserCombinators.Parsec.Language(emptyDef)
+import Text.ParserCombinators.Parsec.Expr
 
 import SyntaxTree
 
@@ -167,6 +169,22 @@
                 (map (fromIntegral.ord) $ reverse chars)
                 (iterate (*256) 1)
         
+const_int_expr = buildExpressionParser optable basic
+    where
+        basic = fmap GivenValue (integer objc)
+            <|> fmap GivenValue multiCharConstant
+            <|> fmap TooComplicatedValue
+                     (many1 (satisfy (\x -> x /= ';' && x /= '}')))
+        optable = [ [Infix shiftLeft AssocLeft] ]
+        
+        shiftLeft = op "<<" (flip $ flip shiftL . fromIntegral)
+        
+        op str f = reservedOp objc str >> return (opFun f)
+        opFun f (GivenValue x) (GivenValue y) = GivenValue $ f x y
+        opFun f v@(TooComplicatedValue _) _ = v
+        opFun f _ v@(TooComplicatedValue _) = v
+        opFun f _ _ = TooComplicatedValue "..."
+        
 enum_type =
     do
         key <- reserved objc "enum"
@@ -179,10 +197,7 @@
             id <- identifier objc
             val <- (do
                     symbol objc "="
-                    val <- fmap GivenValue (integer objc)
-                        <|> fmap GivenValue multiCharConstant
-                        <|> fmap TooComplicatedValue (many1 (satisfy (\x -> x /= ';' && x /= '}')))
-                    return $ val
+                    const_int_expr
                 ) <|> return NextValue
             return (id,val)