Changeset 17044

Timestamp:

07/14/07 04:25:29 (17 months ago)

Author:

audreyt

Message:

* Thanks to HPC, continue to eliminate a whole lot of

can't-be-reached toplevel definitions:

Pugs.Monads:

tempVar

Pugs.Parser.Literal:

qInterpolateDelimiterMinimal
(and its associated data constructor, QB_Minimal)

Pugs.Parser.Operator:

optPreSyn, optSymOps, _STATE_START_RUN

Pugs.Parser.Types:

getCurrCharClass

Pugs.Parser:

_dummyParam

Pugs.Prim.Match:

matchFromMR

Pugs.Types:

addNode

Location:

src/Pugs

Files:

• Monads.hs (modified) (2 diffs)
• Parser.hs (modified) (4 diffs)
• Parser/Literal.hs (modified) (4 diffs)
• Parser/Operator.hs (modified) (2 diffs)
• Parser/Types.hs (modified) (3 diffs)
• Parser/Util.hs (modified) (1 diff)
• Prim/Match.hs (modified) (2 diffs)
• Types.hs (modified) (2 diffs)

src/Pugs/Monads.hs

@@ -20 +20 @@
     enterGiven, enterWhen, enterLoop, enterGather, genSymPrim, genSymCC,
     enterBlock, enterSub,
-    evalVal, tempVar,
+    evalVal,
 
     enterFrame, assertFrame, emptyFrames,
@@ -429 +429 @@
                     else return val
 evalVal val = return val
-
-tempVar :: Var -> Val -> Eval a -> Eval a
-tempVar var val action = do
-    old <- readVar var
-    writeVar var val
-    rv  <- action
-    writeVar var old
-    return rv
-

src/Pugs/Parser.hs

@@ -1490 +1490 @@
     }
     deriving (Show)
-
--- XXX - Unused?
-_dummyParam :: SigParam
-_dummyParam = MkParam
-    { p_variable    = varNullScalar
-    , p_types       = []
-    , p_constraints = []
-    , p_unpacking   = Nothing
-    , p_default     = MkParamDefault Nothing
-    , p_label       = nullID
-    , p_slots       = Map.empty
-    , p_hasAccess   = AccessRO
-    , p_isRef       = False
-    , p_isContext   = False
-    , p_isLazy      = False
-    }
 
 ruleSignature :: RuleParser Exp
@@ -2079 +2063 @@
         "INC" | "@" <- sigil           -> return (makeVar name)
         _ -> do
-            -- Plain and simple variable -- do a lexical check
-            -- First check if it's "known".
-            --   If it is, then simply makeVar.
-            --   If it is not, then it's "free"; add it to the list of freeVars
-            --   for the final check.
-
+            -- Plain and simple variable -- do a lexical check.
             state <- get
 
@@ -2091 +2070 @@
                 lexPads     = envLexPads env
                 compPad     = envCompPad env
-                freeVars    = s_freeVars state
                 outerVars   = s_outerVars state
                 knownVars   = s_knownVars state
@@ -2113 +2091 @@
                             fail $ "Variable " ++ show var ++ " requires predeclaration or explicit package name"
                     return (Var $ toGlobalVar var)
-                    -- put state{ s_freeVars = Set.insert (var, lexPads) freeVars }
 
 ruleVar :: RuleParser Exp

src/Pugs/Parser/Literal.hs

@@ -202 +202 @@
     return (Val $ VStr [c])
 
-qInterpolateDelimiterMinimal :: Char -> RuleParser Exp
-qInterpolateDelimiterMinimal protectedChar = do
-    char '\\'
-    c <- oneOf (protectedChar:"\\")
-    return (Val $ VStr ['\\',c])
-
 qInterpolateDelimiterBalanced :: Char -> RuleParser Exp
 qInterpolateDelimiterBalanced protectedChar = do
@@ -256 +250 @@
             QB_Single -> try qInterpolateQuoteConstruct
                <|> (try $ qInterpolateDelimiter $ qfProtectedChar flags)
-            QB_Minimal -> try $ qInterpolateDelimiterMinimal $ qfProtectedChar flags
             QB_Balanced -> try $ qInterpolateDelimiterBalanced $ qfProtectedChar flags
             QB_No -> mzero
@@ -438 +431 @@
 -- qfProtectedChar is the character to be
 --   protected by backslashes, if
---   qfInterpolateBackslash is Minimal or Single or All
+--   qfInterpolateBackslash is Single or All
 data QS_Flag = QS_No | QS_Yes | QS_Protect deriving (Show, Eq, Ord, Typeable)
-data QB_Flag = QB_No | QB_Minimal | QB_Balanced | QB_Single | QB_All deriving (Show, Eq, Ord, Typeable)
+data QB_Flag = QB_No | QB_Balanced | QB_Single | QB_All deriving (Show, Eq, Ord, Typeable)
 
 data QFlags = MkQFlags
@@ -449 +442 @@
     , qfInterpolateFunction     :: !Bool
     , qfInterpolateClosure      :: !Bool
-    , qfInterpolateBackslash    :: !QB_Flag -- No, Minimal, Single, All
+    , qfInterpolateBackslash    :: !QB_Flag -- No, Single, All
     , qfProtectedChar           :: !Char
     , qfP5RegularExpression     :: !Bool

src/Pugs/Parser/Operator.hs

@@ -310 +310 @@
 matchSlurpy _ = False
 
-circumOps, rightSyn, chainOps, matchOps, nonSyn, listSyn, preSyn, optPreSyn, preOps, preSymOps, optSymOps, postOps, optOps, leftOps, rightOps, nonOps, listOps :: Set OpName -> [RuleOperator Exp]
+circumOps, rightSyn, chainOps, matchOps, nonSyn, listSyn, preSyn, preOps, preSymOps, postOps, optOps, leftOps, rightOps, nonOps, listOps :: Set OpName -> [RuleOperator Exp]
 preSyn      = ops  $ makeOp1 Prefix "" Syn
-optPreSyn   = ops  $ makeOp1 OptionalPrefix "" Syn
 preOps      = (ops $ makeOp1 Prefix "&prefix:" doApp) . addHyperPrefix
 preSymOps   = (ops $ makeOp1 Prefix "&prefix:" doAppSym) . addHyperPrefix
-optSymOps   = (ops $ makeOp1 OptionalPrefix "&prefix:" doAppSym) . addHyperPrefix
 postOps     = (ops $ makeOp1 Postfix "&postfix:" doApp) . addHyperPostfix
 optOps      = (ops $ makeOp1 OptionalPrefix "&prefix:" doApp) . addHyperPrefix
@@ -396 +394 @@
             App (_Var "&prefix:?") Nothing [App app (Just x) args]
         _ -> con (sigil ++ name) [x,y]
-
-_STATE_START_RUN :: Var
-_STATE_START_RUN = cast "$?STATE_START_RUN"
 
 -- Just for the ".=" rewriting

src/Pugs/Parser/Types.hs

@@ -8 +8 @@
     RuleOperator, RuleOperatorTable,
     getRuleEnv, modifyRuleEnv, putRuleEnv, insertIntoPosition,
-    clearDynParsers, enterBracketLevel, getCurrCharClass, charClassOf,
+    clearDynParsers, enterBracketLevel, charClassOf,
     addBlockPad, popClosureTrait, addClosureTrait,
     -- Alternate Char implementations that keeps track of s_charClass
@@ -73 +73 @@
                 | otherwise     = SymClass
 
+{-
+
 getCurrCharClass :: RuleParser CharClass
 getCurrCharClass = fmap charClassOf (lookAhead anyToken) <|> return SpaceClass
 
-{-
 getPrevCharClass :: RuleParser CharClass
 getPrevCharClass = do
@@ -152 +153 @@
     , s_knownVars     :: !(Map Var MPad)        -- ^ Map from variables to its associated scope
     , s_outerVars     :: !(Map MPad (Set Var))  -- ^ Map from scopes to vars that must not be declared in it
-    , s_freeVars      :: !(Set (Var, LexPads))  -- ^ Set of free vars and the mpadlist to check with
+--  , s_freeVars      :: !(Set (Var, LexPads))  -- ^ Set of free vars and the mpadlist to check with
     , s_protoPad      :: !Pad                   -- ^ Pad that's part of all scopes; used in param init
     , s_closureTraits :: [TraitBlocks -> TraitBlocks]

src/Pugs/Parser/Util.hs

@@ -104 +104 @@
     , do rv <- p; return (rv, False)
     ]
-
-
-isOperatorName :: String -> Bool
-isOperatorName ('&':name) = any hasOperatorPrefix [name, tail name]
-    where
-    hasOperatorPrefix :: String -> Bool
-    hasOperatorPrefix name = any (`isPrefixOf` name) grammaticalCategories
-isOperatorName _ = False
 
 

src/Pugs/Prim/Match.hs

@@ -2 +2 @@
 
 module Pugs.Prim.Match (
-    op2Match, rxSplit, rxSplit_n, matchFromMR, pkgParents, pkgParentClasses
+    op2Match, rxSplit, rxSplit_n, pkgParents, pkgParentClasses
 ) where
 import Pugs.Internals
@@ -91 +91 @@
     csBytes = encodeUTF8 csChars
 
-matchFromMR :: MatchResult Char -> Val
-matchFromMR mr = VMatch $ mkMatchOk 0 0 (decodeUTF8 all) subsMatch Map.empty
-    where
-    (all:subs) = elems $ mrSubs mr
-    subsMatch = [ VMatch $ mkMatchOk 0 0 (decodeUTF8 sub) [] Map.empty | sub <- subs ]
-
 -- Used in op2Match
 not_VRule :: Val -> Bool

src/Pugs/Types.hs

@@ -14 +14 @@
 (
     Type(..), mkType, anyType, showType, isaType, isaType', deltaType,
-    ClassTree, initTree, addNode,
+    ClassTree, initTree,
 
     Cxt(..), 
@@ -855 +855 @@
 
 {-|
-Add a new \'top-level\' type to the class tree, under @Object@.
--}
-addNode :: ClassTree -> Type -> ClassTree
-addNode (MkClassTree (Node obj [Node any (Node item ns:rest), junc])) typ =
-    MkClassTree (Node obj [Node any (Node item ((Node typ []):ns):rest), junc])
-addNode _ _ = error "malformed tree"
-
-{-|
 Default class tree, containing all built-in types.
 -}