Changeset 26 for src/Parser.hs

Timestamp:

02/14/05 06:02:18 (4 years ago)

Author:

autrijus

svk:copy_cache_prev:

1041

Message:

* snapshot during monadic refactoring

Files:

• src/Parser.hs (modified) (4 diffs)

src/Parser.hs

@@ -17 +17 @@
 -- Lexical units --------------------------------------------------
 
-ruleProgram :: RuleParser Exp
+ruleProgram :: RuleParser Env
 ruleProgram = rule "program" $ do
+    whiteSpace
     many (symbol ";")
     rv <- option [] ruleStatementList
     eof
-    retSyn ";" rv
+    env <- getState
+    return $ env { envBody = (Syn ";" rv) }
 
 ruleBlock :: RuleParser Exp
 ruleBlock = rule "block" $ braces $ do
+    whiteSpace
     many (symbol ";")
     rv <- option [] ruleStatementList
@@ -63 +66 @@
         return (scope, multi, name)
     pos     <- getPosition
-    cxt     <- option "Any" $ preSpace (ruleBareTrait "returns")
+    cxt     <- option "Any" $ ruleBareTrait "returns"
     formal  <- option Nothing $ return . Just =<< parens ruleSubParameters
     body    <- ruleBlock
@@ -85 +88 @@
 ruleSubName = rule "subroutine name" $ do
     star    <- option "" $ string "*"
-    fixity  <- option "prefix:" $ choice (map string $ words fixities)
+    fixity  <- option "prefix:" $ choice (map (try . string) $ words fixities)
     c       <- wordAlpha
     cs      <- many wordAny
@@ -352 +355 @@
 parseProgram = do { whiteSpace ; x <- parseOp ; eof ; return x }
 
-runRule :: Env -> (Exp -> a) -> RuleParser Exp -> String -> a
-runRule env f p str = f $ case ( runParser ruleProgram (envPad env) "" str ) of
-    Left err    -> Val $ VError (showErr err) (NonTerm $ errorPos err)
-    Right ast   -> ast
+runRule :: Env -> (Env -> a) -> RuleParser Env -> String -> a
+runRule env f p str = f $ case ( runParser ruleProgram env "" str ) of
+    Left err    -> env { envBody = Val $ VError (showErr err) (NonTerm $ errorPos err) }
+    Right env'  -> env'
 
 showErr err =