suzanne.soy/tock-mirror
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Use genStructured to do PAR -- which is much shorter

Browse Source
This commit is contained in:
Adam Sampson 2007-04-30 01:28:17 +00:00
parent ace34232fd
commit 7205272fa5
4 changed files with 46 additions and 48 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
fco2/EvalConstants.hs
View File

@ -54,7 +54,7 @@ simplifyExpression :: ParseState -> A.Expression -> Either String A.Expression
simplifyExpression ps e
= case runEvaluator ps (evalExpression e) of
Left err -> Left err
Right val -> Right $ snd $ renderValue (metaOfExpression e) val
Right val -> Right $ snd $ renderValue (findMeta e) val
--{{{ expression evaluator
evalLiteral :: A.Literal -> EvalM OccValue

63
fco2/GenerateC.hs
View File

@ -11,6 +11,7 @@ import Numeric
import Text.Printf
import qualified AST as A
import EvalConstants
import EvalLiterals
import Metadata
import ParseState
@ -433,7 +434,7 @@ genArraySubscript v es
tell [", "]
genVariable v
tell ["_sizes[", show sub, "], "]
genMeta (metaOfExpression e)
genMeta (findMeta e)
tell [")"]
genChunks = [genVariable v >> tell ["_sizes[", show i, "]"] | i <- subs]
--}}}
@ -660,7 +661,7 @@ genGeneralReplicatorLoop index base count
tell ["++"]
genReplicatorSize :: A.Replicator -> CGen ()
genReplicatorSize (A.For m n base count) = genExpression count
genReplicatorSize rep = genExpression (sizeOfReplicator rep)
--}}}
--{{{ abbreviations
@ -677,7 +678,7 @@ genSlice v (A.Variable _ on) start count ds
tell [", "]
genName on
tell ["_sizes[0], "]
genMeta (metaOfExpression count)
genMeta (findMeta count)
tell [")"]
sequence_ [do tell [", "]
genName on
@ -1044,7 +1045,7 @@ genProcess p = case p of
A.If m s -> genIf m s
A.Case m e s -> genCase m e s
A.While m e p -> genWhile e p
A.Par m pm s -> genParBody pm s
A.Par m pm s -> genPar pm s
-- PROCESSOR does nothing special.
A.Processor m e p -> genProcess p
A.Alt m b s -> genAlt b s
@ -1230,51 +1231,27 @@ genWhile e p
tell ["}\n"]
--}}}
--{{{ par
-- FIXME: This is a bit odd because it'll only generate the two forms of the
-- AST resulting from regular and replicated PARs. It'd probably be better to
-- make it deal with a general Structured PAR.
genParBody :: A.ParMode -> A.Structured -> CGen ()
genParBody pm (A.Spec _ spec s) = genSpec spec (genParBody pm s)
genParBody pm (A.ProcThen _ p s) = genProcess p >> genParBody pm s
genParBody pm (A.Several _ ss) = genPar pm ss
genParBody pm (A.Rep _ rep s) = genParRep pm rep s
genParProc :: (A.Process -> CGen()) -> A.Structured -> CGen ()
genParProc gen (A.Spec _ spec s) = genSpec spec (genParProc gen s)
genParProc gen (A.ProcThen _ p s) = genProcess p >> genParProc gen s
genParProc gen (A.OnlyP _ p) = gen p
genPar :: A.ParMode -> [A.Structured] -> CGen ()
genPar pm ss
= do pids <- sequence [makeNonce "pid" | _ <- ss]
sequence_ $ [genParProc (\p -> do tell ["Process *", pid, " = "]
genProcAlloc p
tell [";\n"]) s
| (pid, s) <- (zip pids ss)]
case pm of
A.PlainPar ->
do tell ["ProcPar ("]
sequence_ $ [tell [pid, ", "] | pid <- pids]
tell ["NULL);\n"]
_ -> missing $ "genPar " ++ show pm
sequence_ $ [tell ["ProcAllocClean (", pid, ");\n"] | pid <- pids]
genParRep :: A.ParMode -> A.Replicator -> A.Structured -> CGen ()
genParRep pm rep s
= do pids <- makeNonce "pids"
genPar :: A.ParMode -> A.Structured -> CGen ()
genPar pm s
= do (size, _, _) <- constantFold $ addOne (sizeOfStructured s)
pids <- makeNonce "pids"
index <- makeNonce "i"
tell ["Process *", pids, "["]
genReplicatorSize rep
tell [" + 1];\n"]
genExpression size
tell ["];\n"]
tell ["int ", index, " = 0;\n"]
genReplicator rep $ genParProc (\p -> do tell [pids, "[", index, "++] = "]
genProcAlloc p
tell [";\n"]) s
genStructured s (createP pids index)
tell [pids, "[", index, "] = NULL;\n"]
tell ["ProcParList (", pids, ");\n"]
tell [index, " = 0;\n"]
genReplicator rep $ tell ["ProcAllocClean (", pids, "[", index, "++]);\n"]
genStructured s (freeP pids index)
where
createP pids index (A.OnlyP _ p)
= do tell [pids, "[", index, "++] = "]
genProcAlloc p
tell [";\n"]
freeP pids index (A.OnlyP _ _)
= do tell ["ProcAllocClean (", pids, "[", index, "++]);\n"]
genProcAlloc :: A.Process -> CGen ()
genProcAlloc (A.ProcCall m n as)

2
fco2/SimplifyExprs.hs
View File

@ -136,7 +136,7 @@ pullUp = doGeneric `extM` doStructured `extM` doProcess `extM` doSpecification `
where
pull :: A.Type -> A.Expression -> PassM A.Expression
pull t e
= do let m = metaOfExpression e
= do let m = findMeta e
spec@(A.Specification _ n _) <- makeNonceIsExpr "array_expr" m t e
addPulled $ A.Spec m spec
return $ A.ExprVariable m (A.Variable m n)

27
fco2/Types.hs
View File

@ -231,9 +231,9 @@ makeAbbrevAM am = am
makeConstant :: Meta -> Int -> A.Expression
makeConstant m n = A.ExprLiteral m $ A.Literal m A.Int $ A.IntLiteral m (show n)
-- | Find the Meta value in an expression.
metaOfExpression :: A.Expression -> Meta
metaOfExpression e = head $ gmapQ (mkQ emptyMeta findMeta) e
-- | Find the first Meta value in some part of the AST.
findMeta :: (Data t, Typeable t) => t -> Meta
findMeta e = head $ gmapQ (mkQ emptyMeta findMeta) e
where
findMeta :: Meta -> Meta
findMeta m = m
@ -362,3 +362,24 @@ bytesInType (A.UserDataType n)
bytesInType _ = return $ BIUnknown
--}}}
-- | Get the number of items a replicator produces.
sizeOfReplicator :: A.Replicator -> A.Expression
sizeOfReplicator (A.For _ _ _ count) = count
-- | Get the number of items in a Structured as an expression.
sizeOfStructured :: A.Structured -> A.Expression
sizeOfStructured (A.Rep m rep s)
= A.Dyadic m A.Times (sizeOfReplicator rep) (sizeOfStructured s)
sizeOfStructured (A.Spec _ _ s) = sizeOfStructured s
sizeOfStructured (A.ProcThen _ _ s) = sizeOfStructured s
sizeOfStructured (A.Several m ss)
= case ss of
[] -> makeConstant m 0
_ -> foldl1 (A.Dyadic m A.Plus) (map sizeOfStructured ss)
sizeOfStructured s = makeConstant (findMeta s) 1
-- | Add one to an expression.
addOne :: A.Expression -> A.Expression
addOne e = A.Dyadic m A.Plus (makeConstant m 1) e
where m = findMeta e