Changeset 3724 for src/Pugs/Eval.hs

Show
Ignore:
Timestamp:
05/23/05 13:09:12 (4 years ago)
Author:
scook0
svk:copy_cache_prev:
5313
Message:

* Some non-toplevel function type signatures (for readability)
* Minor tweaks to Haddocks

Files:
1 modified

Legend:

Unmodified
Added
Removed

  • src/Pugs/Eval.hs

    r3709 r3724  
    5858         => String             -- ^ Name associated with the environment 
    5959         -> [STM (Pad -> Pad)] -- ^ List of 'Pad'-mutating transactions used 
    60                                -- to declare an initial set of global vars 
     60                               --     to declare an initial set of global vars 
    6161         -> m Env 
    6262emptyEnv name genPad = do 
    … …  
    224224    | otherwise = doFindVarRef name 
    225225    where 
     226    doFindVarRef :: Var -> Eval (Maybe (TVar VRef)) 
    226227    doFindVarRef name = do 
    227228        callCC $ \foundIt -> do 
    … …  
    665666    _ -> retError "Unknown syntactic construct" exp 
    666667    where 
     668    doCond :: (Bool -> Bool) -> Eval Val 
    667669    doCond f = do 
    668670        let [cond, bodyIf, bodyElse] = exps 
    … …  
    673675            else reduce bodyElse 
    674676    -- XXX This treatment of while/until loops probably needs work 
     677    doWhileUntil :: (Bool -> Bool) -> Eval Val 
    675678    doWhileUntil f = do 
    676679        let [cond, body] = exps 
    … …  
    722725        shiftT $ const (retVal val) 
    723726    where 
     727    callerEnv :: Env -> Env 
    724728    callerEnv env = let caller = maybe env id (envCaller env) in 
    725729        env{ envCaller  = envCaller caller 
    … …  
    750754    where 
    751755    err = retError "No compatible subroutine found" name 
     756    applySub :: VCode -> [Exp] -> [Exp] -> Eval Val 
    752757    applySub sub invs args 
    753758        -- list-associativity 
    … …  
    770775        | otherwise 
    771776        = apply sub invs args 
     777    mungeChainSub :: VCode -> [Exp] -> Eval Val 
    772778    mungeChainSub sub invs = do 
    773779        let MkCode{ subAssoc = "chain", subParams = (p:_) } = sub 
    … …  
    777783            Just sub'    -> applyChainSub sub invs sub' invs' args' rest 
    778784            Nothing      -> apply sub{ subParams = (length invs) `replicate` p } invs [] -- XXX Wrong 
     785    applyChainSub :: VCode -> [Exp] -> VCode -> [Exp] -> [a] -> [Exp] -> Eval Val 
    779786    applyChainSub sub invs sub' invs' args' rest 
    780787        | MkCode{ subAssoc = "chain", subBody = fun, subParams = prm }   <- sub 
    … …  
    10441051-- XXX - faking application of lexical contexts 
    10451052-- XXX - what about defaulting that depends on a junction? 
    1046 -- |Apply a sub (or other code) to lists of invocants 
    1047 -- and arguments, in the specified context. 
     1053{-| 
     1054Apply a sub (or other code) to lists of invocants and arguments, in the  
     1055specified context. 
     1056-} 
    10481057doApply :: Env   -- ^ Environment to evaluate in 
    10491058        -> VCode -- ^ Code to apply 
    … …  
    10781087        | typ >= SubBlock = id 
    10791088        | otherwise       = resetT 
     1089    fixEnv :: Env -> Env 
    10801090    fixEnv env 
    10811091        | typ >= SubBlock = env 
    … …  
    11171127                    return (VRef ref) 
    11181128        return (val, (isSlurpyCxt cxt || isCollapsed (typeOfCxt cxt))) 
     1129    checkSlurpyLimit :: (VInt, Exp) -> Eval [Val] 
    11191130    checkSlurpyLimit (n, exp) = do 
    11201131        listVal <- enterLValue $ enterEvalContext (cxtItem "Array") exp 
    … …  
    11221133        elms    <- mapM fromVal list -- flatten 
    11231134        return $ genericDrop n (concat elms :: [Val]) 
     1135    isCollapsed :: Type -> Bool 
    11241136    isCollapsed typ 
    11251137        | isaType (envClasses env) "Bool" typ        = True