GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-04-09 04:59:31 -06:00
Code Issues Packages Projects Releases Wiki Activity

peb

Browse Source
This commit is contained in:
peb
2006-01-13 08:42:25 +00:00
parent a46c3d2b00
commit ec2cf7c4d4
6 changed files with 49 additions and 19 deletions
Download Patch File Download Diff File Expand all files Collapse all files

1
lib/prelude/Prelude.gf
View File

@@ -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}} ;

32
src/GF/Conversion/GFC.hs
View File

@@ -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

15
src/GF/Conversion/GFCtoSimple.hs
View File

@@ -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

9
src/GF/Conversion/Prolog.hs
View File

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

9
src/GF/Conversion/SimpleToFinite.hs
View File

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

2
src/GF/Shell/ShellCommands.hs
View File

@@ -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 =