ASUtils.hs revision 3d3889e0cefcdce9b3f43c53aaa201943ac2e895
4b0a4c7dea0f67a233dcc42ce9bb18d36de109aeChristian MaederModule : $Header$
5ba323da9f037264b4a356085e844889aedeac23Christian MaederDescription : Utils for the abstract syntax of EnCL
c58a94c44b76b072ace930f2126c889c0b64cb2aChristian MaederCopyright : (c) Dominik Dietrich, Ewaryst Schulz, DFKI Bremen 2011
97018cf5fa25b494adffd7e9b4e87320dae6bf47Christian MaederLicense : GPLv2 or higher, see LICENSE.txt
3f69b6948966979163bdfe8331c38833d5d90ecdChristian MaederMaintainer : Ewaryst.Schulz@dfki.de
4b0a4c7dea0f67a233dcc42ce9bb18d36de109aeChristian MaederStability : experimental
4561227a776bdf0ab679b19fb92f1eaaed8786f7Christian MaederPortability : portable
ea03c5d09694b4a966fbd19d46cfa5772648d95fChristian MaederUtils to create and access abstract syntax data
e8ffec0fa3d3061061bdc16e44247b9cf96b050fChristian Maeder ( getDefiniens -- accessor function for AssDefinition
81946e2b3f6dde6167f48769bd02c7a634736856Christian Maeder , getArguments -- accessor function for AssDefinition
ad270004874ce1d0697fb30d7309f180553bb315Christian Maeder , isFunDef -- predicate for AssDefinition
ad270004874ce1d0697fb30d7309f180553bb315Christian Maeder , isInterval -- predicate for EXPRESSION
f8c07dc6526e0134d66885d461a30abadc2c6038Christian Maeder , mkDefinition -- constructor for AssDefinition
afa6848d579d235c9677e1ab477916df8e5ae11aChristian Maeder , updateDefinition -- updates the definiens
dc6b48bb46df8e56da3491c98476e6da0d1d5d1dChristian Maeder , mapExpr -- maps function over EXPRESSION arguments
b603f34b79bc0992e5d74f484e5bdc9f9c2346c6Christian Maeder , varDeclName
4561227a776bdf0ab679b19fb92f1eaaed8786f7Christian Maeder , varDeclToVar
fd5d3885a092ac0727fa2436cdfc3b248318ebd8Christian Maeder , mkVar -- Variable constructor
4561227a776bdf0ab679b19fb92f1eaaed8786f7Christian Maeder , mkOp -- Simple Operator constructor
0be2d0cfd911d313e7e941edbc77f95052c8c19bChristian Maeder , mkPredefOp -- Simple Operator constructor for predefined ops
0be2d0cfd911d313e7e941edbc77f95052c8c19bChristian Maeder , mkUserdefOp
0be2d0cfd911d313e7e941edbc77f95052c8c19bChristian Maeder , mkAndAnalyzeOp
502ed7ed7fecd10b6d0c83cdd48a244ec45e840aChristian Maeder , mkAndAnalyzeOp'
0be2d0cfd911d313e7e941edbc77f95052c8c19bChristian Maeder , toElimConst -- Constant naming for elim constants, see Analysis.hs
c00adad2e9459b422dee09e3a2bddba66b433bb7Christian Maeder , setOfUserDefined
9348e8460498ddfcd9da11cd8b5794c06023e004Christian Maeder , setOfConstsAndEPSpecs
4561227a776bdf0ab679b19fb92f1eaaed8786f7Christian Maederimport qualified Data.Set as Set
0be2d0cfd911d313e7e941edbc77f95052c8c19bChristian Maederimport Data.List (sort, mapAccumL)
9348e8460498ddfcd9da11cd8b5794c06023e004Christian Maeder{- ---------------------------------------------------------------------------
0be2d0cfd911d313e7e941edbc77f95052c8c19bChristian MaederPreliminaries and Utilities
7de39d39bc1700cc8a9bb9df90b920aad9e18d4aChristian Maeder--------------------------------------------------------------------------- -}
23f8d286586ff38a9e73052b2c7c04c62c5c638fChristian Maeder-- | A simple operator constructor from given operator name and arguments
4561227a776bdf0ab679b19fb92f1eaaed8786f7Christian MaedermkOp :: String -> [EXPRESSION] -> EXPRESSION
7de39d39bc1700cc8a9bb9df90b920aad9e18d4aChristian MaedermkOp s el = Op (OpUser $ SimpleConstant s) [] el nullRange
9348e8460498ddfcd9da11cd8b5794c06023e004Christian Maeder-- | A variable constructor
0be2d0cfd911d313e7e941edbc77f95052c8c19bChristian MaedermkVar :: String -> EXPRESSION
f454c20b6c126bea7d31d400cc8824b9ee8cc6eaChristian MaedermkVar = Var . mkSimpleId
e1839fb37a3a2ccd457464cb0dcc5efd466dbe22Christian Maeder-- | A simple operator constructor from given operator id and arguments
9348e8460498ddfcd9da11cd8b5794c06023e004Christian MaedermkPredefOp :: OPNAME -> [EXPRESSION] -> EXPRESSION
0be2d0cfd911d313e7e941edbc77f95052c8c19bChristian MaedermkPredefOp n el = Op (OpId n) [] el nullRange
0be2d0cfd911d313e7e941edbc77f95052c8c19bChristian Maeder-- | A simple operator constructor from given operator id and arguments
0be2d0cfd911d313e7e941edbc77f95052c8c19bChristian MaedermkUserdefOp :: String -> [EXTPARAM] -> [EXPRESSION] -> Range -> EXPRESSION
27912d626bf179b82fcb337077e5cd9653bb71cfChristian MaedermkUserdefOp n = Op (OpUser $ SimpleConstant n)
9348e8460498ddfcd9da11cd8b5794c06023e004Christian MaederfoldNaryToBinary :: OPID -> Range -> [EXPRESSION] -> EXPRESSION
0be2d0cfd911d313e7e941edbc77f95052c8c19bChristian MaederfoldNaryToBinary op rg exps = foldl f (f (head exps) (exps !! 1)) $ drop 2 exps
0be2d0cfd911d313e7e941edbc77f95052c8c19bChristian Maeder where f e' e'' = Op op [] [e', e''] rg
ad187062b0009820118c1b773a232e29b879a2faChristian MaedermkAndAnalyzeOp :: OperatorState st => st -> String -> [EXTPARAM] -> [EXPRESSION]
0be2d0cfd911d313e7e941edbc77f95052c8c19bChristian Maeder -> Range -> EXPRESSION
5ba323da9f037264b4a356085e844889aedeac23Christian MaedermkAndAnalyzeOp st s eps exps rg =
5ba323da9f037264b4a356085e844889aedeac23Christian Maeder either f g $ mkAndAnalyzeOp' False st s eps exps rg
ad187062b0009820118c1b773a232e29b879a2faChristian Maeder where f = error
0be2d0cfd911d313e7e941edbc77f95052c8c19bChristian Maeder-- | Lookup the string in the given 'OperatorState'
7de39d39bc1700cc8a9bb9df90b920aad9e18d4aChristian MaedermkAndAnalyzeOp' :: OperatorState st => Bool -- ^ process binders
9348e8460498ddfcd9da11cd8b5794c06023e004Christian Maeder -> st -> String -> [EXTPARAM] -> [EXPRESSION]
9348e8460498ddfcd9da11cd8b5794c06023e004Christian Maeder -> Range -> Either String EXPRESSION
1d589334ba6b4a4cbfb35307a7a732261e77b0cdChristian MaedermkAndAnalyzeOp' b st s eps exps rg =
f26a1fc3851297e6483cf3fb56e9c0967b8f8b13Christian Maeder case lookupOperator st s (length exps) of
9348e8460498ddfcd9da11cd8b5794c06023e004Christian Maeder | isVar st s -> if null exps && null eps
9348e8460498ddfcd9da11cd8b5794c06023e004Christian Maeder then Right $ Var Token { tokStr = s, tokPos = rg }
4561227a776bdf0ab679b19fb92f1eaaed8786f7Christian Maeder else Left "Variable requires no (extended) parameters"
0be2d0cfd911d313e7e941edbc77f95052c8c19bChristian Maeder | otherwise -> f exps $ OpUser $ SimpleConstant s
9348e8460498ddfcd9da11cd8b5794c06023e004Christian Maeder {- if registered it must be registered with the given arity or
4561227a776bdf0ab679b19fb92f1eaaed8786f7Christian Maeder as flex-op, otherwise we don't accept it -}
9348e8460498ddfcd9da11cd8b5794c06023e004Christian Maeder Left True -> Left "Wrong arity"
9348e8460498ddfcd9da11cd8b5794c06023e004Christian Maeder | null eps ->
9348e8460498ddfcd9da11cd8b5794c06023e004Christian Maeder if foldNAry oi && length exps > 2
9348e8460498ddfcd9da11cd8b5794c06023e004Christian Maeder then Right $ foldNaryToBinary (OpId $ opname oi) rg exps
9348e8460498ddfcd9da11cd8b5794c06023e004Christian Maeder else let exps' =
9348e8460498ddfcd9da11cd8b5794c06023e004Christian Maeder case bind oi of
4561227a776bdf0ab679b19fb92f1eaaed8786f7Christian Maeder Just x -> if b then processBinderArgs x exps else exps
0be2d0cfd911d313e7e941edbc77f95052c8c19bChristian Maeder in f exps' $ OpId $ opname oi
7de39d39bc1700cc8a9bb9df90b920aad9e18d4aChristian Maeder | otherwise -> Left "No extended parameters allowed"
0be2d0cfd911d313e7e941edbc77f95052c8c19bChristian Maeder where f exps' op = Right $ Op op eps exps' rg
9348e8460498ddfcd9da11cd8b5794c06023e004Christian Maeder{- | For given binder arguments we replace the constant-expressions at the
502ed7ed7fecd10b6d0c83cdd48a244ec45e840aChristian Maederbound variable positions by variable-expressions and also all constants with
9348e8460498ddfcd9da11cd8b5794c06023e004Christian Maederthe name of a variable in the arguments at binder body positions. -}
81946e2b3f6dde6167f48769bd02c7a634736856Christian MaederprocessBinderArgs :: BindInfo -> [EXPRESSION] -> [EXPRESSION]
7c57322afb6342e5cc8b1fdc96050b707407fc61Christian MaederprocessBinderArgs (BindInfo {bindingVarPos = bvl, boundBodyPos = bbl}) exps =
0be2d0cfd911d313e7e941edbc77f95052c8c19bChristian Maeder let bvl' = sort bvl
7de39d39bc1700cc8a9bb9df90b920aad9e18d4aChristian Maeder (vs, vl) = varSet $ map (exps !!) bvl'
36c6cc568751e4235502cfee00ba7b597dae78dcChristian Maeder g l'@((j, ve) : l) (i, e)
9348e8460498ddfcd9da11cd8b5794c06023e004Christian Maeder | j == i -- at bound variable position
fd5d3885a092ac0727fa2436cdfc3b248318ebd8Christian Maeder | otherwise = (l', g' (i, e))
9348e8460498ddfcd9da11cd8b5794c06023e004Christian Maeder g l x = (l, g' x)
9348e8460498ddfcd9da11cd8b5794c06023e004Christian Maeder | elem i bbl -- at binder body position
0be2d0cfd911d313e7e941edbc77f95052c8c19bChristian Maeder = constsToVars vs e
7de39d39bc1700cc8a9bb9df90b920aad9e18d4aChristian Maeder | otherwise = e
0be2d0cfd911d313e7e941edbc77f95052c8c19bChristian Maeder in snd $ mapAccumL g (zip bvl' vl) $ zip [0 ..] exps
4561227a776bdf0ab679b19fb92f1eaaed8786f7Christian MaedermapExpr :: (EXPRESSION -> EXPRESSION) -> EXPRESSION -> EXPRESSION
7de39d39bc1700cc8a9bb9df90b920aad9e18d4aChristian Maeder Op oi epl args rg -> Op oi epl (map f args) rg
f454c20b6c126bea7d31d400cc8824b9ee8cc6eaChristian Maeder List exps rg -> List (map f exps) rg
9348e8460498ddfcd9da11cd8b5794c06023e004Christian Maeder-- | Transforms Op-Expressions to a set of op-names and a Var-list
0be2d0cfd911d313e7e941edbc77f95052c8c19bChristian MaedervarSet :: [EXPRESSION] -> (Set.Set String, [EXPRESSION])
f454c20b6c126bea7d31d400cc8824b9ee8cc6eaChristian Maeder let opToVar' s (Op v _ _ rg') =
0be2d0cfd911d313e7e941edbc77f95052c8c19bChristian Maeder ( Set.insert (simpleName v) s
5ba323da9f037264b4a356085e844889aedeac23Christian Maeder , Var Token { tokStr = simpleName v, tokPos = rg' } )
628310b42327ad76ce471caf0dde6563d6fa6307Christian Maeder opToVar' s v@(Var tok) = (Set.insert (tokStr tok) s, v)
ad187062b0009820118c1b773a232e29b879a2faChristian Maeder opToVar' _ x =
ad187062b0009820118c1b773a232e29b879a2faChristian Maeder error $ "varSet: not supported varexpression at " ++ show x
ad187062b0009820118c1b773a232e29b879a2faChristian Maeder in mapAccumL opToVar' Set.empty l
ad187062b0009820118c1b773a232e29b879a2faChristian Maeder-- | Replaces Op occurrences to Var if the op is in the given set
ad187062b0009820118c1b773a232e29b879a2faChristian MaederconstsToVars :: Set.Set String -> EXPRESSION -> EXPRESSION
9348e8460498ddfcd9da11cd8b5794c06023e004Christian MaederconstsToVars env e =
aff01ee50b66032469c232e00c945d1fd4f57d1bChristian Maeder let substRec =
0be2d0cfd911d313e7e941edbc77f95052c8c19bChristian Maeder \ _ s epl' args rg' ->
aff01ee50b66032469c232e00c945d1fd4f57d1bChristian Maeder if Set.member (simpleName s) env then
ad187062b0009820118c1b773a232e29b879a2faChristian Maeder then Var Token { tokStr = simpleName s, tokPos = rg' }
fd5d3885a092ac0727fa2436cdfc3b248318ebd8Christian Maeder else error $ "constsToVars: variable must not have"
4561227a776bdf0ab679b19fb92f1eaaed8786f7Christian Maeder ++ " arguments:" ++ show args
c9892acbf03a509d874ac6d79b9a2cb09042e0dcChristian Maeder else Op s epl' args rg'
9348e8460498ddfcd9da11cd8b5794c06023e004Christian Maeder , foldList = \ _ l rg' -> List l rg'
0be2d0cfd911d313e7e941edbc77f95052c8c19bChristian Maeder in foldTerm substRec e
0be2d0cfd911d313e7e941edbc77f95052c8c19bChristian MaederupdateDefinition :: EXPRESSION -> AssDefinition -> AssDefinition
0be2d0cfd911d313e7e941edbc77f95052c8c19bChristian MaederupdateDefinition e' (ConstDef _) = ConstDef e'
0be2d0cfd911d313e7e941edbc77f95052c8c19bChristian MaederupdateDefinition e' (FunDef l _) = FunDef l e'
0be2d0cfd911d313e7e941edbc77f95052c8c19bChristian MaedermkDefinition :: [String] -> EXPRESSION -> AssDefinition
0be2d0cfd911d313e7e941edbc77f95052c8c19bChristian MaedermkDefinition l e = if null l then ConstDef e else FunDef l e
b49276c9f50038e0bd499ad49f7bd6444566a834Christian MaedergetDefiniens :: AssDefinition -> EXPRESSION
ad187062b0009820118c1b773a232e29b879a2faChristian MaedergetDefiniens (ConstDef e) = e
ad187062b0009820118c1b773a232e29b879a2faChristian MaedergetDefiniens (FunDef _ e) = e
ad187062b0009820118c1b773a232e29b879a2faChristian MaedergetArguments :: AssDefinition -> [String]
9348e8460498ddfcd9da11cd8b5794c06023e004Christian MaedergetArguments (FunDef l _) = l
c00adad2e9459b422dee09e3a2bddba66b433bb7Christian MaedergetArguments _ = []
0be2d0cfd911d313e7e941edbc77f95052c8c19bChristian MaederisFunDef :: AssDefinition -> Bool
0be2d0cfd911d313e7e941edbc77f95052c8c19bChristian MaederisFunDef (FunDef _ _) = True
0be2d0cfd911d313e7e941edbc77f95052c8c19bChristian MaederisFunDef _ = False
0be2d0cfd911d313e7e941edbc77f95052c8c19bChristian MaederisInterval :: EXPRESSION -> Bool
0be2d0cfd911d313e7e941edbc77f95052c8c19bChristian MaederisInterval (Interval {}) = True
0be2d0cfd911d313e7e941edbc77f95052c8c19bChristian MaederisInterval _ = False
0be2d0cfd911d313e7e941edbc77f95052c8c19bChristian MaedersimpleName :: OPID -> String
0be2d0cfd911d313e7e941edbc77f95052c8c19bChristian MaedersimpleName (OpId n) = showOPNAME n
c00adad2e9459b422dee09e3a2bddba66b433bb7Christian MaedersimpleName (OpUser (SimpleConstant s)) = s
facf15c975d25ca5d31d8f84bf48f09d1d951ad6Christian MaedersimpleName (OpUser x) = error "simpleName: ElimConstant not supported: " ++
facf15c975d25ca5d31d8f84bf48f09d1d951ad6Christian MaedertoElimConst :: ConstantName -> Int -> ConstantName
facf15c975d25ca5d31d8f84bf48f09d1d951ad6Christian MaedertoElimConst (SimpleConstant s) i = ElimConstant s i
ad187062b0009820118c1b773a232e29b879a2faChristian MaedertoElimConst ec _ = error $ "toElimConst: already an elim const " ++ show ec
ad187062b0009820118c1b773a232e29b879a2faChristian MaedervarDeclName :: VarDecl -> String
ad187062b0009820118c1b773a232e29b879a2faChristian MaedervarDeclName (VarDecl n _) = Id.tokStr n
ad187062b0009820118c1b773a232e29b879a2faChristian MaedervarDeclToVar :: VarDecl -> EXPRESSION
ad187062b0009820118c1b773a232e29b879a2faChristian MaedervarDeclToVar (VarDecl n _) = Var n
ad187062b0009820118c1b773a232e29b879a2faChristian MaederopDeclToOp :: OpDecl -> EXPRESSION
ad187062b0009820118c1b773a232e29b879a2faChristian MaederopDeclToOp (OpDecl n epl vdl rg ) = Op (OpUser n) epl (map varDeclToVar vdl) rg
ad187062b0009820118c1b773a232e29b879a2faChristian Maeder-- | Returns a set of user defined constants ignoring 'EXTPARAM' instantiation.
afa6848d579d235c9677e1ab477916df8e5ae11aChristian MaedersetOfUserDefined :: EXPRESSION -> Set.Set String
afa6848d579d235c9677e1ab477916df8e5ae11aChristian MaedersetOfUserDefined = g Set.empty
0be2d0cfd911d313e7e941edbc77f95052c8c19bChristian Maeder Op oi@(OpUser _) _ al _ -> foldl g (Set.insert (simpleName oi) s) al
0be2d0cfd911d313e7e941edbc77f95052c8c19bChristian Maeder -- handle also non-userdefined ops.
afa6848d579d235c9677e1ab477916df8e5ae11aChristian Maeder Op _ _ al _ -> foldl g s al
afa6848d579d235c9677e1ab477916df8e5ae11aChristian Maeder -- ignoring lists (TODO: they should be removed soon anyway)
0be2d0cfd911d313e7e941edbc77f95052c8c19bChristian Maeder-- | Returns a set of user defined constants and 'EXTPARAM' specifications.
0be2d0cfd911d313e7e941edbc77f95052c8c19bChristian MaedersetOfConstsAndEPSpecs :: EXPRESSION -> (Set.Set String, Set.Set EXTPARAM)
afa6848d579d235c9677e1ab477916df8e5ae11aChristian MaedersetOfConstsAndEPSpecs = g (Set.empty, Set.empty)
f8c07dc6526e0134d66885d461a30abadc2c6038Christian Maeder g s@(s1, s2) x =
4561227a776bdf0ab679b19fb92f1eaaed8786f7Christian Maeder Op oi@(OpUser _) epl al _ ->
f8c07dc6526e0134d66885d461a30abadc2c6038Christian Maeder foldl g ( Set.insert (simpleName oi) s1
afa6848d579d235c9677e1ab477916df8e5ae11aChristian Maeder , foldr Set.insert s2 epl) al
afa6848d579d235c9677e1ab477916df8e5ae11aChristian Maeder -- handle also non-userdefined ops.
f8c07dc6526e0134d66885d461a30abadc2c6038Christian Maeder Op _ _ al _ -> foldl g s al
4561227a776bdf0ab679b19fb92f1eaaed8786f7Christian Maeder -- ignoring lists (TODO: they should be removed soon anyway)