forked from GitHub/gf-core
finalizing experiments with Finnish nouns
This commit is contained in:
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
|
||||
@@ -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)
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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]
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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 [])
|
||||
|
||||
Reference in New Issue
Block a user