diff --git a/examples/uusisuomi/Makefile b/examples/uusisuomi/Makefile index 0c593c8d3..a054f0a20 100644 --- a/examples/uusisuomi/Makefile +++ b/examples/uusisuomi/Makefile @@ -1,10 +1,14 @@ -#LEX=Duodecim -#LEX=Aino -#LEX=Omat -#LEX=NSSK -LEX=Swadesh +LEX=Omat -all: tests +all: + export LEX=NSSK ; make -e tests + export LEX=Omat ; make -e tests + export LEX=Swadesh ; make -e tests + export LEX=Dictionary ; make -e tests + export LEX=Duodecim ; make -e tests + export LEX=Aino ; make -e tests + cat all-diff-* >all-differences + cat all-differences gf-files: runghc MkLex.hs 0 $(LEX) > $(LEX)Abs.gf diff --git a/examples/uusisuomi/Nominal.gf b/examples/uusisuomi/Nominal.gf index 60bec2d60..e9eee3c6a 100644 --- a/examples/uusisuomi/Nominal.gf +++ b/examples/uusisuomi/Nominal.gf @@ -31,10 +31,17 @@ resource Nominal = ResFin ** open MorphoFin,Declensions,CatFin,Prelude in { _ + "is" => dKaunis ukko ; _ + ("i" | "u") + "n" => dLiitin ukko (renka + "men") ; _ + ("ton" | "tön") => dOnneton ukko ; + _ + "e" => dRae ukko (rake + "en") ; _ + ("ut" | "yt") => dRae ukko (ukk + "en") ; _ + ("as" | "äs") => dRae ukko (renka + last renka + "n") ; - _ + "e" => dRae ukko (rake + "en") ; + _ + ("uus" | "yys") => dLujuus ukko ; _ + "s" => dJalas ukko ; + _ + ("a" | "e" | "i") + C_ + _ + "aja" => -- opettaja correct autom. + dSilakka ukko (ukko + "n") (ukk + "ia") ; + _ + ("a" | "e" | "i" | "o" | "u") + C_ + _ + "ija" => + dSilakka ukko (ukko + "n") (ukk + "oita") ; + _ + ("e" | "i" | "y" | "ä" | "ö") + C_ + _ + "ijä" => + dSilakka ukko (ukko + "n") (ukk + "öitä") ; _ + "i" +o@("o"|"ö") => dSilakka ukko (ukko+"n") (ukko+"it"+getHarmony o); _ + "i" + "a" => dSilakka ukko (ukko + "n") (ukk + "oita") ; _ + "i" + "ä" => dSilakka ukko (ukko + "n") (ukk + "öitä") ; @@ -52,7 +59,7 @@ resource Nominal = ResFin ** open MorphoFin,Declensions,CatFin,Prelude in { case of { <_ + ("aa" | "ee" | "ii" | "oo" | "uu" | "yy" | "ää" | "öö" | "ie" | "uo" | "yö" | "ea" | "eä" | - "ia" | "iä" | "io" | "iö"), _ + "n"> => + "ia" | "iä" | "io" | "iö" | "ja" | "jä"), _ + "n"> => nForms1 ukko ; --- to protect <_ + ("a" | "o" | "u" | "y" | "ä" | "ö"), _ + "n"> => dUkko ukko ukon ; -- auto,auton diff --git a/examples/uusisuomi/correct-Duodecim.txt b/examples/uusisuomi/correct-Duodecim.txt index c8732a274..a56ec4167 100644 --- a/examples/uusisuomi/correct-Duodecim.txt +++ b/examples/uusisuomi/correct-Duodecim.txt @@ -52,7 +52,7 @@ hyperkalsemia hyperkalsemian hyperkalsemiaa hyperkalsemiana hyperkalsemiaan hype seerumi seerumin seerumia seerumina seerumiin seerumien seerumeja seerumeina seerumeissa seerumeihin -pitoisuus pitoisuuksen pitoisuusta pitoisuuksena pitoisuukseen pitoisuusten pitoisuuksia pitoisuuksina pitoisuuksissa pitoisuuksiin +pitoisuus pitoisuuden pitoisuutta pitoisuutena pitoisuuteen pitoisuuksien pitoisuuksia pitoisuuksina pitoisuuksissa pitoisuuksiin viitealue viitealueen viitealuetta viitealueena viitealueeseen viitealueiden viitealueita viitealueina viitealueissa viitealueisiin diff --git a/src/GF/Compile/CheckGrammar.hs b/src/GF/Compile/CheckGrammar.hs index 81ac891ad..b33d11017 100644 --- a/src/GF/Compile/CheckGrammar.hs +++ b/src/GF/Compile/CheckGrammar.hs @@ -613,6 +613,7 @@ inferLType gr trm = case trm of PString _ -> True PInt _ -> True PFloat _ -> True + PChar -> True PSeq p q -> isConstPatt p && isConstPatt q PAlt p q -> isConstPatt p && isConstPatt q PRep p -> isConstPatt p @@ -626,6 +627,7 @@ inferLType gr trm = case trm of PNeg p -> inferPatt p PAlt p q -> checks [inferPatt p, inferPatt q] PSeq _ _ -> return $ typeStr + PChar -> return $ typeStr PRep _ -> return $ typeStr _ -> infer (patt2term p) >>= return . snd diff --git a/src/GF/Devel/CheckGrammar.hs b/src/GF/Devel/CheckGrammar.hs index 9502bbec1..4ad308366 100644 --- a/src/GF/Devel/CheckGrammar.hs +++ b/src/GF/Devel/CheckGrammar.hs @@ -613,6 +613,7 @@ inferLType gr trm = case trm of PString _ -> True PInt _ -> True PFloat _ -> True + PChar -> True PSeq p q -> isConstPatt p && isConstPatt q PAlt p q -> isConstPatt p && isConstPatt q PRep p -> isConstPatt p @@ -627,6 +628,7 @@ inferLType gr trm = case trm of PAlt p q -> checks [inferPatt p, inferPatt q] PSeq _ _ -> return $ typeStr PRep _ -> return $ typeStr + PChar -> return $ typeStr _ -> infer (patt2term p) >>= return . snd diff --git a/src/GF/Grammar/Grammar.hs b/src/GF/Grammar/Grammar.hs index 58634c31c..85e515342 100644 --- a/src/GF/Grammar/Grammar.hs +++ b/src/GF/Grammar/Grammar.hs @@ -190,6 +190,7 @@ data Patt = | PAlt Patt Patt -- ^ disjunctive pattern: p1 | p2 | PSeq Patt Patt -- ^ sequence of token parts: p + q | PRep Patt -- ^ repetition of token part: p* + | PChar -- ^ string of length one deriving (Read, Show, Eq, Ord) diff --git a/src/GF/Grammar/Macros.hs b/src/GF/Grammar/Macros.hs index 51f483a0a..8e3332b12 100644 --- a/src/GF/Grammar/Macros.hs +++ b/src/GF/Grammar/Macros.hs @@ -521,6 +521,8 @@ term2patt trm = case termForm trm of Ok ([], Cn (IC "*"), [a]) -> do a' <- term2patt a return (PRep a') + Ok ([], Cn (IC "?"), []) -> do + return PChar Ok ([], Cn (IC "+"), [a,b]) -> do a' <- term2patt a b' <- term2patt b @@ -547,6 +549,7 @@ patt2term pt = case pt of PString s -> K s PAs x p -> appc "@" [Vr x, patt2term p] --- an encoding + PChar -> appc "?" [] --- an encoding PSeq a b -> appc "+" [(patt2term a), (patt2term b)] --- an encoding PAlt a b -> appc "|" [(patt2term a), (patt2term b)] --- an encoding PRep a -> appc "*" [(patt2term a)] --- an encoding diff --git a/src/GF/Grammar/PatternMatch.hs b/src/GF/Grammar/PatternMatch.hs index 881f10198..4b69c3ffd 100644 --- a/src/GF/Grammar/PatternMatch.hs +++ b/src/GF/Grammar/PatternMatch.hs @@ -111,6 +111,8 @@ tryMatch (p,t) = do matches <- checks [mapM tryMatch [(p1,K s1),(p2,K s2)] | (s1,s2) <- cuts] return (concat matches) + (PChar, ([],K [_],[])) -> return [] + (PRep p1, ([],K s, [])) -> checks [ trym (foldr (const (PSeq p1)) (PString "") [1..n]) t' | n <- [0 .. length s] diff --git a/src/GF/Source/GrammarToSource.hs b/src/GF/Source/GrammarToSource.hs index 0a2715be0..9ad8b8850 100644 --- a/src/GF/Source/GrammarToSource.hs +++ b/src/GF/Source/GrammarToSource.hs @@ -219,6 +219,7 @@ trp p = case p of PSeq p q -> P.PSeq (trp p) (trp q) PRep p -> P.PRep (trp p) PNeg p -> P.PNeg (trp p) + PChar -> P.PV (IC "C_") ---- temporary encoding trAssign (lab, (mty, t)) = maybe (P.LDDef x t') (\ty -> P.LDFull x (trt ty) t') mty diff --git a/src/GF/Source/SourceToGrammar.hs b/src/GF/Source/SourceToGrammar.hs index 8435540e4..8e4f334e3 100644 --- a/src/GF/Source/SourceToGrammar.hs +++ b/src/GF/Source/SourceToGrammar.hs @@ -539,7 +539,7 @@ trLabel :: Label -> Err G.Label trLabel x = case x of -- this case is for bward compatibiity and should be removed - LIdent (IC ('v':ds)) | all isDigit ds -> return $ G.LVar $ readIntArg ds + LIdent (IC ('v':ds@(_:_))) | all isDigit ds -> return $ G.LVar $ readIntArg ds LIdent (IC s) -> return $ G.LIdent s LVar x -> return $ G.LVar $ fromInteger x @@ -572,6 +572,7 @@ transPatts p = case p of transPatt :: Patt -> Err G.Patt transPatt x = case x of PW -> return G.wildPatt + PV (IC "C_") -> return G.PChar ---- temporary encoding PV id -> liftM G.PV $ transIdent id PC id patts -> liftM2 G.PC (transIdent id) (mapM transPatt patts) PCon id -> liftM2 G.PC (transIdent id) (return [])