diff options
| author | peb <unknown> | 2005-02-24 10:46:37 +0000 |
|---|---|---|
| committer | peb <unknown> | 2005-02-24 10:46:37 +0000 |
| commit | bf436aebaa5b84bbb50e305e8f7dc9ca4ae34299 (patch) | |
| tree | 346ac1e13a90d7b2c992c69f45b3e19c22f4bfe2 /src/GF/Grammar/MMacros.hs | |
| parent | 0137dd5511a83ea4672619ad3dc22fe7c51ab4bf (diff) | |
"Committed_by_peb"
Diffstat (limited to 'src/GF/Grammar/MMacros.hs')
| -rw-r--r-- | src/GF/Grammar/MMacros.hs | 52 |
1 files changed, 38 insertions, 14 deletions
diff --git a/src/GF/Grammar/MMacros.hs b/src/GF/Grammar/MMacros.hs index acffa5298..b97c211d7 100644 --- a/src/GF/Grammar/MMacros.hs +++ b/src/GF/Grammar/MMacros.hs @@ -5,9 +5,9 @@ -- Stability : (stable) -- Portability : (portable) -- --- > CVS $Date: 2005/02/18 19:21:12 $ +-- > CVS $Date: 2005/02/24 11:46:34 $ -- > CVS $Author: peb $ --- > CVS $Revision: 1.6 $ +-- > CVS $Revision: 1.7 $ -- -- some more abstractions on grammars, esp. for Edit ----------------------------------------------------------------------------- @@ -27,19 +27,33 @@ import Macros import Monad +nodeTree :: Tree -> TrNode +argsTree :: Tree -> [Tree] + nodeTree (Tr (n,_)) = n argsTree (Tr (_,ts)) = ts -isFocusNode (N (_,_,_,_,b)) = b -bindsNode (N (b,_,_,_,_)) = b -atomNode (N (_,a,_,_,_)) = a -valNode (N (_,_,v,_,_)) = v -constrsNode (N (_,_,_,(c,_),_)) = c +isFocusNode :: TrNode -> Bool +bindsNode :: TrNode -> Binds +atomNode :: TrNode -> Atom +valNode :: TrNode -> Val +constrsNode :: TrNode -> Constraints +metaSubstsNode :: TrNode -> MetaSubst + +isFocusNode (N (_,_,_,_,b)) = b +bindsNode (N (b,_,_,_,_)) = b +atomNode (N (_,a,_,_,_)) = a +valNode (N (_,_,v,_,_)) = v +constrsNode (N (_,_,_,(c,_),_)) = c metaSubstsNode (N (_,_,_,(_,m),_)) = m +atomTree :: Tree -> Atom +valTree :: Tree -> Val + atomTree = atomNode . nodeTree valTree = valNode . nodeTree +mkNode :: Binds -> Atom -> Val -> (Constraints, MetaSubst) -> TrNode mkNode binds atom vtyp cs = N (binds,atom,vtyp,cs,False) type Var = Ident @@ -91,14 +105,14 @@ vClos = VClos [] uExp :: Exp uExp = Meta meta0 -mExp :: Exp -mExp = Meta meta0 - +mExp, mExp0 :: Exp +mExp = Meta meta0 mExp0 = mExp meta2exp :: MetaSymb -> Exp meta2exp = Meta +atomC :: Fun -> Atom atomC = AtC funAtom :: Atom -> Err Fun @@ -114,6 +128,7 @@ atomIsMeta atom = case atom of AtM _ -> True _ -> False +getMetaAtom :: Atom -> Err Meta getMetaAtom a = case a of AtM m -> return m _ -> Bad "the active node is not meta" @@ -148,12 +163,17 @@ alphaConv oldvars (x,x') = substitute (x:x':oldvars) [(x,Vr x')] alphaFresh :: [Var] -> Exp -> Err Exp alphaFresh vs = refreshTermN $ maxVarIndex vs +-- | done in a state monad alphaFreshAll :: [Var] -> [Exp] -> Err [Exp] -alphaFreshAll vs = mapM $ alphaFresh vs -- done in a state monad +alphaFreshAll vs = mapM $ alphaFresh vs +-- | for display +val2exp :: Val -> Err Exp +val2exp = val2expP False -val2exp = val2expP False -- for display -val2expSafe = val2expP True -- for type checking +-- | for type checking +val2expSafe :: Val -> Err Exp +val2expSafe = val2expP True val2expP :: Bool -> Val -> Err Exp val2expP safe v = case v of @@ -191,6 +211,7 @@ freeVarsExp e = case e of Prod x a b -> freeVarsExp a ++ filter (/=x) (freeVarsExp b) _ -> [] --- thus applies to abstract syntax only +ident2string :: Ident -> String ident2string = prIdent tree :: (TrNode,[Tree]) -> Tree @@ -230,7 +251,8 @@ ref2exp bounds typ ref = do return $ mkApp ref args -- no refreshment of metas -type Ref = Exp -- invariant: only Con or Var +-- | invariant: only 'Con' or 'Var' +type Ref = Exp fun2wrap :: [Var] -> ((Fun,Int),Type) -> Exp -> Err Exp fun2wrap oldvars ((fun,i),typ) exp = do @@ -252,6 +274,7 @@ compatType v t = errVal True $ do --- +mkJustProd :: Context -> Term -> Term mkJustProd cont typ = mkProd (cont,typ,[]) int2var :: Int -> Ident @@ -263,6 +286,7 @@ meta0 = int2meta 0 termMeta0 :: Term termMeta0 = Meta meta0 +identVar :: Term -> Err Ident identVar (Vr x) = return x identVar _ = Bad "not a variable" |
