1
0
forked from GitHub/gf-core

Added dir for parsing.

This commit is contained in:
aarne
2003-10-02 06:37:34 +00:00
parent c985dab565
commit be81ac50a9
6 changed files with 21 additions and 7 deletions

View File

@@ -20,7 +20,7 @@ computeAbsTerm :: GFCGrammar -> Exp -> Err Exp
computeAbsTerm gr = computeAbsTermIn gr []
computeAbsTermIn :: GFCGrammar -> [Ident] -> Exp -> Err Exp
computeAbsTermIn gr = compt where
computeAbsTermIn gr xs e = errIn ("computing" +++ prt e) $ compt xs e where
compt vv t = case t of
Prod x a b -> liftM2 (Prod x) (compt vv a) (compt (x:vv) b)
Abs x b -> liftM (Abs x) (compt (x:vv) b)

View File

@@ -13,7 +13,7 @@ import Monad
type GFCGrammar = C.CanonGrammar
lookupAbsDef :: GFCGrammar -> Ident -> Ident -> Err (Maybe Term)
lookupAbsDef gr m c = do
lookupAbsDef gr m c = errIn ("looking up absdef of" +++ prt c) $ do
mi <- lookupModule gr m
case mi of
ModMod mo -> do
@@ -25,7 +25,7 @@ lookupAbsDef gr m c = do
_ -> Bad $ prt m +++ "is not an abstract module"
lookupFunType :: GFCGrammar -> Ident -> Ident -> Err Type
lookupFunType gr m c = do
lookupFunType gr m c = errIn ("looking up funtype of" +++ prt c) $ do
mi <- lookupModule gr m
case mi of
ModMod mo -> do
@@ -37,7 +37,7 @@ lookupFunType gr m c = do
_ -> Bad $ prt m +++ "is not an abstract module"
lookupCatContext :: GFCGrammar -> Ident -> Ident -> Err Context
lookupCatContext gr m c = do
lookupCatContext gr m c = errIn ("looking up context of cat" +++ prt c) $ do
mi <- lookupModule gr m
case mi of
ModMod mo -> do

View File

@@ -118,6 +118,7 @@ inferExp :: Theory -> TCEnv -> Exp -> Err (AExp, Val, [(Val,Val)])
inferExp th tenv@(k,rho,gamma) e = case e of
Vr x -> mkAnnot (AVr x) $ noConstr $ lookupVar gamma x
Q m c -> mkAnnot (ACn (m,c)) $ noConstr $ lookupConst th (m,c)
QC m c -> mkAnnot (ACn (m,c)) $ noConstr $ lookupConst th (m,c) ----
Sort _ -> return (AType, vType, [])
App f t -> do
(f',w,csf) <- inferExp th tenv f
@@ -187,6 +188,9 @@ checkPatt th tenv exp val = do
Q m c -> do
typ <- lookupConst th (m,c)
return $ (ACn (m,c) typ, typ, [])
QC m c -> do
typ <- lookupConst th (m,c)
return $ (ACn (m,c) typ, typ, []) ----
App f t -> do
(f',w,csf) <- checkExpP tenv f val
typ <- whnf w

View File

@@ -231,7 +231,7 @@ editAsTermCommand gr c e = err (const []) singleton $ do
return $ tree2exp $ loc2tree t'
exp2termCommand :: GFCGrammar -> (Exp -> Err Exp) -> Tree -> Err Tree
exp2termCommand gr f t = do
exp2termCommand gr f t = errIn ("modifying term" +++ prt t) $ do
let exp = tree2exp t
exp2 <- f exp
annotate gr exp2