diff options
Diffstat (limited to 'src/GF/GFCC/Macros.hs')
| -rw-r--r-- | src/GF/GFCC/Macros.hs | 121 |
1 files changed, 0 insertions, 121 deletions
diff --git a/src/GF/GFCC/Macros.hs b/src/GF/GFCC/Macros.hs deleted file mode 100644 index 4897aa667..000000000 --- a/src/GF/GFCC/Macros.hs +++ /dev/null @@ -1,121 +0,0 @@ -module GF.GFCC.Macros where - -import GF.GFCC.CId -import GF.GFCC.DataGFCC -import GF.Formalism.FCFG (FGrammar) -import GF.Parsing.FCFG.PInfo (FCFPInfo, fcfPInfoToFGrammar) -----import GF.GFCC.PrintGFCC -import Control.Monad -import Data.Map -import Data.Maybe -import Data.List - --- operations for manipulating GFCC grammars and objects - -lookLin :: GFCC -> CId -> CId -> Term -lookLin gfcc lang fun = - lookMap tm0 fun $ lins $ lookMap (error "no lang") lang $ concretes gfcc - -lookOper :: GFCC -> CId -> CId -> Term -lookOper gfcc lang fun = - lookMap tm0 fun $ opers $ lookMap (error "no lang") lang $ concretes gfcc - -lookLincat :: GFCC -> CId -> CId -> Term -lookLincat gfcc lang fun = - lookMap tm0 fun $ lincats $ lookMap (error "no lang") lang $ concretes gfcc - -lookParamLincat :: GFCC -> CId -> CId -> Term -lookParamLincat gfcc lang fun = - lookMap tm0 fun $ paramlincats $ lookMap (error "no lang") lang $ concretes gfcc - -lookType :: GFCC -> CId -> Type -lookType gfcc f = - fst $ lookMap (error $ "lookType " ++ show f) f (funs (abstract gfcc)) - -lookParser :: GFCC -> CId -> Maybe FCFPInfo -lookParser gfcc lang = parser $ lookMap (error "no lang") lang $ concretes gfcc - -lookFCFG :: GFCC -> CId -> Maybe FGrammar -lookFCFG gfcc lang = fmap fcfPInfoToFGrammar $ lookParser gfcc lang - -lookStartCat :: GFCC -> String -lookStartCat gfcc = fromMaybe "S" $ msum $ Data.List.map (Data.Map.lookup (CId "startcat")) - [gflags gfcc, aflags (abstract gfcc)] - -lookGlobalFlag :: GFCC -> CId -> String -lookGlobalFlag gfcc f = - lookMap "?" f (gflags gfcc) - -lookAbsFlag :: GFCC -> CId -> String -lookAbsFlag gfcc f = - lookMap "?" f (aflags (abstract gfcc)) - -lookCncFlag :: GFCC -> CId -> CId -> String -lookCncFlag gfcc lang f = - lookMap "?" f $ cflags $ lookMap (error "no lang") lang $ concretes gfcc - -functionsToCat :: GFCC -> CId -> [(CId,Type)] -functionsToCat gfcc cat = - [(f,ty) | f <- fs, Just (ty,_) <- [Data.Map.lookup f $ funs $ abstract gfcc]] - where - fs = lookMap [] cat $ catfuns $ abstract gfcc - -depth :: Exp -> Int -depth tr = case tr of - DTr _ _ [] -> 1 - DTr _ _ ts -> maximum (lmap depth ts) + 1 - -tree :: Atom -> [Exp] -> Exp -tree = DTr [] - -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 - -cid :: String -> CId -cid = CId - -wildCId :: CId -wildCId = cid "_" - -exp0 :: Exp -exp0 = tree (AM 0) [] - -primNotion :: Exp -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 i a -> a -lookMap d c m = maybe d id $ Data.Map.lookup c m - ---- from Operations -combinations :: [[a]] -> [[a]] -combinations t = case t of - [] -> [[]] - aa:uu -> [a:u | a <- aa, u <- combinations uu] - - |
