summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authoraarne <unknown>2005-06-14 19:09:56 +0000
committeraarne <unknown>2005-06-14 19:09:56 +0000
commitfd56758c40b75ab47a4db71b7ffb3a578e296551 (patch)
tree7b0555c35487bf041378d80f0be5d3ce8d3fc1b9 /src
parenta40d1b5305e0d3bc576b56b416669647fe4ef372 (diff)
started Finnish paradigms (still dummy); exper with non-precomuted gfr
Diffstat (limited to 'src')
-rw-r--r--src/GF/Compile/Optimize.hs7
-rw-r--r--src/GF/Grammar/Compute.hs21
-rw-r--r--src/GF/Shell.hs5
3 files changed, 21 insertions, 12 deletions
diff --git a/src/GF/Compile/Optimize.hs b/src/GF/Compile/Optimize.hs
index c9dfbbf6c..f159074ee 100644
--- a/src/GF/Compile/Optimize.hs
+++ b/src/GF/Compile/Optimize.hs
@@ -5,9 +5,9 @@
-- Stability : (stable)
-- Portability : (portable)
--
--- > CVS $Date: 2005/06/14 15:43:03 $
+-- > CVS $Date: 2005/06/14 20:09:57 $
-- > CVS $Author: aarne $
--- > CVS $Revision: 1.16 $
+-- > CVS $Revision: 1.17 $
--
-- Top-level partial evaluation for GF source modules.
-----------------------------------------------------------------------------
@@ -93,7 +93,7 @@ evalResInfo optres gr (c,info) = case info of
_ -> return info
where
- comp = computeConcrete gr
+ comp = if optres then computeConcrete gr else computeConcreteRec gr
eIn cat = errIn ("Error optimizing" +++ cat +++ prt c +++ ":")
@@ -127,7 +127,6 @@ evalCncInfo gr cnc abs (c,info) = case info of
_ -> return (c,info)
where
- comp = computeConcrete gr
pEval = partEval gr
eIn cat = errIn ("Error optimizing" +++ cat +++ prt c +++ ":")
diff --git a/src/GF/Grammar/Compute.hs b/src/GF/Grammar/Compute.hs
index 0401c2417..9920a8f6f 100644
--- a/src/GF/Grammar/Compute.hs
+++ b/src/GF/Grammar/Compute.hs
@@ -5,14 +5,14 @@
-- Stability : (stable)
-- Portability : (portable)
--
--- > CVS $Date: 2005/05/09 15:44:59 $
+-- > CVS $Date: 2005/06/14 20:09:57 $
-- > CVS $Author: aarne $
--- > CVS $Revision: 1.17 $
+-- > CVS $Revision: 1.18 $
--
-- 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.Grammar.Grammar
@@ -34,10 +34,17 @@ import Control.Monad (liftM2, liftM)
-- | computation of concrete syntax terms into normal form
-- used mainly for partial evaluation
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 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
case t of
@@ -263,7 +270,9 @@ computeTerm gr = comp 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
diff --git a/src/GF/Shell.hs b/src/GF/Shell.hs
index 058715a17..29e00e72f 100644
--- a/src/GF/Shell.hs
+++ b/src/GF/Shell.hs
@@ -5,9 +5,9 @@
-- Stability : (stable)
-- Portability : (portable)
--
--- > CVS $Date: 2005/06/10 21:04:01 $
+-- > CVS $Date: 2005/06/14 20:09:57 $
-- > CVS $Author: aarne $
--- > CVS $Revision: 1.39 $
+-- > CVS $Revision: 1.40 $
--
-- 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 >>=
Ch.justCheckLTerm src >>=
Co.computeConcrete src))) sa
+--- Co.computeConcreteRec src))) sa
CShowOpers t -> do
m <- return $
maybe (I.identC "?") id $ -- meaningful if no opers in t