diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/compiler/GF/Command/Commands.hs | 2 | ||||
| -rw-r--r-- | src/compiler/GF/Speech/PGFToCFG.hs | 2 | ||||
| -rw-r--r-- | src/compiler/GF/Speech/VoiceXML.hs | 2 | ||||
| -rw-r--r-- | src/runtime/haskell/PGF/Macros.hs | 24 | ||||
| -rw-r--r-- | src/runtime/haskell/PGF/VisualizeTree.hs | 4 |
5 files changed, 17 insertions, 17 deletions
diff --git a/src/compiler/GF/Command/Commands.hs b/src/compiler/GF/Command/Commands.hs index 47960f0fe..82ce69b41 100644 --- a/src/compiler/GF/Command/Commands.hs +++ b/src/compiler/GF/Command/Commands.hs @@ -985,7 +985,7 @@ allCommands env@(pgf, mos) = Map.fromList [ Fun cid [] -> t Fun cid ts -> Fun (mk cid) (map t2m ts) _ -> t - mk = mkCId . ("mk" ++) . showCId . lookValCat pgf + mk = mkCId . ("mk" ++) . showCId . lookValCat (abstract pgf) unlex opts lang = stringOps Nothing (getUnlex opts lang ++ map prOpt opts) ---- diff --git a/src/compiler/GF/Speech/PGFToCFG.hs b/src/compiler/GF/Speech/PGFToCFG.hs index 01c16393e..4b1afa8d6 100644 --- a/src/compiler/GF/Speech/PGFToCFG.hs +++ b/src/compiler/GF/Speech/PGFToCFG.hs @@ -107,7 +107,7 @@ pgfToCFG pgf lang = mkCFG (showCId (lookStartCat pgf)) extCats (startRules ++ co profilesToTerm :: [Profile] -> CFTerm profilesToTerm ps = CFObj f (zipWith profileToTerm argTypes ps) - where (argTypes,_) = catSkeleton $ lookType pgf f + where (argTypes,_) = catSkeleton $ lookType (abstract pgf) f profileToTerm :: CId -> Profile -> CFTerm profileToTerm t [] = CFMeta t diff --git a/src/compiler/GF/Speech/VoiceXML.hs b/src/compiler/GF/Speech/VoiceXML.hs index 40976dc02..308806bea 100644 --- a/src/compiler/GF/Speech/VoiceXML.hs +++ b/src/compiler/GF/Speech/VoiceXML.hs @@ -39,7 +39,7 @@ grammar2vxml pgf cnc = showsXMLDoc (skel2vxml name language start skel qs) "" type Skeleton = [(CId, [(CId, [CId])])] pgfSkeleton :: PGF -> Skeleton -pgfSkeleton pgf = [(c,[(f,fst (catSkeleton (lookType pgf f))) | (_,f) <- fs]) +pgfSkeleton pgf = [(c,[(f,fst (catSkeleton (lookType (abstract pgf) f))) | (_,f) <- fs]) | (c,(_,fs)) <- Map.toList (cats (abstract pgf))] -- diff --git a/src/runtime/haskell/PGF/Macros.hs b/src/runtime/haskell/PGF/Macros.hs index aecb584d5..31af63534 100644 --- a/src/runtime/haskell/PGF/Macros.hs +++ b/src/runtime/haskell/PGF/Macros.hs @@ -18,24 +18,24 @@ import Text.PrettyPrint mapConcretes :: (Concr -> Concr) -> PGF -> PGF mapConcretes f pgf = pgf { concretes = Map.map f (concretes pgf) } -lookType :: PGF -> CId -> Type -lookType pgf f = - case lookMap (error $ "lookType " ++ show f) f (funs (abstract pgf)) of +lookType :: Abstr -> CId -> Type +lookType abs f = + case lookMap (error $ "lookType " ++ show f) f (funs abs) of (ty,_,_,_) -> ty -lookDef :: PGF -> CId -> Maybe [Equation] -lookDef pgf f = - case lookMap (error $ "lookDef " ++ show f) f (funs (abstract pgf)) of +lookDef :: Abstr -> CId -> Maybe [Equation] +lookDef abs f = + case lookMap (error $ "lookDef " ++ show f) f (funs abs) of (_,a,eqs,_) -> eqs -isData :: PGF -> CId -> Bool -isData pgf f = - case Map.lookup f (funs (abstract pgf)) of +isData :: Abstr -> CId -> Bool +isData abs f = + case Map.lookup f (funs abs) of Just (_,_,Nothing,_) -> True -- the encoding of data constrs _ -> False -lookValCat :: PGF -> CId -> CId -lookValCat pgf = valCat . lookType pgf +lookValCat :: Abstr -> CId -> CId +lookValCat abs = valCat . lookType abs lookStartCat :: PGF -> CId lookStartCat pgf = mkCId $ @@ -119,7 +119,7 @@ showPrintName :: PGF -> Language -> CId -> String showPrintName pgf lang id = lookMap (showCId id) id $ printnames $ lookMap (error "no lang") lang $ concretes pgf -- lookup with default value -lookMap :: (Show i, Ord i) => a -> i -> Map.Map i a -> a +lookMap :: Ord i => a -> i -> Map.Map i a -> a lookMap d c m = Map.findWithDefault d c m --- from Operations diff --git a/src/runtime/haskell/PGF/VisualizeTree.hs b/src/runtime/haskell/PGF/VisualizeTree.hs index c054e1e78..dfb1cbd75 100644 --- a/src/runtime/haskell/PGF/VisualizeTree.hs +++ b/src/runtime/haskell/PGF/VisualizeTree.hs @@ -65,7 +65,7 @@ graphvizAbstractTree pgf (funs,cats) = render . tree2graph getApp e es = (e,es) getLbl scope (EFun f) = let fun = if funs then ppCId f else empty - cat = if cats then ppCId (lookValCat pgf f) else empty + cat = if cats then ppCId (lookValCat (abstract pgf) f) else empty sep = if funs && cats then colon else empty in fun <+> sep <+> cat getLbl scope (ELit l) = text (escapeStr (render (ppLit l))) @@ -503,7 +503,7 @@ graphvizDependencyTree format debug mlab ms pgf lang tr = case format of wnodes = [[show i, maltws ws, showCId fun, pos, pos, morph, show dom, lab, unspec, unspec] | (i, ((fun,p),ws)) <- tail nodeWords, - let pos = showCId $ lookValCat pgf fun, + let pos = showCId $ lookValCat (abstract pgf) fun, let morph = unspec, let (dom,lab) = lookDomLab p ] |