resource.txt updates ; lock field and lookup book fixes

This commit is contained in:
aarne
2006-06-20 15:05:22 +00:00
parent 402a113b56
commit a75c3b1907
7 changed files with 235 additions and 177 deletions

View File

@@ -80,7 +80,9 @@ redInfo (c,info) = errIn ("decompiling abstract" +++ show c) $ do
xx' <- mapM redArgVar xx
body' <- redCTerm body
ppr' <- redCTerm ppr
return $ G.CncFun Nothing (Yes (F.mkAbs xx' body')) (Yes ppr')
cat' <- redIdent cat
return $ G.CncFun (Just (cat', ([],F.typeStr))) -- Nothing
(Yes (F.mkAbs xx' body')) (Yes ppr')
AnyInd b c -> liftM (G.AnyInd b) $ redIdent c

View File

@@ -82,7 +82,7 @@ mkCncGroups opts0 ((res,path),files) = do
return
(\cat s ->
errVal ([],"No parse") $
optParseArgErrMsg (options [newMParser, firstCat cat, beVerbose]) gr s >>=
optParseArgErrMsg (options [newFParser, firstCat cat, beVerbose]) gr s >>=
(\ (ts,e) -> return (map tree2exp ts, e)) ,
isKnownWord gr)
putStrLn "Building parser"

View File

@@ -204,7 +204,9 @@ renameTerm env vars = ren vars where
| elem r vs -> return trm -- var proj first
| otherwise -> case renid (Q r (label2ident l)) of -- qualif second
Ok t -> return t
_ -> liftM (flip P l) $ renid t -- const proj last
_ -> case liftM (flip P l) $ renid t of
Ok t -> return t -- const proj last
_ -> prtBad "unknown qualified constant" trm
_ -> composOp (ren vs) trm

View File

@@ -51,6 +51,8 @@ lookupResDef gr m c = look True m c where
CncCat (Yes ty) _ _ -> lock c ty
CncCat _ _ _ -> lock c defLinType
CncFun (Just (cat,_)) (Yes tr) _ -> unlock cat tr
CncFun _ (Yes tr) _ -> unlock c tr
AnyInd _ n -> look False n c
@@ -73,7 +75,7 @@ lookupResType gr m c = do
-- used in reused concrete
CncCat _ _ _ -> return typeType
CncFun (Just (cat,(cont,val))) _ _ -> do
CncFun (Just (cat,(cont@(_:_),val))) _ _ -> do
val' <- lock cat val
return $ mkProd (cont, val', [])
CncFun _ _ _ -> lookFunType m m c

View File

@@ -83,7 +83,8 @@ parseStringC opts0 sg cat s
t:_ -> t
_ -> [] ---- no support for undet. tok.
ts <- checkErr $ New.parse algorithm strategy (pInfo sg) (absId sg) cat toks
ts' <- mapM (checkErr . annotate (stateGrammarST sg) . refreshMetas []) ts
ts' <- checkErr $
allChecks $ map (annotate (stateGrammarST sg) . refreshMetas []) ts
return $ optIntOrAll opts flagNumber ts'
@@ -115,7 +116,8 @@ trees2trms opts sg cn as ts0 info = do
)
(ts1,ss) <- checkErr $ mapErrN 1 postParse ts01
if null ts1 then raise ss else return ()
ts2 <- mapM (checkErr . annotate gr . refreshMetas [] . trExp) ts1 ----
ts2 <- checkErr $
allChecks $ map (annotate gr . refreshMetas [] . trExp) ts1 ----
if forgive then return ts2 else do
let tsss = [(t, allLinsOfTree gr cn t) | t <- ts2]
ps = [t | (t,ss) <- tsss,
@@ -127,7 +129,6 @@ trees2trms opts sg cn as ts0 info = do
unlines (nub (map sstr (concatMap snd tsss)))
else ""
else return ps
if verb
then checkWarn $ " the token list" +++ show as ++++ unknownWords sg as +++++ info
else return ()
@@ -140,6 +141,8 @@ trees2trms opts sg cn as ts0 info = do
verb = oElem beVerbose opts
forgive = oElem forgiveParse opts
---- Operatins.allChecks :: ErrorMonad m => [m a] -> m [a]
unknownWords sg ts = case filter noMatch [t | t@(TS _) <- ts] of
[] -> "where all words are known"
us -> "with the unknown tokens" +++ show us --- needs to be fixed for literals