diff --git a/src/GF/Conversion/GFC.hs b/src/GF/Conversion/GFC.hs index 0975d552a..e4a5ef298 100644 --- a/src/GF/Conversion/GFC.hs +++ b/src/GF/Conversion/GFC.hs @@ -46,19 +46,29 @@ convertGFC opts = \g -> let s = g2s g in trace2 "Options" (show opts) (s, (e, (e2m e, e2c e))) where e2c = M2C.convertGrammar e2m = case getOptVal opts firstCat of - Just cat -> flip RemEra.convertGrammar [identC cat] - Nothing -> flip RemEra.convertGrammar [] + Just cat -> flip erasing [identC cat] + Nothing -> flip erasing [] s2e = case getOptVal opts gfcConversion of - Just "strict" -> S2M.convertGrammarStrict - Just "finite-strict" -> S2M.convertGrammarStrict - Just "epsilon" -> RemEps.convertGrammar . S2M.convertGrammarNondet - _ -> S2M.convertGrammarNondet + Just "strict" -> strict + Just "finite-strict" -> strict + Just "epsilon" -> epsilon . nondet + _ -> nondet g2s = case getOptVal opts gfcConversion of - Just "finite" -> S2Fin.convertGrammar . G2S.convertGrammar - Just "singletons" -> RemSing.convertGrammar . G2S.convertGrammar - Just "finite-singletons" -> RemSing.convertGrammar . S2Fin.convertGrammar . G2S.convertGrammar - Just "finite-strict" -> S2Fin.convertGrammar . G2S.convertGrammar - _ -> G2S.convertGrammar + Just "finite" -> finite . simple + Just "finite2" -> finite . finite . simple + Just "finite3" -> finite . finite . finite . simple + Just "singletons" -> single . simple + Just "finite-singletons" -> single . finite . simple + Just "finite-strict" -> finite . simple + _ -> simple + + simple = G2S.convertGrammar + strict = S2M.convertGrammarStrict + nondet = S2M.convertGrammarNondet + epsilon = RemEps.convertGrammar + finite = S2Fin.convertGrammar + single = RemSing.convertGrammar + erasing = RemEra.convertGrammar gfc2simple :: Options -> (CanonGrammar, Ident) -> SGrammar gfc2simple opts = fst . convertGFC opts diff --git a/src/GF/Conversion/GFCtoSimple.hs b/src/GF/Conversion/GFCtoSimple.hs index de76eeb48..72b774e16 100644 --- a/src/GF/Conversion/GFCtoSimple.hs +++ b/src/GF/Conversion/GFCtoSimple.hs @@ -53,7 +53,8 @@ convertGrammar (g,i) = trace2 "GFCtoSimple - concrete language" (prt (snd gram)) gram = (unSubelimCanon g,i) convertAbsFun :: Env -> I.Ident -> A.Exp -> SRule -convertAbsFun gram fun typing = Rule abs cnc +convertAbsFun gram fun typing = -- trace2 "GFCtoSimple - converting function" (prt fun) $ + Rule abs cnc where abs = convertAbstract [] fun typing cnc = convertConcrete gram abs @@ -74,6 +75,14 @@ convertType x args (A.EAtom at) = Decl x (convertCat at) args convertType x args (A.EProd _ _ b) = convertType x args b ---- AR 7/10 workaround convertType x args exp = error $ "GFCtoSimple.convertType: " ++ prt exp +{- Exp from GF/Canon/GFC.cf: +EApp. Exp1 ::= Exp1 Exp2 ; +EProd. Exp ::= "(" Ident ":" Exp ")" "->" Exp ; +EAbs. Exp ::= "\\" Ident "->" Exp ; +EAtom. Exp2 ::= Atom ; +EData. Exp2 ::= "data" ; +-} + convertExp :: [TTerm] -> A.Exp -> TTerm convertExp args (A.EAtom at) = convertAtom args at convertExp args (A.EApp a b) = convertExp (convertExp [] b : args) a @@ -81,8 +90,10 @@ convertExp args exp = error $ "GFCtoSimple.convertExp: " ++ prt exp convertAtom :: [TTerm] -> A.Atom -> TTerm convertAtom args (A.AC con) = con :@ reverse args +-- A.AD: is this correct??? +convertAtom args (A.AD con) = con :@ args convertAtom [] (A.AV var) = TVar var -convertAtom args atom = error $ "GFCtoSimple.convertAtom: " ++ prt args ++ " " ++ prt atom +convertAtom args atom = error $ "GFCtoSimple.convertAtom: " ++ prt args ++ " " ++ show atom convertCat :: A.Atom -> SCat convertCat (A.AC (A.CIQ _ cat)) = cat diff --git a/src/GF/Conversion/Prolog.hs b/src/GF/Conversion/Prolog.hs index ab4b53e66..235f31198 100644 --- a/src/GF/Conversion/Prolog.hs +++ b/src/GF/Conversion/Prolog.hs @@ -101,10 +101,10 @@ prtSPath (Path path) = prtPList (map (either prtQ prtSTerm) path) prtSCat (Decl var cat args) = prVar ++ prtFunctor (prtQ cat) (map prtSTTerm args) where prVar | var == anyVar = "" - | otherwise = "_" ++ prt var ++ ":" + | otherwise = "_" ++ prtVar var ++ ":" prtSTTerm (con :@ args) = prtFunctor (prtQ con) (map prtSTTerm args) -prtSTTerm (TVar var) = "_" ++ prt var +prtSTTerm (TVar var) = "_" ++ prtVar var ---------------------------------------------------------------------- -- | MCFG to Prolog @@ -188,6 +188,11 @@ prtQStr atom = "'" ++ concatMap esc (prt atom) ++ "'" esc '\t' = "\\t" esc c = [c] +prtVar var = reprime (prt var) + where reprime "" = "" + reprime ('\'' : cs) = "_0" ++ reprime cs + reprime (c:cs) = c : reprime cs + prtLine = replicate 70 '%' diff --git a/src/GF/Conversion/SimpleToFinite.hs b/src/GF/Conversion/SimpleToFinite.hs index b875a698e..7f50f626e 100644 --- a/src/GF/Conversion/SimpleToFinite.hs +++ b/src/GF/Conversion/SimpleToFinite.hs @@ -107,14 +107,17 @@ calcSplitable rules = (listAssoc splitableCat2Funs, listAssoc splitableFun2Cat) (nondepCats <**> depCats) <\\> resultCats -- all result cats for some pure function - resultCats = nubsort [ cat | Rule (Abs (Decl _ cat _) decls _) _ <- rules, + resultCats = tracePrt "SimpleToFinite - result cats" prt $ + nubsort [ cat | Rule (Abs (Decl _ cat _) decls _) _ <- rules, not (null decls) ] -- all cats in constants without dependencies - nondepCats = nubsort [ cat | Rule (Abs (Decl _ cat []) [] _) _ <- rules ] + nondepCats = tracePrt "SimpleToFinite - nondep cats" prt $ + nubsort [ cat | Rule (Abs (Decl _ cat []) [] _) _ <- rules ] -- all cats occurring as some dependency of another cat - depCats = nubsort [ cat | Rule (Abs decl decls _) _ <- rules, + depCats = tracePrt "SimpleToFinite - dep cats" prt $ + nubsort [ cat | Rule (Abs decl decls _) _ <- rules, cat <- varCats [] (decls ++ [decl]) ] varCats _ [] = [] diff --git a/src/GF/Shell/ShellCommands.hs b/src/GF/Shell/ShellCommands.hs index 47c27bb24..48eac25a5 100644 --- a/src/GF/Shell/ShellCommands.hs +++ b/src/GF/Shell/ShellCommands.hs @@ -146,7 +146,7 @@ testValidFlag st co f x = case f of "filter" -> testInc customStringCommand "length" -> testN "optimize"-> testIn $ words "parametrize values all share none" - "conversion" -> testIn $ words "strict nondet finite singletons finite-strict finite-singletons" + "conversion" -> testIn $ words "strict nondet finite finite2 finite3 singletons finite-strict finite-singletons" _ -> return () where testInc ci =