diff --git a/src/compiler/GF/Compile/GrammarToLPGF.hs b/src/compiler/GF/Compile/GrammarToLPGF.hs index 2bd3721f7..14ff29b92 100644 --- a/src/compiler/GF/Compile/GrammarToLPGF.hs +++ b/src/compiler/GF/Compile/GrammarToLPGF.hs @@ -182,13 +182,33 @@ mkCanon2lpgf opts gr am = do L.lins = lins }) +-- | Remove ParamAliasDefs by inlining their definitions +inlineParamAliases :: [C.ParamDef] -> [C.ParamDef] +inlineParamAliases defs = if null aliases then defs else map rp' pdefs + where + (aliases,pdefs) = L.partition isParamAliasDef defs + + rp' :: C.ParamDef -> C.ParamDef + rp' (C.ParamDef pid pids) = C.ParamDef pid (map rp'' pids) + rp' _ = error "inlineParamAliases called on ParamAliasDef" + + rp'' :: C.ParamValueDef -> C.ParamValueDef + rp'' (C.Param pid pids) = C.Param pid (map rp''' pids) + + rp''' :: C.ParamId -> C.ParamId + rp''' pid = case L.find (\(C.ParamAliasDef p _) -> p == pid) aliases of + Just (C.ParamAliasDef _ (C.ParamType (C.ParamTypeId p))) -> p + _ -> pid + -- | Enumerate all paramvalue combinations for looking up index numbers mkParamMap :: [C.ParamDef] -> [[C.LinValue]] -mkParamMap defs = map mk' defs +mkParamMap defs = map mk' pdefs where + pdefs = inlineParamAliases defs + mk' :: C.ParamDef -> [C.LinValue] mk' (C.ParamDef _ pids) = concatMap mk'' pids - mk' (C.ParamAliasDef _ _) = error "mkParamMap not implemented for ParamAliasDef" -- TODO + mk' (C.ParamAliasDef _ _) = error "mkParamMap not implemented for ParamAliasDef" mk'' :: C.ParamValueDef -> [C.LinValue] mk'' (C.Param pid []) = [C.ParamConstant (C.Param pid [])] @@ -198,18 +218,20 @@ mkParamMap defs = map mk' defs kids = [ mk' def | p <- pids - , let Just def = find (\(C.ParamDef pid _) -> pid == p) defs + , let Just def = L.find (\(C.ParamDef pid _) -> pid == p) pdefs ] :: [[C.LinValue]] -- | Build LPGF tuple of param values, needed when param index is looked up dynamically mkParamTuples :: [C.ParamDef] -> [L.LinFun] -mkParamTuples defs = map (\def -> CMS.evalState (mk' def) 1) defs +mkParamTuples defs = map (\def -> CMS.evalState (mk' def) 1) pdefs where + pdefs = inlineParamAliases defs + mk' :: C.ParamDef -> CMS.State Int L.LinFun mk' (C.ParamDef _ pids) = do ms <- mapM mk'' pids return $ L.LFTuple ms - mk' (C.ParamAliasDef _ _) = error "mkParamTuples not implemented for ParamAliasDef" -- TODO + mk' (C.ParamAliasDef _ _) = error "mkParamTuples not implemented for ParamAliasDef" mk'' :: C.ParamValueDef -> CMS.State Int L.LinFun mk'' (C.Param _ []) = do @@ -242,6 +264,10 @@ sortRecordRows = L.sortBy ordLabel (_,"s") -> GT (s1,s2) -> compare s1 s2 +isParamAliasDef :: C.ParamDef -> Bool +isParamAliasDef (C.ParamAliasDef _ _) = True +isParamAliasDef _ = False + isParamType :: C.LinType -> Bool isParamType (C.ParamType _) = True isParamType _ = False