forked from GitHub/gf-core
removed dependencies of Zipper and editor in GF grammar compiler
This commit is contained in:
@@ -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
|
||||
|
||||
|
||||
@@ -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)
|
||||
-}
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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))
|
||||
|
||||
-}
|
||||
|
||||
Reference in New Issue
Block a user