summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/GF/Canon/CanonToGFCC.hs9
-rw-r--r--src/GF/Canon/GFCC/DataGFCC.hs14
-rw-r--r--src/GF/Canon/GFCC/RunGFCC.hs8
-rw-r--r--src/GF/Canon/GFCC/Test.gf20
4 files changed, 32 insertions, 19 deletions
diff --git a/src/GF/Canon/CanonToGFCC.hs b/src/GF/Canon/CanonToGFCC.hs
index f7fc3f18f..f49908db9 100644
--- a/src/GF/Canon/CanonToGFCC.hs
+++ b/src/GF/Canon/CanonToGFCC.hs
@@ -182,7 +182,7 @@ paramValues cgr = (labels,untyps,typs) where
[(cat,ls) | (_,(cat,CncCat (RecType ls) _ _)) <- jments]
labels = Map.fromList $ concat
[((cat,[lab]),(typ,i)):
- [((cat,[lab2,lab]),(ty,j)) |
+ [((cat,[lab,lab2]),(ty,j)) |
rs <- getRec typ, (Lbg lab2 ty,j) <- zip rs [0..]]
|
(cat,ls) <- lincats, (Lbg lab typ,i) <- zip ls [0..]]
@@ -197,7 +197,7 @@ paramValues cgr = (labels,untyps,typs) where
term2term :: CanonGrammar -> ParamEnv -> Term -> Term
term2term cgr env@(labels,untyps,typs) tr = case tr of
Par _ _ -> mkValCase tr
- R rs | any (isStr . trmAss) rs ->
+ R rs -> ---- | any (isStr . trmAss) rs ->
R [Ass (mkLab i) (t2t t) | (i,Ass l t) <- zip [0..] rs, not (isLock l t)]
R rs -> valNum tr
P t l -> r2r tr
@@ -219,7 +219,7 @@ term2term cgr env@(labels,untyps,typs) tr = case tr of
Arg (A cat _) -> return (cat,[])
P p lab2 -> do
(cat,labs) <- getLab p
- return (cat,lab2:labs)
+ return (cat,labs++[lab2])
S p _ -> getLab p
_ -> Bad "getLab"
@@ -249,7 +249,8 @@ term2term cgr env@(labels,untyps,typs) tr = case tr of
let tr' = LI $ identC $ show k
let tyvs = case Map.lookup (cat,lab) labels of
Just (ty,_) -> case Map.lookup ty typs of
- Just vs -> (ty,Map.keys vs)
+ Just vs -> (ty,[t |
+ (t,_) <- sortBy (\x y -> compare (snd x) (snd y)) (Map.assocs vs)])
_ -> error $ A.prt ty
_ -> error $ A.prt tr
updateSTM ((tyvs, (tr', tr)):)
diff --git a/src/GF/Canon/GFCC/DataGFCC.hs b/src/GF/Canon/GFCC/DataGFCC.hs
index 0c38a3826..9571d7c23 100644
--- a/src/GF/Canon/GFCC/DataGFCC.hs
+++ b/src/GF/Canon/GFCC/DataGFCC.hs
@@ -27,11 +27,11 @@ statGFCC gfcc = unlines [
type Concr = Map CId Term
-lookMap :: (Show i, Ord i) => i -> Map i a -> a
-lookMap c m = maybe (error ("cannot find " ++ show c)) id $ Data.Map.lookup c m
+lookMap :: (Show i, Ord i) => a -> i -> Map i a -> a
+lookMap d c m = maybe d id $ Data.Map.lookup c m
lookLin :: GFCC -> CId -> CId -> Term
-lookLin mcfg lang fun = lookMap fun $ lookMap lang $ concretes mcfg
+lookLin mcfg lang fun = lookMap term0 fun $ lookMap undefined lang $ concretes mcfg
linearize :: GFCC -> CId -> Exp -> String
linearize mcfg lang = realize . linExp mcfg lang
@@ -57,6 +57,12 @@ linExp mcfg lang tree@(Tr at trees) =
comp = compute mcfg lang
look = lookLin mcfg lang
+exp0 :: Exp
+exp0 = Tr (AS "NO_PARSE") []
+
+term0 :: Term
+term0 = kks "UNKNOWN_ID"
+
kks :: String -> Term
kks = K . KS
@@ -81,7 +87,7 @@ compute mcfg lang args = compg [] where
W s t -> W s (comp t)
R ts -> R $ Prelude.map comp ts
V i -> idx args (fromInteger i) -- already computed
- S ts -> S (Prelude.map comp ts)
+ S ts -> S $ Prelude.filter (/= S []) $ Prelude.map comp ts
F c -> comp $ look c -- global const: not comp'd (if contains argvar)
FV ts -> FV $ Prelude.map comp ts
_ -> trm
diff --git a/src/GF/Canon/GFCC/RunGFCC.hs b/src/GF/Canon/GFCC/RunGFCC.hs
index a013d7ccb..5caa5e8d2 100644
--- a/src/GF/Canon/GFCC/RunGFCC.hs
+++ b/src/GF/Canon/GFCC/RunGFCC.hs
@@ -39,9 +39,11 @@ treat grammar s = case words s of
_ -> putStrLn "no parse found"
_ -> lins $ readExp s
where
- lins t = mapM_ (lin t) $ cncnames grammar
+ lins t = mapM_ (lint t) $ cncnames grammar
+ lint t lang = do
+ putStrLn $ printTree $ linExp grammar lang t
+ lin t lang
lin t lang = do
- -- putStrLn $ printTree $ linExp grammar lang t
putStrLn $ linearize grammar lang t
prlins t = do
putStrLn $ printTree t
@@ -54,7 +56,7 @@ file2gfcc f =
readFile f >>= err (error "no parse") (return . mkGFCC) . pGrammar . myLexer
readExp :: String -> Exp
-readExp = err (error "no parse") id . (pExp . myLexer)
+readExp = errVal exp0 . (pExp . myLexer)
{-
diff --git a/src/GF/Canon/GFCC/Test.gf b/src/GF/Canon/GFCC/Test.gf
index 6cbbd367c..efb77eff6 100644
--- a/src/GF/Canon/GFCC/Test.gf
+++ b/src/GF/Canon/GFCC/Test.gf
@@ -24,6 +24,7 @@ lincat VP = Verb ;
oper Noun = {s : NForm => Str} ;
oper Verb = {s : VForm => Str} ;
+-- {-
lincat NP = {s : Case => Str ; n : Number ; p : Person} ;
lin Pred np vp = {s = np.s ! Nom ++ vp.s ! VF np.n np.p} ;
lin Pred2 np vp ob = {s = np.s ! Nom ++ vp.s ! VF np.n np.p ++ ob.s ! Part} ;
@@ -31,16 +32,19 @@ lin Det no = {s = \\c => no.s ! NF Sg c ; n = Sg ; p = P3} ;
lin Dets no = {s = \\c => no.s ! NF Pl c ; n = Pl ; p = P3} ;
lin Mina = {s = table Case ["minä" ; "minua"] ; n = Sg ; p = P1} ;
lin Te = {s = table Case ["te" ; "teitä"] ; n = Pl ; p = P2} ;
---lincat NP = {s : Case => Str ; a : {n : Number ; p : Person}} ;
---lin Pred np vp = {s = np.s ! Nom ++ vp.s ! VF np.a.n np.a.p} ;
---lin Pred2 np vp ob = {s = np.s ! Nom ++ vp.s ! VF np.a.n np.a.p ++ ob.s ! Part} ;
---lin Det no = {s = \\c => no.s ! NF Sg c ; a = {n = Sg ; p = P3}} ;
---lin Dets no = {s = \\c => no.s ! NF Pl c ; a = {n = Pl ; p = P3}} ;
---lin Mina = {s = table Case ["minä" ; "minua"] ; a = {n = Sg ; p = P1}} ;
---lin Te = {s = table Case ["te" ; "teitä"] ; a = {n = Pl ; p = P2}} ;
+-- -}
+{-
+lincat NP = {s : Case => Str ; a : {n : Number ; p : Person}} ;
+lin Pred np vp = {s = np.s ! Nom ++ vp.s ! VF np.a.n np.a.p} ;
+lin Pred2 np vp ob = {s = np.s ! Nom ++ vp.s ! VF np.a.n np.a.p ++ ob.s ! Part} ;
+lin Det no = {s = \\c => no.s ! NF Sg c ; a = {n = Sg ; p = P3}} ;
+lin Dets no = {s = \\c => no.s ! NF Pl c ; a = {n = Pl ; p = P3}} ;
+lin Mina = {s = table Case ["minä" ; "minua"] ; a = {n = Sg ; p = P1}} ;
+lin Te = {s = table Case ["te" ; "teitä"] ; a = {n = Pl ; p = P2}} ;
+-}
-lin Raha = mkN "raha" ;
+lin Raha = mkN "raha" ;
lin Paska = mkN "paska" ;
lin Pallo = mkN "pallo" ;
lin Puhua = mkV "puhu" ;