1
0
forked from GitHub/gf-core

removed dependencies of Zipper and editor in GF grammar compiler

This commit is contained in:
aarne
2008-12-08 14:25:11 +00:00
parent 75ecc5f97b
commit e009048e08
4 changed files with 46 additions and 37 deletions

View File

@@ -20,7 +20,7 @@ module GF.Compile.TypeCheck (-- * top-level type checking functions; TC should n
) where
import GF.Data.Operations
import GF.Data.Zipper
--import GF.Data.Zipper
import GF.Grammar.Abstract
import GF.Compile.Refresh
@@ -42,7 +42,7 @@ initTCEnv gamma =
type2val :: Type -> Val
type2val = VClos []
{-
aexp2tree :: (AExp,[(Val,Val)]) -> Err Tree
aexp2tree (aexp,cs) = do
(bi,at,vt,ts) <- treeForm aexp
@@ -74,7 +74,7 @@ aexp2tree (aexp,cs) = do
v' <- whnf v ----
return ([],AtM m,v',[])
_ -> Bad "illegal tree" -- AProd
-}
cont2exp :: Context -> Exp
cont2exp c = mkProd (c, eType, []) -- to check a context

View File

@@ -15,7 +15,7 @@
module GF.Grammar.MMacros where
import GF.Data.Operations
import GF.Data.Zipper
--import GF.Data.Zipper
import GF.Grammar.Grammar
import GF.Grammar.PrGrammar
@@ -27,7 +27,7 @@ import GF.Grammar.Macros
import Control.Monad
import qualified Data.ByteString.Char8 as BS
{-
nodeTree :: Tree -> TrNode
argsTree :: Tree -> [Tree]
@@ -57,9 +57,6 @@ valTree = valNode . nodeTree
mkNode :: Binds -> Atom -> Val -> (Constraints, MetaSubst) -> TrNode
mkNode binds atom vtyp cs = N (binds,atom,vtyp,cs,False)
type Var = Ident
type Meta = MetaSymb
metasTree :: Tree -> [Meta]
metasTree = concatMap metasNode . scanTree where
metasNode n = [m | AtM m <- [atomNode n]] ++ map fst (metaSubstsNode n)
@@ -96,6 +93,10 @@ uAtom = AtM meta0
mAtom :: Atom
mAtom = AtM meta0
-}
type Var = Ident
type Meta = MetaSymb
uVal :: Val
uVal = vClos uExp
@@ -112,7 +113,7 @@ mExp0 = mExp
meta2exp :: MetaSymb -> Exp
meta2exp = Meta
{-
atomC :: Fun -> Atom
atomC = AtC
@@ -130,7 +131,7 @@ getMetaAtom :: Atom -> Err Meta
getMetaAtom a = case a of
AtM m -> return m
_ -> Bad "the active node is not meta"
-}
cat2val :: Context -> Cat -> Val
cat2val cont cat = vClos $ mkApp (qq cat) [mkMeta i | i <- [1..length cont]]
@@ -212,7 +213,7 @@ freeVarsExp e = case e of
ident2string :: Ident -> String
ident2string = prIdent
{-
tree :: (TrNode,[Tree]) -> Tree
tree = Tr
@@ -224,7 +225,7 @@ addBinds b (Tr (N (b0,at,t,c,x),ts)) = Tr (N (b ++ b0,at,t,c,x),ts)
bodyTree :: Tree -> Tree
bodyTree (Tr (N (_,a,t,c,x),ts)) = Tr (N ([],a,t,c,x),ts)
-}
refreshMetas :: [Meta] -> Exp -> Exp
refreshMetas metas = fst . rms minMeta where
rms meta trm = case trm of
@@ -318,7 +319,7 @@ reindexTerm = qualif (0,[]) where
look x = maybe x id . lookup x --- if x is not in scope it is unchanged
ind x d = identC $ ident2bs x `BS.append` BS.singleton '_' `BS.append` BS.pack (show d)
{-
-- this method works for context-free abstract syntax
-- and is meant to be used in simple embedded GF applications
@@ -338,3 +339,4 @@ exp2tree e = do
_ -> prtBad "cannot convert to atom" f
ts <- mapM exp2tree xs
return $ Tr (N (cont,at,uVal,([],[]),True),ts)
-}

View File

@@ -25,17 +25,17 @@ module GF.Grammar.PrGrammar (Print(..),
prContext, prParam,
prQIdent, prQIdent_,
prRefinement, prTermOpt,
prt_Tree, prMarkedTree, prTree,
tree2string, prprTree,
-- prt_Tree, prMarkedTree, prTree,
-- tree2string, prprTree,
prConstrs, prConstraints,
prMetaSubst, prEnv, prMSubst,
-- prMetaSubst, prEnv, prMSubst,
prExp, prOperSignature,
lookupIdent, lookupIdentInfo, lookupIdentInfoIn,
prTermTabular
) where
import GF.Data.Operations
import GF.Data.Zipper
--import GF.Data.Zipper
import GF.Grammar.Grammar
import GF.Infra.Modules
import qualified GF.Source.PrintGF as P
@@ -110,7 +110,7 @@ prContext :: Context -> String
prContext co = unwords $ map prParenth [prt x +++ ":" +++ prt t | (x,t) <- co]
-- some GFC notions
{-
instance Print a => Print (Tr a) where
prt (Tr (n, trees)) = prt n +++ unwords (map prt2 trees)
prt2 t@(Tr (_,args)) = if null args then prt t else prParenth (prt t)
@@ -157,7 +157,7 @@ prprTree = prf False where
else s:ss
ifPar (Tr (N ([],_,_,_,_), [])) = False
ifPar _ = True
-}
-- auxiliaries
@@ -167,10 +167,6 @@ prConstraints = concat . prConstrs
prMetaSubst :: MetaSubst -> String
prMetaSubst = concat . prMSubst
prEnv :: Env -> String
---- prEnv [] = prCurly "" ---- for debugging
prEnv e = concatMap (\ (x,t) -> prCurly (prt x ++ ":=" ++ prt t)) e
prConstrs :: Constraints -> [String]
prConstrs = map (\ (v,w) -> prCurly (prt v ++ "<>" ++ prt w))
@@ -182,6 +178,21 @@ prBinds bi = if null bi
else "\\" ++ concat (intersperse "," (map prValDecl bi)) +++ "-> "
where
prValDecl (x,t) = prParenth (prt_ x +++ ":" +++ prt_ t)
{-
instance Print Atom where
prt (AtC f) = prQIdent f
prt (AtM i) = prt i
prt (AtV i) = prt i
prt (AtL s) = prQuotedString s
prt (AtI i) = show i
prt (AtF i) = show i
prt_ (AtC (_,f)) = prt f
prt_ a = prt a
-}
prEnv :: Env -> String
---- prEnv [] = prCurly "" ---- for debugging
prEnv e = concatMap (\ (x,t) -> prCurly (prt x ++ ":=" ++ prt t)) e
instance Print Val where
prt (VGen i x) = prt x ++ "{-" ++ show i ++ "-}" ---- latter part for debugging
@@ -197,15 +208,6 @@ prv1 v = case v of
VClos _ _ -> prParenth $ prt v
_ -> prt v
instance Print Atom where
prt (AtC f) = prQIdent f
prt (AtM i) = prt i
prt (AtV i) = prt i
prt (AtL s) = prQuotedString s
prt (AtI i) = show i
prt (AtF i) = show i
prt_ (AtC (_,f)) = prt f
prt_ a = prt a
prQIdent :: QIdent -> String
prQIdent (m,f) = prt m ++ "." ++ prt f

View File

@@ -15,15 +15,17 @@
module GF.Grammar.Values (-- * values used in TC type checking
Exp, Val(..), Env,
-- * annotated tree used in editing
Tree, TrNode(..), Atom(..), Binds, Constraints, MetaSubst,
--Z Tree, TrNode(..), Atom(..),
Binds, Constraints, MetaSubst,
-- * for TC
valAbsInt, valAbsFloat, valAbsString, vType,
isPredefCat,
eType, tree2exp, loc2treeFocus
eType,
--Z tree2exp, loc2treeFocus
) where
import GF.Data.Operations
import GF.Data.Zipper
---Z import GF.Data.Zipper
import GF.Infra.Ident
import GF.Grammar.Grammar
@@ -38,6 +40,7 @@ data Val = VGen Int Ident | VApp Val Val | VCn QIdent | VType | VClos Env Exp
type Env = [(Ident,Val)]
{-
-- annotated tree used in editing
type Tree = Tr TrNode
@@ -48,11 +51,12 @@ newtype TrNode = N (Binds,Atom,Val,(Constraints,MetaSubst),Bool)
data Atom =
AtC Fun | AtM MetaSymb | AtV Ident | AtL String | AtI Integer | AtF Double
deriving (Eq,Show)
-}
type Binds = [(Ident,Val)]
type Constraints = [(Val,Val)]
type MetaSubst = [(MetaSymb,Val)]
-- for TC
valAbsInt :: Val
@@ -70,6 +74,7 @@ vType = VType
eType :: Exp
eType = Sort cType
{-
tree2exp :: Tree -> Exp
tree2exp (Tr (N (bi,at,_,_,_),ts)) = foldr Abs (foldl App at' ts') bi' where
at' = case at of
@@ -88,4 +93,4 @@ loc2treeFocus (Loc (Tr (a,ts),p)) =
where
(mark, nomark) = (\(N (a,b,c,d,_)) -> N(a,b,c,d,True),
\(N (a,b,c,d,_)) -> N(a,b,c,d,False))
-}