summaryrefslogtreecommitdiff
path: root/src-3.0/GF
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 /src-3.0/GF
parent944eea8de9e077d1b3ee1a9edad9c52e9dbc2bd0 (diff)
split the Exp type to Tree and Expr
Diffstat (limited to 'src-3.0/GF')
-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
8 files changed, 47 insertions, 48 deletions
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