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

Nonlinear patterns in concrete syntax are now detected and reported as errors

Browse Source 
Before, they were silently converted to linear patterns.
Nonlinear patterns in MorphoCat.gf, ParadigmsGre.gf and ParadigmsFin.gf have
been make linear by renaming pattern variables.
This commit is contained in:
hallgren
2013-09-09 19:52:08 +00:00
parent f1386b3400
commit 1846e6bf65
4 changed files with 78 additions and 73 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
lib/src/catalan/MorphoCat.gf
View File

@@ -236,7 +236,7 @@ oper
mkAdj2Reg : Str -> Str -> Adj = \petit,petita -> mkAdj2Reg : Str -> Str -> Adj = \petit,petita ->
case <petit,petita> of { case <petit,petita> of {
<_, _ + ("b"|"c"|"d"|"e"|"f"|"g"|"h"|"i"|"j"|"k"|"l"|"m"|"n"|"o"|"p"|"q"|"r"|"s"|"t"|"u"|"v"|"x"|"y"|"z")> => adjFidel petit ; --feminine doesn't end in "a" <_, _ + ("b"|"c"|"d"|"e"|"f"|"g"|"h"|"i"|"j"|"k"|"l"|"m"|"n"|"o"|"p"|"q"|"r"|"s"|"t"|"u"|"v"|"x"|"y"|"z")> => adjFidel petit ; --feminine doesn't end in "a"
<p@(_ + ("t"|"l"|"ç")), p+"a"> => adjPrim petit ; --1) petit~petita 2) ridícul~ridícula, dolç~dolça <p@(_ + ("t"|"l"|"ç")), p2+"a"> => adjPrim petit ; --1) petit~petita 2) ridícul~ridícula, dolç~dolça -- was nonlinear
<_ + "ig", _> => adjIg petit petita ; --lleig~letja <_ + "ig", _> => adjIg petit petita ; --lleig~letja
<_, _+ "na"> => adjVn petit ; --pla~plana <_, _+ "na"> => adjVn petit ; --pla~plana
<_, _ + ("à"|"é"|"è"|"í"|"ó"|"ò"|"ú") + _> => adjBlau petit petita ; --diari~diària <_, _ + ("à"|"é"|"è"|"í"|"ó"|"ò"|"ú") + _> => adjBlau petit petita ; --diari~diària

4
lib/src/finnish/ParadigmsFin.gf
View File

@@ -522,9 +522,9 @@ mkVS = overload {
dSilakka ukko ukon ukkoja ; -- auto,auton dSilakka ukko ukon ukkoja ; -- auto,auton
<_ + "mpi", _ + ("emman" | "emmän")> => dSuurempi ukko ; <_ + "mpi", _ + ("emman" | "emmän")> => dSuurempi ukko ;
<_ + "in", _ + ("imman" | "immän")> => dSuurin ukko ; <_ + "in", _ + ("imman" | "immän")> => dSuurin ukko ;
<terv + "e", terv + "een"> => <terv + "e", terv2 + "een"> => -- was nonlinear
dRae ukko ukon ; dRae ukko ukon ;
<taiv + ("as" | "äs"), taiv + ("aan" | "ään")> => <taiv + ("as" | "äs"), taiv2 + ("aan" | "ään")> => -- was nonlinear
dRae ukko ukon ; dRae ukko ukon ;
<nukk + "e", nuk + "een"> => dRae ukko ukon ; <nukk + "e", nuk + "een"> => dRae ukko ukon ;
<arp + "i", arv + "en"> => dArpi ukko ukon ; <arp + "i", arv + "en"> => dArpi ukko ukon ;

23
lib/src/greek/ParadigmsGre.gf
View File

@@ -42,14 +42,15 @@ oper
mkNending : Str -> Str -> Gender -> N = \x,n,g -> mkNending : Str -> Str -> Gender -> N = \x,n,g ->
case <x,n> of { case <x,n> of {
<c + "ος", c + "ων"> => mkNoun_anthropos x n g ; -- all of these were nonlinear
<c + "η", c + "εις"> => mkNoun_kivernisi x n g ; <c + "ος", c2 + "ων"> => mkNoun_anthropos x n g ;
<c + "ης", c + "ηδες"> => mkNoun_fournaris x n g ; <c + "η", c2 + "εις"> => mkNoun_kivernisi x n g ;
<c + "ας", c + "ων"> => mkNoun_filakas x n g ; <c + "ης", c2 + "ηδες"> => mkNoun_fournaris x n g ;
<c + "ο", c + "ων"> => mkNoun_prosopo x n g ; <c + "ας", c2 + "ων"> => mkNoun_filakas x n g ;
<c + ("ώς" | "ός" | "ως" ) , c + ("ος"|"ός" ) > => mkNoun_fws x n g ; <c + "ο", c2 + "ων"> => mkNoun_prosopo x n g ;
<c + ("μα" | "ιμο" ), c + "ατα"> => mkNoun_provlima x n g ; <c + ("ώς" | "ός" | "ως" ) , c2 + ("ος"|"ός" ) > => mkNoun_fws x n g ;
<c + "ος", c + "η"> => mkNoun_megethos x n g <c + ("μα" | "ιμο" ), c2 + "ατα"> => mkNoun_provlima x n g ;
<c + "ος", c2 + "η"> => mkNoun_megethos x n g
} ** {lock_N = <>} ; } ** {lock_N = <>} ;
@@ -128,9 +129,9 @@ oper
mkA1 : Str -> Str -> A = \x,n -> mkA1 : Str -> Str -> A = \x,n ->
case <x,n> of { case <x,n> of {
<c + "ης", c + "ες"> => mkAdjective4 x n ; <c + "ης", c2 + "ες"> => mkAdjective4 x n ; -- was nonlinear
<c + "ων", c + "όντων"> => mkAdjective3 x n ; <c + "ων", c2 + "όντων"> => mkAdjective3 x n ; -- was nonlinear
<c + "ύς", c + "έως"> => mkAdjectiveIr x n <c + "ύς", c2 + "έως"> => mkAdjectiveIr x n -- was nonlinear
} ** {lock_A = <>} ; } ** {lock_A = <>} ;

122
src/compiler/GF/Compile/Rename.hs
View File

@@ -39,7 +39,7 @@ import GF.Grammar.Printer
import GF.Data.Operations import GF.Data.Operations
import Control.Monad import Control.Monad
import Data.List (nub) import Data.List (nub,(\\))
import Text.PrettyPrint import Text.PrettyPrint
-- | this gives top-level access to renaming term input in the cc command -- | this gives top-level access to renaming term input in the cc command
@@ -235,76 +235,80 @@ renameTerm env vars = ren vars where
-- | vars not needed in env, since patterns always overshadow old vars -- | vars not needed in env, since patterns always overshadow old vars
renamePattern :: Status -> Patt -> Check (Patt,[Ident]) renamePattern :: Status -> Patt -> Check (Patt,[Ident])
renamePattern env patt = case patt of renamePattern env patt =
do r@(p',vs) <- renp patt
let dupl = vs \\ nub vs
unless (null dupl) $ checkError (hang (text "[C.4.13] Pattern is not linear:") 4
(ppPatt Unqualified 0 patt))
return r
where
renp patt = case patt of
PMacro c -> do
c' <- renid $ Vr c
case c' of
Q d -> renp $ PM d
_ -> checkError (text "unresolved pattern" <+> ppPatt Unqualified 0 patt)
PMacro c -> do PC c ps -> do
c' <- renid $ Vr c c' <- renid $ Cn c
case c' of case c' of
Q d -> renp $ PM d QC c -> do psvss <- mapM renp ps
_ -> checkError (text "unresolved pattern" <+> ppPatt Unqualified 0 patt) let (ps,vs) = unzip psvss
return (PP c ps, concat vs)
Q _ -> checkError (text "data constructor expected but" <+> ppTerm Qualified 0 c' <+> text "is found instead")
_ -> checkError (text "unresolved data constructor" <+> ppTerm Qualified 0 c')
PC c ps -> do PP c ps -> do
c' <- renid $ Cn c (QC c') <- renid (QC c)
case c' of psvss <- mapM renp ps
QC c -> do psvss <- mapM renp ps let (ps',vs) = unzip psvss
let (ps,vs) = unzip psvss return (PP c' ps', concat vs)
return (PP c ps, concat vs)
Q _ -> checkError (text "data constructor expected but" <+> ppTerm Qualified 0 c' <+> text "is found instead")
_ -> checkError (text "unresolved data constructor" <+> ppTerm Qualified 0 c')
PP c ps -> do PM c -> do
(QC c') <- renid (QC c) x <- renid (Q c)
psvss <- mapM renp ps c' <- case x of
let (ps',vs) = unzip psvss (Q c') -> return c'
return (PP c' ps', concat vs) _ -> checkError (text "not a pattern macro" <+> ppPatt Qualified 0 patt)
return (PM c', [])
PM c -> do PV x -> checks [ renid' (Vr x) >>= \t' -> case t' of
x <- renid (Q c) QC c -> return (PP c [],[])
c' <- case x of _ -> checkError (text "not a constructor")
(Q c') -> return c' , return (patt, [x])
_ -> checkError (text "not a pattern macro" <+> ppPatt Qualified 0 patt) ]
return (PM c', [])
PV x -> checks [ renid' (Vr x) >>= \t' -> case t' of PR r -> do
QC c -> return (PP c [],[]) let (ls,ps) = unzip r
_ -> checkError (text "not a constructor") psvss <- mapM renp ps
, return (patt, [x]) let (ps',vs') = unzip psvss
] return (PR (zip ls ps'), concat vs')
PR r -> do PAlt p q -> do
let (ls,ps) = unzip r (p',vs) <- renp p
psvss <- mapM renp ps (q',ws) <- renp q
let (ps',vs') = unzip psvss return (PAlt p' q', vs ++ ws)
return (PR (zip ls ps'), concat vs')
PAlt p q -> do PSeq p q -> do
(p',vs) <- renp p (p',vs) <- renp p
(q',ws) <- renp q (q',ws) <- renp q
return (PAlt p' q', vs ++ ws) return (PSeq p' q', vs ++ ws)
PSeq p q -> do PRep p -> do
(p',vs) <- renp p (p',vs) <- renp p
(q',ws) <- renp q return (PRep p', vs)
return (PSeq p' q', vs ++ ws)
PRep p -> do PNeg p -> do
(p',vs) <- renp p (p',vs) <- renp p
return (PRep p', vs) return (PNeg p', vs)
PNeg p -> do PAs x p -> do
(p',vs) <- renp p (p',vs) <- renp p
return (PNeg p', vs) return (PAs x p', x:vs)
PAs x p -> do _ -> return (patt,[])
(p',vs) <- renp p
return (PAs x p', x:vs)
_ -> return (patt,[]) renid = renameIdentTerm env
renid' = renameIdentTerm' env
where
renp = renamePattern env
renid = renameIdentTerm env
renid' = renameIdentTerm' env
renameContext :: Status -> Context -> Check Context renameContext :: Status -> Context -> Check Context
renameContext b = renc [] where renameContext b = renc [] where