1
0
forked from GitHub/gf-core

finalizing experiments with Finnish nouns

This commit is contained in:
aarne
2008-01-04 15:54:40 +00:00
parent 1204d1972d
commit 799fd2c3e5
10 changed files with 33 additions and 10 deletions

View File

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

View File

@@ -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 <ukko,ukon> 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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

@@ -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 [])