"Committed_by_peb"

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"
 

src/GF/Grammar/Macros.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.17 $
+-- > CVS $Revision: 1.18 $
 --
 -- Macros for constructing and analysing source code terms.
 --
@@ -52,7 +52,8 @@ qTypeForm t = case t of
 qq :: QIdent -> Term
 qq (m,c) = Q m c
 
-typeForm = qTypeForm ---- no need to dist any more
+typeForm :: Type -> Err (Context, Cat, [Term])
+typeForm = qTypeForm ---- no need to distinguish any more
 
 cPredef :: Ident
 cPredef = identC "Predef"
@@ -160,6 +161,7 @@ stripTerm t = case t of
    stripPatt p = errVal p $ term2patt $ stripTerm $ patt2term p
 -}
 
+computed :: Term -> Term
 computed = Computed
 
 termForm :: Term -> Err ([(Ident)], Term, [Term])
@@ -219,6 +221,7 @@ mkLet defs t = foldr Let t defs
 mkLetUntyped :: Context -> Term -> Term
 mkLetUntyped defs = mkLet [(x,(Nothing,t)) | (x,t) <- defs]
 
+isVariable :: Term -> Bool
 isVariable (Vr _ ) = True
 isVariable _ = False
 
@@ -277,22 +280,30 @@ mkRecTypeN int lab typs = RecType [ (lab i, t) | (i,t) <- zip [int..] typs]
 mkRecType :: (Int -> Label) -> [Type] -> Type
 mkRecType = mkRecTypeN 0
 
+typeType, typePType, typeStr, typeTok, typeStrs :: Term
+
 typeType  = srt "Type"
 typePType = srt "PType"
 typeStr   = srt "Str"
 typeTok   = srt "Tok"
 typeStrs  = srt "Strs"
 
+typeString, typeInt :: Term
+typeInts :: Int -> Term
+
 typeString = constPredefRes "String"
 typeInt = constPredefRes "Int"
 typeInts i = App (constPredefRes "Ints") (EInt i)
 
+isTypeInts :: Term -> Bool
 isTypeInts ty = case ty of
   App c _ -> c == constPredefRes "Ints"
   _ -> False
 
+constPredefRes :: String -> Term
 constPredefRes s = Q (IC "Predef") (zIdent s)
 
+isPredefConstant :: Term -> Bool
 isPredefConstant t = case t of
   Q (IC "Predef") _ -> True
   Q (IC "PredefAbs") _ -> True
@@ -314,9 +325,11 @@ mkDecl typ = (wildIdent, typ)
 eqStrIdent :: Ident -> Ident -> Bool
 eqStrIdent = (==)
 
+tupleLabel, linLabel :: Int -> Label
 tupleLabel i = LIdent $ "p" ++ show i
 linLabel i = LIdent $ "s" ++ show i
 
+theLinLabel :: Label
 theLinLabel = LIdent "s"
 
 tuple2record :: [Term] -> [Assign]
@@ -354,15 +367,15 @@ plusRecord t1 t2 =
    (FV rs,_    ) -> mapM (`plusRecord` t2) rs >>= return . FV
    _ -> Bad ("cannot add records" +++ prt t1 +++ "and" +++ prt t2)
 
--- default linearization type
-
+-- | default linearization type
+defLinType :: Type
 defLinType = RecType [(LIdent "s",  typeStr)]
 
--- refreshing variables
-
+-- | refreshing variables
 varX :: Int -> Ident
 varX i = identV (i,"x")
 
+-- | refreshing variables
 mkFreshVar :: [Ident] -> Ident
 mkFreshVar olds = varX (maxVarIndex olds + 1) 
 
@@ -384,6 +397,8 @@ freshAsTerm s = Vr (varX (readIntArg s))
 string2term :: String -> Term
 string2term = ccK
 
+ccK :: String -> Term
+ccC :: Term -> Term -> Term
 ccK = K
 ccC = C
 
@@ -398,25 +413,37 @@ string2CnTrm = Cn . zIdent
 symbolOfIdent :: Ident -> String
 symbolOfIdent = prIdent
 
+symid :: Ident -> String
 symid = symbolOfIdent
 
+vr :: Ident -> Term
+cn :: Ident -> Term
+srt :: String -> Term
+meta :: MetaSymb -> Term
+cnIC :: String -> Term
+
 vr = Vr
 cn = Cn
 srt = Sort
 meta = Meta
 cnIC = cn . IC
 
+justIdentOf :: Term -> Maybe Ident
 justIdentOf (Vr x) = Just x
 justIdentOf (Cn x) = Just x
 justIdentOf _ = Nothing
 
+isMeta :: Term -> Bool
 isMeta (Meta _) = True
 isMeta _ = False
+
+mkMeta :: Int -> Term
 mkMeta = Meta . MetaSymb
 
 nextMeta :: MetaSymb -> MetaSymb
 nextMeta = int2meta . succ . metaSymbInt
 
+int2meta :: Int -> MetaSymb
 int2meta = MetaSymb
 
 metaSymbInt :: MetaSymb -> Int
@@ -503,6 +530,7 @@ allLinFields trm = case unComputed trm of
   _ -> prtBad "fields can only be sought in a record not in" trm
 
 -- | deprecated
+isLinLabel :: Label -> Bool
 isLinLabel l = case l of
      LIdent ('s':cs) | all isDigit cs -> True
      _ -> False
@@ -696,6 +724,7 @@ wordsInTerm trm = filter (not . null) $ case trm of
    _       -> collectOp wo trm
  where wo = wordsInTerm
 
+noExist :: Term
 noExist = FV []
 
 defaultLinType :: Type