Restored printnames.

src/GF/Canon/CMacros.hs

@@ -149,120 +149,5 @@ allLinValues trm = do
 
 redirectIdent n f@(CIQ _ c) = CIQ n c
 
-
-{- ---- to be removed 21/9
--- to analyse types and terms into eta normal form
-
-typeForm :: Exp -> Err (Context, Exp, [Exp])
-typeForm e = do
-  (cont,val) <- getContext e
-  (cat,args) <- getArgs val
-  return (cont,cat,args)
-
-getContext :: Exp -> Err (Context, Exp)
-getContext e = case e of
-  EProd x a b -> do
-    (g,b') <- getContext b
-    return ((x,a):g,b')
-  _ -> return ([],e)
-
-valAtom :: Exp -> Err Atom
-valAtom e = do
-  (_,val,_) <- typeForm e
-  case val of
-    EAtom a -> return a
-    _ -> prtBad "atom expected instead of" val
- 
-valCat :: Exp -> Err CIdent
-valCat e = do
-  a <- valAtom e
-  case a of
-    AC c -> return c
-    _ -> prtBad "cat expected instead of" a
-
-termForm :: Exp -> Err ([A.Ident], Exp, [Exp])
-termForm e = do
-  (cont,val) <- getBinds e
-  (cat,args) <- getArgs val
-  return (cont,cat,args)
-
-getBinds :: Exp -> Err ([A.Ident], Exp)
-getBinds e = case e of
-  EAbs x b -> do
-    (g,b') <- getBinds b
-    return (x:g,b')
-  _ -> return ([],e)
-
-getArgs :: Exp -> Err (Exp,[Exp])
-getArgs = get [] where
-  get xs e = case e of
-    EApp f a -> get (a:xs) f
-    _ -> return (e, reverse xs)
-
--- the inverses of these
-
-mkProd :: Context -> Exp -> Exp
-mkProd c e = foldr (uncurry EProd) e c
-
-mkApp :: Exp -> [Exp] -> Exp
-mkApp = foldl EApp
-
-mkAppAtom :: Atom -> [Exp] -> Exp
-mkAppAtom a = mkApp (EAtom a)
-
-mkAppCons :: CIdent -> [Exp] -> Exp
-mkAppCons c = mkAppAtom $ AC c
-
-mkType :: Context -> Exp -> [Exp] -> Exp
-mkType c e xs = mkProd c $ mkApp e xs
-
-mkAbs :: Context -> Exp -> Exp
-mkAbs c e = foldr EAbs e $ map fst c
-
-mkTerm :: Context -> Exp -> [Exp] -> Exp
-mkTerm c e xs = mkAbs c $ mkApp e xs
-
-mkAbsR :: [A.Ident] -> Exp -> Exp
-mkAbsR c e = foldr EAbs e c
-
-mkTermR :: [A.Ident] -> Exp -> [Exp] -> Exp
-mkTermR c e xs = mkAbsR c $ mkApp e xs
-
--- this is used to create heuristic menus
-eqCatId :: Cat -> Atom -> Bool
-eqCatId (CIQ _ c) b = case b of
-  AC (CIQ _ d) -> c == d
-  AD (CIQ _ d) -> c == d
-  _ -> False
-
--- a very weak notion of "compatible value category"
-compatCat :: Cat -> Type -> Bool
-compatCat c t = case t of
-  EAtom b  -> eqCatId c b
-  EApp f _  -> compatCat c f
-  _ -> False
-
--- this is the way an atomic category looks as a type
-
-cat2type :: Cat -> Type
-cat2type = EAtom . AC
-
-compatType :: Type -> Type -> Bool
-compatType t = case t of
-  EAtom (AC c) -> compatCat c
-  _ -> (t ==)
-
-type Fun = CIdent
-type Cat = CIdent
-type Type = Exp
-
-mkFun, mkCat :: String -> String -> Fun
-mkFun m f = CIQ (A.identC m) (A.identC f)
-mkCat = mkFun
-
-mkFunC, mkCatC :: String -> Fun
-mkFunC s = let (m,f) = span (/= '.') s in mkFun m (drop 1 f)
-mkCatC = mkFunC
-
--}
+ciq n f = CIQ n f