ASUtils.hs revision e40c19038803d4a3d8914f5310a0ae8f4e683c3c
57221209d11b05aa0373cc3892d5df89ba96ebf9Christian MaederModule : $Header$
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian MaederDescription : Utils for the abstract syntax of EnCL
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian MaederCopyright : (c) Dominik Dietrich, Ewaryst Schulz, DFKI Bremen 2011
e6d40133bc9f858308654afb1262b8b483ec5922Till MossakowskiLicense : GPLv2 or higher, see LICENSE.txt
98890889ffb2e8f6f722b00e265a211f13b5a861Corneliu-Claudiu ProdescuMaintainer : Ewaryst.Schulz@dfki.de
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian MaederStability : experimental
3f69b6948966979163bdfe8331c38833d5d90ecdChristian MaederPortability : portable
f3a94a197960e548ecd6520bb768cb0d547457bbChristian MaederUtils to create and access abstract syntax data
351391e0e3226210e7ffb183b334da9f96de36eaChristian Maeder ( getDefiniens -- accessor function for AssDefinition
351391e0e3226210e7ffb183b334da9f96de36eaChristian Maeder , getArguments -- accessor function for AssDefinition
351391e0e3226210e7ffb183b334da9f96de36eaChristian Maeder , isFunDef -- predicate for AssDefinition
351391e0e3226210e7ffb183b334da9f96de36eaChristian Maeder , isInterval -- predicate for EXPRESSION
351391e0e3226210e7ffb183b334da9f96de36eaChristian Maeder , mkDefinition -- constructor for AssDefinition
351391e0e3226210e7ffb183b334da9f96de36eaChristian Maeder , updateDefinition -- updates the definiens
351391e0e3226210e7ffb183b334da9f96de36eaChristian Maeder , mapExpr -- maps function over EXPRESSION arguments
351391e0e3226210e7ffb183b334da9f96de36eaChristian Maeder , varDeclName
351391e0e3226210e7ffb183b334da9f96de36eaChristian Maeder , varDeclToVar
351391e0e3226210e7ffb183b334da9f96de36eaChristian Maeder , mkVar -- Variable constructor
351391e0e3226210e7ffb183b334da9f96de36eaChristian Maeder , mkOp -- Simple Operator constructor
351391e0e3226210e7ffb183b334da9f96de36eaChristian Maeder , mkPredefOp -- Simple Operator constructor for predefined ops
351391e0e3226210e7ffb183b334da9f96de36eaChristian Maeder , mkUserdefOp
351391e0e3226210e7ffb183b334da9f96de36eaChristian Maeder , mkAndAnalyzeOp
351391e0e3226210e7ffb183b334da9f96de36eaChristian Maeder , mkAndAnalyzeOp'
351391e0e3226210e7ffb183b334da9f96de36eaChristian Maeder , toElimConst -- Constant naming for elim constants, see Analysis.hs
351391e0e3226210e7ffb183b334da9f96de36eaChristian Maeder , setOfUserDefined
351391e0e3226210e7ffb183b334da9f96de36eaChristian Maeder , setOfConstsAndEPSpecs
351391e0e3226210e7ffb183b334da9f96de36eaChristian Maederimport qualified Data.Set as Set
351391e0e3226210e7ffb183b334da9f96de36eaChristian Maederimport Data.List (sort, mapAccumL)
351391e0e3226210e7ffb183b334da9f96de36eaChristian Maeder-- ---------------------------------------------------------------------------
351391e0e3226210e7ffb183b334da9f96de36eaChristian Maeder-- * Preliminaries and Utilities
351391e0e3226210e7ffb183b334da9f96de36eaChristian Maeder-- ---------------------------------------------------------------------------
351391e0e3226210e7ffb183b334da9f96de36eaChristian Maeder-- | A simple operator constructor from given operator name and arguments
351391e0e3226210e7ffb183b334da9f96de36eaChristian MaedermkOp :: String -> [EXPRESSION] -> EXPRESSION
351391e0e3226210e7ffb183b334da9f96de36eaChristian MaedermkOp s el = Op (OpUser $ SimpleConstant s) [] el nullRange
351391e0e3226210e7ffb183b334da9f96de36eaChristian Maeder-- | A variable constructor
351391e0e3226210e7ffb183b334da9f96de36eaChristian MaedermkVar :: String -> EXPRESSION
351391e0e3226210e7ffb183b334da9f96de36eaChristian MaedermkVar = Var . mkSimpleId
351391e0e3226210e7ffb183b334da9f96de36eaChristian Maeder-- | A simple operator constructor from given operator id and arguments
351391e0e3226210e7ffb183b334da9f96de36eaChristian MaedermkPredefOp :: OPNAME -> [EXPRESSION] -> EXPRESSION
351391e0e3226210e7ffb183b334da9f96de36eaChristian MaedermkPredefOp n el = Op (OpId n) [] el nullRange
351391e0e3226210e7ffb183b334da9f96de36eaChristian Maeder-- | A simple operator constructor from given operator id and arguments
351391e0e3226210e7ffb183b334da9f96de36eaChristian MaedermkUserdefOp :: String -> [EXTPARAM] -> [EXPRESSION] -> Range -> EXPRESSION
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian MaedermkUserdefOp n epl el rg = Op (OpUser $ SimpleConstant n) epl el rg
575a55eadc8dcab8ee350324b417cbd9e52e69c0Christian MaederfoldNaryToBinary :: OPID -> Range -> [EXPRESSION] -> EXPRESSION
ad270004874ce1d0697fb30d7309f180553bb315Christian MaederfoldNaryToBinary op rg exps = foldl f (f (exps!!0) (exps!!1)) $ drop 2 exps
ad270004874ce1d0697fb30d7309f180553bb315Christian Maeder where f e' e'' = Op op [] [e', e''] rg
5e46b572ed576c0494768998b043d9d340594122Till MossakowskimkAndAnalyzeOp :: OperatorState st => st -> String -> [EXTPARAM] -> [EXPRESSION]
db453fe9625a9dab5d108f7a5e464598814144b8Jian Chun Wang -> Range -> EXPRESSION
575a55eadc8dcab8ee350324b417cbd9e52e69c0Christian MaedermkAndAnalyzeOp st s eps exps rg =
575a55eadc8dcab8ee350324b417cbd9e52e69c0Christian Maeder either f g $ mkAndAnalyzeOp' False st s eps exps rg
8e9c3881fb6e710b1e08bf5ac8ff9d393df2e74eChristian Maeder where f = error
575a55eadc8dcab8ee350324b417cbd9e52e69c0Christian Maeder-- | Lookup the string in the given 'OperatorState'
a001917177db7ae636853b37c0d0f9f4e90a83ffChristian MaedermkAndAnalyzeOp' :: OperatorState st => Bool -- ^ process binders
a001917177db7ae636853b37c0d0f9f4e90a83ffChristian Maeder -> st -> String -> [EXTPARAM] -> [EXPRESSION]
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski -> Range -> Either String EXPRESSION
aea143fff7a50aceb809845fbc42698b0b3f545aChristian MaedermkAndAnalyzeOp' b st s eps exps rg =
0e2ae85e2453466d03c1fc5884a3d693235bb9d9Christian Maeder case lookupOperator st s (length exps) of
90c174bac60a72ffd81bc3bf5ae2dd9a61943b8bChristian Maeder | isVar st s -> if null exps && null eps
2561b4bfc45d280ee2be8a7870314670e4e682e4Christian Maeder then Right $ Var $ Token { tokStr = s, tokPos = rg }
ca020e82eb3567e7bdbb1cf70729efbd07e9caa4Klaus Luettich else Left "Variable requires no (extended) parameters"
aea143fff7a50aceb809845fbc42698b0b3f545aChristian Maeder | otherwise -> f exps $ OpUser $ SimpleConstant s
ca020e82eb3567e7bdbb1cf70729efbd07e9caa4Klaus Luettich -- if registered it must be registered with the given arity or
a001917177db7ae636853b37c0d0f9f4e90a83ffChristian Maeder -- as flex-op, otherwise we don't accept it
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski Left True -> Left "Wrong arity"
c7e03d0708369f944b6f235057b39142a21599f2Mihai Codescu | null eps ->
9ecf13b5fd914bc7272f1fc17348d7f4a8c77061Christian Maeder if foldNAry oi && length exps > 2
986d3f255182539098a97ac86da9eeee5b7a72e3Christian Maeder then Right $ foldNaryToBinary (OpId $ opname oi) rg exps
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian Maeder else let exps' =
8e80792f474d154ff11762fac081a422e34f1accChristian Maeder case bind oi of
03136b84a0c70d877e227444f0875e209506b9e4Christian Maeder Just x -> if b then processBinderArgs x exps else exps
03136b84a0c70d877e227444f0875e209506b9e4Christian Maeder in f exps' $ OpId $ opname oi
03136b84a0c70d877e227444f0875e209506b9e4Christian Maeder | otherwise -> Left "No extended parameters allowed"
03136b84a0c70d877e227444f0875e209506b9e4Christian Maeder where f exps' op = Right $ Op op eps exps' rg
4c7f058cdd19ce67b2b5d4b7f69703d0f8a21e38Christian Maeder-- | For given binder arguments we replace the constant-expressions at the
b2026c46f0e4c6a05931f1bf0ab2e84ce884c814Christian Maeder-- bound variable positions by variable-expressions and also all constants with
b2026c46f0e4c6a05931f1bf0ab2e84ce884c814Christian Maeder-- the name of a variable in the arguments at binder body positions.
b2026c46f0e4c6a05931f1bf0ab2e84ce884c814Christian MaederprocessBinderArgs :: BindInfo -> [EXPRESSION] -> [EXPRESSION]
b2026c46f0e4c6a05931f1bf0ab2e84ce884c814Christian MaederprocessBinderArgs (BindInfo {bindingVarPos = bvl, boundBodyPos = bbl}) exps =
b2026c46f0e4c6a05931f1bf0ab2e84ce884c814Christian Maeder let bvl' = sort bvl
b2026c46f0e4c6a05931f1bf0ab2e84ce884c814Christian Maeder (vs, vl) = varSet $ map (exps!!) bvl'
b2026c46f0e4c6a05931f1bf0ab2e84ce884c814Christian Maeder g l'@((j,ve):l) (i, e)
b2026c46f0e4c6a05931f1bf0ab2e84ce884c814Christian Maeder | j == i -- at bound variable position
b2026c46f0e4c6a05931f1bf0ab2e84ce884c814Christian Maeder | otherwise = (l', g' (i, e))
9eb39c7a0e7a1ddad1eec1d23c6d4e3a99c54023Christian Maeder g l x = (l, g' x)
e6dccba746efe07338d3107fed512e713fd50b28Christian Maeder | elem i bbl -- at binder body position
9eb39c7a0e7a1ddad1eec1d23c6d4e3a99c54023Christian Maeder = constsToVars vs e
7830e8fa7442fb7452af7ecdba102bc297ae367eChristian Maeder | otherwise = e
9eb39c7a0e7a1ddad1eec1d23c6d4e3a99c54023Christian Maeder in snd $ mapAccumL g (zip bvl' vl) $ zip [0..] exps
351145cfe8c03b4d47133c96b209f2bd6cfbf504Christian MaedermapExpr :: (EXPRESSION -> EXPRESSION) -> EXPRESSION -> EXPRESSION
9a6779c8495854bdf36e4a87f98f095e8d0a6e45Christian Maeder Op oi epl args rg -> Op oi epl (map f args) rg
81101b83a042f5a1bdeeef93b1b49aff05817e44Christian Maeder List exps rg -> List (map f exps) rg
351145cfe8c03b4d47133c96b209f2bd6cfbf504Christian Maeder-- | Transforms Op-Expressions to a set of op-names and a Var-list
351145cfe8c03b4d47133c96b209f2bd6cfbf504Christian MaedervarSet :: [EXPRESSION] -> (Set.Set String, [EXPRESSION])
81101b83a042f5a1bdeeef93b1b49aff05817e44Christian Maeder let opToVar' s (Op v _ _ rg') =
81101b83a042f5a1bdeeef93b1b49aff05817e44Christian Maeder ( Set.insert (simpleName v) s
7830e8fa7442fb7452af7ecdba102bc297ae367eChristian Maeder , Var Token{ tokStr = simpleName v, tokPos = rg' } )
351145cfe8c03b4d47133c96b209f2bd6cfbf504Christian Maeder opToVar' s v@(Var tok) = (Set.insert (tokStr tok) s, v)
d5833d2ee7bafcbf2fdd2bdfd9a728c769b100c7Christian Maeder opToVar' _ x =
81101b83a042f5a1bdeeef93b1b49aff05817e44Christian Maeder error $ "varSet: not supported varexpression at " ++ show x
81101b83a042f5a1bdeeef93b1b49aff05817e44Christian Maeder in mapAccumL opToVar' Set.empty l
9eb39c7a0e7a1ddad1eec1d23c6d4e3a99c54023Christian Maeder-- | Replaces Op occurrences to Var if the op is in the given set
d0c66a832d7b556e20ea4af4852cdc27a5463d51Christian MaederconstsToVars :: Set.Set String -> EXPRESSION -> EXPRESSION
d0c66a832d7b556e20ea4af4852cdc27a5463d51Christian MaederconstsToVars env e =
9ecf13b5fd914bc7272f1fc17348d7f4a8c77061Christian Maeder let substRec =
4b6aa93c12e4db86ccc7694a48a73e9cf7262d06Christian Maeder \ _ s epl' args rg' ->
4b6aa93c12e4db86ccc7694a48a73e9cf7262d06Christian Maeder if Set.member (simpleName s) env then
a001917177db7ae636853b37c0d0f9f4e90a83ffChristian Maeder then Var (Token { tokStr = simpleName s, tokPos = rg' })
03136b84a0c70d877e227444f0875e209506b9e4Christian Maeder else error $ "constsToVars: variable must not have"
03136b84a0c70d877e227444f0875e209506b9e4Christian Maeder ++ " arguments:" ++ show args
4b6aa93c12e4db86ccc7694a48a73e9cf7262d06Christian Maeder else Op s epl' args rg'
9ecf13b5fd914bc7272f1fc17348d7f4a8c77061Christian Maeder , foldList = \ _ l rg' -> List l rg'
fa167e362877db231378e17ba49c66fbb84862fcChristian Maeder in foldTerm substRec e
9ecf13b5fd914bc7272f1fc17348d7f4a8c77061Christian MaederupdateDefinition :: EXPRESSION -> AssDefinition -> AssDefinition
9ecf13b5fd914bc7272f1fc17348d7f4a8c77061Christian MaederupdateDefinition e' (ConstDef _) = ConstDef e'
6a22b2854c3bc9cb4877cb7d29049d6559238639Christian MaederupdateDefinition e' (FunDef l _) = FunDef l e'
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill MossakowskimkDefinition :: [String] -> EXPRESSION -> AssDefinition
a001917177db7ae636853b37c0d0f9f4e90a83ffChristian MaedermkDefinition l e = if null l then ConstDef e else FunDef l e
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill MossakowskigetDefiniens :: AssDefinition -> EXPRESSION
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill MossakowskigetDefiniens (ConstDef e) = e
4b6aa93c12e4db86ccc7694a48a73e9cf7262d06Christian MaedergetDefiniens (FunDef _ e) = e
03136b84a0c70d877e227444f0875e209506b9e4Christian MaedergetArguments :: AssDefinition -> [String]
4b6aa93c12e4db86ccc7694a48a73e9cf7262d06Christian MaedergetArguments (FunDef l _) = l
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian MaedergetArguments _ = []
9ecf13b5fd914bc7272f1fc17348d7f4a8c77061Christian MaederisFunDef :: AssDefinition -> Bool
4601edb679f0ba530bbb085b25d82a411cd070aaChristian MaederisFunDef (FunDef _ _) = True
03136b84a0c70d877e227444f0875e209506b9e4Christian MaederisFunDef _ = False
03136b84a0c70d877e227444f0875e209506b9e4Christian MaederisInterval :: EXPRESSION -> Bool
03136b84a0c70d877e227444f0875e209506b9e4Christian MaederisInterval (Interval _ _ _) = True
03136b84a0c70d877e227444f0875e209506b9e4Christian MaederisInterval _ = False
03136b84a0c70d877e227444f0875e209506b9e4Christian MaedersimpleName :: OPID -> String
03136b84a0c70d877e227444f0875e209506b9e4Christian MaedersimpleName (OpId n) = showOPNAME n
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian MaedersimpleName (OpUser (SimpleConstant s)) = s
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian MaedersimpleName (OpUser x) = error "simpleName: ElimConstant not supported: " ++ show x
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian MaedertoElimConst :: ConstantName -> Int -> ConstantName
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian MaedertoElimConst (SimpleConstant s) i = ElimConstant s i
ebc51e8081f6f1fe2f3d39ceff81d8dd0169c0b0Christian MaedertoElimConst ec _ = error $ "toElimConst: already an elim const " ++ show ec
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian MaedervarDeclName :: VarDecl -> String
03136b84a0c70d877e227444f0875e209506b9e4Christian MaedervarDeclName (VarDecl n _) = Id.tokStr n
aea143fff7a50aceb809845fbc42698b0b3f545aChristian MaedervarDeclToVar :: VarDecl -> EXPRESSION
5e46b572ed576c0494768998b043d9d340594122Till MossakowskivarDeclToVar (VarDecl n _) = Var n
ef60398f3b9f24614b074f8f0f1349ab527e1c77Christian MaederopDeclToOp :: OpDecl -> EXPRESSION
ef60398f3b9f24614b074f8f0f1349ab527e1c77Christian MaederopDeclToOp (OpDecl n epl vdl rg ) = Op (OpUser n) epl (map varDeclToVar vdl) rg
ef60398f3b9f24614b074f8f0f1349ab527e1c77Christian Maeder-- | Returns a set of user defined constants ignoring 'EXTPARAM' instantiation.
ef60398f3b9f24614b074f8f0f1349ab527e1c77Christian MaedersetOfUserDefined :: EXPRESSION -> Set.Set String
ef60398f3b9f24614b074f8f0f1349ab527e1c77Christian MaedersetOfUserDefined e = g Set.empty e
b2026c46f0e4c6a05931f1bf0ab2e84ce884c814Christian Maeder Op oi@(OpUser _) _ al _ -> foldl g (Set.insert (simpleName oi) s) al
bdf2e01977470bedcb4425e2dadabc9e9f6ba149Ewaryst Schulz -- handle also non-userdefined ops.
ef60398f3b9f24614b074f8f0f1349ab527e1c77Christian Maeder Op _ _ al _ -> foldl g s al
ef60398f3b9f24614b074f8f0f1349ab527e1c77Christian Maeder -- ignoring lists (TODO: they should be removed soon anyway)
ef60398f3b9f24614b074f8f0f1349ab527e1c77Christian Maeder-- | Returns a set of user defined constants and 'EXTPARAM' specifications.
ef60398f3b9f24614b074f8f0f1349ab527e1c77Christian MaedersetOfConstsAndEPSpecs :: EXPRESSION -> (Set.Set String, Set.Set EXTPARAM)
ef60398f3b9f24614b074f8f0f1349ab527e1c77Christian MaedersetOfConstsAndEPSpecs e = g (Set.empty, Set.empty) e
ef60398f3b9f24614b074f8f0f1349ab527e1c77Christian Maeder g s@(s1, s2) x =
bdf2e01977470bedcb4425e2dadabc9e9f6ba149Ewaryst Schulz Op oi@(OpUser _) epl al _ ->
bdf2e01977470bedcb4425e2dadabc9e9f6ba149Ewaryst Schulz foldl g ( Set.insert (simpleName oi) s1
bdf2e01977470bedcb4425e2dadabc9e9f6ba149Ewaryst Schulz , foldr Set.insert s2 epl) al
bdf2e01977470bedcb4425e2dadabc9e9f6ba149Ewaryst Schulz -- handle also non-userdefined ops.
bdf2e01977470bedcb4425e2dadabc9e9f6ba149Ewaryst Schulz Op _ _ al _ -> foldl g s al
ebc51e8081f6f1fe2f3d39ceff81d8dd0169c0b0Christian Maeder -- ignoring lists (TODO: they should be removed soon anyway)