summaryrefslogtreecommitdiff
path: root/src/GF/Canon
diff options
context:
space:
mode:
authoraarne <unknown>2003-10-08 10:09:58 +0000
committeraarne <unknown>2003-10-08 10:09:58 +0000
commita979508aa75a3f2b93072d214ca9c75ed874a39c (patch)
tree74add47e62a9b5fdb1720a365754f738c3de4b93 /src/GF/Canon
parent889e5a92e4e0c40ab249f9f86d0fa2647132d87a (diff)
Restored printnames.
Diffstat (limited to 'src/GF/Canon')
-rw-r--r--src/GF/Canon/CMacros.hs117
1 files changed, 1 insertions, 116 deletions
diff --git a/src/GF/Canon/CMacros.hs b/src/GF/Canon/CMacros.hs
index 49e9c71e4..e782d977a 100644
--- a/src/GF/Canon/CMacros.hs
+++ b/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