summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorkrasimir <krasimir@chalmers.se>2008-06-19 12:48:29 +0000
committerkrasimir <krasimir@chalmers.se>2008-06-19 12:48:29 +0000
commit4dd62417dc64609e0c37633fbbba52e82c221b2e (patch)
treeba6404c44f7f681c40a7dea5521243f0ede9c752
parent944eea8de9e077d1b3ee1a9edad9c52e9dbc2bd0 (diff)
split the Exp type to Tree and Expr
-rw-r--r--GF.cabal2
-rw-r--r--src-3.0/GF/Command/Abstract.hs2
-rw-r--r--src-3.0/GF/Command/Commands.hs26
-rw-r--r--src-3.0/GF/Command/Interpreter.hs24
-rw-r--r--src-3.0/GF/Command/Parse.hs6
-rw-r--r--src-3.0/GF/Compile/GFCCtoJS.hs2
-rw-r--r--src-3.0/GF/Compile/GenerateFCFG.hs6
-rw-r--r--src-3.0/GF/Compile/GeneratePMCFG.hs6
-rw-r--r--src-3.0/GF/Compile/GrammarToGFCC.hs23
-rw-r--r--src-3.0/GFI.hs494
-rw-r--r--src-3.0/PGF.hs34
-rw-r--r--src-3.0/PGF/Data.hs62
-rw-r--r--src-3.0/PGF/Expr.hs202
-rw-r--r--src-3.0/PGF/ExprSyntax.hs73
-rw-r--r--src-3.0/PGF/Generate.hs18
-rw-r--r--src-3.0/PGF/Linearize.hs26
-rw-r--r--src-3.0/PGF/Macros.hs10
-rw-r--r--src-3.0/PGF/Parsing/FCFG.hs4
-rw-r--r--src-3.0/PGF/Parsing/FCFG/Active.hs4
-rw-r--r--src-3.0/PGF/Parsing/FCFG/Incremental.hs6
-rw-r--r--src-3.0/PGF/Parsing/FCFG/Utilities.hs12
-rw-r--r--src-3.0/PGF/Raw/Convert.hs26
-rw-r--r--src-3.0/PGF/ShowLinearize.hs22
23 files changed, 613 insertions, 477 deletions
diff --git a/GF.cabal b/GF.cabal
index bd928df7a..e9bf84b80 100644
--- a/GF.cabal
+++ b/GF.cabal
@@ -37,7 +37,7 @@ library
PGF.Parsing.FCFG.Active
PGF.Parsing.FCFG.Incremental
PGF.Parsing.FCFG
- PGF.ExprSyntax
+ PGF.Expr
PGF.Raw.Parse
PGF.Raw.Print
PGF.Raw.Convert
diff --git a/src-3.0/GF/Command/Abstract.hs b/src-3.0/GF/Command/Abstract.hs
index 8643a649f..b26499d54 100644
--- a/src-3.0/GF/Command/Abstract.hs
+++ b/src-3.0/GF/Command/Abstract.hs
@@ -24,7 +24,7 @@ data Value
deriving (Eq,Ord,Show)
data Argument
- = AExp Exp
+ = ATree Tree
| ANoArg
| AMacro Ident
deriving (Eq,Ord,Show)
diff --git a/src-3.0/GF/Command/Commands.hs b/src-3.0/GF/Command/Commands.hs
index b66d4764d..27c8e5fb4 100644
--- a/src-3.0/GF/Command/Commands.hs
+++ b/src-3.0/GF/Command/Commands.hs
@@ -20,7 +20,7 @@ import GF.Compile.Export
import GF.Infra.Option (noOptions)
import GF.Infra.UseIO
import GF.Data.ErrM ----
-import PGF.ExprSyntax (readExp)
+import PGF.Expr (readTree)
import GF.Command.Abstract
import GF.Text.Lexing
import GF.Text.Transliterations
@@ -29,12 +29,12 @@ import GF.Data.Operations
import Data.Maybe
import qualified Data.Map as Map
-import System
+import System.Cmd
-type CommandOutput = ([Exp],String) ---- errors, etc
+type CommandOutput = ([Tree],String) ---- errors, etc
data CommandInfo = CommandInfo {
- exec :: [Option] -> [Exp] -> IO CommandOutput,
+ exec :: [Option] -> [Tree] -> IO CommandOutput,
synopsis :: String,
syntax :: String,
explanation :: String,
@@ -192,7 +192,7 @@ allCommands pgf = Map.fromList [
("full","give full information of the commands")
],
exec = \opts ts -> return ([], case ts of
- [t] -> let co = showExp t in
+ [t] -> let co = showTree t in
case lookCommand co (allCommands pgf) of ---- new map ??!!
Just info -> commandHelp True (co,info)
_ -> "command not found"
@@ -381,9 +381,9 @@ allCommands pgf = Map.fromList [
s <- readFile file
return $ case opts of
_ | isOpt "lines" opts && isOpt "tree" opts ->
- fromTrees [t | l <- lines s, Just t <- [readExp l]]
+ fromTrees [t | l <- lines s, Just t <- [readTree l]]
_ | isOpt "tree" opts ->
- fromTrees [t | Just t <- [readExp s]]
+ fromTrees [t | Just t <- [readTree s]]
_ | isOpt "lines" opts -> fromStrings $ lines s
_ -> fromString s,
flags = [("file","the input file name")]
@@ -469,7 +469,7 @@ allCommands pgf = Map.fromList [
_ -> linearize pgf lang
treebank opts t = unlines $
- (abstractName pgf ++ ": " ++ showExp t) :
+ (abstractName pgf ++ ": " ++ showTree t) :
[lang ++ ": " ++ linear opts lang t | lang <- optLangs opts]
optRestricted opts = restrictPGF (hasLin pgf (mkCId (optLang opts))) pgf
@@ -483,11 +483,11 @@ allCommands pgf = Map.fromList [
optNum opts = valIntOpts "number" 1 opts
optNumInf opts = valIntOpts "number" 1000000000 opts ---- 10^9
- fromTrees ts = (ts,unlines (map showExp ts))
- fromStrings ss = (map EStr ss, unlines ss)
- fromString s = ([EStr s], s)
- toStrings ts = [s | EStr s <- ts]
- toString ts = unwords [s | EStr s <- ts]
+ fromTrees ts = (ts,unlines (map showTree ts))
+ fromStrings ss = (map (Lit . LStr) ss, unlines ss)
+ fromString s = ([Lit (LStr s)], s)
+ toStrings ts = [s | Lit (LStr s) <- ts]
+ toString ts = unwords [s | Lit (LStr s) <- ts]
prGrammar opts = case opts of
_ | isOpt "cats" opts -> unwords $ categories pgf
diff --git a/src-3.0/GF/Command/Interpreter.hs b/src-3.0/GF/Command/Interpreter.hs
index ee354bd45..e1a06a205 100644
--- a/src-3.0/GF/Command/Interpreter.hs
+++ b/src-3.0/GF/Command/Interpreter.hs
@@ -24,7 +24,7 @@ data CommandEnv = CommandEnv {
multigrammar :: PGF,
commands :: Map.Map String CommandInfo,
commandmacros :: Map.Map String CommandLine,
- expmacros :: Map.Map String Exp
+ expmacros :: Map.Map String Tree
}
mkCommandEnv :: PGF -> CommandEnv
@@ -64,18 +64,18 @@ interpretPipe env cs = do
appLine es = map (map (appCommand es))
-- macro definition applications: replace ?i by (exps !! i)
-appCommand :: [Exp] -> Command -> Command
+appCommand :: [Tree] -> Command -> Command
appCommand xs c@(Command i os arg) = case arg of
- AExp e -> Command i os (AExp (app e))
- _ -> c
+ ATree e -> Command i os (ATree (app e))
+ _ -> c
where
app e = case e of
- EMeta i -> xs !! i
- EApp f as -> EApp f (map app as)
- EAbs x b -> EAbs x (app b)
+ Meta i -> xs !! i
+ Fun f as -> Fun f (map app as)
+ Abs x b -> Abs x (app b)
-- return the trees to be sent in pipe, and the output possibly printed
-interpret :: CommandEnv -> [Exp] -> Command -> IO CommandOutput
+interpret :: CommandEnv -> [Tree] -> Command -> IO CommandOutput
interpret env trees0 comm = case lookCommand co comms of
Just info -> do
checkOpts info
@@ -100,17 +100,17 @@ interpret env trees0 comm = case lookCommand co comms of
-- analyse command parse tree to a uniform datastructure, normalizing comm name
--- the env is needed for macro lookup
-getCommand :: CommandEnv -> Command -> [Exp] -> (String,[Option],[Exp])
+getCommand :: CommandEnv -> Command -> [Tree] -> (String,[Option],[Tree])
getCommand env co@(Command c opts arg) ts =
(getCommandOp c,opts,getCommandArg env arg ts)
-getCommandArg :: CommandEnv -> Argument -> [Exp] -> [Exp]
+getCommandArg :: CommandEnv -> Argument -> [Tree] -> [Tree]
getCommandArg env a ts = case a of
AMacro m -> case Map.lookup m (expmacros env) of
Just t -> [t]
_ -> []
- AExp t -> [t] -- ignore piped
- ANoArg -> ts -- use piped
+ ATree t -> [t] -- ignore piped
+ ANoArg -> ts -- use piped
-- abbreviation convention from gf commands
getCommandOp s = case break (=='_') s of
diff --git a/src-3.0/GF/Command/Parse.hs b/src-3.0/GF/Command/Parse.hs
index 1b603f411..eaf4cba84 100644
--- a/src-3.0/GF/Command/Parse.hs
+++ b/src-3.0/GF/Command/Parse.hs
@@ -1,7 +1,7 @@
module GF.Command.Parse(readCommandLine, pCommand) where
-import PGF.ExprSyntax
-import PGF.Data(Exp)
+import PGF.Expr
+import PGF.Data(Tree)
import GF.Command.Abstract
import Data.Char
@@ -43,6 +43,6 @@ pFilename = liftM2 (:) (RP.satisfy isFileFirst) (RP.munch (not . isSpace)) where
pArgument =
RP.option ANoArg
- (fmap AExp (pExp False)
+ (fmap ATree (pTree False)
RP.<++
(RP.munch isSpace >> RP.char '%' >> fmap AMacro pIdent))
diff --git a/src-3.0/GF/Compile/GFCCtoJS.hs b/src-3.0/GF/Compile/GFCCtoJS.hs
index 024de7273..8259e7385 100644
--- a/src-3.0/GF/Compile/GFCCtoJS.hs
+++ b/src-3.0/GF/Compile/GFCCtoJS.hs
@@ -31,7 +31,7 @@ pgf2js pgf =
abstract2js :: String -> Abstr -> JS.Expr
abstract2js start ds = new "GFAbstract" [JS.EStr start, JS.EObj $ map absdef2js (Map.assocs (funs ds))]
-absdef2js :: (CId,(Type,Exp)) -> JS.Property
+absdef2js :: (CId,(Type,Expr)) -> JS.Property
absdef2js (f,(typ,_)) =
let (args,cat) = M.catSkeleton typ in
JS.Prop (JS.IdentPropName (JS.Ident (prCId f))) (new "Type" [JS.EArray [JS.EStr (prCId x) | x <- args], JS.EStr (prCId cat)])
diff --git a/src-3.0/GF/Compile/GenerateFCFG.hs b/src-3.0/GF/Compile/GenerateFCFG.hs
index 64f824acf..c2854ef3d 100644
--- a/src-3.0/GF/Compile/GenerateFCFG.hs
+++ b/src-3.0/GF/Compile/GenerateFCFG.hs
@@ -42,7 +42,7 @@ convertConcrete abs cnc = fixHoasFuns $ convert abs_defs' conc' cats'
cats = lincats cnc
(abs_defs',conc',cats') = expandHOAS abs_defs conc cats
-expandHOAS :: [(CId,(Type,Exp))] -> TermMap -> TermMap -> ([(CId,(Type,Exp))],TermMap,TermMap)
+expandHOAS :: [(CId,(Type,Expr))] -> TermMap -> TermMap -> ([(CId,(Type,Expr))],TermMap,TermMap)
expandHOAS funs lins lincats = (funs' ++ hoFuns ++ varFuns,
Map.unions [lins, hoLins, varLins],
Map.unions [lincats, hoLincats, varLincat])
@@ -97,7 +97,7 @@ fixHoasFuns (rs, cs) = ([FRule (fixName n) ps args cat lins | FRule n ps args ca
| BS.pack "_Var_" `BS.isPrefixOf` n = wildCId
fixName n = n
-convert :: [(CId,(Type,Exp))] -> TermMap -> TermMap -> FGrammar
+convert :: [(CId,(Type,Expr))] -> TermMap -> TermMap -> FGrammar
convert abs_defs cnc_defs cat_defs = getFGrammar (loop frulesEnv)
where
srules = [
@@ -193,7 +193,7 @@ convertTerm cnc_defs selector (K (KS str)) ((lbl_path,lin) : lins) =
return ((lbl_path,Right str : lin) : lins)
convertTerm cnc_defs selector (K (KP strs vars))((lbl_path,lin) : lins) =
do projectHead lbl_path
- toks <- member (strs:[strs' | Var strs' _ <- vars])
+ toks <- member (strs:[strs' | Alt strs' _ <- vars])
return ((lbl_path, map Right toks ++ lin) : lins)
convertTerm cnc_defs selector (F id) lins = do term <- Map.lookup id cnc_defs
convertTerm cnc_defs selector term lins
diff --git a/src-3.0/GF/Compile/GeneratePMCFG.hs b/src-3.0/GF/Compile/GeneratePMCFG.hs
index 435a06eb1..e0343e8d6 100644
--- a/src-3.0/GF/Compile/GeneratePMCFG.hs
+++ b/src-3.0/GF/Compile/GeneratePMCFG.hs
@@ -44,7 +44,7 @@ convertConcrete abs cnc = fixHoasFuns $ convert abs_defs' conc' cats'
cats = lincats cnc
(abs_defs',conc',cats') = expandHOAS abs_defs conc cats
-expandHOAS :: [(CId,(Type,Exp))] -> TermMap -> TermMap -> ([(CId,(Type,Exp))],TermMap,TermMap)
+expandHOAS :: [(CId,(Type,Expr))] -> TermMap -> TermMap -> ([(CId,(Type,Expr))],TermMap,TermMap)
expandHOAS funs lins lincats = (funs' ++ hoFuns ++ varFuns,
Map.unions [lins, hoLins, varLins],
Map.unions [lincats, hoLincats, varLincat])
@@ -99,7 +99,7 @@ fixHoasFuns (!rs, !cs) = ([FRule (fixName n) ps args cat lins | FRule n ps args
| BS.pack "_Var_" `BS.isPrefixOf` n = wildCId
fixName n = n
-convert :: [(CId,(Type,Exp))] -> TermMap -> TermMap -> FGrammar
+convert :: [(CId,(Type,Expr))] -> TermMap -> TermMap -> FGrammar
convert abs_defs cnc_defs cat_defs = getFGrammar (List.foldl' (convertRule cnc_defs) emptyFRulesEnv srules)
where
srules = [
@@ -159,7 +159,7 @@ convertTerm cnc_defs sel ctype (FV vars) lins = do term <-
convertTerm cnc_defs sel ctype (S ts) ((lbl_path,lin) : lins) = foldM (\lins t -> convertTerm cnc_defs sel ctype t lins) ((lbl_path,lin) : lins) (reverse ts)
convertTerm cnc_defs sel ctype (K (KS str)) ((lbl_path,lin) : lins) = return ((lbl_path,FSymTok str : lin) : lins)
convertTerm cnc_defs sel ctype (K (KP strs vars))((lbl_path,lin) : lins) =
- do toks <- member (strs:[strs' | Var strs' _ <- vars])
+ do toks <- member (strs:[strs' | Alt strs' _ <- vars])
return ((lbl_path, map FSymTok toks ++ lin) : lins)
convertTerm cnc_defs sel ctype (F id) lins = do term <- Map.lookup id cnc_defs
convertTerm cnc_defs sel ctype term lins
diff --git a/src-3.0/GF/Compile/GrammarToGFCC.hs b/src-3.0/GF/Compile/GrammarToGFCC.hs
index 010393bfd..d14a914f1 100644
--- a/src-3.0/GF/Compile/GrammarToGFCC.hs
+++ b/src-3.0/GF/Compile/GrammarToGFCC.hs
@@ -119,28 +119,27 @@ mkType :: A.Type -> C.Type
mkType t = case GM.typeForm t of
Ok (hyps,(_,cat),args) -> C.DTyp (mkContext hyps) (i2i cat) (map mkExp args)
-mkExp :: A.Term -> C.Exp
+mkExp :: A.Term -> C.Expr
mkExp t = case t of
A.Eqs eqs -> C.EEq [C.Equ (map mkPatt ps) (mkExp e) | (ps,e) <- eqs]
_ -> case GM.termForm t of
Ok (xs,c,args) -> mkAbs xs (mkApp c (map mkExp args))
where
- mkAbs [] t = t
- mkAbs xs t = C.EAbs [i2i x | x <- xs] t
- mkApp c args = case c of
- Q _ c -> C.EApp (i2i c) args
- QC _ c -> C.EApp (i2i c) args
+ mkAbs xs t = foldr (C.EAbs . i2i) t xs
+ mkApp c args = case c of
+ Q _ c -> foldl C.EApp (C.EVar (i2i c)) args
+ QC _ c -> foldl C.EApp (C.EVar (i2i c)) args
Vr x -> C.EVar (i2i x)
- EInt i -> C.EInt i
- EFloat f -> C.EFloat f
- K s -> C.EStr s
+ EInt i -> C.ELit (C.LInt i)
+ EFloat f -> C.ELit (C.LFlt f)
+ K s -> C.ELit (C.LStr s)
Meta (MetaSymb i) -> C.EMeta i
_ -> C.EMeta 0
mkPatt p = case p of
- A.PP _ c ps -> C.EApp (i2i c) (map mkPatt ps)
+ A.PP _ c ps -> foldl C.EApp (C.EVar (i2i c)) (map mkPatt ps)
A.PV x -> C.EVar (i2i x)
A.PW -> C.EVar wildCId
- A.PInt i -> C.EInt i
+ A.PInt i -> C.ELit (C.LInt i)
mkContext :: A.Context -> [C.Hypo]
mkContext hyps = [C.Hyp (i2i x) (mkType ty) | (x,ty) <- hyps]
@@ -167,7 +166,7 @@ mkTerm tr = case tr of
App _ _ -> prtTrace tr $ C.C 66661 ---- for debugging
Abs _ t -> mkTerm t ---- only on toplevel
Alts (td,tvs) ->
- C.K (C.KP (strings td) [C.Var (strings u) (strings v) | (u,v) <- tvs])
+ C.K (C.KP (strings td) [C.Alt (strings u) (strings v) | (u,v) <- tvs])
_ -> prtTrace tr $ C.S [C.K (C.KS (A.prt tr +++ "66662"))] ---- for debugging
where
mkLab (LIdent l) = case BS.unpack l of
diff --git a/src-3.0/GFI.hs b/src-3.0/GFI.hs
index 27a825c12..8bcc7df14 100644
--- a/src-3.0/GFI.hs
+++ b/src-3.0/GFI.hs
@@ -1,257 +1,237 @@
-module GFI (mainGFI) where
-
-import GF.Command.Interpreter
-import GF.Command.Importing
-import GF.Command.Commands
-import GF.Command.Abstract
-import GF.Command.Parse
-import GF.Data.ErrM
-import GF.Grammar.API -- for cc command
-import GF.Infra.UseIO
-import GF.Infra.Option
-import GF.System.Readline
-
-import PGF
-import PGF.Data
-import PGF.Macros
-import PGF.ExprSyntax (readExp)
-
-import Data.Char
-import Data.List(isPrefixOf)
-import qualified Data.Map as Map
-import qualified Text.ParserCombinators.ReadP as RP
-import System.Cmd
-import System.CPUTime
-import Control.Exception
-
-import Data.Version
-import Paths_gf
-
-mainGFI :: Options -> [FilePath] -> IO ()
-mainGFI opts files = do
- putStrLn welcome
- gfenv <- importInEnv emptyGFEnv opts files
- loop opts gfenv
- return ()
-
-loop :: Options -> GFEnv -> IO GFEnv
-loop opts gfenv0 = do
- let env = commandenv gfenv0
- let sgr = sourcegrammar gfenv0
- setCompletionFunction (Just (wordCompletion (commandenv gfenv0)))
- s <- fetchCommand (prompt env)
- let gfenv = gfenv0 {history = s : history gfenv0}
- let loopNewCPU gfenv' = do
- cpu' <- getCPUTime
- putStrLnFlush (show ((cpu' - cputime gfenv') `div` 1000000000) ++ " msec")
- loop opts $ gfenv' {cputime = cpu'}
- let
- pwords = case words s of
- w:ws -> getCommandOp w :ws
- ws -> ws
- case pwords of
- -- special commands, requiring source grammar in env
- "!":ws -> do
- system $ unwords ws
- loopNewCPU gfenv
- "cc":ws -> do
- let
- (style,term) = case ws of
- ('-':w):ws2 -> (pTermPrintStyle w, ws2)
- _ -> (TermPrintDefault, ws)
- case pTerm (unwords term) >>= checkTerm sgr >>= computeTerm sgr of ---- pipe!
- Ok x -> putStrLnFlush (showTerm style x)
- Bad s -> putStrLnFlush s
- loopNewCPU gfenv
- "i":args -> do
- gfenv' <- case parseOptions args of
- Ok (opts',files) -> importInEnv gfenv (addOptions opts opts') files
- Bad err -> do
- putStrLn $ "Command parse error: " ++ err
- return gfenv
- loopNewCPU gfenv'
-
- -- other special commands, working on GFEnv
- "e":_ -> loopNewCPU $ gfenv {
- commandenv=emptyCommandEnv, sourcegrammar = emptyGrammar
- }
-
- "dc":f:ws -> do
- case readCommandLine (unwords ws) of
- Just comm -> loopNewCPU $ gfenv {
- commandenv = env {
- commandmacros = Map.insert f comm (commandmacros env)
- }
- }
- _ -> putStrLnFlush "command definition not parsed" >> loopNewCPU gfenv
-
- "dt":f:"<":ws -> do
- case readCommandLine (unwords ws) of
- Just [pip] -> do
- ip <- interpretPipe env pip
- case ip of
- (exp:es,_) -> do
- if null es then return () else
- putStrLnFlush $ "ambiguous definition, selected the first one"
- loopNewCPU $ gfenv {
- commandenv = env {
- expmacros = Map.insert f exp (expmacros env)
- }
- }
- _ -> putStrLnFlush "no value given in definition" >> loopNewCPU gfenv
- _ -> putStrLnFlush "value definition not parsed" >> loopNewCPU gfenv
-
- "dt":f:ws -> do
- case readExp (unwords ws) of
- Just exp -> loopNewCPU $ gfenv {
- commandenv = env {
- expmacros = Map.insert f exp (expmacros env)
- }
- }
- _ -> putStrLnFlush "value definition not parsed" >> loopNewCPU gfenv
-
- "ph":_ -> mapM_ putStrLnFlush (reverse (history gfenv0)) >> loopNewCPU gfenv
- "q":_ -> putStrLnFlush "See you." >> return gfenv
-
- -- ordinary commands, working on CommandEnv
- _ -> do
- interpretCommandLine env s
- loopNewCPU gfenv
-
-importInEnv :: GFEnv -> Options -> [FilePath] -> IO GFEnv
-importInEnv gfenv opts files
- | flag optRetainResource opts =
- do src <- importSource (sourcegrammar gfenv) opts files
- return $ gfenv {sourcegrammar = src}
- | otherwise =
- do let opts' = addOptions (setOptimization OptCSE False) opts
- cenv0 = commandenv gfenv
- pgf0 = multigrammar cenv0
- pgf1 <- importGrammar pgf0 opts' files
- putStrLnFlush $ unwords $ "\nLanguages:" : languages pgf1
- return $ gfenv { commandenv = (mkCommandEnv pgf1)
- {commandmacros = commandmacros cenv0, expmacros = expmacros cenv0}}
---- return $ gfenv { commandenv = cenv0 {multigrammar = pgf1} } -- WHY NOT
-
-welcome = unlines [
- " ",
- " * * * ",
- " * * ",
- " * * ",
- " * ",
- " * ",
- " * * * * * * * ",
- " * * * ",
- " * * * * * * ",
- " * * * ",
- " * * * ",
- " ",
- "This is GF version "++showVersion version++". ",
- "Some things may work. "
- ]
-
-prompt env = absname ++ "> " where
- absname = case abstractName (multigrammar env) of
- "_" -> "" --- created by new Ident handling 22/5/2008
- n -> n
-
-data GFEnv = GFEnv {
- sourcegrammar :: Grammar, -- gfo grammar -retain
- commandenv :: CommandEnv,
- history :: [String],
- cputime :: Integer
- }
-
-emptyGFEnv :: GFEnv
-emptyGFEnv = GFEnv emptyGrammar (mkCommandEnv emptyPGF) [] 0
-
-
-wordCompletion cmdEnv line prefix p =
- case wc_type (take p line) of
- CmplCmd pref
- -> ret ' ' [name | name <- Map.keys (commands cmdEnv), isPrefixOf pref name]
- CmplStr (Just (Command _ opts _)) s
- -> do mb_state0 <- try (evaluate (initState pgf (optLang opts) (optCat opts)))
- case mb_state0 of
- Right state0 -> let ws = words (take (length s - length prefix) s)
- state = foldl nextState state0 ws
- compls = getCompletions state prefix
- in ret ' ' (Map.keys compls)
- Left _ -> ret ' ' []
- CmplOpt (Just (Command n _ _)) pref
- -> case Map.lookup n (commands cmdEnv) of
- Just inf -> do let flg_compls = ['-':flg | (flg,_) <- flags inf, isPrefixOf pref flg]
- opt_compls = ['-':opt | (opt,_) <- options inf, isPrefixOf pref opt]
- ret (if null flg_compls then ' ' else '=')
- (flg_compls++opt_compls)
- Nothing -> ret ' ' []
- CmplIdent (Just (Command "i" _ _)) _ -- HACK: file name completion for command i
- -> filenameCompletionFunction prefix
- CmplIdent _ pref
- -> do mb_abs <- try (evaluate (abstract pgf))
- case mb_abs of
- Right abs -> ret ' ' [name | cid <- Map.keys (funs abs), let name = prCId cid, isPrefixOf pref name]
- Left _ -> ret ' ' []
- _ -> ret ' ' []
- where
- pgf = multigrammar cmdEnv
- optLang opts = valIdOpts "lang" (head (languages pgf)) opts
- optCat opts = valIdOpts "cat" (lookStartCat pgf) opts
-
- ret c [x] = return [x++[c]]
- ret _ xs = return xs
-
-
-data CompletionType
- = CmplCmd Ident
- | CmplStr (Maybe Command) String
- | CmplOpt (Maybe Command) Ident
- | CmplIdent (Maybe Command) Ident
- deriving Show
-
-wc_type :: String -> CompletionType
-wc_type = cmd_name
- where
- cmd_name cs =
- let cs1 = dropWhile isSpace cs
- in go cs1 cs1
- where
- go x [] = CmplCmd x
- go x (c:cs)
- | isIdent c = go x cs
- | otherwise = cmd x cs
-
- cmd x [] = ret CmplIdent x "" 0
- cmd _ ('|':cs) = cmd_name cs
- cmd _ (';':cs) = cmd_name cs
- cmd x ('"':cs) = str x cs cs
- cmd x ('-':cs) = option x cs cs
- cmd x (c :cs)
- | isIdent c = ident x (c:cs) cs
- | otherwise = cmd x cs
-
- option x y [] = ret CmplOpt x y 1
- option x y (c:cs)
- | isIdent c = option x y cs
- | otherwise = cmd x cs
-
- ident x y [] = ret CmplIdent x y 0
- ident x y (c:cs)
- | isIdent c = ident x y cs
- | otherwise = cmd x cs
-
- str x y [] = ret CmplStr x y 1
- str x y ('\"':cs) = cmd x cs
- str x y ('\\':c:cs) = str x y cs
- str x y (c:cs) = str x y cs
-
- ret f x y d = f cmd y
- where
- x1 = take (length x - length y - d) x
- x2 = takeWhile (\c -> isIdent c || isSpace c || c == '-' || c == '=') x1
-
- cmd = case [x | (x,cs) <- RP.readP_to_S pCommand x2, all isSpace cs] of
- [x] -> Just x
- _ -> Nothing
-
- isIdent c = c == '_' || c == '\'' || isAlphaNum c
+module GFI (mainGFI) where
+
+import GF.Command.Interpreter
+import GF.Command.Importing
+import GF.Command.Commands
+import GF.Command.Abstract
+import GF.Command.Parse
+import GF.Data.ErrM
+import GF.Grammar.API -- for cc command
+import GF.Infra.UseIO
+import GF.Infra.Option
+import GF.System.Readline
+
+import PGF
+import PGF.Data
+import PGF.Macros
+import PGF.Expr (readTree)
+
+import Data.Char
+import Data.List(isPrefixOf)
+import qualified Data.Map as Map
+import qualified Text.ParserCombinators.ReadP as RP
+import System.Cmd
+import System.CPUTime
+import Control.Exception
+
+import Data.Version
+import Paths_gf
+
+mainGFI :: Options -> [FilePath] -> IO ()
+mainGFI opts files = do
+ putStrLn welcome
+ gfenv <- importInEnv emptyGFEnv opts files
+ loop opts gfenv
+ return ()
+
+loop :: Options -> GFEnv -> IO GFEnv
+loop opts gfenv0 = do
+ let env = commandenv gfenv0
+ let sgr = sourcegrammar gfenv0
+ setCompletionFunction (Just (wordCompletion (commandenv gfenv0)))
+ s <- fetchCommand (prompt env)
+ let gfenv = gfenv0 {history = s : history gfenv0}
+ let loopNewCPU gfenv' = do
+ cpu' <- getCPUTime
+ putStrLnFlush (show ((cpu' - cputime gfenv') `div` 1000000000) ++ " msec")
+ loop opts $ gfenv' {cputime = cpu'}
+ let
+ pwords = case words s of
+ w:ws -> getCommandOp w :ws
+ ws -> ws
+ case pwords of
+ -- special commands, requiring source grammar in env
+ "!":ws -> do
+ system $ unwords ws
+ loopNewCPU gfenv
+ "cc":ws -> do
+ let
+ (style,term) = case ws of
+ ('-':w):ws2 -> (pTermPrintStyle w, ws2)
+ _ -> (TermPrintDefault, ws)
+ case pTerm (unwords term) >>= checkTerm sgr >>= computeTerm sgr of ---- pipe!
+ Ok x -> putStrLn (showTerm style x)
+ Bad s -> putStrLn s
+ loopNewCPU gfenv
+ "i":args -> do
+ gfenv' <- case parseOptions args of
+ Ok (opts',files) -> importInEnv gfenv (addOptions opts opts') files
+ Bad err -> do putStrLn $ "Command parse error: " ++ err
+ return gfenv
+ loopNewCPU gfenv'
+
+ -- other special commands, working on GFEnv
+ "e":_ -> loopNewCPU $ gfenv {
+ commandenv=emptyCommandEnv, sourcegrammar = emptyGrammar
+ }
+
+ "dc":f:ws -> do
+ case readCommandLine (unwords ws) of
+ Just comm -> loopNewCPU $ gfenv {
+ commandenv = env {
+ commandmacros = Map.insert f comm (commandmacros env)
+ }
+ }
+ _ -> putStrLn "command definition not parsed" >> loopNewCPU gfenv
+
+ "dt":f:ws -> do
+ case readTree (unwords ws) of
+ Just exp -> loopNewCPU $ gfenv {
+ commandenv = env {
+ expmacros = Map.insert f exp (expmacros env)
+ }
+ }
+ _ -> putStrLn "value definition not parsed" >> loopNewCPU gfenv
+
+ "ph":_ -> mapM_ putStrLn (reverse (history gfenv0)) >> loopNewCPU gfenv
+ "q":_ -> putStrLn "See you." >> return gfenv
+
+ -- ordinary commands, working on CommandEnv
+ _ -> do
+ interpretCommandLine env s
+ loopNewCPU gfenv
+
+importInEnv :: GFEnv -> Options -> [FilePath] -> IO GFEnv
+importInEnv gfenv opts files
+ | flag optRetainResource opts =
+ do src <- importSource (sourcegrammar gfenv) opts files
+ return $ gfenv {sourcegrammar = src}
+ | otherwise =
+ do let opts' = addOptions (setOptimization OptCSE False) opts
+ pgf0 = multigrammar (commandenv gfenv)
+ pgf1 <- importGrammar pgf0 opts' files
+ putStrLnFlush $ unwords $ "\nLanguages:" : languages pgf1
+ return $ gfenv { commandenv = mkCommandEnv pgf1 }
+
+welcome = unlines [
+ " ",
+ " * * * ",
+ " * * ",
+ " * * ",
+ " * ",
+ " * ",
+ " * * * * * * * ",
+ " * * * ",
+ " * * * * * * ",
+ " * * * ",
+ " * * * ",
+ " ",
+ "This is GF version "++showVersion version++". ",
+ "Some things may work. "
+ ]
+
+prompt env = absname ++ "> " where
+ absname = case abstractName (multigrammar env) of
+ "_" -> "" --- created by new Ident handling 22/5/2008
+ n -> n
+
+data GFEnv = GFEnv {
+ sourcegrammar :: Grammar, -- gfo grammar -retain
+ commandenv :: CommandEnv,
+ history :: [String],
+ cputime :: Integer
+ }
+
+emptyGFEnv :: GFEnv
+emptyGFEnv = GFEnv emptyGrammar (mkCommandEnv emptyPGF) [] 0
+
+
+wordCompletion cmdEnv line prefix p =
+ case wc_type (take p line) of
+ CmplCmd pref
+ -> ret ' ' [name | name <- Map.keys (commands cmdEnv), isPrefixOf pref name]
+ CmplStr (Just (Command _ opts _)) s
+ -> do mb_state0 <- try (evaluate (initState pgf (optLang opts) (optCat opts)))
+ case mb_state0 of
+ Right state0 -> let ws = words (take (length s - length prefix) s)
+ state = foldl nextState state0 ws
+ compls = getCompletions state prefix
+ in ret ' ' (Map.keys compls)
+ Left _ -> ret ' ' []
+ CmplOpt (Just (Command n _ _)) pref
+ -> case Map.lookup n (commands cmdEnv) of
+ Just inf -> do let flg_compls = ['-':flg | (flg,_) <- flags inf, isPrefixOf pref flg]
+ opt_compls = ['-':opt | (opt,_) <- options inf, isPrefixOf pref opt]
+ ret (if null flg_compls then ' ' else '=')
+ (flg_compls++opt_compls)
+ Nothing -> ret ' ' []
+ CmplIdent (Just (Command "i" _ _)) _ -- HACK: file name completion for command i
+ -> filenameCompletionFunction prefix
+ CmplIdent _ pref
+ -> do mb_abs <- try (evaluate (abstract pgf))
+ case mb_abs of
+ Right abs -> ret ' ' [name | cid <- Map.keys (funs abs), let name = prCId cid, isPrefixOf pref name]
+ Left _ -> ret ' ' []
+ _ -> ret ' ' []
+ where
+ pgf = multigrammar cmdEnv
+ optLang opts = valIdOpts "lang" (head (languages pgf)) opts
+ optCat opts = valIdOpts "cat" (lookStartCat pgf) opts
+
+ ret c [x] = return [x++[c]]
+ ret _ xs = return xs
+
+
+data CompletionType
+ = CmplCmd Ident
+ | CmplStr (Maybe Command) String
+ | CmplOpt (Maybe Command) Ident
+ | CmplIdent (Maybe Command) Ident
+ deriving Show
+
+wc_type :: String -> CompletionType
+wc_type = cmd_name
+ where
+ cmd_name cs =
+ let cs1 = dropWhile isSpace cs
+ in go cs1 cs1
+ where
+ go x [] = CmplCmd x
+ go x (c:cs)
+ | isIdent c = go x cs
+ | otherwise = cmd x cs
+
+ cmd x [] = ret CmplIdent x "" 0
+ cmd _ ('|':cs) = cmd_name cs
+ cmd _ (';':cs) = cmd_name cs
+ cmd x ('"':cs) = str x cs cs
+ cmd x ('-':cs) = option x cs cs
+ cmd x (c :cs)
+ | isIdent c = ident x (c:cs) cs
+ | otherwise = cmd x cs
+
+ option x y [] = ret CmplOpt x y 1
+ option x y (c:cs)
+ | isIdent c = option x y cs
+ | otherwise = cmd x cs
+
+ ident x y [] = ret CmplIdent x y 0
+ ident x y (c:cs)
+ | isIdent c = ident x y cs
+ | otherwise = cmd x cs
+
+ str x y [] = ret CmplStr x y 1
+ str x y ('\"':cs) = cmd x cs
+ str x y ('\\':c:cs) = str x y cs
+ str x y (c:cs) = str x y cs
+
+ ret f x y d = f cmd y
+ where
+ x1 = take (length x - length y - d) x
+ x2 = takeWhile (\c -> isIdent c || isSpace c || c == '-' || c == '=') x1
+
+ cmd = case [x | (x,cs) <- RP.readP_to_S pCommand x2, all isSpace cs] of
+ [x] -> Just x
+ _ -> Nothing
+
+ isIdent c = c == '_' || c == '\'' || isAlphaNum c
diff --git a/src-3.0/PGF.hs b/src-3.0/PGF.hs
index aa2fa2edf..0739815be 100644
--- a/src-3.0/PGF.hs
+++ b/src-3.0/PGF.hs
@@ -28,8 +28,13 @@ module PGF(
Category, categories, startCat,
-- * Expressions
- Exp(..), Equation(..),
- showExp, readExp,
+ -- ** Tree
+ Tree(..),
+ showTree, readTree,
+
+ -- ** Expr
+ Expr(..), Equation(..),
+ showExpr, readExpr,
-- * Operations
-- ** Linearization
@@ -38,6 +43,9 @@ module PGF(
-- ** Parsing
parse, parseAllLang, parseAll,
+ -- ** Evaluation
+ tree2expr, expr2tree,
+
-- ** Word Completion (Incremental Parsing)
Incremental.ParseState,
initState, Incremental.nextState, Incremental.getCompletions, extractExps,
@@ -52,7 +60,7 @@ import qualified PGF.Linearize (linearize)
import PGF.Generate
import PGF.Macros
import PGF.Data
-import PGF.ExprSyntax
+import PGF.Expr
import PGF.Raw.Convert
import PGF.Raw.Parse
import PGF.Raw.Print (printTree)
@@ -90,25 +98,25 @@ type Category = String
readPGF :: FilePath -> IO PGF
-- | Linearizes given expression as string in the language
-linearize :: PGF -> Language -> Exp -> String
+linearize :: PGF -> Language -> Tree -> String
-- | Tries to parse the given string in the specified language
-- and to produce abstract syntax expression. An empty
-- list is returned if the parsing is not successful. The list may also
-- contain more than one element if the grammar is ambiguous.
-parse :: PGF -> Language -> Category -> String -> [Exp]
+parse :: PGF -> Language -> Category -> String -> [Tree]
-- | The same as 'linearizeAllLang' but does not return
-- the language.
-linearizeAll :: PGF -> Exp -> [String]
+linearizeAll :: PGF -> Tree -> [String]
-- | Linearizes given expression as string in all languages
-- available in the grammar.
-linearizeAllLang :: PGF -> Exp -> [(Language,String)]
+linearizeAllLang :: PGF -> Tree -> [(Language,String)]
-- | The same as 'parseAllLang' but does not return
-- the language.
-parseAll :: PGF -> Category -> String -> [[Exp]]
+parseAll :: PGF -> Category -> String -> [[Tree]]
-- | Tries to parse the given string with every language
-- available in the grammar and to produce abstract syntax
@@ -117,7 +125,7 @@ parseAll :: PGF -> Category -> String -> [[Exp]]
-- for which at least one parsing is possible are listed.
-- More than one abstract syntax expressions are possible
-- if the grammar is ambiguous.
-parseAllLang :: PGF -> Category -> String -> [(Language,[Exp])]
+parseAllLang :: PGF -> Category -> String -> [(Language,[Tree])]
-- | Creates an initial parsing state for a given language and
-- startup category.
@@ -127,21 +135,21 @@ initState :: PGF -> Language -> Category -> Incremental.ParseState
-- that spans the whole input consumed so far. The trees are also
-- limited by the category specified, which is usually
-- the same as the startup category.
-extractExps :: Incremental.ParseState -> Category -> [Exp]
+extractExps :: Incremental.ParseState -> Category -> [Tree]
-- | The same as 'generateAllDepth' but does not limit
-- the depth in the generation.
-generateAll :: PGF -> Category -> [Exp]
+generateAll :: PGF -> Category -> [Tree]
-- | Generates an infinite list of random abstract syntax expressions.
-- This is usefull for tree bank generation which after that can be used
-- for grammar testing.
-generateRandom :: PGF -> Category -> IO [Exp]
+generateRandom :: PGF -> Category -> IO [Tree]
-- | Generates an exhaustive possibly infinite list of
-- abstract syntax expressions. A depth can be specified
-- to limit the search space.
-generateAllDepth :: PGF -> Category -> Maybe Int -> [Exp]
+generateAllDepth :: PGF -> Category -> Maybe Int -> [Tree]
-- | List of all languages available in the given grammar.
languages :: PGF -> [Language]
diff --git a/src-3.0/PGF/Data.hs b/src-3.0/PGF/Data.hs
index 896e821db..06013924c 100644
--- a/src-3.0/PGF/Data.hs
+++ b/src-3.0/PGF/Data.hs
@@ -21,10 +21,10 @@ data PGF = PGF {
}
data Abstr = Abstr {
- aflags :: Map.Map CId String, -- value of a flag
- funs :: Map.Map CId (Type,Exp), -- type and def of a fun
- cats :: Map.Map CId [Hypo], -- context of a cat
- catfuns :: Map.Map CId [CId] -- funs to a cat (redundant, for fast lookup)
+ aflags :: Map.Map CId String, -- value of a flag
+ funs :: Map.Map CId (Type,Expr), -- type and def of a fun
+ cats :: Map.Map CId [Hypo], -- context of a cat
+ catfuns :: Map.Map CId [CId] -- funs to a cat (redundant, for fast lookup)
}
data Concr = Concr {
@@ -39,20 +39,40 @@ data Concr = Concr {
}
data Type =
- DTyp [Hypo] CId [Exp]
+ DTyp [Hypo] CId [Expr]
deriving (Eq,Ord,Show)
--- | An expression representing the abstract syntax tree
--- in PGF. The same expression is used in the dependent
--- types.
-data Exp =
- EAbs [CId] Exp -- ^ lambda abstraction. The list should contain at least one variable
- | EApp CId [Exp] -- ^ application. Note that unevaluated lambda abstractions are not allowed
- | EStr String -- ^ string constant
- | EInt Integer -- ^ integer constant
- | EFloat Double -- ^ floating point constant
+data Literal =
+ LStr String -- ^ string constant
+ | LInt Integer -- ^ integer constant
+ | LFlt Double -- ^ floating point constant
+ deriving (Eq,Ord,Show)
+
+-- | The tree is an evaluated expression in the abstract syntax
+-- of the grammar. The type is especially restricted to not
+-- allow unapplied lambda abstractions. The meta variables
+-- also does not have indices because both the parser and
+-- the linearizer consider all meta variable occurrences as
+-- distinct. The tree is used directly from the linearizer
+-- and is produced directly from the parser.
+data Tree =
+ Abs [CId] Tree -- ^ lambda abstraction. The list of variables is non-empty
+ | Var CId -- ^ variable
+ | Fun CId [Tree] -- ^ function application
+ | Lit Literal -- ^ literal
+ | Meta Int -- ^ meta variable. Each occurency of 'Meta' means a different metavariable
+ deriving (Show, Eq, Ord)
+
+-- | An expression represents a potentially unevaluated expression
+-- in the abstract syntax of the grammar. It can be evaluated with
+-- the 'expr2tree' function and then linearized or it can be used
+-- directly in the dependent types.
+data Expr =
+ EAbs CId Expr -- ^ lambda abstraction
+ | EApp Expr Expr -- ^ application
+ | ELit Literal -- ^ literal
| EMeta Int -- ^ meta variable
- | EVar CId -- ^ variable reference
+ | EVar CId -- ^ variable or function reference
| EEq [Equation] -- ^ lambda function defined as a set of equations with pattern matching
deriving (Eq,Ord,Show)
@@ -71,11 +91,11 @@ data Term =
data Tokn =
KS String
- | KP [String] [Variant]
+ | KP [String] [Alternative]
deriving (Eq,Ord,Show)
-data Variant =
- Var [String] [String]
+data Alternative =
+ Alt [String] [String]
deriving (Eq,Ord,Show)
data Hypo =
@@ -83,11 +103,11 @@ data Hypo =
deriving (Eq,Ord,Show)
-- | The equation is used to define lambda function as a sequence
--- of equations with pattern matching. The list of 'Exp' represents
--- the patterns and the second 'Exp' is the function body for this
+-- of equations with pattern matching. The list of 'Expr' represents
+-- the patterns and the second 'Expr' is the function body for this
-- equation.
data Equation =
- Equ [Exp] Exp
+ Equ [Expr] Expr
deriving (Eq,Ord,Show)
diff --git a/src-3.0/PGF/Expr.hs b/src-3.0/PGF/Expr.hs
new file mode 100644
index 000000000..332fbc657
--- /dev/null
+++ b/src-3.0/PGF/Expr.hs
@@ -0,0 +1,202 @@
+module PGF.Expr(readTree, showTree, pTree, ppTree,
+ readExpr, showExpr, pExpr, ppExpr,
+
+ tree2expr, expr2tree,
+
+ -- needed in the typechecker
+ Value(..), Env, eval,
+
+ -- helpers
+ pIdent,pStr
+ ) where
+
+import PGF.CId
+import PGF.Data
+
+import Data.Char
+import Data.Maybe
+import Control.Monad
+import qualified Text.PrettyPrint as PP
+import qualified Text.ParserCombinators.ReadP as RP
+import qualified Data.Map as Map
+
+
+-- | parses 'String' as an expression
+readTree :: String -> Maybe Tree
+readTree s = case [x | (x,cs) <- RP.readP_to_S (pTree False) s, all isSpace cs] of
+ [x] -> Just x
+ _ -> Nothing
+
+-- | renders expression as 'String'
+showTree :: Tree -> String
+showTree = PP.render . ppTree 0
+
+-- | parses 'String' as an expression
+readExpr :: String -> Maybe Expr
+readExpr s = case [x | (x,cs) <- RP.readP_to_S pExpr s, all isSpace cs] of
+ [x] -> Just x
+ _ -> Nothing
+
+-- | renders expression as 'String'
+showExpr :: Expr -> String
+showExpr = PP.render . ppExpr 0
+
+
+-----------------------------------------------------
+-- Parsing
+-----------------------------------------------------
+
+pTrees :: RP.ReadP [Tree]
+pTrees = liftM2 (:) (pTree True) pTrees RP.<++ (RP.skipSpaces >> return [])
+
+pTree :: Bool -> RP.ReadP Tree
+pTree isNested = RP.skipSpaces >> (pParen RP.<++ pAbs RP.<++ pApp RP.<++ fmap Lit pLit RP.<++ pMeta)
+ where
+ pParen = RP.between (RP.char '(') (RP.char ')') (pTree False)
+ pAbs = do xs <- RP.between (RP.char '\\') (RP.skipSpaces >> RP.string "->") (RP.sepBy1 (RP.skipSpaces >> pCId) (RP.skipSpaces >> RP.char ','))
+ t <- pTree False
+ return (Abs xs t)
+ pApp = do f <- pCId
+ ts <- (if isNested then return [] else pTrees)
+ return (Fun f ts)
+ pMeta = do RP.char '?'
+ n <- fmap read (RP.munch1 isDigit)
+ return (Meta n)
+
+pExpr :: RP.ReadP Expr
+pExpr = RP.skipSpaces >> (pAbs RP.<++ pTerm RP.<++ pEqs)
+ where
+ pTerm = fmap (foldl1 EApp) (RP.sepBy1 pFactor RP.skipSpaces)
+
+ pFactor = fmap EVar pCId
+ RP.<++ fmap ELit pLit
+ RP.<++ pMeta
+ RP.<++ RP.between (RP.char '(') (RP.char ')') pExpr
+
+ pAbs = do xs <- RP.between (RP.char '\\') (RP.skipSpaces >> RP.string "->") (RP.sepBy1 (RP.skipSpaces >> pCId) (RP.skipSpaces >> RP.char ','))
+ e <- pExpr
+ return (foldr EAbs e xs)
+
+ pMeta = do RP.char '?'
+ n <- fmap read (RP.munch1 isDigit)
+ return (EMeta n)
+
+ pEqs = fmap EEq $
+ RP.between (RP.skipSpaces >> RP.char '{')
+ (RP.skipSpaces >> RP.char '}')
+ (RP.sepBy1 (RP.skipSpaces >> pEq)
+ (RP.skipSpaces >> RP.string ";"))
+
+ pEq = do pats <- (RP.sepBy1 pExpr RP.skipSpaces)
+ RP.skipSpaces >> RP.string "=>"
+ e <- pExpr
+ return (Equ pats e)
+
+pLit :: RP.ReadP Literal
+pLit = pNum RP.<++ liftM LStr pStr
+
+pNum = do x <- RP.munch1 isDigit
+ ((RP.char '.' >> RP.munch1 isDigit >>= \y -> return (LFlt (read (x++"."++y))))
+ RP.<++
+ (return (LInt (read x))))
+
+pStr = RP.char '"' >> (RP.manyTill (pEsc RP.<++ RP.get) (RP.char '"'))
+ where
+ pEsc = RP.char '\\' >> RP.get
+
+pCId = fmap mkCId pIdent
+
+pIdent = liftM2 (:) (RP.satisfy isIdentFirst) (RP.munch isIdentRest)
+ where
+ isIdentFirst c = c == '_' || isLetter c
+ isIdentRest c = c == '_' || c == '\'' || isAlphaNum c
+
+
+-----------------------------------------------------
+-- Printing
+-----------------------------------------------------
+
+ppTree d (Abs xs t) = ppParens (d > 0) (PP.char '\\' PP.<>
+ PP.hsep (PP.punctuate PP.comma (map (PP.text . prCId) xs)) PP.<+>
+ PP.text "->" PP.<+>
+ ppTree 0 t)
+ppTree d (Fun f []) = PP.text (prCId f)
+ppTree d (Fun f ts) = ppParens (d > 0) (PP.text (prCId f) PP.<+> PP.hsep (map (ppTree 1) ts))
+ppTree d (Lit l) = ppLit l
+ppTree d (Meta n) = PP.char '?' PP.<> PP.int n
+ppTree d (Var id) = PP.text (prCId id)
+
+
+ppExpr d (EAbs x e) = let (xs,e1) = getVars (EAbs x e)
+ in ppParens (d > 0) (PP.char '\\' PP.<>
+ PP.hsep (PP.punctuate PP.comma (map (PP.text . prCId) xs)) PP.<+>
+ PP.text "->" PP.<+>
+ ppExpr 0 e1)
+ where
+ getVars (EAbs x e) = let (xs,e1) = getVars e in (x:xs,e1)
+ getVars e = ([],e)
+ppExpr d (EApp e1 e2) = ppParens (d > 1) ((ppExpr 1 e1) PP.<+> (ppExpr 2 e2))
+ppExpr d (ELit l) = ppLit l
+ppExpr d (EMeta n) = PP.char '?' PP.<+> PP.int n
+ppExpr d (EVar f) = PP.text (prCId f)
+ppExpr d (EEq eqs) = PP.braces (PP.sep (PP.punctuate PP.semi (map ppEquation eqs)))
+
+ppEquation (Equ pats e) = PP.hsep (map (ppExpr 2) pats) PP.<+> PP.text "=>" PP.<+> ppExpr 0 e
+
+ppLit (LStr s) = PP.text (show s)
+ppLit (LInt n) = PP.integer n
+ppLit (LFlt d) = PP.double d
+
+ppParens True = PP.parens
+ppParens False = id
+
+
+-----------------------------------------------------
+-- Evaluation
+-----------------------------------------------------
+
+-- | Converts a tree to expression.
+tree2expr :: Tree -> Expr
+tree2expr (Fun x ts) = foldl EApp (EVar x) (map tree2expr ts)
+tree2expr (Lit l) = ELit l
+tree2expr (Meta n) = EMeta n
+tree2expr (Abs xs t) = foldr EAbs (tree2expr t) xs
+tree2expr (Var x) = EVar x
+
+-- | Converts an expression to tree. If the expression
+-- contains unevaluated applications they will be applied.
+expr2tree e = value2tree (eval Map.empty e) [] []
+ where
+ value2tree (VApp v1 v2) xs ts = value2tree v1 xs (value2tree v2 [] []:ts)
+ value2tree (VVar x) xs ts = ret xs (fun xs x ts)
+ value2tree (VMeta n) xs [] = ret xs (Meta n)
+ value2tree (VLit l) xs [] = ret xs (Lit l)
+ value2tree (VClosure env (EAbs x e)) xs [] = value2tree (eval (Map.insert x (VVar x) env) e) (x:xs) []
+
+ fun xs x ts
+ | x `elem` xs = Var x
+ | otherwise = Fun x ts
+
+ ret [] t = t
+ ret xs t = Abs (reverse xs) t
+
+data Value
+ = VGen Int
+ | VApp Value Value
+ | VVar CId
+ | VMeta Int
+ | VLit Literal
+ | VClosure Env Expr
+
+type Env = Map.Map CId Value
+
+eval :: Env -> Expr -> Value
+eval env (EVar x) = fromMaybe (VVar x) (Map.lookup x env)
+eval env (EApp e1 e2) = apply (eval env e1) (eval env e2)
+eval env (EAbs x e) = VClosure env (EAbs x e)
+eval env (EMeta k) = VMeta k
+eval env (ELit l) = VLit l
+
+apply :: Value -> Value -> Value
+apply (VClosure env (EAbs x e)) v = eval (Map.insert x v env) e
+apply v0 v = VApp v0 v
diff --git a/src-3.0/PGF/ExprSyntax.hs b/src-3.0/PGF/ExprSyntax.hs
deleted file mode 100644
index ee4be36ea..000000000
--- a/src-3.0/PGF/ExprSyntax.hs
+++ /dev/null
@@ -1,73 +0,0 @@
-module PGF.ExprSyntax(readExp, showExp,
- pExp,ppExp,
-
- -- helpers
- pIdent,pStr
- ) where
-
-import PGF.CId
-import PGF.Data
-
-import Data.Char
-import Control.Monad
-import qualified Text.PrettyPrint as PP
-import qualified Text.ParserCombinators.ReadP as RP
-
-
--- | parses 'String' as an expression
-readExp :: String -> Maybe Exp
-readExp s = case [x | (x,cs) <- RP.readP_to_S (pExp False) s, all isSpace cs] of
- [x] -> Just x
- _ -> Nothing
-
--- | renders expression as 'String'
-showExp :: Exp -> String
-showExp = PP.render . ppExp False
-
-pExps :: RP.ReadP [Exp]
-pExps = liftM2 (:) (pExp True) pExps RP.<++ (RP.skipSpaces >> return [])
-
-pExp :: Bool -> RP.ReadP Exp
-pExp isNested = RP.skipSpaces >> (pParen RP.<++ pAbs RP.<++ pApp RP.<++ pNum RP.<++
- liftM EStr pStr RP.<++ pMeta)
- where
- pParen = RP.between (RP.char '(') (RP.char ')') (pExp False)
- pAbs = do xs <- RP.between (RP.char '\\') (RP.skipSpaces >> RP.string "->") (RP.sepBy1 (RP.skipSpaces >> pCId) (RP.skipSpaces >> RP.char ','))
- t <- pExp False
- return (EAbs xs t)
- pApp = do f <- pCId
- ts <- (if isNested then return [] else pExps)
- return (EApp f ts)
- pMeta = do RP.char '?'
- x <- RP.munch1 isDigit
- return (EMeta (read x))
- pNum = do x <- RP.munch1 isDigit
- ((RP.char '.' >> RP.munch1 isDigit >>= \y -> return (EFloat (read (x++"."++y))))
- RP.<++
- (return (EInt (read x))))
-
-pStr = RP.char '"' >> (RP.manyTill (pEsc RP.<++ RP.get) (RP.char '"'))
- where
- pEsc = RP.char '\\' >> RP.get
-
-pCId = fmap mkCId pIdent
-
-pIdent = liftM2 (:) (RP.satisfy isIdentFirst) (RP.munch isIdentRest)
- where
- isIdentFirst c = c == '_' || isLetter c
- isIdentRest c = c == '_' || c == '\'' || isAlphaNum c
-
-ppExp isNested (EAbs xs t) = ppParens isNested (PP.char '\\' PP.<>
- PP.hsep (PP.punctuate PP.comma (map (PP.text . prCId) xs)) PP.<+>
- PP.text "->" PP.<+>
- ppExp False t)
-ppExp isNested (EApp f []) = PP.text (prCId f)
-ppExp isNested (EApp f ts) = ppParens isNested (PP.text (prCId f) PP.<+> PP.hsep (map (ppExp True) ts))
-ppExp isNested (EStr s) = PP.text (show s)
-ppExp isNested (EInt n) = PP.integer n
-ppExp isNested (EFloat d) = PP.double d
-ppExp isNested (EMeta n) = PP.char '?' PP.<> PP.int n
-ppExp isNested (EVar id) = PP.text (prCId id)
-
-ppParens True = PP.parens
-ppParens False = id
diff --git a/src-3.0/PGF/Generate.hs b/src-3.0/PGF/Generate.hs
index 4c369c6d0..64ca4d5f5 100644
--- a/src-3.0/PGF/Generate.hs
+++ b/src-3.0/PGF/Generate.hs
@@ -8,23 +8,23 @@ import qualified Data.Map as M
import System.Random
-- generate an infinite list of trees exhaustively
-generate :: PGF -> CId -> Maybe Int -> [Exp]
+generate :: PGF -> CId -> Maybe Int -> [Tree]
generate pgf cat dp = concatMap (\i -> gener i cat) depths
where
- gener 0 c = [EApp f [] | (f, ([],_)) <- fns c]
+ gener 0 c = [Fun f [] | (f, ([],_)) <- fns c]
gener i c = [
tr |
(f, (cs,_)) <- fns c,
let alts = map (gener (i-1)) cs,
ts <- combinations alts,
- let tr = EApp f ts,
+ let tr = Fun f ts,
depth tr >= i
]
fns c = [(f,catSkeleton ty) | (f,ty) <- functionsToCat pgf c]
depths = maybe [0 ..] (\d -> [0..d]) dp
-- generate an infinite list of trees randomly
-genRandom :: StdGen -> PGF -> CId -> [Exp]
+genRandom :: StdGen -> PGF -> CId -> [Tree]
genRandom gen pgf cat = genTrees (randomRs (0.0, 1.0 :: Double) gen) cat where
timeout = 47 -- give up
@@ -36,16 +36,16 @@ genRandom gen pgf cat = genTrees (randomRs (0.0, 1.0 :: Double) gen) cat where
(genTrees ds2 cat) -- else (drop k ds)
genTree rs = gett rs where
- gett ds cid | cid == mkCId "String" = (EStr "foo", 1)
- gett ds cid | cid == mkCId "Int" = (EInt 12345, 1)
- gett [] _ = (EStr "TIMEOUT", 1) ----
+ gett ds cid | cid == mkCId "String" = (Lit (LStr "foo"), 1)
+ gett ds cid | cid == mkCId "Int" = (Lit (LInt 12345), 1)
+ gett [] _ = (Lit (LStr "TIMEOUT"), 1) ----
gett ds cat = case fns cat of
- [] -> (EMeta 0,1)
+ [] -> (Meta 0,1)
fs -> let
d:ds2 = ds
(f,args) = getf d fs
(ts,k) = getts ds2 args
- in (EApp f ts, k+1)
+ in (Fun f ts, k+1)
getf d fs = let lg = (length fs) in
fs !! (floor (d * fromIntegral lg))
getts ds cats = case cats of
diff --git a/src-3.0/PGF/Linearize.hs b/src-3.0/PGF/Linearize.hs
index 2d23e8653..c3341698f 100644
--- a/src-3.0/PGF/Linearize.hs
+++ b/src-3.0/PGF/Linearize.hs
@@ -10,8 +10,8 @@ import Debug.Trace
-- linearization and computation of concrete PGF Terms
-linearize :: PGF -> CId -> Exp -> String
-linearize pgf lang = realize . linExp pgf lang
+linearize :: PGF -> CId -> Tree -> String
+linearize pgf lang = realize . linTree pgf lang
realize :: Term -> String
realize trm = case trm of
@@ -25,18 +25,18 @@ realize trm = case trm of
TM s -> s
_ -> "ERROR " ++ show trm ---- debug
-linExp :: PGF -> CId -> Exp -> Term
-linExp pgf lang = lin
+linTree :: PGF -> CId -> Tree -> Term
+linTree pgf lang = lin
where
- lin (EAbs xs e ) = case lin e of
- R ts -> R $ ts ++ (Data.List.map (kks . prCId) xs)
- TM s -> R $ (TM s) : (Data.List.map (kks . prCId) xs)
- lin (EApp fun es) = comp (map lin es) $ look fun
- lin (EStr s ) = R [kks (show s)] -- quoted
- lin (EInt i ) = R [kks (show i)]
- lin (EFloat d ) = R [kks (show d)]
- lin (EVar x ) = TM (prCId x)
- lin (EMeta i ) = TM (show i)
+ lin (Abs xs e ) = case lin e of
+ R ts -> R $ ts ++ (Data.List.map (kks . prCId) xs)
+ TM s -> R $ (TM s) : (Data.List.map (kks . prCId) xs)
+ lin (Fun fun es) = comp (map lin es) $ look fun
+ lin (Lit (LStr s)) = R [kks (show s)] -- quoted
+ lin (Lit (LInt i)) = R [kks (show i)]
+ lin (Lit (LFlt d)) = R [kks (show d)]
+ lin (Var x) = TM (prCId x)
+ lin (Meta i) = TM (show i)
comp = compute pgf lang
look = lookLin pgf lang
diff --git a/src-3.0/PGF/Macros.hs b/src-3.0/PGF/Macros.hs
index baa0fc355..a680cf0f9 100644
--- a/src-3.0/PGF/Macros.hs
+++ b/src-3.0/PGF/Macros.hs
@@ -87,10 +87,10 @@ restrictPGF cond pgf = pgf {
restrict = Map.filterWithKey (\c _ -> cond c)
abstr = abstract pgf
-depth :: Exp -> Int
-depth (EAbs _ t) = depth t
-depth (EApp _ ts) = maximum (0:map depth ts) + 1
-depth _ = 1
+depth :: Tree -> Int
+depth (Abs _ t) = depth t
+depth (Fun _ ts) = maximum (0:map depth ts) + 1
+depth _ = 1
cftype :: [CId] -> CId -> Type
cftype args val = DTyp [Hyp wildCId (cftype [] arg) | arg <- args] val []
@@ -111,7 +111,7 @@ contextLength :: Type -> Int
contextLength ty = case ty of
DTyp hyps _ _ -> length hyps
-primNotion :: Exp
+primNotion :: Expr
primNotion = EEq []
term0 :: CId -> Term
diff --git a/src-3.0/PGF/Parsing/FCFG.hs b/src-3.0/PGF/Parsing/FCFG.hs
index abf90c83f..4ca6a956a 100644
--- a/src-3.0/PGF/Parsing/FCFG.hs
+++ b/src-3.0/PGF/Parsing/FCFG.hs
@@ -29,11 +29,11 @@ import qualified Data.Map as Map
-- main parsing function
-parseFCFG :: String -- ^ parsing strategy
+parseFCFG :: String -- ^ parsing strategy
-> ParserInfo -- ^ compiled grammar (fcfg)
-> CId -- ^ starting category
-> [String] -- ^ input tokens
- -> Err [Exp] -- ^ resulting GF terms
+ -> Err [Tree] -- ^ resulting GF terms
parseFCFG "bottomup" pinfo start toks = return $ Active.parse "b" pinfo start toks
parseFCFG "topdown" pinfo start toks = return $ Active.parse "t" pinfo start toks
parseFCFG "incremental" pinfo start toks = return $ Incremental.parse pinfo start toks
diff --git a/src-3.0/PGF/Parsing/FCFG/Active.hs b/src-3.0/PGF/Parsing/FCFG/Active.hs
index 80cfccdee..4386bfdd1 100644
--- a/src-3.0/PGF/Parsing/FCFG/Active.hs
+++ b/src-3.0/PGF/Parsing/FCFG/Active.hs
@@ -32,8 +32,8 @@ makeFinalEdge cat 0 0 = (cat, [EmptyRange])
makeFinalEdge cat i j = (cat, [makeRange i j])
-- | the list of categories = possible starting categories
-parse :: String -> ParserInfo -> CId -> [FToken] -> [Exp]
-parse strategy pinfo start toks = nubsort $ filteredForests >>= forest2exps
+parse :: String -> ParserInfo -> CId -> [FToken] -> [Tree]
+parse strategy pinfo start toks = nubsort $ filteredForests >>= forest2trees
where
inTokens = input toks
starts = Map.findWithDefault [] start (startupCats pinfo)
diff --git a/src-3.0/PGF/Parsing/FCFG/Incremental.hs b/src-3.0/PGF/Parsing/FCFG/Incremental.hs
index 16a5e8875..fff5f0212 100644
--- a/src-3.0/PGF/Parsing/FCFG/Incremental.hs
+++ b/src-3.0/PGF/Parsing/FCFG/Incremental.hs
@@ -25,7 +25,7 @@ import PGF.Data
import PGF.Parsing.FCFG.Utilities
import Debug.Trace
-parse :: ParserInfo -> CId -> [FToken] -> [Exp]
+parse :: ParserInfo -> CId -> [FToken] -> [Tree]
parse pinfo start toks = extractExps (foldl' nextState (initState pinfo start) toks) start
initState :: ParserInfo -> CId -> ParseState
@@ -82,7 +82,7 @@ getCompletions (State pinfo chart items) w =
| isPrefixOf w tok = fromMaybe map (MM.insert' tok item map)
| otherwise = map
-extractExps :: ParseState -> CId -> [Exp]
+extractExps :: ParseState -> CId -> [Tree]
extractExps (State pinfo chart items) start = exps
where
(_,st) = process (\_ _ -> id) (allRules pinfo) (Set.toList items) ((),chart)
@@ -103,7 +103,7 @@ extractExps (State pinfo chart items) start = exps
if fn == wildCId
then go (Set.insert fid rec) (head args)
else do args <- mapM (go (Set.insert fid rec)) args
- return (EApp fn args)
+ return (Fun fn args)
process fn !rules [] acc_chart = acc_chart
process fn !rules (item:items) acc_chart = univRule item acc_chart
diff --git a/src-3.0/PGF/Parsing/FCFG/Utilities.hs b/src-3.0/PGF/Parsing/FCFG/Utilities.hs
index e435c6154..4187d0f24 100644
--- a/src-3.0/PGF/Parsing/FCFG/Utilities.hs
+++ b/src-3.0/PGF/Parsing/FCFG/Utilities.hs
@@ -179,9 +179,9 @@ applyProfileToForest (FFloat f) = [FFloat f]
applyProfileToForest (FMeta) = [FMeta]
-forest2exps :: SyntaxForest CId -> [Exp]
-forest2exps (FNode n forests) = map (EApp n) $ forests >>= mapM forest2exps
-forest2exps (FString s) = [EStr s]
-forest2exps (FInt n) = [EInt n]
-forest2exps (FFloat f) = [EFloat f]
-forest2exps (FMeta) = [EMeta 0]
+forest2trees :: SyntaxForest CId -> [Tree]
+forest2trees (FNode n forests) = map (Fun n) $ forests >>= mapM forest2trees
+forest2trees (FString s) = [Lit (LStr s)]
+forest2trees (FInt n) = [Lit (LInt n)]
+forest2trees (FFloat f) = [Lit (LFlt f)]
+forest2trees (FMeta) = [Meta 0]
diff --git a/src-3.0/PGF/Raw/Convert.hs b/src-3.0/PGF/Raw/Convert.hs
index a8398093b..af3708eb5 100644
--- a/src-3.0/PGF/Raw/Convert.hs
+++ b/src-3.0/PGF/Raw/Convert.hs
@@ -105,16 +105,16 @@ toHypo e = case e of
App x [typ] -> Hyp (mkCId x) (toType typ)
_ -> error $ "hypo " ++ show e
-toExp :: RExp -> Exp
+toExp :: RExp -> Expr
toExp e = case e of
- App "Abs" [App "B" xs, exp] -> EAbs [mkCId x | App x [] <- xs] (toExp exp)
- App "App" (App fun [] : exps) -> EApp (mkCId fun) (map toExp exps)
+ App "Abs" [App x [], exp] -> EAbs (mkCId x) (toExp exp)
+ App "App" [e1,e2] -> EApp (toExp e1) (toExp e2)
App "Eq" eqs -> EEq [Equ (map toExp ps) (toExp v) | App "E" (v:ps) <- eqs]
App "Var" [App i []] -> EVar (mkCId i)
AMet -> EMeta 0
- AInt i -> EInt i
- AFlt i -> EFloat i
- AStr i -> EStr i
+ AInt i -> ELit (LInt i)
+ AFlt i -> ELit (LFlt i)
+ AStr i -> ELit (LStr i)
_ -> error $ "exp " ++ show e
toTerm :: RExp -> Term
@@ -170,14 +170,14 @@ fromHypo :: Hypo -> RExp
fromHypo e = case e of
Hyp x typ -> App (prCId x) [fromType typ]
-fromExp :: Exp -> RExp
+fromExp :: Expr -> RExp
fromExp e = case e of
- EAbs xs exp -> App "Abs" [App "B" (map (flip App [] . prCId) xs), fromExp exp]
- EApp fun exps -> App "App" (App (prCId fun) [] : map fromExp exps)
+ EAbs x exp -> App "Abs" [App (prCId x) [], fromExp exp]
+ EApp e1 e2 -> App "App" [fromExp e1, fromExp e2]
EVar x -> App "Var" [App (prCId x) []]
- EStr s -> AStr s
- EFloat d -> AFlt d
- EInt i -> AInt (toInteger i)
+ ELit (LStr s) -> AStr s
+ ELit (LFlt d) -> AFlt d
+ ELit (LInt i) -> AInt (toInteger i)
EMeta _ -> AMet ----
EEq eqs ->
App "Eq" [App "E" (map fromExp (v:ps)) | Equ ps v <- eqs]
@@ -194,7 +194,7 @@ fromTerm e = case e of
F f -> App (prCId f) []
V i -> App "A" [AInt (toInteger i)]
K (KS s) -> AStr s ----
- K (KP d vs) -> App "FV" (str d : [str v | Var v _ <- vs]) ----
+ K (KP d vs) -> App "FV" (str d : [str v | Alt v _ <- vs]) ----
where
str v = App "S" (map AStr v)
diff --git a/src-3.0/PGF/ShowLinearize.hs b/src-3.0/PGF/ShowLinearize.hs
index 8c01c3ddd..ae1385d98 100644
--- a/src-3.0/PGF/ShowLinearize.hs
+++ b/src-3.0/PGF/ShowLinearize.hs
@@ -53,17 +53,17 @@ mkRecord typ trm = case (typ,trm) of
str = realize
-- show all branches, without labels and params
-allLinearize :: PGF -> CId -> Exp -> String
+allLinearize :: PGF -> CId -> Tree -> String
allLinearize pgf lang = concat . map pr . tabularLinearize pgf lang where
pr (p,vs) = unlines vs
-- show all branches, with labels and params
-tableLinearize :: PGF -> CId -> Exp -> String
+tableLinearize :: PGF -> CId -> Tree -> String
tableLinearize pgf lang = unlines . map pr . tabularLinearize pgf lang where
pr (p,vs) = p +++ ":" +++ unwords (intersperse "|" vs)
-- create a table from labels+params to variants
-tabularLinearize :: PGF -> CId -> Exp -> [(String,[String])]
+tabularLinearize :: PGF -> CId -> Tree -> [(String,[String])]
tabularLinearize pgf lang = branches . recLinearize pgf lang where
branches r = case r of
RR fs -> [(lab +++ b,s) | (lab,t) <- fs, (b,s) <- branches t]
@@ -73,18 +73,18 @@ tabularLinearize pgf lang = branches . recLinearize pgf lang where
RCon _ -> []
-- show record in GF-source-like syntax
-recordLinearize :: PGF -> CId -> Exp -> String
+recordLinearize :: PGF -> CId -> Tree -> String
recordLinearize pgf lang = prRecord . recLinearize pgf lang
-- create a GF-like record, forming the basis of all functions above
-recLinearize :: PGF -> CId -> Exp -> Record
-recLinearize pgf lang exp = mkRecord typ $ linExp pgf lang exp where
- typ = case exp of
- EApp f _ -> lookParamLincat pgf lang $ valCat $ lookType pgf f
+recLinearize :: PGF -> CId -> Tree -> Record
+recLinearize pgf lang tree = mkRecord typ $ linTree pgf lang tree where
+ typ = case tree of
+ Fun f _ -> lookParamLincat pgf lang $ valCat $ lookType pgf f
-- show PGF term
-termLinearize :: PGF -> CId -> Exp -> String
-termLinearize pgf lang = show . linExp pgf lang
+termLinearize :: PGF -> CId -> Tree -> String
+termLinearize pgf lang = show . linTree pgf lang
-- for Morphology: word, lemma, tags
@@ -94,7 +94,7 @@ collectWords pgf lang =
[(f,c,0) | (f,(DTyp [] c _,_)) <- Map.toList $ funs $ abstract pgf]
where
collOne (f,c,i) =
- fromRec f [prCId c] (recLinearize pgf lang (EApp f (replicate i (EMeta 888))))
+ fromRec f [prCId c] (recLinearize pgf lang (Fun f (replicate i (Meta 888))))
fromRec f v r = case r of
RR rs -> concat [fromRec f v t | (_,t) <- rs]
RT rs -> concat [fromRec f (p:v) t | (p,t) <- rs]