summaryrefslogtreecommitdiff
path: root/src/compiler
diff options
context:
space:
mode:
Diffstat (limited to 'src/compiler')
-rw-r--r--src/compiler/GF/Compile/Compute/AppPredefined.hs7
-rw-r--r--src/compiler/GF/Compile/Compute/Concrete.hs4
-rw-r--r--src/compiler/GF/Compile/Compute/ConcreteLazy.hs7
-rw-r--r--src/compiler/GF/Compile/GeneratePMCFG.hs6
-rw-r--r--src/compiler/GF/Compile/Optimize.hs42
-rw-r--r--src/compiler/GF/Infra/Option.hs13
-rw-r--r--src/compiler/GFI.hs18
7 files changed, 48 insertions, 49 deletions
diff --git a/src/compiler/GF/Compile/Compute/AppPredefined.hs b/src/compiler/GF/Compile/Compute/AppPredefined.hs
index 6b125e001..2a1998283 100644
--- a/src/compiler/GF/Compile/Compute/AppPredefined.hs
+++ b/src/compiler/GF/Compile/Compute/AppPredefined.hs
@@ -12,10 +12,10 @@
-- Predefined function type signatures and definitions.
-----------------------------------------------------------------------------
-module GF.Compile.Compute.AppPredefined (
- isInPredefined, typPredefined, arrityPredefined, predefModInfo, appPredefined
+module GF.Compile.Compute.AppPredefined ({-
+ isInPredefined, typPredefined, arrityPredefined, predefModInfo, appPredefined-}
) where
-
+{-
import GF.Compile.TypeCheck.Primitives
import GF.Infra.Option
import GF.Data.Operations
@@ -140,3 +140,4 @@ mapStr ty f t = case (ty,t) of
mapField (mty,te) = case mty of
Just ty -> (mty,mapStr ty f te)
_ -> (mty,te)
+-} \ No newline at end of file
diff --git a/src/compiler/GF/Compile/Compute/Concrete.hs b/src/compiler/GF/Compile/Compute/Concrete.hs
index f5a940022..f411f2ca0 100644
--- a/src/compiler/GF/Compile/Compute/Concrete.hs
+++ b/src/compiler/GF/Compile/Compute/Concrete.hs
@@ -1,3 +1,3 @@
-module GF.Compile.Compute.Concrete(module M) where
-import GF.Compile.Compute.ConcreteLazy as M -- New
+module GF.Compile.Compute.Concrete{-(module M)-} where
+--import GF.Compile.Compute.ConcreteLazy as M -- New
--import GF.Compile.Compute.ConcreteStrict as M -- Old, inefficient
diff --git a/src/compiler/GF/Compile/Compute/ConcreteLazy.hs b/src/compiler/GF/Compile/Compute/ConcreteLazy.hs
index 67d21768b..abfa93578 100644
--- a/src/compiler/GF/Compile/Compute/ConcreteLazy.hs
+++ b/src/compiler/GF/Compile/Compute/ConcreteLazy.hs
@@ -12,10 +12,10 @@
-- Computation of source terms. Used in compilation and in @cc@ command.
-----------------------------------------------------------------------------
-module GF.Compile.Compute.ConcreteLazy (computeConcrete, computeTerm,checkPredefError) where
-
-import GF.Data.Operations
+module GF.Compile.Compute.ConcreteLazy ({-computeConcrete, computeTerm,checkPredefError-}) where
+{-
import GF.Grammar.Grammar
+import GF.Data.Operations
import GF.Infra.Ident
--import GF.Infra.Option
import GF.Data.Str
@@ -528,3 +528,4 @@ checkPredefError sgr t = case t of
predef_error s = App (Q (cPredef,cError)) (K s)
-}
+-}
diff --git a/src/compiler/GF/Compile/GeneratePMCFG.hs b/src/compiler/GF/Compile/GeneratePMCFG.hs
index 059038b6c..72e280b07 100644
--- a/src/compiler/GF/Compile/GeneratePMCFG.hs
+++ b/src/compiler/GF/Compile/GeneratePMCFG.hs
@@ -150,9 +150,9 @@ convert opts gr cenv loc term ty@(_,val) pargs =
where
conv t = convertTerm opts CNil val =<< unfactor t
- term' = if flag optNewComp opts
- then normalForm cenv loc (expand ty term) -- new evaluator
- else term -- old evaluator is invoked from GF.Compile.Optimize
+ term' = {-if flag optNewComp opts
+ then-} normalForm cenv loc (expand ty term) -- new evaluator
+ --else term -- old evaluator is invoked from GF.Compile.Optimize
expand ty@(context,val) = recordExpand val . etaExpand ty
diff --git a/src/compiler/GF/Compile/Optimize.hs b/src/compiler/GF/Compile/Optimize.hs
index bd75cbc2c..9d15a9970 100644
--- a/src/compiler/GF/Compile/Optimize.hs
+++ b/src/compiler/GF/Compile/Optimize.hs
@@ -22,7 +22,8 @@ import GF.Grammar.Macros
import GF.Grammar.Lookup
import GF.Grammar.Predef
--import GF.Compile.Refresh
-import GF.Compile.Compute.Concrete
+--import GF.Compile.Compute.Concrete
+import GF.Compile.Compute.ConcreteNew(GlobalEnv,normalForm,resourceValues)
--import GF.Compile.CheckGrammar
--import GF.Compile.Update
@@ -49,12 +50,14 @@ optimizeModule opts sgr m@(name,mi)
where
oopts = opts `addOptions` mflags mi
+ resenv = resourceValues sgr
+
updateEvalInfo mi (i,info) = do
- info <- evalInfo oopts sgr (name,mi) i info
+ info <- evalInfo oopts resenv sgr (name,mi) i info
return (mi{jments=updateTree (i,info) (jments mi)})
-evalInfo :: Options -> SourceGrammar -> SourceModule -> Ident -> Info -> Err Info
-evalInfo opts sgr m c info = do
+evalInfo :: Options -> GlobalEnv -> SourceGrammar -> SourceModule -> Ident -> Info -> Err Info
+evalInfo opts resenv sgr m c info = do
(if verbAtLeast opts Verbose then trace (" " ++ showIdent c) else id) return ()
@@ -81,7 +84,7 @@ evalInfo opts sgr m c info = do
return (Just (L loc (factor param c 0 re)))
_ -> return pre -- indirection
- ppr' <- evalPrintname gr ppr
+ let ppr' = fmap (evalPrintname resenv c) ppr
return (CncCat ptyp pde' pre' ppr' mpmcfg)
@@ -91,9 +94,9 @@ evalInfo opts sgr m c info = do
Just (L loc de) -> do de <- partEval opts gr (cont,val) de
return (Just (L loc (factor param c 0 de)))
Nothing -> return pde
- ppr' <- evalPrintname gr ppr
+ let ppr' = fmap (evalPrintname resenv c) ppr
return $ CncFun mt pde' ppr' mpmcfg -- only cat in type actually needed
-
+{-
ResOper pty pde
| not new && OptExpand `Set.member` optim -> do
pde' <- case pde of
@@ -101,10 +104,10 @@ evalInfo opts sgr m c info = do
return (Just (L loc (factor param c 0 de)))
Nothing -> return Nothing
return $ ResOper pty pde'
-
+-}
_ -> return info
where
- new = flag optNewComp opts -- computations moved to GF.Compile.GeneratePMCFG
+-- new = flag optNewComp opts -- computations moved to GF.Compile.GeneratePMCFG
gr = prependModule sgr m
optim = flag optOptimizations opts
@@ -113,14 +116,14 @@ evalInfo opts sgr m c info = do
-- | the main function for compiling linearizations
partEval :: Options -> SourceGrammar -> (Context,Type) -> Term -> Err Term
-partEval opts = if flag optNewComp opts
- then partEvalNew opts
- else partEvalOld opts
+partEval opts = {-if flag optNewComp opts
+ then-} partEvalNew opts
+ {-else partEvalOld opts-}
partEvalNew opts gr (context, val) trm =
errIn (render (text "partial evaluation" <+> ppTerm Qualified 0 trm)) $
checkPredefError trm
-
+{-
partEvalOld opts gr (context, val) trm = errIn (render (text "partial evaluation" <+> ppTerm Qualified 0 trm)) $ do
let vars = map (\(bt,x,t) -> x) context
args = map Vr vars
@@ -140,8 +143,6 @@ partEvalOld opts gr (context, val) trm = errIn (render (text "partial evaluation
rightType _ = False
-
-
-- here we must be careful not to reduce
-- variants {{s = "Auto" ; g = N} ; {s = "Wagen" ; g = M}}
-- {s = variants {"Auto" ; "Wagen"} ; g = variants {N ; M}} ;
@@ -153,7 +154,7 @@ recordExpand typ trm = case typ of
_ -> return $ R [assign lab (P trm lab) | (lab,_) <- tys]
_ -> return trm
-
+-}
-- | auxiliaries for compiling the resource
mkLinDefault :: SourceGrammar -> Type -> Err Term
@@ -196,12 +197,8 @@ mkLinReference gr typ =
_ | Just _ <- isTypeInts typ -> Bad "no string"
_ -> Bad (render (text "linearization type field cannot be" <+> ppTerm Unqualified 0 typ))
-evalPrintname :: SourceGrammar -> Maybe (L Term) -> Err (Maybe (L Term))
-evalPrintname gr mpr =
- case mpr of
- Just (L loc pr) -> do pr <- computeConcrete gr pr
- return (Just (L loc pr))
- Nothing -> return Nothing
+evalPrintname :: GlobalEnv -> Ident -> L Term -> L Term
+evalPrintname resenv c (L loc pr) = L loc (normalForm resenv (L loc c) pr)
-- do even more: factor parametric branches
@@ -238,4 +235,3 @@ replace old new trm =
R _ | trm == old -> new
App x y -> App (replace old new x) (replace old new y)
_ -> composSafeOp (replace old new) trm
-
diff --git a/src/compiler/GF/Infra/Option.hs b/src/compiler/GF/Infra/Option.hs
index 08f0df18b..fb516a690 100644
--- a/src/compiler/GF/Infra/Option.hs
+++ b/src/compiler/GF/Infra/Option.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE CPP #-}
+-- LANGUAGE CPP
module GF.Infra.Option
(
-- * Option types
@@ -173,8 +173,8 @@ data Flags = Flags {
optTagsOnly :: Bool,
optHeuristicFactor :: Maybe Double,
optMetaProb :: Maybe Double,
- optMetaToknProb :: Maybe Double,
- optNewComp :: Bool
+ optMetaToknProb :: Maybe Double{-,
+ optNewComp :: Bool-}
}
deriving (Show)
@@ -285,13 +285,14 @@ defaultFlags = Flags {
optTagsOnly = False,
optHeuristicFactor = Nothing,
optMetaProb = Nothing,
- optMetaToknProb = Nothing,
+ optMetaToknProb = Nothing{-,
optNewComp =
#ifdef NEW_COMP
True
#else
False
#endif
+-}
}
-- | Option descriptions
@@ -374,8 +375,8 @@ optDescr =
Option [] ["heuristic_search_factor"] (ReqArg (readDouble (\d o -> o { optHeuristicFactor = Just d })) "FACTOR") "Set the heuristic search factor for statistical parsing",
Option [] ["meta_prob"] (ReqArg (readDouble (\d o -> o { optMetaProb = Just d })) "PROB") "Set the probability of introducting a meta variable in the parser",
Option [] ["meta_token_prob"] (ReqArg (readDouble (\d o -> o { optMetaToknProb = Just d })) "PROB") "Set the probability for skipping a token in the parser",
- Option [] ["new-comp"] (NoArg (set $ \o -> o{optNewComp = True})) "Use the new experimental compiler.",
- Option [] ["old-comp"] (NoArg (set $ \o -> o{optNewComp = False})) "Use old trusty compiler.",
+-- Option [] ["new-comp"] (NoArg (set $ \o -> o{optNewComp = True})) "Use the new experimental compiler.",
+-- Option [] ["old-comp"] (NoArg (set $ \o -> o{optNewComp = False})) "Use old trusty compiler.",
dumpOption "source" Source,
dumpOption "rebuild" Rebuild,
dumpOption "extend" Extend,
diff --git a/src/compiler/GFI.hs b/src/compiler/GFI.hs
index 070a95384..ead5a3ff7 100644
--- a/src/compiler/GFI.hs
+++ b/src/compiler/GFI.hs
@@ -15,7 +15,7 @@ import GF.Grammar.Parser (runP, pExp)
import GF.Grammar.ShowTerm
import GF.Grammar.Lookup (allOpers,allOpersTo)
import GF.Compile.Rename(renameSourceTerm)
-import GF.Compile.Compute.Concrete (computeConcrete,checkPredefError)
+--import GF.Compile.Compute.Concrete (computeConcrete,checkPredefError)
import qualified GF.Compile.Compute.ConcreteNew as CN(normalForm,resourceValues)
import GF.Compile.TypeCheck.Concrete (inferLType,ppType)
import GF.Infra.Dependencies(depGraph)
@@ -178,16 +178,17 @@ execute1 opts gfenv0 s0 =
pOpts style q ("-qual" :ws) = pOpts style Qualified ws
pOpts style q ws = (style,q,unwords ws)
- (style,q,s) = pOpts TermPrintDefault Qualified ws'
+ (style,q,s) = pOpts TermPrintDefault Qualified ws
+ {-
(new,ws') = case ws of
"-new":ws' -> (True,ws')
"-old":ws' -> (False,ws')
_ -> (flag optNewComp opts,ws)
-
+ -}
case runP pExp (UTF8.fromString s) of
Left (_,msg) -> putStrLn msg
Right t -> putStrLn . err id (showTerm sgr style q)
- . checkComputeTerm' new sgr
+ . checkComputeTerm sgr
$ {-codeTerm (decodeUnicode utf8 . BS.pack)-} t
continue gfenv
@@ -324,14 +325,13 @@ execute1 opts gfenv0 s0 =
printException e = maybe (print e) (putStrLn . ioErrorText) (fromException e)
-checkComputeTerm = checkComputeTerm' False
-checkComputeTerm' new sgr t = do
+checkComputeTerm sgr t = do
mo <- maybe (raise "no source grammar in scope") return $ greatestResource sgr
((t,_),_) <- runCheck $ do t <- renameSourceTerm sgr mo t
inferLType sgr [] t
- t1 <- if new
- then return (CN.normalForm (CN.resourceValues sgr) (L NoLoc identW) t)
- else computeConcrete sgr t
+ t1 <- {-if new
+ then-} return (CN.normalForm (CN.resourceValues sgr) (L NoLoc identW) t)
+ {-else computeConcrete sgr t-}
checkPredefError t1
fetchCommand :: GFEnv -> IO String
generated by cgit v1.2.3 (git 2.39.1) at 2026-05-20 05:49:30 +0000