From 666184ca64c90265842123744e759e3db1eba076 Mon Sep 17 00:00:00 2001 From: aarne Date: Mon, 8 Dec 2008 14:25:11 +0000 Subject: [PATCH] removed dependencies of Zipper and editor in GF grammar compiler --- src/GF/Compile/TypeCheck.hs | 6 +++--- src/GF/Grammar/MMacros.hs | 22 ++++++++++---------- src/GF/Grammar/PrGrammar.hs | 40 +++++++++++++++++++------------------ src/GF/Grammar/Values.hs | 15 +++++++++----- 4 files changed, 46 insertions(+), 37 deletions(-) diff --git a/src/GF/Compile/TypeCheck.hs b/src/GF/Compile/TypeCheck.hs index 04698ea89..99f46f86f 100644 --- a/src/GF/Compile/TypeCheck.hs +++ b/src/GF/Compile/TypeCheck.hs @@ -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 diff --git a/src/GF/Grammar/MMacros.hs b/src/GF/Grammar/MMacros.hs index 9436955a3..94bd98c8c 100644 --- a/src/GF/Grammar/MMacros.hs +++ b/src/GF/Grammar/MMacros.hs @@ -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) +-} diff --git a/src/GF/Grammar/PrGrammar.hs b/src/GF/Grammar/PrGrammar.hs index c1593dd63..df8c014c7 100644 --- a/src/GF/Grammar/PrGrammar.hs +++ b/src/GF/Grammar/PrGrammar.hs @@ -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 diff --git a/src/GF/Grammar/Values.hs b/src/GF/Grammar/Values.hs index ab7d874da..c83ced9df 100644 --- a/src/GF/Grammar/Values.hs +++ b/src/GF/Grammar/Values.hs @@ -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)) - +-}