diff options
| author | bringert <bringert@cs.chalmers.se> | 2006-01-20 18:18:49 +0000 |
|---|---|---|
| committer | bringert <bringert@cs.chalmers.se> | 2006-01-20 18:18:49 +0000 |
| commit | 0f6c51f741668adc68491c79ca94cc4b98f5d154 (patch) | |
| tree | e106896163bee3eeffa2192201b4affea075ef7f /src/GF | |
| parent | c9ed0c42187502cfa066ae48fb55c9e6a9476428 (diff) | |
Report errors in at command.
Diffstat (limited to 'src/GF')
| -rw-r--r-- | src/GF/API.hs | 13 | ||||
| -rw-r--r-- | src/GF/Shell.hs | 10 |
2 files changed, 12 insertions, 11 deletions
diff --git a/src/GF/API.hs b/src/GF/API.hs index 906bd062f..9ad5c7a3f 100644 --- a/src/GF/API.hs +++ b/src/GF/API.hs @@ -372,17 +372,18 @@ wrapByFun opts gr f t = g = grammar gr applyTransfer :: Options -> GFGrammar -> [(Ident,T.Env)] -> - (Maybe Ident,Ident) -> Tree -> Tree -applyTransfer opts gr trs (mm,f) t = - err (const t) id $ annotate g t' + (Maybe Ident,Ident) -> Tree -> Err [Tree] +applyTransfer opts gr trs (mm,f) t = mapM (annotate g) ts' where - t' = qualifTerm (absId gr) $ trans tr f $ tree2exp t + ts' = map (qualifTerm (absId gr)) $ trans tr f $ tree2exp t g = grammar gr tr = case mm of Just m -> maybe empty id $ lookup m trs _ -> ifNull empty (snd . head) trs - - trans tr f = core2exp . T.evaluateExp tr . exp2core f + -- FIXME: if the returned value is a list, + -- return a list of trees + trans :: T.Env -> Ident -> Exp -> [Exp] + trans tr f = (:[]) . core2exp . T.evaluateExp tr . exp2core f empty = T.builtin {- diff --git a/src/GF/Shell.hs b/src/GF/Shell.hs index 417f01215..36dfc5b14 100644 --- a/src/GF/Shell.hs +++ b/src/GF/Shell.hs @@ -298,10 +298,10 @@ execC co@(comm, opts0) sa@(sh@(st,(h,_,_,_)),a) = checkOptions st co >> case com g3 = return () ---- system "rm -f grphtmp.*" justOutput opts (g0 >> g1 >> g2 >> g3 >> return ()) sa - CPutTerm -> changeArg (opTT2CommandArg (optTermCommand opts gro) . s2t) sa + CPutTerm -> changeArg (opTT2CommandArg (return . optTermCommand opts gro) . s2t) sa - CWrapTerm f -> changeArg (opTT2CommandArg (return . wrapByFun opts gro f) . s2t) sa - CApplyTransfer f -> changeArg (opTT2CommandArg (return . applyTransfer opts gro transfs f) . s2t) sa + CWrapTerm f -> changeArg (opTT2CommandArg (return . return . wrapByFun opts gro f) . s2t) sa + CApplyTransfer f -> changeArg (opTT2CommandArg (applyTransfer opts gro transfs f) . s2t) sa CMorphoAnalyse -> changeArg (AString . morphoAnalyse opts gro . prCommandArg) sa CTestTokenizer -> changeArg (AString . optTokenizer opts gro . prCommandArg) sa @@ -498,7 +498,7 @@ opTS2CommandArg f (ATrms ts) = AString $ unlines $ map f ts opTS2CommandArg _ (AError s) = AError ("expected term, but got error:" ++++ s) opTS2CommandArg _ a = AError ("expected term, but got:" ++++ prCommandArg a) -opTT2CommandArg :: (Tree -> [Tree]) -> CommandArg -> CommandArg -opTT2CommandArg f (ATrms ts) = ATrms $ concat $ map f ts +opTT2CommandArg :: (Tree -> Err [Tree]) -> CommandArg -> CommandArg +opTT2CommandArg f (ATrms ts) = err AError (ATrms . concat) $ mapM f ts opTT2CommandArg _ (AError s) = AError ("expected term, but got error:" ++++ s) opTT2CommandArg _ a = AError ("expected term, but got:" ++++ prCommandArg a) |