started Finnish paradigms (still dummy); exper with non-precomuted gfr

This commit is contained in:
aarne
2005-06-14 19:09:56 +00:00
parent a40d1b5305
commit fd56758c40
3 changed files with 21 additions and 12 deletions

View File

@@ -5,9 +5,9 @@
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date: 2005/06/14 15:43:03 $ -- > CVS $Date: 2005/06/14 20:09:57 $
-- > CVS $Author: aarne $ -- > CVS $Author: aarne $
-- > CVS $Revision: 1.16 $ -- > CVS $Revision: 1.17 $
-- --
-- Top-level partial evaluation for GF source modules. -- Top-level partial evaluation for GF source modules.
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
@@ -93,7 +93,7 @@ evalResInfo optres gr (c,info) = case info of
_ -> return info _ -> return info
where where
comp = computeConcrete gr comp = if optres then computeConcrete gr else computeConcreteRec gr
eIn cat = errIn ("Error optimizing" +++ cat +++ prt c +++ ":") eIn cat = errIn ("Error optimizing" +++ cat +++ prt c +++ ":")
@@ -127,7 +127,6 @@ evalCncInfo gr cnc abs (c,info) = case info of
_ -> return (c,info) _ -> return (c,info)
where where
comp = computeConcrete gr
pEval = partEval gr pEval = partEval gr
eIn cat = errIn ("Error optimizing" +++ cat +++ prt c +++ ":") eIn cat = errIn ("Error optimizing" +++ cat +++ prt c +++ ":")

View File

@@ -5,14 +5,14 @@
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date: 2005/05/09 15:44:59 $ -- > CVS $Date: 2005/06/14 20:09:57 $
-- > CVS $Author: aarne $ -- > CVS $Author: aarne $
-- > CVS $Revision: 1.17 $ -- > CVS $Revision: 1.18 $
-- --
-- Computation of source terms. Used in compilation and in @cc@ command. -- Computation of source terms. Used in compilation and in @cc@ command.
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
module GF.Grammar.Compute (computeConcrete, computeTerm) where module GF.Grammar.Compute (computeConcrete, computeTerm,computeConcreteRec) where
import GF.Data.Operations import GF.Data.Operations
import GF.Grammar.Grammar import GF.Grammar.Grammar
@@ -34,10 +34,17 @@ import Control.Monad (liftM2, liftM)
-- | computation of concrete syntax terms into normal form -- | computation of concrete syntax terms into normal form
-- used mainly for partial evaluation -- used mainly for partial evaluation
computeConcrete :: SourceGrammar -> Term -> Err Term computeConcrete :: SourceGrammar -> Term -> Err Term
computeConcrete g t = {- refreshTerm t >>= -} computeTerm g [] t computeConcrete g t = {- refreshTerm t >>= -} computeTerm g [] t
computeConcreteRec g t = {- refreshTerm t >>= -} computeTermOpt True g [] t
computeTerm :: SourceGrammar -> Substitution -> Term -> Err Term computeTerm :: SourceGrammar -> Substitution -> Term -> Err Term
computeTerm gr = comp where computeTerm = computeTermOpt False
-- rec=True is used if it cannot be assumed that looked-up constants
-- have already been computed (mainly with -optimize=noexpand in .gfr)
computeTermOpt :: Bool -> SourceGrammar -> Substitution -> Term -> Err Term
computeTermOpt rec gr = comp where
comp g t = ---- errIn ("subterm" +++ prt t) $ --- for debugging comp g t = ---- errIn ("subterm" +++ prt t) $ --- for debugging
case t of case t of
@@ -263,7 +270,9 @@ computeTerm gr = comp where
where where
look = lookupResDef gr look p c
| rec = lookupResDef gr p c >>= comp []
| otherwise = lookupResDef gr p c
ext x a g = (x,a):g ext x a g = (x,a):g

View File

@@ -5,9 +5,9 @@
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date: 2005/06/10 21:04:01 $ -- > CVS $Date: 2005/06/14 20:09:57 $
-- > CVS $Author: aarne $ -- > CVS $Author: aarne $
-- > CVS $Revision: 1.39 $ -- > CVS $Revision: 1.40 $
-- --
-- GF shell command interpreter. -- GF shell command interpreter.
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
@@ -224,6 +224,7 @@ execC co@(comm, opts0) sa@((st,(h,_)),a) = checkOptions st co >> case comm of
string2srcTerm src m t >>= string2srcTerm src m t >>=
Ch.justCheckLTerm src >>= Ch.justCheckLTerm src >>=
Co.computeConcrete src))) sa Co.computeConcrete src))) sa
--- Co.computeConcreteRec src))) sa
CShowOpers t -> do CShowOpers t -> do
m <- return $ m <- return $
maybe (I.identC "?") id $ -- meaningful if no opers in t maybe (I.identC "?") id $ -- meaningful if no opers in t