diff --git a/examples/paraphrase/City.gf b/examples/paraphrase/City.gf new file mode 100644 index 000000000..2ea8a10ff --- /dev/null +++ b/examples/paraphrase/City.gf @@ -0,0 +1,26 @@ +abstract City = { + +cat S ; City ; Country ; Adj ; + +data + PredIn : City -> Country -> S ; +fun + PredAdj : City -> Adj -> S ; + Capital : Country -> City ; + CountryAdj : Adj -> Country ; +data + Stockholm, Helsinki : City ; + Sweden, Finland : Country ; + Swedish, Finnish : Adj ; + +def + PredAdj city x = PredIn city (CountryAdj x) ; + + Capital Finland = Helsinki ; + Capital Sweden = Stockholm ; + + CountryAdj Finnish = Finland ; + CountryAdj Swedish = Sweden ; + + +} diff --git a/examples/paraphrase/CityEng.gf b/examples/paraphrase/CityEng.gf new file mode 100644 index 000000000..39a0974c8 --- /dev/null +++ b/examples/paraphrase/CityEng.gf @@ -0,0 +1,16 @@ +concrete CityEng of City = { + +lincat S, City, Country, Adj = Str ; + +lin + PredIn ci co = ci ++ "is in" ++ co ; + PredAdj ci ad = ci ++ "is" ++ ad ; + Capital co = "the capital of" ++ co ; + CountryAdj ad = "the" ++ ad ++ "country" ; + Stockholm = "Stockholm" ; + Helsinki = "Helsinki" ; + Sweden = "Sweden" ; + Finland = "Finland" ; + Swedish = "Swedish" ; + Finnish = "Finnish" ; +} diff --git a/examples/paraphrase/Nat.gf b/examples/paraphrase/Nat.gf new file mode 100644 index 000000000..7caa0fc93 --- /dev/null +++ b/examples/paraphrase/Nat.gf @@ -0,0 +1,29 @@ +abstract Nat = { + +cat Nat ; + +data + Zero : Nat ; + Succ : Nat -> Nat ; + +fun one : Nat ; +def one = Succ Zero ; + +fun plus : Nat -> Nat -> Nat ; +def plus x Zero = x ; +def plus x (Succ y) = Succ (plus x y) ; + +fun twice : Nat -> Nat ; +def twice x = plus x x ; + +fun times : Nat -> Nat -> Nat ; +def times x Zero = Zero ; +def times x (Succ y) = plus (times x y) x ; + +fun four : Nat ; +def four = twice (twice one) ; + +fun exp : Nat -> Nat ; +def exp Zero = one ; +def exp (Succ x) = twice (exp x) ; +} diff --git a/src/GF/Command/TreeOperations.hs b/src/GF/Command/TreeOperations.hs index da7399615..d4b5d175a 100644 --- a/src/GF/Command/TreeOperations.hs +++ b/src/GF/Command/TreeOperations.hs @@ -25,7 +25,7 @@ allTreeOps pgf = [ ("compute",("compute by using semantic definitions (def)", map (compute pgf))), ("paraphrase",("paraphrase by using semantic definitions (def)", - concatMap (paraphrase pgf))), + nub . concatMap (paraphrase pgf))), ("smallest",("sort trees from smallest to largest, in number of nodes", smallest)), ("typecheck",("type check and solve metavariables; reject if incorrect", diff --git a/src/PGF/Paraphrase.hs b/src/PGF/Paraphrase.hs index 6e20e1e18..9e0123605 100644 --- a/src/PGF/Paraphrase.hs +++ b/src/PGF/Paraphrase.hs @@ -5,9 +5,7 @@ -- Stability : (stable) -- Portability : (portable) -- --- generate parapharases with def definitions. --- --- modified from src GF computation +-- Generate parapharases with def definitions. ----------------------------------------------------------------------------- module PGF.Paraphrase ( @@ -20,9 +18,11 @@ import PGF.Macros (lookDef,isData) import PGF.Expr import PGF.CId -import Data.List +import Data.List (nub,sort,group) import qualified Data.Map as Map +import Debug.Trace ---- + paraphrase :: PGF -> Tree -> [Tree] paraphrase pgf = nub . paraphraseN 2 pgf @@ -38,8 +38,8 @@ paraphraseN i pgf t = fromDef :: PGF -> Tree -> [Tree] fromDef pgf t@(Fun f ts) = defDown t ++ defUp t where - defDown t = [subst g u | let equ = equsFrom f, (u,g) <- match equ ts] - defUp t = [subst g u | equ <- equsTo f, (u,g) <- match [equ] ts] + defDown t = [subst g u | let equ = equsFrom f, (u,g) <- match equ ts, trequ "U" f equ] + defUp t = [subst g u | equ <- equsTo f, (u,g) <- match [equ] ts, trequ "D" f equ] equsFrom f = [(ps,d) | Just equs <- [lookup f equss], (Fun _ ps,d) <- equs] @@ -50,7 +50,14 @@ fromDef pgf t@(Fun f ts) = defDown t ++ defUp t where isClosed d || (length equs == 1 && isLinear d)] equss = [(f,[(Fun f (map expr2tree ps), expr2tree d) | (Equ ps d) <- eqs]) | - (f,(_,EEq eqs)) <- Map.assocs (funs (abstract pgf))] + (f,(_,d)) <- Map.assocs (funs (abstract pgf)), eqs <- defs d] + + defs d = case d of + EEq eqs -> [eqs] + EMeta _ -> [] + _ -> [[Equ [] d]] + + trequ s f e = True ----trace (s ++ ": " ++ show f ++ " " ++ show e) True subst :: Subst -> Tree -> Tree subst g e = case e of