GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-04-13 23:09:31 -06:00
Code Issues Packages Projects Releases Wiki Activity

tracing a bug in gfcc generation

Browse Source
This commit is contained in:
aarne
2006-09-29 15:22:20 +00:00
parent 1dd70a285e
commit 4d9b719ccc
2 changed files with 32 additions and 18 deletions
Download Patch File Download Diff File Expand all files Collapse all files

22
src/GF/Canon/CanonToGFCC.hs
View File

@@ -252,6 +252,7 @@ term2term cgr env@(labels,untyps,typs) tr = case tr of
Ok (cat, lab) -> do
k <- readSTM >>= return . length
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,[t |
@@ -260,6 +261,19 @@ term2term cgr env@(labels,untyps,typs) tr = case tr of
_ -> error $ A.prt ty
_ -> error $ A.prt tr
updateSTM ((tyvs, (tr', tr)):)
{-
case Map.lookup (cat,lab) labels of
Just (ty,_) -> case Map.lookup ty typs of
Just vs -> do
let tyvs = (ty,[t |
(t,_) <- sortBy (\x y -> compare (snd x) (snd y))
(Map.assocs vs)])
updateSTM ((tyvs, (tr', tr)):)
_ -> return ()
_ -> return ()
-}
return tr'
_ -> composOp doVar tr
@@ -280,7 +294,8 @@ term2term cgr env@(labels,untyps,typs) tr = case tr of
--- complexity could be lowered by sorting the records
where
tryPerm tr = case tr of
R rs -> case [v | Just v <- [Map.lookup (R rs') untyps | rs' <- permutations rs]] of
R rs -> case [v | Just v <-
[Map.lookup (R rs') untyps | rs' <- permutations rs]] of
v:_ -> EInt v
_ -> valNumFV $ tryVar tr
_ -> valNumFV $ tryVar tr
@@ -299,13 +314,16 @@ term2term cgr env@(labels,untyps,typs) tr = case tr of
EInt _ -> False
R rs -> any (isStr . trmAss) rs
FV ts -> any isStr ts
S t _ -> isStr t
E -> True
T _ cs -> any isStr [v | Cas _ v <- cs]
P t r -> case getLab tr of
Ok (cat,labs) -> case
Map.lookup (cat,labs) labels of
Just (ty,_) -> isStrType ty
_ -> True ---- TODO?
_ -> True
_ -> True
_ -> True ----
isStrType ty = case ty of
TStr -> True
RecType ts -> any isStrType [t | Lbg _ t <- ts]

28
src/GF/Canon/GFCC/DataGFCC.hs
View File

@@ -3,6 +3,7 @@ module GF.Canon.GFCC.DataGFCC where
import GF.Canon.GFCC.AbsGFCC
import Data.Map
import Data.List
import Debug.Trace ----
data GFCC = GFCC {
absname :: CId ,
@@ -44,6 +45,8 @@ realize trm = case trm of
K (KP s _) -> unwords s ---- prefix choice TODO
W s t -> s ++ realize t
FV (t:_) -> realize t
RP _ r -> realize r
_ -> "ERROR " ++ show trm ---- debug
linExp :: GFCC -> CId -> Exp -> Term
@@ -76,31 +79,16 @@ compute mcfg lang args = compg [] where
compg g trm = case trm of
P r (FV ts) -> FV $ Prelude.map (comp . P r) ts
-- for the abstraction optimization
-- P (A x t) p -> compg ((x,comp p):g) t
-- L x -> maybe (error (show x)) id $ Prelude.lookup x g
P r p -> case (comp r, comp p) of
-- for the suffix optimization
(W s t, R (C i : _)) -> comp $ P (W s t) (C i)
(W s t, C i) -> case comp t of
R ss -> case comp $ idx ss (fromInteger i) of
K (KS u) -> kks (s ++ u) -- the only case where W occurs
----TODO: this is only needed because of some GFCC compilation bug
-- (R [C _ , R rs], C i) -> comp $ idx rs (fromInteger i)
(R rs, R (C i : _)) -> comp $ idx rs (fromInteger i)
-- parameter record
(RP _ (R rs), C i) -> comp $ idx rs (fromInteger i)
(R rs, RP t _) -> case comp t of
C i -> comp $ idx rs (fromInteger i)
RP (C i) _ -> comp $ idx rs (fromInteger i) ---- why?
(r', p') -> comp $ idx (getFields r') (getIndex (P r' p') p')
(R rs, C i) -> comp $ idx rs (fromInteger i)
(r',p') -> P r' p'
RP i t -> RP (comp i) (comp t)
W s t -> W s (comp t)
R ts -> R $ Prelude.map comp ts
@@ -117,7 +105,15 @@ compute mcfg lang args = compg [] where
then K (KS ("ERROR" ++ show xs ++ " !! " ++ show i)) else
xs !! i
getIndex t0 t = case t of
C i -> fromInteger i
RP p _ -> getIndex t0 $ p
---- TODO: this is workaround for a compiler bug
R (u : _) -> trace (show t ++ " IN\n" ++ show t0) $ getIndex t0 u
getFields t = case t of
R rs -> rs
RP _ r -> getFields r
{-