diff --git a/fco2/Parse.hs b/fco2/Parse.hs index d8fb66f..ea93407 100644 --- a/fco2/Parse.hs +++ b/fco2/Parse.hs @@ -594,12 +594,20 @@ newFieldName = anyName A.FieldName newTagName = anyName A.TagName --}}} --{{{ types +-- | A sized array of a production. arrayType :: OccParser A.Type -> OccParser A.Type arrayType element = do (s, t) <- tryXVXV sLeft constIntExpr sRight element sVal <- evalIntExpression s return $ makeArrayType (A.Dimension sVal) t +-- | Either a sized or unsized array of a production. +specArrayType :: OccParser A.Type -> OccParser A.Type +specArrayType element + = arrayType element + <|> do t <- tryXXV sLeft sRight element + return $ makeArrayType A.UnknownDimension t + dataType :: OccParser A.Type dataType = do { sBOOL; return A.Bool } @@ -1070,6 +1078,13 @@ port' = do { m <- md; n <- try portName; return $ A.Variable m n } <|> maybeSliced port A.SubscriptedVariable typeOfVariable "port'" + +portOfType :: A.Type -> OccParser A.Variable +portOfType wantT + = do p <- port + t <- typeOfVariable p + matchType wantT t + return p --}}} --{{{ protocols protocol :: OccParser A.Type @@ -1274,20 +1289,34 @@ checkRetypes fromT toT dataSpecifier :: OccParser A.Type dataSpecifier = dataType - <|> do s <- tryXXV sLeft sRight dataSpecifier - return $ makeArrayType A.UnknownDimension s - <|> arrayType dataSpecifier + <|> specArrayType dataSpecifier "data specifier" +channelSpecifier :: OccParser A.Type +channelSpecifier + = channelType + <|> specArrayType channelSpecifier + "channel specifier" + +timerSpecifier :: OccParser A.Type +timerSpecifier + = timerType + <|> specArrayType timerSpecifier + "timer specifier" + +portSpecifier :: OccParser A.Type +portSpecifier + = portType + <|> specArrayType portSpecifier + "port specifier" + specifier :: OccParser A.Type specifier = dataType <|> channelType <|> timerType <|> portType - <|> do s <- tryXXV sLeft sRight specifier - return $ makeArrayType A.UnknownDimension s - <|> arrayType specifier + <|> specArrayType specifier "specifier" --{{{ PROCs and FUNCTIONs @@ -1305,9 +1334,15 @@ formalArgSet = do (am, t) <- formalVariableType ns <- sepBy1NE newVariableName sComma return [A.Formal am t n | n <- ns] - <|> do t <- specifier + <|> do t <- channelSpecifier ns <- sepBy1NE newChannelName sComma return [A.Formal A.Abbrev t n | n <- ns] + <|> do t <- timerSpecifier + ns <- sepBy1NE newTimerName sComma + return [A.Formal A.Abbrev t n | n <- ns] + <|> do t <- portSpecifier + ns <- sepBy1NE newPortName sComma + return [A.Formal A.Abbrev t n | n <- ns] formalVariableType :: OccParser (A.AbbrevMode, A.Type) formalVariableType @@ -1752,12 +1787,18 @@ actuals fs = intersperseP (map actual fs) sComma actual :: A.Formal -> OccParser A.Actual actual (A.Formal am t n) = do case am of - A.ValAbbrev -> do { e <- expressionOfType t; return $ A.ActualExpression t e } "actual expression for " ++ an - _ -> if isChannelType t - then do { c <- channelOfType t; return $ A.ActualVariable am t c } "actual channel for " ++ an - else do { v <- variableOfType t; return $ A.ActualVariable am t v } "actual variable for " ++ an + A.ValAbbrev -> + do e <- expressionOfType t + return $ A.ActualExpression t e + _ -> + case stripArrayType t of + A.Chan _ -> var (channelOfType t) + A.Timer -> var timer + A.Port _ -> var (portOfType t) + _ -> var (variableOfType t) + "actual of type " ++ show t ++ " for " ++ show n where - an = A.nameName n + var inner = liftM (A.ActualVariable am t) inner --}}} --{{{ intrinsic PROC call intrinsicProcName :: OccParser (String, [A.Formal]) diff --git a/fco2/Types.hs b/fco2/Types.hs index a7d6b83..4ac4281 100644 --- a/fco2/Types.hs +++ b/fco2/Types.hs @@ -207,11 +207,8 @@ makeArrayType :: A.Dimension -> A.Type -> A.Type makeArrayType d (A.Array ds t) = A.Array (d : ds) t makeArrayType d t = A.Array [d] t -isChannelType :: A.Type -> Bool -isChannelType (A.Array _ t) = isChannelType t -isChannelType (A.Chan _) = True -isChannelType _ = False - +-- | Return a type with any enclosing arrays removed; useful for identifying +-- things that should be channel names, timer names, etc. in the parser. stripArrayType :: A.Type -> A.Type stripArrayType (A.Array _ t) = stripArrayType t stripArrayType t = t diff --git a/fco2/testcases/timer-arg.occ b/fco2/testcases/timer-arg.occ new file mode 100644 index 0000000..801c0f3 --- /dev/null +++ b/fco2/testcases/timer-arg.occ @@ -0,0 +1,10 @@ +PROC read.timer (TIMER tim, INT t) + tim ? t +: +PROC P () + TIMER tim: + INT x: + SEQ + read.timer (tim, x) + read.timer (tim, x) +: