Adjusted the modules in common to match the new array constructor change
This commit is contained in:
parent
957699313f
commit
8de2dbca88
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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
|
||||
--}}}
|
||||
|
||||
|
|
Loading…
Reference in New Issue
Block a user