diff --git a/common/EvalConstants.hs b/common/EvalConstants.hs index 7e3fe02..1ff467c 100644 --- a/common/EvalConstants.hs +++ b/common/EvalConstants.hs @@ -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 diff --git a/common/EvalLiterals.hs b/common/EvalLiterals.hs index c645eef..b8d566c 100644 --- a/common/EvalLiterals.hs +++ b/common/EvalLiterals.hs @@ -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 diff --git a/common/ShowCode.hs b/common/ShowCode.hs index 1686100..3b754ce 100644 --- a/common/ShowCode.hs +++ b/common/ShowCode.hs @@ -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 [""] -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) diff --git a/common/Types.hs b/common/Types.hs index 372880b..d8bd1e9 100644 --- a/common/Types.hs +++ b/common/Types.hs @@ -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 --}}}