msyds/gf-core
1
0
Fork 0
forked from GitHub/gf-core
Code Pull Requests Activity

Commment code and options relating to the old partial evaluator

Browse Source 
This means that the -old-comp and -new-comp flags are not recognized anymore.

The only functional difference is that printnames were still normalized with
the old partial evaluator. Now that is done with the new partial evaluator.
This commit is contained in:
hallgren
2013-11-29 16:26:49 +00:00
parent 729d04051a
commit 7d1c011389
8 changed files with 54 additions and 55 deletions
Download Patch File Download Diff File Expand all files Collapse all files

12
gf.cabal
View File

@@ -49,9 +49,9 @@ flag server
Description: Include --server mode
Default: True
flag new-comp
Description: Make -new-comp the default
Default: True
--flag new-comp
-- Description: Make -new-comp the default
-- Default: True
flag custom-binary
Description: Use a customised version of the binary package
@@ -137,8 +137,8 @@ Executable gf
other-modules: GFServer
hs-source-dirs: src/server src/server/transfer src/example-based
if flag(new-comp)
cpp-options: -DNEW_COMP
--if flag(new-comp)
-- cpp-options: -DNEW_COMP
build-tools: happy, alex>=3
@@ -206,7 +206,7 @@ Executable gf
GF.Compile.TypeCheck.ConcreteNew
GF.Compile.TypeCheck.TC
GF.Compile.Compute.Abstract
GF.Compile.Compute.Concrete
-- GF.Compile.Compute.Concrete
GF.Compile.Compute.ConcreteNew1
GF.Compile.Compute.ConcreteNew
GF.Compile.Compute.AppPredefined

7
src/compiler/GF/Compile/Compute/AppPredefined.hs
View File

@@ -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)
-}

4
src/compiler/GF/Compile/Compute/Concrete.hs
View File

@@ -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

7
src/compiler/GF/Compile/Compute/ConcreteLazy.hs
View File

@@ -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)
-}
-}

6
src/compiler/GF/Compile/GeneratePMCFG.hs
View File

@@ -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

42
src/compiler/GF/Compile/Optimize.hs
View File

@@ -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

13
src/compiler/GF/Infra/Option.hs
View File

@@ -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,

18
src/compiler/GFI.hs
View File

@@ -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