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

fix in records as param arguments

Browse Source
This commit is contained in:
aarne
2007-10-14 10:36:06 +00:00
parent 6bc3dc45b6
commit 54db8d29f7
2 changed files with 13 additions and 10 deletions
Download Patch File Download Diff File Expand all files Collapse all files

21
src/GF/Devel/GrammarToGFCC.hs
View File

@@ -224,19 +224,21 @@ canon2canon abs =
where where
t2t = term2term cg pv t2t = term2term cg pv
ty2ty = type2type cg pv ty2ty = type2type cg pv
pv@(labels,untyps,typs) = paramValues cg pv@(labels,untyps,typs) = paramValues cg ---trs $ paramValues cg
-- flatten record arguments of param constructors -- flatten record arguments of param constructors
p2p (f,j) = case j of p2p (f,j) = case j of
ResParam (Yes (ps,v)) -> ResParam (Yes (ps,v)) ->
(f,ResParam (Yes ([(c,concatMap unRec cont) | (c,cont) <- ps],v))) (f,ResParam (Yes ([(c,concatMap unRec cont) | (c,cont) <- ps],Nothing)))
_ -> (f,j) _ -> (f,j)
unRec (x,ty) = case ty of unRec (x,ty) = case ty of
RecType fs -> [ity | (_,typ) <- fs, ity <- unRec (identW,typ)] RecType fs -> [ity | (_,typ) <- fs, ity <- unRec (identW,typ)]
_ -> [(x,ty)] _ -> [(x,ty)]
{- ----
tr = trace $ trs v = trace (tr v) v
tr (labels,untyps,typs) =
("labels:" ++++ ("labels:" ++++
unlines [A.prt c ++ "." ++ unwords (map A.prt l) +++ "=" +++ show i | unlines [A.prt c ++ "." ++ unwords (map A.prt l) +++ "=" +++ show i |
((c,l),i) <- Map.toList labels]) ++ ((c,l),i) <- Map.toList labels]) ++
@@ -244,7 +246,7 @@ canon2canon abs =
(t,i) <- Map.toList untyps]) ++ (t,i) <- Map.toList untyps]) ++
("typs:" ++++ unlines [A.prt t | ("typs:" ++++ unlines [A.prt t |
(t,_) <- Map.toList typs]) (t,_) <- Map.toList typs])
-} ----
purgeGrammar :: Ident -> SourceGrammar -> SourceGrammar purgeGrammar :: Ident -> SourceGrammar -> SourceGrammar
purgeGrammar abstr gr = purgeGrammar abstr gr =
@@ -371,8 +373,6 @@ term2term cgr env@(labels,untyps,typs) tr = case tr of
return tr' return tr'
_ -> GM.composOp doVar tr _ -> GM.composOp doVar tr
r2r tr@(P (S (V ty ts) v) l) = t2t $ S (V ty [comp (P t l) | t <- ts]) v r2r tr@(P (S (V ty ts) v) l) = t2t $ S (V ty [comp (P t l) | t <- ts]) v
r2r tr@(P p _) = case getLab tr of r2r tr@(P p _) = case getLab tr of
@@ -401,16 +401,18 @@ term2term cgr env@(labels,untyps,typs) tr = case tr of
valNum tr = maybe (tryPerm tr) EInt $ Map.lookup tr untyps valNum tr = maybe (tryPerm tr) EInt $ Map.lookup tr untyps
where where
tryPerm tr = case tr of tryPerm tr = case tr of
{- obsolete ----
R rs -> case Map.lookup (R rs) untyps of R rs -> case Map.lookup (R rs) untyps of
Just v -> EInt v Just v -> EInt v
_ -> valNumFV $ tryVar tr _ -> valNumFV $ tryVar tr
-}
_ -> valNumFV $ tryVar tr _ -> valNumFV $ tryVar tr
tryVar tr = case GM.appForm tr of tryVar tr = case GM.appForm tr of
(c@(QC _ _), ts) -> [GM.mkApp c ts' | ts' <- combinations (map tryVar ts)] (c@(QC _ _), ts) -> [GM.mkApp c ts' | ts' <- combinations (map tryVar ts)]
(FV ts,_) -> ts (FV ts,_) -> ts
_ -> [tr] _ -> [tr]
valNumFV ts = case ts of valNumFV ts = case ts of
[tr] -> K (A.prt tr ++ "66667") [tr] -> prtTrace tr $ K "66667"
_ -> FV $ map valNum ts _ -> FV $ map valNum ts
mkCurry trm = case trm of mkCurry trm = case trm of
@@ -442,6 +444,7 @@ unlockTyp = filter notlock where
RecType [] -> False RecType [] -> False
_ -> True _ -> True
prtTrace tr n = trace ("-- ERROR" +++ A.prt tr +++ show n +++ show tr) n prtTrace tr n =
trace ("-- INTERNAL COMPILER ERROR" +++ A.prt tr ++++ show tr ++++ show n) n
prTrace tr n = trace ("-- OBSERVE" +++ A.prt tr +++ show n +++ show tr) n prTrace tr n = trace ("-- OBSERVE" +++ A.prt tr +++ show n +++ show tr) n

2
src/GF/GFCC/API.hs
View File

@@ -25,7 +25,7 @@ import GF.GFCC.ParGFCC
import GF.GFCC.ErrM import GF.GFCC.ErrM
import GF.Parsing.FCFG import GF.Parsing.FCFG
import GF.Conversion.SimpleToFCFG (convertGrammar,FCat(..)) import GF.Conversion.SimpleToFCFG (convertGrammar)
--import GF.Data.Operations --import GF.Data.Operations
--import GF.Infra.UseIO --import GF.Infra.UseIO