Adjusted the modules in common to match the new array constructor change

This commit is contained in:
Neil Brown 2009-02-01 21:52:13 +00:00
parent 957699313f
commit 8de2dbca88
4 changed files with 26 additions and 33 deletions

View File

@ -87,17 +87,17 @@ isConstantName n
--{{{ expression evaluator
evalLiteral :: A.Expression -> EvalM OccValue
evalLiteral (A.Literal m _ (A.ArrayLiteral _ []))
= throwError (Just m, "empty array")
evalLiteral (A.Literal _ _ (A.ArrayLiteral _ aes))
= liftM OccArray (mapM evalLiteralArray aes)
evalLiteral (A.Literal _ _ (A.ArrayListLiteral _ aes))
= evalLiteralStruct aes
evalLiteral (A.Literal _ (A.Record n) (A.RecordLiteral _ es))
= liftM (OccRecord n) (mapM evalExpression es)
evalLiteral l = evalSimpleLiteral l
evalLiteralArray :: A.ArrayElem -> EvalM OccValue
evalLiteralArray (A.ArrayElemArray aes) = liftM OccArray (mapM evalLiteralArray aes)
evalLiteralArray (A.ArrayElemExpr e) = evalExpression e
evalLiteralStruct :: A.Structured A.Expression -> EvalM OccValue
evalLiteralStruct (A.Several _ aes) = liftM OccArray $ mapM evalLiteralStruct aes
evalLiteralStruct (A.Only _ e) = evalExpression e
-- TODO should probably evaluate the ones involving constants:
evalLiteralStruct s = throwError (Just $ findMeta s, "Non-constant array (replicator) used in eval literals")
evalVariable :: A.Variable -> EvalM OccValue
evalVariable (A.Variable m n)
@ -321,11 +321,11 @@ renderLiteral m t v
renderArray :: [OccValue] -> m (A.Type, A.LiteralRepr)
renderArray vs
= do (t', aes) <- renderArrayElems t vs
return (t', A.ArrayLiteral m aes)
return (t', A.ArrayListLiteral m aes)
-- We must make sure to apply array sizes if we've learned them while
-- expanding the literal.
renderArrayElems :: A.Type -> [OccValue] -> m (A.Type, [A.ArrayElem])
renderArrayElems :: A.Type -> [OccValue] -> m (A.Type, A.Structured A.Expression)
renderArrayElems t vs
= do subT <- trivialSubscriptType m t
(ts, aes) <- mapM (renderArrayElem subT) vs >>* unzip
@ -333,16 +333,15 @@ renderLiteral m t v
t' = case ts of
[] -> applyDimension dim t
_ -> addDimensions [dim] (head ts)
return (t', aes)
return (t', A.Several m aes)
renderArrayElem :: A.Type -> OccValue -> m (A.Type, A.ArrayElem)
renderArrayElem :: A.Type -> OccValue -> m (A.Type, A.Structured A.Expression)
renderArrayElem t (OccArray vs)
= do (t', aes) <- renderArrayElems t vs
return (t', A.ArrayElemArray aes)
= renderArrayElems t vs
renderArrayElem t v
= do e <- renderValue m t v
t' <- astTypeOf e
return (t', A.ArrayElemExpr e)
return (t', A.Only m e)
renderRecord :: [OccValue] -> m (A.Type, A.LiteralRepr)
renderRecord vs

View File

@ -58,8 +58,8 @@ data OccValue =
-- | Is an expression a constant literal?
isConstant :: A.Expression -> Bool
isConstant (A.Literal _ _ (A.ArrayLiteral _ aes))
= and $ map isConstantArray aes
isConstant (A.Literal _ _ (A.ArrayListLiteral _ aes))
= isConstantStruct aes
isConstant (A.Literal _ _ (A.RecordLiteral _ es))
= and $ map isConstant es
isConstant (A.Literal _ _ _) = True
@ -68,9 +68,11 @@ isConstant (A.False _) = True
isConstant _ = False
-- | Is an array literal element constant?
isConstantArray :: A.ArrayElem -> Bool
isConstantArray (A.ArrayElemArray aes) = and $ map isConstantArray aes
isConstantArray (A.ArrayElemExpr e) = isConstant e
isConstantStruct :: A.Structured A.Expression -> Bool
isConstantStruct (A.Several _ ss) = and $ map isConstantStruct ss
isConstantStruct (A.Only _ e) = isConstant e
isConstantStruct (A.ProcThen {}) = False
isConstantStruct (A.Spec {}) = False
-- | Evaluate a byte literal.
evalByte :: (CSMR m, Die m) => Meta -> String -> m Char

View File

@ -235,6 +235,7 @@ instance ShowOccam A.Type where
showOccamM A.Any = tell ["ANY"]
showOccamM (A.Timer _) = tell ["TIMER"]
showOccamM A.Time = tell ["TIME"]
showOccamM A.Infer = tell ["inferred type"]
showOccamM (A.UnknownVarType _ en)
= do tell ["(inferred type for: "]
either showName (tell . (:[]) . show) en
@ -376,16 +377,12 @@ instance ShowRain A.Variable where
showRainM (A.DirectedVariable _ A.DirOutput v) = tell ["!"] >> showRainM v
showRainM x = tell ["<invalid Rain variable: ", show x, ">"]
instance ShowOccam A.ArrayElem where
showOccamM (A.ArrayElemArray elems) = tell ["["] >> showWithCommas elems >> tell ["]"]
showOccamM (A.ArrayElemExpr e) = showOccamM e
instance ShowOccam A.LiteralRepr where
showOccamM (A.RealLiteral _ s) = tell [s]
showOccamM (A.IntLiteral _ s) = tell [s]
showOccamM (A.HexLiteral _ s) = tell ["#", s]
showOccamM (A.ByteLiteral _ s) = tell ["'", s, "'"]
showOccamM (A.ArrayLiteral _ elems) = tell ["["] >> showWithCommas elems >> tell ["]"]
showOccamM (A.ArrayListLiteral _ elems) = tell ["["] >> showOccamM elems >> tell ["]"]
--TODO record literals
instance ShowRain A.LiteralRepr where
@ -393,9 +390,7 @@ instance ShowRain A.LiteralRepr where
showRainM (A.IntLiteral _ s) = tell [s]
showRainM (A.HexLiteral _ s) = tell ["#", s]
showRainM (A.ByteLiteral _ s) = tell ["'", s, "'"]
showRainM (A.ArrayLiteral _ elems) = tell ["["] >> showWithCommas elems >> tell ["]"]
showRainM (A.ListLiteral _ elems) = tell ["["] >> showWithCommas elems >> tell ["]"]
showRainM (A.ArrayListLiteral _ elems) = tell ["["] >> showRainM elems >> tell ["]"]
instance ShowOccam A.Subscript where
showOccamM (A.Subscript _ _ e) = getTempItem >> tell ["["] >> showOccamM e >> tell ["]"]
@ -450,12 +445,11 @@ instance ShowRain A.Expression where
showRainM (A.BytesInExpr _ e) = bracket $ tell ["BYTESIN "] >> showRainM e
showRainM (A.BytesInType _ t) = bracket $ tell ["BYTESIN "] >> showRainM t
showRainM (A.OffsetOf _ t n) = tell ["OFFSETOF("] >> showRainM t >> tell [" , "] >> showName n >> tell [")"]
showRainM (A.ExprConstr _ (A.RangeConstr _ _ e e'))
= showRainM e >> tell [".."] >> showRainM e'
showRainM (A.ExprConstr _ (A.RepConstr _ _ n r e))
{- showRainM (A.ExprConstr _ (A.RepConstr _ _ n r e))
= tell ["["] >> showRainM e >> tell ["|"] >> showName n >>
showRainM r >> tell ["]"]
-}
instance ShowOccam A.Formal where
showOccamM (A.Formal am t n) = (maybeVal am)
>> (showOccamM t)

View File

@ -272,8 +272,6 @@ typeOfExpression e
A.BytesInExpr m e -> return A.Int
A.BytesInType m t -> return A.Int
A.OffsetOf m t n -> return A.Int
A.ExprConstr m (A.RangeConstr _ t _ _) -> return t
A.ExprConstr m (A.RepConstr _ t _ _ _) -> return t
A.AllocMobile _ t _ -> return t
--}}}