peb

lib/prelude/Prelude.gf

@@ -10,6 +10,7 @@ oper
   ss3 : (_,_ ,_: Str) -> SS = \x,y,z -> ss (x ++ y ++ z) ;
 
   cc2 : (_,_ : SS) -> SS = \x,y -> ss (x.s ++ y.s) ;
+  cc3 : (_,_,_ : SS) -> SS = \x,y,z -> ss (x.s ++ y.s ++ z.s) ;
 
   SS1 : Type -> Type = \P -> {s : P => Str} ;
   ss1 : (A : Type) -> Str -> SS1 A = \A,s -> {s = table {_ => s}} ;

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]
+		  Just cat -> flip erasing [identC cat]
-		  Nothing  -> flip RemEra.convertGrammar []
+		  Nothing  -> flip erasing []
 	  s2e = case getOptVal opts gfcConversion of
-		  Just "strict"            -> S2M.convertGrammarStrict
+		  Just "strict"            -> strict
-		  Just "finite-strict"     -> S2M.convertGrammarStrict
+		  Just "finite-strict"     -> strict
-		  Just "epsilon"           -> RemEps.convertGrammar . S2M.convertGrammarNondet
+		  Just "epsilon"           -> epsilon . nondet
-		  _                        -> S2M.convertGrammarNondet
+		  _                        -> nondet
 	  g2s = case getOptVal opts gfcConversion of
-		  Just "finite"            ->                          S2Fin.convertGrammar . G2S.convertGrammar
+		  Just "finite"            -> finite . simple
-		  Just "singletons"        -> RemSing.convertGrammar .                        G2S.convertGrammar
+		  Just "finite2"           -> finite . finite . simple
-		  Just "finite-singletons" -> RemSing.convertGrammar . S2Fin.convertGrammar . G2S.convertGrammar
+		  Just "finite3"           -> finite . finite . finite . simple
-		  Just "finite-strict"     ->                          S2Fin.convertGrammar . G2S.convertGrammar
+		  Just "singletons"        -> single . simple
-		  _                        ->                                                 G2S.convertGrammar
+		  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 

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

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 '%'
 
 

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 _ [] = []

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 =