diff options
| author | krasimir <krasimir@chalmers.se> | 2008-06-19 12:48:29 +0000 |
|---|---|---|
| committer | krasimir <krasimir@chalmers.se> | 2008-06-19 12:48:29 +0000 |
| commit | 4dd62417dc64609e0c37633fbbba52e82c221b2e (patch) | |
| tree | ba6404c44f7f681c40a7dea5521243f0ede9c752 /src-3.0/GF | |
| parent | 944eea8de9e077d1b3ee1a9edad9c52e9dbc2bd0 (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.hs | 2 | ||||
| -rw-r--r-- | src-3.0/GF/Command/Commands.hs | 26 | ||||
| -rw-r--r-- | src-3.0/GF/Command/Interpreter.hs | 24 | ||||
| -rw-r--r-- | src-3.0/GF/Command/Parse.hs | 6 | ||||
| -rw-r--r-- | src-3.0/GF/Compile/GFCCtoJS.hs | 2 | ||||
| -rw-r--r-- | src-3.0/GF/Compile/GenerateFCFG.hs | 6 | ||||
| -rw-r--r-- | src-3.0/GF/Compile/GeneratePMCFG.hs | 6 | ||||
| -rw-r--r-- | src-3.0/GF/Compile/GrammarToGFCC.hs | 23 |
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 |
