Overhauled the Types module and ParseOccam to support the new system of operators-as-functions
The idea behind this is to parse unary/binary operators into function calls with 1/2 operands. So the AST actually has a FunctionCall with the name "+". Function names may now be quoted operators, and thus you can also have function declarations with names such as "+". Resolving is *not* done in the parser for these function names, but rather every "+" is left as "+" (no matter what types it operates on, or what is in scope) by the parser (see later patches to InferTypes instead). When parsing an occam source file, we automatically insert a bunch of PRAGMA TOCKEXTERNAL that define the default occam operators (e.g. + on INT) as external C functions (which they are!). The naming scheme for these C functions is standardised, and must be used by functions such as mulExprs (which bases the function on the type of its operands) and the new versions mulExprsInt (which are pegged to INT). The Types module also has some new functions for dealing with operator-functions.
This commit is contained in:
Neil Brown
parent
cd0dd96939
commit
f7e114f2fd
179
common/Types.hs
179
common/Types.hs
|
|
@ -22,11 +22,13 @@ module Types
|
|||
specTypeOfName, typeOfSpec, typeOfSpec', abbrevModeOfName, underlyingType, stripArrayType, abbrevModeOfVariable, abbrevModeOfSpec
|
||||
, isRealType, isIntegerType, isNumericType, isCaseableType, isScalarType, isDataType, isCommunicableType, isSequenceType, isMobileType
|
||||
, resolveUserType, isSafeConversion, isPreciseConversion, isImplicitConversionRain
|
||||
, isOperator, functionOperator, occamDefaultOperator
|
||||
, returnTypesOfFunction
|
||||
, BytesInResult(..), bytesInType, countReplicator, countStructured, computeStructured
|
||||
|
||||
, makeAbbrevAM, makeConstant, makeDimension, specificDimSize, addOne, subOne, addExprs, subExprs,
|
||||
mulExprs, divExprs
|
||||
, makeAbbrevAM, makeConstant, makeDimension, specificDimSize
|
||||
, addOne, subOne, addExprs, subExprs, mulExprs, divExprs
|
||||
, addOneInt, subOneInt, addExprsInt, subExprsInt, mulExprsInt, divExprsInt
|
||||
, addDimensions, applyDimension, removeFixedDimensions, trivialSubscriptType, subscriptType, unsubscriptType
|
||||
, applyDirection
|
||||
, recordFields, recordAttr, protocolItems, dirAttr
|
||||
|
|
@ -37,6 +39,7 @@ module Types
|
|||
) where
|
||||
|
||||
import Control.Monad.State
|
||||
import Data.Char
|
||||
import Data.Generics
|
||||
import qualified Data.Map as Map
|
||||
import Data.Maybe
|
||||
|
|
@ -198,7 +201,7 @@ subscriptType (A.SubscriptFrom m _ base) (A.Array (d:ds) t)
|
|||
= return $ A.Array (dim : ds) t
|
||||
where
|
||||
dim = case d of
|
||||
A.Dimension size -> dimensionFromExpr $ A.Dyadic m A.Subtr size base
|
||||
A.Dimension size -> dimensionFromExpr $ subExprsInt size base
|
||||
_ -> A.UnknownDimension
|
||||
subscriptType (A.SubscriptFor m _ count) (A.Array (_:ds) t)
|
||||
= return $ A.Array (dimensionFromExpr count : ds) t
|
||||
|
|
@ -278,16 +281,6 @@ abbrevModeOfVariable (A.DirectedVariable _ _ v) = abbrevModeOfVariable v
|
|||
abbrevModeOfVariable (A.DerefVariable _ v) = return A.Original
|
||||
abbrevModeOfVariable (A.VariableSizes {}) = return A.Original
|
||||
|
||||
dyadicIsBoolean :: A.DyadicOp -> Bool
|
||||
dyadicIsBoolean A.Eq = True
|
||||
dyadicIsBoolean A.NotEq = True
|
||||
dyadicIsBoolean A.Less = True
|
||||
dyadicIsBoolean A.More = True
|
||||
dyadicIsBoolean A.LessEq = True
|
||||
dyadicIsBoolean A.MoreEq = True
|
||||
dyadicIsBoolean A.After = True
|
||||
dyadicIsBoolean _ = False
|
||||
|
||||
instance ASTTypeable A.Expression where
|
||||
astTypeOf = typeOfExpression
|
||||
|
||||
|
|
@ -295,18 +288,6 @@ instance ASTTypeable A.Expression where
|
|||
typeOfExpression :: (CSMR m, Die m) => A.Expression -> m A.Type
|
||||
typeOfExpression e
|
||||
= case e of
|
||||
A.Monadic m op e -> typeOfExpression e
|
||||
A.Dyadic m op e f ->
|
||||
if dyadicIsBoolean op then return A.Bool
|
||||
else
|
||||
--Need to handle multiplying Time types specially, due to the asymmetry:
|
||||
if (op == A.Times)
|
||||
then do tlhs <- typeOfExpression e
|
||||
trhs <- typeOfExpression f
|
||||
if (tlhs == A.Time || trhs == A.Time)
|
||||
then return A.Time
|
||||
else return tlhs
|
||||
else typeOfExpression e
|
||||
A.MostPos m t -> return t
|
||||
A.MostNeg m t -> return t
|
||||
A.SizeType m t -> return A.Int
|
||||
|
|
@ -659,8 +640,8 @@ bytesInType a@(A.Array _ _) = bytesInArray 0 a
|
|||
bytesInArray num (A.Array (d:ds) t)
|
||||
= do ts <- bytesInArray (num + 1) (A.Array ds t)
|
||||
case (d, ts) of
|
||||
(A.Dimension n, BIJust m) -> return $ BIJust (mulExprs n m)
|
||||
(A.Dimension n, BIOneFree m x) -> return $ BIOneFree (mulExprs n m) x
|
||||
(A.Dimension n, BIJust m) -> return $ BIJust (mulExprsInt n m)
|
||||
(A.Dimension n, BIOneFree m x) -> return $ BIOneFree (mulExprsInt n m) x
|
||||
(A.UnknownDimension, BIJust m) -> return $ BIOneFree m num
|
||||
(A.UnknownDimension, BIOneFree _ _) -> return BIManyFree
|
||||
(_, _) -> return ts
|
||||
|
|
@ -678,7 +659,7 @@ bytesInType (A.Record n)
|
|||
= do bi <- bytesInType t
|
||||
br <- bytesInList rest
|
||||
case (bi, br) of
|
||||
(BIJust a, BIJust b) -> return $ BIJust (addExprs a b)
|
||||
(BIJust a, BIJust b) -> return $ BIJust (addExprsInt a b)
|
||||
(_, _) -> return BIUnknown
|
||||
bytesInType _ = return $ BIUnknown
|
||||
--}}}
|
||||
|
|
@ -694,46 +675,150 @@ countStructured = computeStructured (\m _ -> makeConstant m 1)
|
|||
-- | Compute an expression over a Structured.
|
||||
computeStructured :: Data a => (Meta -> a -> A.Expression) -> A.Structured a -> A.Expression
|
||||
computeStructured f (A.Spec _ (A.Specification _ _ (A.Rep m rep)) s)
|
||||
= A.Dyadic m A.Times (countReplicator rep) (computeStructured f s)
|
||||
= mulExprsInt (countReplicator rep) (computeStructured f s)
|
||||
computeStructured f (A.Spec _ _ s) = computeStructured f s
|
||||
computeStructured f (A.ProcThen _ _ s) = computeStructured f s
|
||||
computeStructured f (A.Only m x) = f m x
|
||||
computeStructured f (A.Several m ss)
|
||||
= case ss of
|
||||
[] -> makeConstant m 0
|
||||
_ -> foldl1 (A.Dyadic m A.Plus) (map (computeStructured f) ss)
|
||||
_ -> foldl1 addExprsInt (map (computeStructured f) ss)
|
||||
|
||||
specificDimSize :: Int -> A.Variable -> A.Variable
|
||||
specificDimSize n v = A.SubscriptedVariable (findMeta v) (A.Subscript (findMeta v) A.NoCheck
|
||||
$ makeConstant (findMeta v) n) $ A.VariableSizes (findMeta v) v
|
||||
|
||||
|
||||
functionOperator :: (CSMR m, Die m) => A.Name -> m (Maybe String)
|
||||
functionOperator n
|
||||
= lookupNameOrError n (dieP (A.nameMeta n) $ "Can't find operator definition for " ++ A.nameName n)
|
||||
>>* A.ndOrigName
|
||||
>>* (\op -> if isOperator op then Just op else Nothing)
|
||||
|
||||
isOperator :: String -> Bool
|
||||
isOperator op = any (== op) operatorNames
|
||||
|
||||
operatorNames :: [String]
|
||||
operatorNames =
|
||||
["??"
|
||||
,"@@"
|
||||
,"$$"
|
||||
,"%"
|
||||
,"%%"
|
||||
,"&&"
|
||||
,"<%"
|
||||
,"%>"
|
||||
,"<&"
|
||||
,"&>"
|
||||
,"<]"
|
||||
,"[>"
|
||||
,"<@"
|
||||
,"@>"
|
||||
,"@"
|
||||
,"++"
|
||||
,"!!"
|
||||
,"=="
|
||||
,"^"
|
||||
,"-"
|
||||
,"MINUS"
|
||||
,"~"
|
||||
,"NOT"
|
||||
,"+"
|
||||
,"*"
|
||||
,"/"
|
||||
,"\\"
|
||||
,"REM"
|
||||
,"PLUS"
|
||||
,"TIMES"
|
||||
,"AFTER"
|
||||
,"/\\"
|
||||
,"\\/"
|
||||
,"><"
|
||||
,"<<"
|
||||
,">>"
|
||||
,"AND"
|
||||
,"OR"
|
||||
,"="
|
||||
,"<>"
|
||||
,"<="
|
||||
,"<"
|
||||
,">="
|
||||
,">"
|
||||
]
|
||||
|
||||
-- | This gives a default mapping from operator (such as "+") to a valid name string
|
||||
-- to be used in the backend (i.e. the Tock support headers), such as "add", which
|
||||
-- will later be suffixed by the types in question.
|
||||
occamOperatorTranslateDefault :: String -> String
|
||||
occamOperatorTranslateDefault "+" = "add"
|
||||
occamOperatorTranslateDefault cs = '_' : concatMap (show . ord) cs
|
||||
|
||||
occamDefaultOperator :: String -> [A.Type] -> String
|
||||
occamDefaultOperator op ts = "occam_" ++ occamOperatorTranslateDefault op
|
||||
++ concatMap (('_':) . showOccam) ts
|
||||
|
||||
-- | Add one to an expression.
|
||||
addOne :: A.Expression -> A.Expression
|
||||
addOne e = A.Dyadic m A.Add (makeConstant m 1) e
|
||||
addOne :: (CSMR m, Die m) => A.Expression -> m A.Expression
|
||||
addOne e = addExprs (makeConstant m 1) e
|
||||
where m = findMeta e
|
||||
|
||||
-- | Subtrace one from an expression.
|
||||
subOne :: A.Expression -> A.Expression
|
||||
subOne e = A.Dyadic m A.Subtr e (makeConstant m 1)
|
||||
subOne :: (CSMR m, Die m) => A.Expression -> m A.Expression
|
||||
subOne e = subExprs e (makeConstant m 1)
|
||||
where m = findMeta e
|
||||
|
||||
-- | Add two expressions.
|
||||
addExprs :: A.Expression -> A.Expression -> A.Expression
|
||||
addExprs a b = A.Dyadic m A.Add a b
|
||||
where m = findMeta a
|
||||
-- | Add one to an expression.
|
||||
addOneInt :: A.Expression -> A.Expression
|
||||
addOneInt e = addExprsInt (makeConstant m 1) e
|
||||
where m = findMeta e
|
||||
|
||||
-- | Subtrace one from an expression.
|
||||
subOneInt :: A.Expression -> A.Expression
|
||||
subOneInt e = subExprsInt e (makeConstant m 1)
|
||||
where m = findMeta e
|
||||
|
||||
type DyadicExpr = A.Expression -> A.Expression -> A.Expression
|
||||
type DyadicExprM = (CSMR m, Die m) => A.Expression -> A.Expression -> m A.Expression
|
||||
|
||||
dyadicExpr' :: (A.Type, A.Type) -> String -> DyadicExpr
|
||||
dyadicExpr' (t0, t1) op a b
|
||||
= A.FunctionCall m (A.Name m $ occamDefaultOperator op [t0,t1]) [a, b]
|
||||
where
|
||||
m = findMeta a
|
||||
|
||||
dyadicExpr :: String -> DyadicExprM
|
||||
dyadicExpr op a b = do ta <- astTypeOf a
|
||||
tb <- astTypeOf b
|
||||
return $ dyadicExpr' (ta, tb) op a b
|
||||
|
||||
-- | Add two expressions.
|
||||
subExprs :: A.Expression -> A.Expression -> A.Expression
|
||||
subExprs a b = A.Dyadic m A.Subtr a b
|
||||
where m = findMeta a
|
||||
addExprs :: DyadicExprM
|
||||
addExprs = dyadicExpr "+"
|
||||
|
||||
-- | Add two expressions.
|
||||
subExprs :: DyadicExprM
|
||||
subExprs = dyadicExpr "-"
|
||||
|
||||
-- | Multiply two expressions.
|
||||
mulExprs :: A.Expression -> A.Expression -> A.Expression
|
||||
mulExprs a b = A.Dyadic m A.Mul a b
|
||||
where m = findMeta a
|
||||
mulExprs :: DyadicExprM
|
||||
mulExprs = dyadicExpr "*"
|
||||
|
||||
-- | Divide two expressions.
|
||||
divExprs :: A.Expression -> A.Expression -> A.Expression
|
||||
divExprs a b = A.Dyadic m A.Div a b
|
||||
where m = findMeta a
|
||||
divExprs :: DyadicExprM
|
||||
divExprs = dyadicExpr "/"
|
||||
|
||||
-- | Add two expressions.
|
||||
addExprsInt :: DyadicExpr
|
||||
addExprsInt = dyadicExpr' (A.Int,A.Int) "+"
|
||||
|
||||
-- | Add two expressions.
|
||||
subExprsInt :: DyadicExpr
|
||||
subExprsInt = dyadicExpr' (A.Int,A.Int) "-"
|
||||
|
||||
-- | Multiply two expressions.
|
||||
mulExprsInt :: DyadicExpr
|
||||
mulExprsInt = dyadicExpr' (A.Int,A.Int) "*"
|
||||
|
||||
-- | Divide two expressions.
|
||||
divExprsInt :: DyadicExpr
|
||||
divExprsInt = dyadicExpr' (A.Int,A.Int) "/"
|
||||
|
|
|
|||
|
|
@ -21,6 +21,7 @@ module ParseOccam (parseOccamProgram) where
|
|||
|
||||
import Control.Monad (join, liftM)
|
||||
import Control.Monad.State (MonadState, modify, get, put)
|
||||
import Data.Char
|
||||
import Data.List
|
||||
import qualified Data.Map as Map
|
||||
import Data.Maybe
|
||||
|
|
@ -518,7 +519,7 @@ timerName = name TimerName
|
|||
variableName = name VariableName
|
||||
|
||||
newChannelName, newChanBundleName, newDataTypeName, newFunctionName, newPortName,
|
||||
newProcName, newProtocolName, newRecordName, newTimerName,
|
||||
newProcName, newProtocolName, newRecordName, newTimerName, newUDOName,
|
||||
newVariableName
|
||||
:: OccParser A.Name
|
||||
|
||||
|
|
@ -533,6 +534,14 @@ newRecordName = newName RecordName
|
|||
newTimerName = newName TimerName
|
||||
newVariableName = newName VariableName
|
||||
|
||||
newUDOName = do m <- md
|
||||
s <- genToken test
|
||||
let chs = splitStringLiteral m s
|
||||
return $ A.Name m $ concat [cs | A.ByteLiteral _ cs <- chs]
|
||||
where
|
||||
test (Token _ (TokStringLiteral s)) = Just (chop 1 1 s)
|
||||
test _ = Nothing
|
||||
|
||||
-- | A name that isn't scoped.
|
||||
-- This is for things like record fields: we don't need to track their scope
|
||||
-- because they're only valid with the particular record they're defined in,
|
||||
|
|
@ -751,9 +760,9 @@ expressionList
|
|||
expression :: OccParser A.Expression
|
||||
expression
|
||||
= do m <- md
|
||||
o <- monadicOperator
|
||||
o <- udOperator ((`elem` [JustMonadic, EitherDyadicMonadic]) . operatorArity)
|
||||
v <- operand
|
||||
return $ A.Monadic m o v
|
||||
return $ A.FunctionCall m o [v]
|
||||
<|> do { m <- md; sMOSTPOS; t <- dataType; return $ A.MostPos m t }
|
||||
<|> do { m <- md; sMOSTNEG; t <- dataType; return $ A.MostNeg m t }
|
||||
<|> do { m <- md; sCLONE; e <- expression; return $ A.CloneMobile m e }
|
||||
|
|
@ -761,9 +770,9 @@ expression
|
|||
<|> do { m <- md; sDEFINED; e <- expression; return $ A.IsDefined m e }
|
||||
<|> sizeExpr
|
||||
<|> do m <- md
|
||||
(l, o) <- tryVV operand dyadicOperator
|
||||
(l, o) <- tryVV operand $ udOperator ((`elem` [JustDyadic, EitherDyadicMonadic]) . operatorArity)
|
||||
r <- operand
|
||||
return $ A.Dyadic m o l r
|
||||
return $ A.FunctionCall m o [l, r]
|
||||
<|> associativeOpExpression
|
||||
<|> conversion
|
||||
<|> operand
|
||||
|
|
@ -786,9 +795,11 @@ arrayConstructor
|
|||
associativeOpExpression :: OccParser A.Expression
|
||||
associativeOpExpression
|
||||
= do m <- md
|
||||
(l, o) <- tryVV operand associativeOperator
|
||||
(l, o) <- tryVV operand $ udOperator
|
||||
(\op -> (operatorArity op `elem` [JustDyadic, EitherDyadicMonadic])
|
||||
&& isAssocOperator op)
|
||||
r <- associativeOpExpression <|> operand
|
||||
return $ A.Dyadic m o l r
|
||||
return $ A.FunctionCall m o [l, r]
|
||||
<?> "associative operator expression"
|
||||
|
||||
sizeExpr :: OccParser A.Expression
|
||||
|
|
@ -823,44 +834,71 @@ functionCall
|
|||
Just _ -> return s
|
||||
Nothing -> pzero
|
||||
|
||||
monadicOperator :: OccParser A.MonadicOp
|
||||
monadicOperator
|
||||
= do { reserved "-"; return A.MonadicSubtr }
|
||||
<|> do { sMINUS; return A.MonadicMinus }
|
||||
<|> do { reserved "~" <|> sBITNOT; return A.MonadicBitNot }
|
||||
<|> do { sNOT; return A.MonadicNot }
|
||||
<?> "monadic operator"
|
||||
data OperatorArity = JustDyadic | JustMonadic | EitherDyadicMonadic | NotOperator
|
||||
deriving (Eq)
|
||||
|
||||
dyadicOperator :: OccParser A.DyadicOp
|
||||
dyadicOperator
|
||||
= do { reserved "+"; return A.Add }
|
||||
<|> do { reserved "-"; return A.Subtr }
|
||||
<|> do { reserved "*"; return A.Mul }
|
||||
<|> do { reserved "/"; return A.Div }
|
||||
<|> do { reserved "\\"; return A.Rem }
|
||||
<|> do { sREM; return A.Rem }
|
||||
<|> do { sMINUS; return A.Minus }
|
||||
<|> do { reserved "/\\" <|> sBITAND; return A.BitAnd }
|
||||
<|> do { reserved "\\/" <|> sBITOR; return A.BitOr }
|
||||
<|> do { reserved "><"; return A.BitXor }
|
||||
<|> do { reserved "<<"; return A.LeftShift }
|
||||
<|> do { reserved ">>"; return A.RightShift }
|
||||
<|> do { reserved "="; return A.Eq }
|
||||
<|> do { reserved "<>"; return A.NotEq }
|
||||
<|> do { reserved "<"; return A.Less }
|
||||
<|> do { reserved ">"; return A.More }
|
||||
<|> do { reserved "<="; return A.LessEq }
|
||||
<|> do { reserved ">="; return A.MoreEq }
|
||||
<|> do { sAFTER; return A.After }
|
||||
<?> "dyadic operator"
|
||||
-- Returns the most operands it can take.
|
||||
operatorArity :: String -> OperatorArity
|
||||
operatorArity "??" = EitherDyadicMonadic
|
||||
operatorArity "@@" = EitherDyadicMonadic
|
||||
operatorArity "$$" = EitherDyadicMonadic
|
||||
operatorArity "%" = EitherDyadicMonadic
|
||||
operatorArity "%%" = EitherDyadicMonadic
|
||||
operatorArity "&&" = EitherDyadicMonadic
|
||||
operatorArity "<%" = EitherDyadicMonadic
|
||||
operatorArity "%>" = EitherDyadicMonadic
|
||||
operatorArity "<&" = EitherDyadicMonadic
|
||||
operatorArity "&>" = EitherDyadicMonadic
|
||||
operatorArity "<]" = EitherDyadicMonadic
|
||||
operatorArity "[>" = EitherDyadicMonadic
|
||||
operatorArity "<@" = EitherDyadicMonadic
|
||||
operatorArity "@>" = EitherDyadicMonadic
|
||||
operatorArity "@" = EitherDyadicMonadic
|
||||
operatorArity "++" = EitherDyadicMonadic
|
||||
operatorArity "!!" = EitherDyadicMonadic
|
||||
operatorArity "==" = EitherDyadicMonadic
|
||||
operatorArity "^" = EitherDyadicMonadic
|
||||
operatorArity "-" = EitherDyadicMonadic
|
||||
operatorArity "MINUS" = EitherDyadicMonadic
|
||||
operatorArity "~" = JustMonadic
|
||||
operatorArity "NOT" = JustMonadic
|
||||
operatorArity "+" = JustDyadic
|
||||
operatorArity "*" = JustDyadic
|
||||
operatorArity "/" = JustDyadic
|
||||
operatorArity "\\" = JustDyadic
|
||||
operatorArity "REM" = JustDyadic
|
||||
operatorArity "PLUS" = JustDyadic
|
||||
operatorArity "TIMES" = JustDyadic
|
||||
operatorArity "AFTER" = JustDyadic
|
||||
operatorArity "/\\" = JustDyadic
|
||||
operatorArity "\\/" = JustDyadic
|
||||
operatorArity "><" = JustDyadic
|
||||
operatorArity "<<" = JustDyadic
|
||||
operatorArity ">>" = JustDyadic
|
||||
operatorArity "AND" = JustDyadic
|
||||
operatorArity "OR" = JustDyadic
|
||||
operatorArity "=" = JustDyadic
|
||||
operatorArity "<>" = JustDyadic
|
||||
operatorArity "<" = JustDyadic
|
||||
operatorArity "<=" = JustDyadic
|
||||
operatorArity ">" = JustDyadic
|
||||
operatorArity ">=" = JustDyadic
|
||||
operatorArity _ = NotOperator
|
||||
|
||||
associativeOperator :: OccParser A.DyadicOp
|
||||
associativeOperator
|
||||
= do { sAND; return A.And }
|
||||
<|> do { sOR; return A.Or }
|
||||
<|> do { sPLUS; return A.Plus }
|
||||
<|> do { sTIMES; return A.Times }
|
||||
<?> "associative operator"
|
||||
isAssocOperator :: String -> Bool
|
||||
isAssocOperator "AND" = True
|
||||
isAssocOperator "OR" = True
|
||||
isAssocOperator "PLUS" = True
|
||||
isAssocOperator "TIMES" = True
|
||||
|
||||
udOperator :: (String -> Bool) -> OccParser A.Name
|
||||
udOperator isOp = do m <- md
|
||||
n <- genToken test
|
||||
return $ A.Name m n
|
||||
where
|
||||
test (Token _ (TokReserved name))
|
||||
= if isOp name then Just name else Nothing
|
||||
test _ = Nothing
|
||||
|
||||
conversion :: OccParser A.Expression
|
||||
conversion
|
||||
|
|
@ -1191,7 +1229,7 @@ definition
|
|||
return (A.Specification m n' $ A.Proc m (sm, rm) fs' (Just p), ProcName, normalName)
|
||||
<|> do m <- md
|
||||
(rs, (sm, (rm, _))) <- tryVV (sepBy1 dataType sComma) (specMode $ recMode sFUNCTION)
|
||||
n <- newFunctionName
|
||||
n <- newFunctionName <|> newUDOName
|
||||
fs <- formalList
|
||||
let addScope body
|
||||
= do n' <- if rm == A.Recursive
|
||||
|
|
@ -1432,7 +1470,7 @@ pragma = do m <- getPosition >>* sourcePosToMeta
|
|||
n <- newProcName
|
||||
return (n, ProcName, origN, fs, A.Proc m (A.PlainSpec, A.PlainRec) fs Nothing)
|
||||
<|> do ts <- tryVX (sepBy1 dataType sComma) sFUNCTION
|
||||
origN <- anyName FunctionName
|
||||
origN <- anyName FunctionName <|> newUDOName
|
||||
fs <- formalList'
|
||||
sEq
|
||||
n <- newFunctionName
|
||||
|
|
@ -1934,8 +1972,30 @@ runTockParser toks prod cs
|
|||
parseOccamProgram :: [Token] -> PassM A.AST
|
||||
parseOccamProgram toks
|
||||
= do cs <- get
|
||||
(p, cs') <- runTockParser toks sourceFile cs
|
||||
(p, cs') <- runTockParser (defaultDecl ++ toks) sourceFile cs
|
||||
put cs'
|
||||
return p
|
||||
|
||||
defaultDecl :: [Token]
|
||||
defaultDecl = concat
|
||||
[let params = [showOccam $ A.Formal A.ValAbbrev t (A.Name emptyMeta $ "x" ++
|
||||
show i)
|
||||
| (t, i :: Integer) <- zip ts [0..]]
|
||||
in
|
||||
[Token emptyMeta $ Pragma $ "TOCKEXTERNAL \""
|
||||
++ showOccam rt
|
||||
++ " FUNCTION \"" ++ concatMap doubleStar op ++ "\"("
|
||||
++ concat (intersperse "," params)
|
||||
++ ") = "
|
||||
++ occamDefaultOperator op ts
|
||||
++ "\""
|
||||
,Token emptyMeta EndOfLine
|
||||
]
|
||||
| (op, rt, ts) <- occamIntrinsicOperators
|
||||
]
|
||||
where
|
||||
doubleStar '*' = "**"
|
||||
doubleStar c = [c]
|
||||
|
||||
--}}}
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user