diff options
| author | krasimir <krasimir@chalmers.se> | 2009-02-23 12:42:44 +0000 |
|---|---|---|
| committer | krasimir <krasimir@chalmers.se> | 2009-02-23 12:42:44 +0000 |
| commit | 01fef5109c2920d13004ae5b94d192fa5fba205f (patch) | |
| tree | a5211ace0573bbe5397b68681d1949889f73a000 /src/GF/Compile/GrammarToGFCC.hs | |
| parent | 2bc918bb9a6489d5f40993c8417b147ffc375472 (diff) | |
Perhaps -> Maybe refactoring and better error message for conflicts during module update
Diffstat (limited to 'src/GF/Compile/GrammarToGFCC.hs')
| -rw-r--r-- | src/GF/Compile/GrammarToGFCC.hs | 38 |
1 files changed, 19 insertions, 19 deletions
diff --git a/src/GF/Compile/GrammarToGFCC.hs b/src/GF/Compile/GrammarToGFCC.hs index e57191de2..272692be7 100644 --- a/src/GF/Compile/GrammarToGFCC.hs +++ b/src/GF/Compile/GrammarToGFCC.hs @@ -69,15 +69,15 @@ canon2gfcc opts pars cgr@(M.MGrammar ((a,abm):cms)) = gflags = Map.empty aflags = Map.fromList [(mkCId f,x) | (f,x) <- optionsPGF (M.flags abm)] mkDef pty = case pty of - Yes t -> mkExp t - _ -> CM.primNotion + Just t -> mkExp t + _ -> CM.primNotion -- concretes lfuns = [(f', (mkType ty, mkDef pty)) | - (f,AbsFun (Yes ty) pty) <- tree2list (M.jments abm), let f' = i2i f] + (f,AbsFun (Just ty) pty) <- tree2list (M.jments abm), let f' = i2i f] funs = Map.fromAscList lfuns lcats = [(i2i c, mkContext cont) | - (c,AbsCat (Yes cont) _) <- tree2list (M.jments abm)] + (c,AbsCat (Just cont) _) <- tree2list (M.jments abm)] cats = Map.fromAscList lcats catfuns = Map.fromList [(cat,[f | (f, (C.DTyp _ c _,_)) <- lfuns, c==cat]) | (cat,_) <- lcats] @@ -95,18 +95,18 @@ canon2gfcc opts pars cgr@(M.MGrammar ((a,abm):cms)) = ---- then (trace "decode" D.convertStringsInTerm decodeUTF8) else id umkTerm = utf . mkTerm lins = Map.fromAscList - [(f', umkTerm tr) | (f,CncFun _ (Yes tr) _) <- js, + [(f', umkTerm tr) | (f,CncFun _ (Just tr) _) <- js, let f' = i2i f, exists f'] -- eliminating lins without fun -- needed even here because of restricted inheritance lincats = Map.fromAscList - [(i2i c, mkCType ty) | (c,CncCat (Yes ty) _ _) <- js] + [(i2i c, mkCType ty) | (c,CncCat (Just ty) _ _) <- js] lindefs = Map.fromAscList - [(i2i c, umkTerm tr) | (c,CncCat _ (Yes tr) _) <- js] + [(i2i c, umkTerm tr) | (c,CncCat _ (Just tr) _) <- js] printnames = Map.union - (Map.fromAscList [(i2i f, umkTerm tr) | (f,CncFun _ _ (Yes tr)) <- js]) - (Map.fromAscList [(i2i f, umkTerm tr) | (f,CncCat _ _ (Yes tr)) <- js]) + (Map.fromAscList [(i2i f, umkTerm tr) | (f,CncFun _ _ (Just tr)) <- js]) + (Map.fromAscList [(i2i f, umkTerm tr) | (f,CncCat _ _ (Just tr)) <- js]) params = Map.fromAscList - [(i2i c, pars lang0 c) | (c,CncCat (Yes ty) _ _) <- js] + [(i2i c, pars lang0 c) | (c,CncCat (Just ty) _ _) <- js] fcfg = Nothing exists f = Map.member f funs @@ -232,7 +232,7 @@ reorder abs cg = M.MGrammar $ adefs = sorted2tree $ sortIds $ predefADefs ++ Look.allOrigInfos cg abs predefADefs = - [(c, AbsCat (Yes []) Nope) | c <- [cFloat,cInt,cString]] + [(c, AbsCat (Just []) Nothing) | c <- [cFloat,cInt,cString]] aflags = concatOptions [M.flags mo | (_,mo) <- M.modules cg, M.isModAbs mo] @@ -246,7 +246,7 @@ reorder abs cg = M.MGrammar $ Just r <- [lookup i (M.allExtendSpecs cg la)]] predefCDefs = - [(c, CncCat (Yes GM.defLinType) Nope Nope) | c <- [cInt,cFloat,cString]] + [(c, CncCat (Just GM.defLinType) Nothing Nothing) | c <- [cInt,cFloat,cString]] sortIds = sortBy (\ (f,_) (g,_) -> compare f g) @@ -279,8 +279,8 @@ canon2canon opts abs cg0 = j2j cg (f,j) = let debug = if verbAtLeast opts Verbose then trace ("+ " ++ prt f) else id in case j of - CncFun x (Yes tr) z -> CncFun x (Yes (debug (t2t tr))) z - CncCat (Yes ty) (Yes x) y -> CncCat (Yes (ty2ty ty)) (Yes (t2t x)) y + CncFun x (Just tr) z -> CncFun x (Just (debug (t2t tr))) z + CncCat (Just ty) (Just x) y -> CncCat (Just (ty2ty ty)) (Just (t2t x)) y _ -> j where cg1 = cg @@ -290,8 +290,8 @@ canon2canon opts abs cg0 = -- flatten record arguments of param constructors p2p (f,j) = case j of - ResParam (Yes (ps,v)) -> - ResParam (Yes ([(c,concatMap unRec cont) | (c,cont) <- ps],Nothing)) + ResParam (Just (ps,v)) -> + ResParam (Just ([(c,concatMap unRec cont) | (c,cont) <- ps],Nothing)) _ -> j unRec (x,ty) = case ty of RecType fs -> [ity | (_,typ) <- fs, ity <- unRec (identW,typ)] @@ -333,13 +333,13 @@ paramValues cgr = (labels,untyps,typs) where partyps = nub $ --- [App (Q (IC "Predef") (IC "Ints")) (EInt i) | i <- [1,9]] ---linTypeInt [ty | - (_,(_,CncCat (Yes ty0) _ _)) <- jments, + (_,(_,CncCat (Just ty0) _ _)) <- jments, ty <- typsFrom ty0 ] ++ [ Q m ty | (m,(ty,ResParam _)) <- jments ] ++ [ty | - (_,(_,CncFun _ (Yes tr) _)) <- jments, + (_,(_,CncFun _ (Just tr) _)) <- jments, ty <- err (const []) snd $ appSTM (typsFromTrm tr) [] ] params = [(ty, errVal (traceD ("UNKNOWN PARAM TYPE" +++ show ty) []) $ @@ -381,7 +381,7 @@ paramValues cgr = (labels,untyps,typs) where [(cat,[f | let RecType fs = GM.defLinType, f <- fs]) | cat <- [cInt,cFloat, cString]] ++ reverse ---- TODO: really those lincats that are reached ---- reverse is enough to expel overshadowed ones... - [(cat,ls) | (_,(cat,CncCat (Yes ty) _ _)) <- jments, + [(cat,ls) | (_,(cat,CncCat (Just ty) _ _)) <- jments, RecType ls <- [unlockTy ty]] labels = Map.fromList $ concat [((cat,[lab]),(typ,i)): |
