From af50c703a6f3add1877d67d59f5334cb21b6e7dd Mon Sep 17 00:00:00 2001 From: aarne Date: Fri, 1 Apr 2005 20:24:24 +0000 Subject: [PATCH] mapStr ; appPredefined in err monad --- lib/prelude/Predef.gf | 4 +- lib/resource/english/RulesEng.gf | 2 +- src/GF/Grammar/AppPredefined.hs | 99 +++++++++++++++++++++----------- src/GF/Grammar/Compute.hs | 10 ++-- src/GF/Shell/ShellCommands.hs | 7 ++- src/HelpFile | 1 + 6 files changed, 81 insertions(+), 42 deletions(-) diff --git a/lib/prelude/Predef.gf b/lib/prelude/Predef.gf index 961e99eb3..0b93b7f57 100644 --- a/lib/prelude/Predef.gf +++ b/lib/prelude/Predef.gf @@ -22,7 +22,9 @@ resource Predef = { oper occur : Tok -> Tok -> PBool = variants {} ; -- test if occurs as substring oper show : (P : Type) -> P -> Tok = variants {} ; -- convert param to string oper read : (P : Type) -> Tok -> P = variants {} ; -- convert string to param - oper toStr : (P : Type) -> P -> Str = variants {} ; -- find the "first" string + oper toStr : (L : Type) -> L -> Str = variants {} ; -- find the "first" string + oper mapStr : (L : Type) -> (Str -> Str) -> L -> L = variants {} ; + -- map all strings in a data structure } ; diff --git a/lib/resource/english/RulesEng.gf b/lib/resource/english/RulesEng.gf index fe934e7b9..27ecc4881 100644 --- a/lib/resource/english/RulesEng.gf +++ b/lib/resource/english/RulesEng.gf @@ -29,7 +29,7 @@ flags optimize=all ; lin - UseN = noun2CommNounPhrase ; + UseN = noun2CommNounPhrase ; UsePN = nameNounPhrase ; SymbPN i = {s = table {Nom => i.s ; Gen => i.s ++ "'s"} ; g = Neutr} ; --- diff --git a/src/GF/Grammar/AppPredefined.hs b/src/GF/Grammar/AppPredefined.hs index 6b0e57a56..ece6f730e 100644 --- a/src/GF/Grammar/AppPredefined.hs +++ b/src/GF/Grammar/AppPredefined.hs @@ -5,9 +5,9 @@ -- Stability : (stable) -- Portability : (portable) -- --- > CVS $Date: 2005/02/18 19:21:12 $ --- > CVS $Author: peb $ --- > CVS $Revision: 1.9 $ +-- > CVS $Date: 2005/04/01 21:24:24 $ +-- > CVS $Author: aarne $ +-- > CVS $Revision: 1.10 $ -- -- Predefined function type signatures and definitions. ----------------------------------------------------------------------------- @@ -47,39 +47,59 @@ typPredefined c@(IC f) = case f of ([(zIdent "P",typePType),(wildIdent,Vr (zIdent "P"))],typeStr,[]) "toStr" -> return $ mkProd -- (L : Type) -> L -> Str ([(zIdent "L",typeType),(wildIdent,Vr (zIdent "L"))],typeStr,[]) + "mapStr" -> + let ty = zIdent "L" in + return $ mkProd -- (L : Type) -> (Str -> Str) -> L -> L + ([(ty,typeType),(wildIdent,mkFunType [typeStr] typeStr),(wildIdent,Vr ty)],Vr ty,[]) "take" -> return $ mkFunType [cnPredef "Int",typeTok] typeTok "tk" -> return $ mkFunType [cnPredef "Int",typeTok] typeTok _ -> prtBad "unknown in Predef:" c typPredefined c = prtBad "unknown in Predef:" c -appPredefined :: Term -> Term +appPredefined :: Term -> Err (Term,Bool) appPredefined t = case t of - App f x -> case f of - + App f x0 -> do + (x,_) <- appPredefined x0 + case f of -- one-place functions - Q (IC "Predef") (IC f) -> case (f, appPredefined x) of - ("length", K s) -> EInt $ length s - _ -> t + Q (IC "Predef") (IC f) -> case (f, x) of + ("length", K s) -> retb $ EInt $ length s + _ -> retb t ---- prtBad "cannot compute predefined" t -- two-place functions - App (Q (IC "Predef") (IC f)) z -> case (f, appPredefined z, appPredefined x) of - ("drop", EInt i, K s) -> K (drop i s) - ("take", EInt i, K s) -> K (take i s) - ("tk", EInt i, K s) -> K (take (max 0 (length s - i)) s) - ("dp", EInt i, K s) -> K (drop (max 0 (length s - i)) s) - ("eqStr",K s, K t) -> if s == t then predefTrue else predefFalse - ("occur",K s, K t) -> if substring s t then predefTrue else predefFalse - ("eqInt",EInt i, EInt j) -> if i==j then predefTrue else predefFalse - ("lessInt",EInt i, EInt j) -> if i EInt $ i+j - ("show", _, t) -> foldr C Empty $ map K $ words $ prt t - ("read", _, K s) -> str2tag s --- because of K, only works for atomic tags - ("toStr", _, t) -> trm2str t + App (Q (IC "Predef") (IC f)) z0 -> do + (z,_) <- appPredefined z0 + case (f, z, x) of + ("drop", EInt i, K s) -> retb $ K (drop i s) + ("take", EInt i, K s) -> retb $ K (take i s) + ("tk", EInt i, K s) -> retb $ K (take (max 0 (length s - i)) s) + ("dp", EInt i, K s) -> retb $ K (drop (max 0 (length s - i)) s) + ("eqStr",K s, K t) -> retb $ if s == t then predefTrue else predefFalse + ("occur",K s, K t) -> retb $ if substring s t then predefTrue else predefFalse + ("eqInt",EInt i, EInt j) -> retb $ if i==j then predefTrue else predefFalse + ("lessInt",EInt i, EInt j) -> retb $ if i retb $ EInt $ i+j + ("show", _, t) -> retb $ foldr C Empty $ map K $ words $ prt t + ("read", _, K s) -> retb $ str2tag s --- because of K, only works for atomic tags + ("toStr", _, t) -> trm2str t >>= retb - _ -> t - _ -> t - _ -> t + _ -> retb t ---- prtBad "cannot compute predefined" t + + -- three-place functions + App (App (Q (IC "Predef") (IC f)) z0) y0 -> do + (y,_) <- appPredefined y0 + (z,_) <- appPredefined z0 + case (f, z, y, x) of + ("mapStr",ty,op,t) -> retf $ mapStr ty op t + _ -> retb t ---- prtBad "cannot compute predefined" t + + _ -> retb t ---- prtBad "cannot compute predefined" t + _ -> retb t + ---- should really check the absence of arg variables + where + retb t = return (t,True) -- no further computing needed + retf t = return (t,False) -- must be computed further -- read makes variables into constants @@ -103,14 +123,27 @@ substring s t = case (s,t) of ([],_) -> True _ -> False -trm2str :: Term -> Term +trm2str :: Term -> Err Term trm2str t = case t of - R ((_,(_,s)):_) -> trm2str s - T _ ((_,s):_) -> trm2str s + R ((_,(_,s)):_) -> trm2str s + T _ ((_,s):_) -> trm2str s TSh _ ((_,s):_) -> trm2str s - V _ (s:_) -> trm2str s - C _ _ -> t - K _ -> t - Empty -> t - _ -> K $ "ERROR_toStr_" ++ prt_ t --- eliminated by type checker + V _ (s:_) -> trm2str s + C _ _ -> return $ t + K _ -> return $ t + Empty -> return $ t + _ -> prtBad "cannot get Str from term" t +-- simultaneous recursion on type and term: type arg is essential! +-- But simplify the task by assuming records are type-annotated +-- (this has been done in type checking) +mapStr :: Type -> Term -> Term -> Term +mapStr ty f t = case (ty,t) of + _ | elem ty [typeStr,typeTok] -> App f t + (_, R ts) -> R [(l,mapField v) | (l,v) <- ts] + (Table a b,T ti cs) -> T ti [(p,mapStr b f v) | (p,v) <- cs] + _ -> t + where + mapField (mty,te) = case mty of + Just ty -> (mty,mapStr ty f te) + _ -> (mty,te) diff --git a/src/GF/Grammar/Compute.hs b/src/GF/Grammar/Compute.hs index 8f1920b72..5e384b141 100644 --- a/src/GF/Grammar/Compute.hs +++ b/src/GF/Grammar/Compute.hs @@ -5,9 +5,9 @@ -- Stability : (stable) -- Portability : (portable) -- --- > CVS $Date: 2005/02/18 19:21:12 $ --- > CVS $Author: peb $ --- > CVS $Revision: 1.13 $ +-- > CVS $Date: 2005/04/01 21:24:24 $ +-- > CVS $Author: aarne $ +-- > CVS $Revision: 1.14 $ -- -- Computation of source terms. Used in compilation and in @cc@ command. ----------------------------------------------------------------------------- @@ -81,7 +81,9 @@ computeTerm gr = comp where (S (T i cs) e,_) -> prawitz g i (flip App a') cs e - _ -> returnC $ appPredefined $ App f' a' + _ -> do + (t',b) <- appPredefined (App f' a') + if b then return t' else comp g t' P t l | isLockLabel l -> return $ R [] ---- a workaround 18/2/2005: take this away and find the reason diff --git a/src/GF/Shell/ShellCommands.hs b/src/GF/Shell/ShellCommands.hs index 06cfbf57a..a46d943c4 100644 --- a/src/GF/Shell/ShellCommands.hs +++ b/src/GF/Shell/ShellCommands.hs @@ -5,9 +5,9 @@ -- Stability : (stable) -- Portability : (portable) -- --- > CVS $Date: 2005/03/18 10:17:10 $ --- > CVS $Author: peb $ --- > CVS $Revision: 1.26 $ +-- > CVS $Date: 2005/04/01 21:24:25 $ +-- > CVS $Author: aarne $ +-- > CVS $Revision: 1.27 $ -- -- The datatype of shell commands and the list of their options. ----------------------------------------------------------------------------- @@ -132,6 +132,7 @@ testValidFlag st co f x = case f of "filter" -> testInc customStringCommand "length" -> testN "optimize"-> testIn $ words "parametrize values all share none" + "conversion" -> testIn $ words "strict nondet" _ -> return () where testInc ci = diff --git a/src/HelpFile b/src/HelpFile index 22e697da6..ead186001 100644 --- a/src/HelpFile +++ b/src/HelpFile @@ -38,6 +38,7 @@ i, import: i File -res set the name used for resource (with -old option) -path use the (colon-separated) search path to find modules -optimize select an optimization to override file-defined flags + -conversion select parsing method (values strict|nondet) examples: i English.gf -- ordinary import of Concrete i -retain german/ParadigmsGer.gf -- import of Resource to test