finalizing experiments with Finnish nouns

7 files changed, 13 insertions, 1 deletions

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