diff options
Diffstat (limited to 'src-3.0/PGF/Macros.hs')
| -rw-r--r-- | src-3.0/PGF/Macros.hs | 139 |
1 files changed, 0 insertions, 139 deletions
diff --git a/src-3.0/PGF/Macros.hs b/src-3.0/PGF/Macros.hs deleted file mode 100644 index bb5e8188b..000000000 --- a/src-3.0/PGF/Macros.hs +++ /dev/null @@ -1,139 +0,0 @@ -module PGF.Macros where - -import PGF.CId -import PGF.Data -import Control.Monad -import qualified Data.Map as Map -import qualified Data.Array as Array -import Data.Maybe -import Data.List - --- operations for manipulating PGF grammars and objects - -lookLin :: PGF -> CId -> CId -> Term -lookLin pgf lang fun = - lookMap tm0 fun $ lins $ lookMap (error "no lang") lang $ concretes pgf - -lookOper :: PGF -> CId -> CId -> Term -lookOper pgf lang fun = - lookMap tm0 fun $ opers $ lookMap (error "no lang") lang $ concretes pgf - -lookLincat :: PGF -> CId -> CId -> Term -lookLincat pgf lang fun = - lookMap tm0 fun $ lincats $ lookMap (error "no lang") lang $ concretes pgf - -lookParamLincat :: PGF -> CId -> CId -> Term -lookParamLincat pgf lang fun = - lookMap tm0 fun $ paramlincats $ lookMap (error "no lang") lang $ concretes pgf - -lookPrintName :: PGF -> CId -> CId -> Term -lookPrintName pgf lang fun = - lookMap tm0 fun $ printnames $ lookMap (error "no lang") lang $ concretes pgf - -lookType :: PGF -> CId -> Type -lookType pgf f = - fst $ lookMap (error $ "lookType " ++ show f) f (funs (abstract pgf)) - -lookValCat :: PGF -> CId -> CId -lookValCat pgf = valCat . lookType pgf - -lookParser :: PGF -> CId -> Maybe ParserInfo -lookParser pgf lang = Map.lookup lang (concretes pgf) >>= parser - -lookFCFG :: PGF -> CId -> Maybe FGrammar -lookFCFG pgf lang = fmap toFGrammar $ lookParser pgf lang - where - toFGrammar :: ParserInfo -> FGrammar - toFGrammar pinfo = (Array.elems (allRules pinfo), startupCats pinfo) - -lookStartCat :: PGF -> String -lookStartCat pgf = fromMaybe "S" $ msum $ Data.List.map (Map.lookup (mkCId "startcat")) - [gflags pgf, aflags (abstract pgf)] - -lookGlobalFlag :: PGF -> CId -> String -lookGlobalFlag pgf f = - lookMap "?" f (gflags pgf) - -lookAbsFlag :: PGF -> CId -> String -lookAbsFlag pgf f = - lookMap "?" f (aflags (abstract pgf)) - -lookConcr :: PGF -> CId -> Concr -lookConcr pgf cnc = - lookMap (error $ "Missing concrete syntax: " ++ prCId cnc) cnc $ concretes pgf - -lookConcrFlag :: PGF -> CId -> CId -> Maybe String -lookConcrFlag pgf lang f = Map.lookup f $ cflags $ lookConcr pgf lang - -functionsToCat :: PGF -> CId -> [(CId,Type)] -functionsToCat pgf cat = - [(f,ty) | f <- fs, Just (ty,_) <- [Map.lookup f $ funs $ abstract pgf]] - where - fs = lookMap [] cat $ catfuns $ abstract pgf - -missingLins :: PGF -> CId -> [CId] -missingLins pgf lang = [c | c <- fs, not (hasl c)] where - fs = Map.keys $ funs $ abstract pgf - hasl = hasLin pgf lang - -hasLin :: PGF -> CId -> CId -> Bool -hasLin pgf lang f = Map.member f $ lins $ lookConcr pgf lang - -restrictPGF :: (CId -> Bool) -> PGF -> PGF -restrictPGF cond pgf = pgf { - abstract = abstr { - funs = restrict $ funs $ abstr, - cats = restrict $ cats $ abstr - } - } ---- restrict concrs also, might be needed - where - restrict = Map.filterWithKey (\c _ -> cond c) - abstr = abstract pgf - -depth :: Tree -> Int -depth (Abs _ t) = depth t -depth (Fun _ ts) = maximum (0:map depth ts) + 1 -depth _ = 1 - -cftype :: [CId] -> CId -> Type -cftype args val = DTyp [Hyp wildCId (cftype [] arg) | arg <- args] val [] - -catSkeleton :: Type -> ([CId],CId) -catSkeleton ty = case ty of - DTyp hyps val _ -> ([valCat ty | Hyp _ ty <- hyps],val) - -typeSkeleton :: Type -> ([(Int,CId)],CId) -typeSkeleton ty = case ty of - DTyp hyps val _ -> ([(contextLength ty, valCat ty) | Hyp _ ty <- hyps],val) - -valCat :: Type -> CId -valCat ty = case ty of - DTyp _ val _ -> val - -contextLength :: Type -> Int -contextLength ty = case ty of - DTyp hyps _ _ -> length hyps - -primNotion :: Expr -primNotion = EEq [] - -term0 :: CId -> Term -term0 = TM . prCId - -tm0 :: Term -tm0 = TM "?" - -kks :: String -> Term -kks = K . KS - --- lookup with default value -lookMap :: (Show i, Ord i) => a -> i -> Map.Map i a -> a -lookMap d c m = fromMaybe d $ Map.lookup c m - ---- from Operations -combinations :: [[a]] -> [[a]] -combinations t = case t of - [] -> [[]] - aa:uu -> [a:u | a <- aa, u <- combinations uu] - - |
