ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst SchulzDescription : Utils for the abstract syntax of EnCL
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst SchulzCopyright : (c) Dominik Dietrich, Ewaryst Schulz, DFKI Bremen 2011
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst SchulzLicense : GPLv2 or higher, see LICENSE.txt
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst SchulzMaintainer : Ewaryst.Schulz@dfki.de
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst SchulzStability : experimental
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst SchulzPortability : portable
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst SchulzUtils to create and access abstract syntax data
e40c19038803d4a3d8914f5310a0ae8f4e683c3cEwaryst Schulz ( getDefiniens -- accessor function for AssDefinition
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst Schulz , getArguments -- accessor function for AssDefinition
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst Schulz , isFunDef -- predicate for AssDefinition
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst Schulz , isInterval -- predicate for EXPRESSION
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst Schulz , mkDefinition -- constructor for AssDefinition
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst Schulz , updateDefinition -- updates the definiens
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst Schulz , mapExpr -- maps function over EXPRESSION arguments
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst Schulz , varDeclName
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst Schulz , varDeclToVar
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst Schulz , mkVar -- Variable constructor
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst Schulz , mkOp -- Simple Operator constructor
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst Schulz , mkPredefOp -- Simple Operator constructor for predefined ops
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst Schulz , mkUserdefOp
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst Schulz , mkAndAnalyzeOp
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst Schulz , mkAndAnalyzeOp'
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst Schulz , toElimConst -- Constant naming for elim constants, see Analysis.hs
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst Schulz , setOfUserDefined
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst Schulz , setOfConstsAndEPSpecs
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst Schulzimport qualified Data.Set as Set
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst Schulzimport Data.List (sort, mapAccumL)
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder{- ---------------------------------------------------------------------------
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroederPreliminaries and Utilities
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder--------------------------------------------------------------------------- -}
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst Schulz-- | A simple operator constructor from given operator name and arguments
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst SchulzmkOp :: String -> [EXPRESSION] -> EXPRESSION
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst SchulzmkOp s el = Op (OpUser $ SimpleConstant s) [] el nullRange
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst Schulz-- | A variable constructor
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst SchulzmkVar :: String -> EXPRESSION
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst SchulzmkVar = Var . mkSimpleId
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst Schulz-- | A simple operator constructor from given operator id and arguments
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst SchulzmkPredefOp :: OPNAME -> [EXPRESSION] -> EXPRESSION
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst SchulzmkPredefOp n el = Op (OpId n) [] el nullRange
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst Schulz-- | A simple operator constructor from given operator id and arguments
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst SchulzmkUserdefOp :: String -> [EXTPARAM] -> [EXPRESSION] -> Range -> EXPRESSION
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroedermkUserdefOp n = Op (OpUser $ SimpleConstant n)
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst SchulzfoldNaryToBinary :: OPID -> Range -> [EXPRESSION] -> EXPRESSION
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroederfoldNaryToBinary op rg exps = foldl f (f (head exps) (exps !! 1)) $ drop 2 exps
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst Schulz where f e' e'' = Op op [] [e', e''] rg
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst SchulzmkAndAnalyzeOp :: OperatorState st => st -> String -> [EXTPARAM] -> [EXPRESSION]
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst Schulz -> Range -> EXPRESSION
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst SchulzmkAndAnalyzeOp st s eps exps rg =
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst Schulz either f g $ mkAndAnalyzeOp' False st s eps exps rg
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst Schulz where f = error
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst Schulz-- | Lookup the string in the given 'OperatorState'
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst SchulzmkAndAnalyzeOp' :: OperatorState st => Bool -- ^ process binders
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst Schulz -> st -> String -> [EXTPARAM] -> [EXPRESSION]
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst Schulz -> Range -> Either String EXPRESSION
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst SchulzmkAndAnalyzeOp' b st s eps exps rg =
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst Schulz case lookupOperator st s (length exps) of
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst Schulz | isVar st s -> if null exps && null eps
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder then Right $ Var Token { tokStr = s, tokPos = rg }
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst Schulz else Left "Variable requires no (extended) parameters"
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst Schulz | otherwise -> f exps $ OpUser $ SimpleConstant s
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder {- if registered it must be registered with the given arity or
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder as flex-op, otherwise we don't accept it -}
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst Schulz Left True -> Left "Wrong arity"
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst Schulz | null eps ->
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst Schulz if foldNAry oi && length exps > 2
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst Schulz then Right $ foldNaryToBinary (OpId $ opname oi) rg exps
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst Schulz else let exps' =
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst Schulz case bind oi of
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst Schulz Just x -> if b then processBinderArgs x exps else exps
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst Schulz in f exps' $ OpId $ opname oi
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst Schulz | otherwise -> Left "No extended parameters allowed"
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst Schulz where f exps' op = Right $ Op op eps exps' rg
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder{- | For given binder arguments we replace the constant-expressions at the
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroederbound variable positions by variable-expressions and also all constants with
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroederthe name of a variable in the arguments at binder body positions. -}
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst SchulzprocessBinderArgs :: BindInfo -> [EXPRESSION] -> [EXPRESSION]
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst SchulzprocessBinderArgs (BindInfo {bindingVarPos = bvl, boundBodyPos = bbl}) exps =
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst Schulz let bvl' = sort bvl
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder (vs, vl) = varSet $ map (exps !!) bvl'
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder g l'@((j, ve) : l) (i, e)
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst Schulz | j == i -- at bound variable position
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst Schulz | otherwise = (l', g' (i, e))
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst Schulz g l x = (l, g' x)
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst Schulz | elem i bbl -- at binder body position
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst Schulz = constsToVars vs e
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst Schulz | otherwise = e
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder in snd $ mapAccumL g (zip bvl' vl) $ zip [0 ..] exps
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst SchulzmapExpr :: (EXPRESSION -> EXPRESSION) -> EXPRESSION -> EXPRESSION
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst Schulz Op oi epl args rg -> Op oi epl (map f args) rg
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst Schulz List exps rg -> List (map f exps) rg
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst Schulz-- | Transforms Op-Expressions to a set of op-names and a Var-list
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst SchulzvarSet :: [EXPRESSION] -> (Set.Set String, [EXPRESSION])
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst Schulz let opToVar' s (Op v _ _ rg') =
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst Schulz ( Set.insert (simpleName v) s
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder , Var Token { tokStr = simpleName v, tokPos = rg' } )
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst Schulz opToVar' s v@(Var tok) = (Set.insert (tokStr tok) s, v)
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst Schulz opToVar' _ x =
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst Schulz error $ "varSet: not supported varexpression at " ++ show x
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst Schulz in mapAccumL opToVar' Set.empty l
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst Schulz-- | Replaces Op occurrences to Var if the op is in the given set
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst SchulzconstsToVars :: Set.Set String -> EXPRESSION -> EXPRESSION
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst SchulzconstsToVars env e =
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst Schulz let substRec =
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst Schulz \ _ s epl' args rg' ->
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst Schulz if Set.member (simpleName s) env then
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder then Var Token { tokStr = simpleName s, tokPos = rg' }
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst Schulz else error $ "constsToVars: variable must not have"
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst Schulz ++ " arguments:" ++ show args
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst Schulz else Op s epl' args rg'
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst Schulz , foldList = \ _ l rg' -> List l rg'
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst Schulz in foldTerm substRec e
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst SchulzupdateDefinition :: EXPRESSION -> AssDefinition -> AssDefinition
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst SchulzupdateDefinition e' (ConstDef _) = ConstDef e'
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst SchulzupdateDefinition e' (FunDef l _) = FunDef l e'
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst SchulzmkDefinition :: [String] -> EXPRESSION -> AssDefinition
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst SchulzmkDefinition l e = if null l then ConstDef e else FunDef l e
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst SchulzgetDefiniens :: AssDefinition -> EXPRESSION
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst SchulzgetDefiniens (ConstDef e) = e
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst SchulzgetDefiniens (FunDef _ e) = e
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst SchulzgetArguments :: AssDefinition -> [String]
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst SchulzgetArguments (FunDef l _) = l
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst SchulzgetArguments _ = []
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst SchulzisFunDef :: AssDefinition -> Bool
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst SchulzisFunDef (FunDef _ _) = True
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst SchulzisFunDef _ = False
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst SchulzisInterval :: EXPRESSION -> Bool
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroederisInterval (Interval {}) = True
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst SchulzisInterval _ = False
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst SchulzsimpleName :: OPID -> String
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst SchulzsimpleName (OpId n) = showOPNAME n
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst SchulzsimpleName (OpUser (SimpleConstant s)) = s
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroedersimpleName (OpUser x) = error "simpleName: ElimConstant not supported: " ++
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst SchulztoElimConst :: ConstantName -> Int -> ConstantName
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst SchulztoElimConst (SimpleConstant s) i = ElimConstant s i
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst SchulztoElimConst ec _ = error $ "toElimConst: already an elim const " ++ show ec
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst SchulzvarDeclName :: VarDecl -> String
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst SchulzvarDeclName (VarDecl n _) = Id.tokStr n
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst SchulzvarDeclToVar :: VarDecl -> EXPRESSION
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst SchulzvarDeclToVar (VarDecl n _) = Var n
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst SchulzopDeclToOp :: OpDecl -> EXPRESSION
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst SchulzopDeclToOp (OpDecl n epl vdl rg ) = Op (OpUser n) epl (map varDeclToVar vdl) rg
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst Schulz-- | Returns a set of user defined constants ignoring 'EXTPARAM' instantiation.
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst SchulzsetOfUserDefined :: EXPRESSION -> Set.Set String
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroedersetOfUserDefined = g Set.empty
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst Schulz Op oi@(OpUser _) _ al _ -> foldl g (Set.insert (simpleName oi) s) al
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst Schulz -- handle also non-userdefined ops.
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder Op _ _ al _ -> foldl g s al
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst Schulz -- ignoring lists (TODO: they should be removed soon anyway)
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst Schulz-- | Returns a set of user defined constants and 'EXTPARAM' specifications.
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst SchulzsetOfConstsAndEPSpecs :: EXPRESSION -> (Set.Set String, Set.Set EXTPARAM)
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroedersetOfConstsAndEPSpecs = g (Set.empty, Set.empty)
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst Schulz g s@(s1, s2) x =
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst Schulz Op oi@(OpUser _) epl al _ ->
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst Schulz foldl g ( Set.insert (simpleName oi) s1
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst Schulz , foldr Set.insert s2 epl) al
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst Schulz -- handle also non-userdefined ops.
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder Op _ _ al _ -> foldl g s al
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst Schulz -- ignoring lists (TODO: they should be removed soon anyway)