diff --git a/lib/prelude/Predef.gf b/lib/prelude/Predef.gf index 866ce5b6a..961e99eb3 100644 --- a/lib/prelude/Predef.gf +++ b/lib/prelude/Predef.gf @@ -22,6 +22,7 @@ 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 } ; diff --git a/lib/resource/abstract/Lang.gf b/lib/resource/abstract/Lang.gf index 06ec5c624..efebecea5 100644 --- a/lib/resource/abstract/Lang.gf +++ b/lib/resource/abstract/Lang.gf @@ -1,3 +1,5 @@ +--# -path=.:../../prelude + abstract Lang = Rules, Clause, diff --git a/lib/resource/abstract/Resource.gf b/lib/resource/abstract/Resource.gf index fd68f4393..60c4e7abd 100644 --- a/lib/resource/abstract/Resource.gf +++ b/lib/resource/abstract/Resource.gf @@ -1 +1 @@ -interface Resource = reuse AllResource ; \ No newline at end of file +abstract Resource = Rules, Clause, Structural ** {} ; diff --git a/lib/resource/danish/MorphoDan.gf b/lib/resource/danish/MorphoDan.gf index bc6c8884b..8338791bb 100644 --- a/lib/resource/danish/MorphoDan.gf +++ b/lib/resource/danish/MorphoDan.gf @@ -83,7 +83,10 @@ oper mkVoice : Voice -> Str -> Str = \v,s -> case v of { Act => s ; - Pass => s + "s" + Pass => s + case last s of { + "s" => "es" ; + _ => "s" + } } ; vHusk : Str -> Verbum = \husk -> diff --git a/lib/resource/doc/Makefile b/lib/resource/doc/Makefile index da5a7b33b..7caf2a716 100644 --- a/lib/resource/doc/Makefile +++ b/lib/resource/doc/Makefile @@ -1,4 +1,4 @@ -all: gfdoc htmls +all: gfdoc htmls gifs htmls: htmls gf-resource.html @@ -14,3 +14,18 @@ gfdoc: gfdoc ../swedish/ParadigmsSwe.gf ; mv ../swedish/ParadigmsSwe.html . gfdoc ../swedish/BasicSwe.gf ; mv ../swedish/BasicSwe.html . gfdoc ../english/ParadigmsEng.gf ; mv ../english/ParadigmsEng.html . + gfdoc ../english/VerbsEng.gf ; mv ../english/VerbsEng.html . + +gifs: lang scand low + +lang: + echo "pm -printer=graph | wf Lang.dot" | gf ../abstract/Lang.gf + dot -Tgif Lang.dot>Lang.gif + +low: + echo "pm -printer=graph | wf Low.dot" | gf ../english/RulesEng.gf + dot -Tgif Low.dot >Low.gif + +scand: + echo "pm -printer=graph | wf Scand.dot" | gf ../swedish/RulesSwe.gf + dot -Tgif Scand.dot >Scand.gif diff --git a/lib/resource/doc/gf-resource.html b/lib/resource/doc/gf-resource.html index d27e8aa83..41faf0a9e 100644 --- a/lib/resource/doc/gf-resource.html +++ b/lib/resource/doc/gf-resource.html @@ -36,6 +36,35 @@ All morphological paradigms Basic lexicon of structural, common, and irregular words + +

Success criteria

+ +Grammatical correctness + +

+ +Semantic coverage + +

+ +Usability as library for non-linguists + + + +

These are not success criteria

+ +Language coverage + +

+ +Semantic correctness +

+  colourless green ideas sleep furiously
+
+  the time is seventy past forty-two
+
+ +

Languages

@@ -110,6 +139,10 @@ Language-dependent resources

+English verbs + +

+ Swedish

@@ -119,19 +152,97 @@ Language-dependent resources -

Using it

+

Use as top-level grammar

+ +Random generation, translation, morphological analysis... + +

+ +Language learning: translation and morpho quiz + +

+ +Generate elementary text books from abstract syntax? + + + + +

Use as library

+ +Import directly by open: +
+  concrete AppNor of App = open LangNor, ParadigmsNor in {...}
+
+No more dummy reuse modules and bulky .gfr files! + +

+ +If you need to convert resource category records to/from strings, use +

+  Predef.toStr   : L -> Str ; 
+  Predef.fromStr : Str -> L ; 
+
+L must be a linearization type. + + + +

Use as library through parser

+ +Use the parser when developing a resource. +
+  > p -cat=S -v "jag ska åka till Chalmers"
+  unknown tokens [TS "åka",TS "Chalmers"]
+
+  > p -cat=S "jag ska gå till Danmark"
+  UseCl (PosTP TFuture ASimul)
+    (AdvCl (SPredV i_NP go_V)
+    (AdvPP (PrepNP to_Prep (UsePN (PNCountry Denmark)))))
+
+Extend vocabulary at need. +
+  åka_V = lexV "åker" ; 
+  Chalmers = regPN "Chalmers" neutrum ;
+
+ +

Implementatin details: the structure of low-level files

+
+ +
+

The use of parametric modules

+In two language families: + +
+ +
+

Current status

+ + + + + + + + + + + + +
Language v0.6 API Paradigms Basic lex Verbs
Danish X
English X X X X X
Finnish X
French X * * *
German X *
Italian X * * *
Norwegian X
Russian X * *
Spanish * *
Swedish X X X X *

Obtaining it

diff --git a/lib/resource/english/BasicEng.gf b/lib/resource/english/BasicEng.gf index 58571e161..a2885790b 100644 --- a/lib/resource/english/BasicEng.gf +++ b/lib/resource/english/BasicEng.gf @@ -218,7 +218,7 @@ lin add_V3 = dirV3 (regV "add") "to" ; number_N = regN "number" ; put_V2 = mkV2 (irregDuplV "put" "put" "put") [] ; - stop_V = regV "stop" ; + stop_V = regDuplV "stop" ; jump_V = regV "jump" ; here_Adv = mkAdv "here" ; here7to_Adv = mkAdv "here" ; diff --git a/lib/resource/english/CountryEng.gf b/lib/resource/english/CountryEng.gf index d427c701c..59a85a4e6 100644 --- a/lib/resource/english/CountryEng.gf +++ b/lib/resource/english/CountryEng.gf @@ -1,4 +1,4 @@ -concrete CountryEng of Country = open ResourceEng, ParadigmsEng in { +concrete CountryEng of Country = open CategoriesEng, ParadigmsEng in { lincat Country = PN ; diff --git a/lib/resource/english/LangEng.gf b/lib/resource/english/LangEng.gf index a8bf85d30..97dd73c73 100644 --- a/lib/resource/english/LangEng.gf +++ b/lib/resource/english/LangEng.gf @@ -8,7 +8,7 @@ concrete LangEng of Lang = TimeEng, CountryEng - ** open Prelude, ResourceEng, ParadigmsEng in { + ** open Prelude, ParadigmsEng in { lin AdvDate d = prefixSS "on" d ; diff --git a/lib/resource/english/ParadigmsEng.gf b/lib/resource/english/ParadigmsEng.gf index 5860c8c48..3b4c906ab 100644 --- a/lib/resource/english/ParadigmsEng.gf +++ b/lib/resource/english/ParadigmsEng.gf @@ -26,8 +26,8 @@ -- -- The following modules are presupposed: -resource ParadigmsEng = open (Predef=Predef), Prelude, SyntaxEng, ResourceEng in { - +resource ParadigmsEng = open (Predef=Predef), Prelude, SyntaxEng, ---- ResourceEng in { + CategoriesEng, RulesEng in { --2 Parameters -- -- To abstract over gender names, we define the following identifiers. diff --git a/lib/resource/english/TimeEng.gf b/lib/resource/english/TimeEng.gf index cb183efe0..b5759fda1 100644 --- a/lib/resource/english/TimeEng.gf +++ b/lib/resource/english/TimeEng.gf @@ -1,5 +1,5 @@ concrete TimeEng of Time = NumeralsEng ** - open Prelude, ResourceEng, ParadigmsEng in { + open Prelude, CategoriesEng, ParadigmsEng in { lincat Date = SS ; diff --git a/lib/resource/norwegian/MorphoNor.gf b/lib/resource/norwegian/MorphoNor.gf index 2d606b2c8..03f674860 100644 --- a/lib/resource/norwegian/MorphoNor.gf +++ b/lib/resource/norwegian/MorphoNor.gf @@ -91,7 +91,7 @@ oper mkVoice : Voice -> Str -> Str = \v,s -> case v of { Act => s ; Pass => s + case last s of { - "t" => "es" ; + "s" => "es" ; _ => "s" } } ; diff --git a/lib/resource/swedish/ResourceSwe.gf b/lib/resource/swedish/ResourceSwe.gf index 2c692c437..656e263e4 100644 --- a/lib/resource/swedish/ResourceSwe.gf +++ b/lib/resource/swedish/ResourceSwe.gf @@ -1,3 +1,4 @@ --# -path=.:../abstract:../../prelude -instance ResourceSwe of Resource = reuse AllResourceSwe ; +concrete ResourceSwe of Resource = RulesSwe, StructuralSwe, ClauseSwe ** {} ; + diff --git a/src/GF/Canon/Share.hs b/src/GF/Canon/Share.hs index ff9be59b2..a5a5f5349 100644 --- a/src/GF/Canon/Share.hs +++ b/src/GF/Canon/Share.hs @@ -18,6 +18,7 @@ import AbsGFC import Ident import GFC import qualified CMacros as C +import PrGrammar (prt) import Operations import List import qualified Modules as M @@ -39,15 +40,15 @@ shareModule opt (i,m) = case m of (i,M.ModMod (M.Module mt st fs me ops (mapTree (shareInfo opt) js))) _ -> (i,m) -shareInfo opt (c, CncCat ty t m) = (c, CncCat ty (shareOptim opt t) m) -shareInfo opt (c, CncFun k xs t m) = (c, CncFun k xs (shareOptim opt t) m) +shareInfo opt (c, CncCat ty t m) = (c, CncCat ty (shareOptim opt c t) m) +shareInfo opt (c, CncFun k xs t m) = (c, CncFun k xs (shareOptim opt c t) m) shareInfo _ i = i -- the function putting together optimizations -shareOptim :: OptSpec -> Term -> Term -shareOptim opt - | doOptFactor opt && doOptValues opt = values . factor 0 - | doOptFactor opt = share . factor 0 +shareOptim :: OptSpec -> Ident -> Term -> Term +shareOptim opt c + | doOptFactor opt && doOptValues opt = values . factor c 0 + | doOptFactor opt = share . factor c 0 | doOptValues opt = values | otherwise = share @@ -80,22 +81,22 @@ share t = case t of -- do even more: factor parametric branches -factor :: Int -> Term -> Term -factor i t = case t of +factor :: Ident -> Int -> Term -> Term +factor c i t = case t of T _ [_] -> t T _ [] -> t - T ty cs -> T ty $ factors i [Cas [p] (factor (i+1) v) | Cas ps v <- cs, p <- ps] - R lts -> R [Ass l (factor i t) | Ass l t <- lts] - P t l -> P (factor i t) l - S t a -> S (factor i t) (factor i a) - C t a -> C (factor i t) (factor i a) - FV ts -> FV (map (factor i) ts) + T ty cs -> T ty $ factors i [Cas [p] (factor c (i+1) v) | Cas ps v <- cs, p <- ps] + R lts -> R [Ass l (factor c i t) | Ass l t <- lts] + P t l -> P (factor c i t) l + S t a -> S (factor c i t) (factor c i a) + C t a -> C (factor c i t) (factor c i a) + FV ts -> FV (map (factor c i) ts) _ -> t where factors i psvs = -- we know psvs has at least 2 elements - let p = pIdent i + let p = pIdent c i vs' = map (mkFun p) psvs in if allEqs vs' then mkCase p vs' @@ -107,7 +108,7 @@ factor i t = case t of mkCase p (v:_) = [Cas [PV p] v] -pIdent i = identC ("p__" ++ show i) +pIdent c i = identC ("p_" ++ prt c ++ "__" ++ show i) -- we need to replace subterms diff --git a/src/GF/Compile/BackOpt.hs b/src/GF/Compile/BackOpt.hs index 9d2e62796..d68b72635 100644 --- a/src/GF/Compile/BackOpt.hs +++ b/src/GF/Compile/BackOpt.hs @@ -17,6 +17,7 @@ module BackOpt (shareModule, OptSpec, shareOpt, paramOpt, valOpt, allOpt) where import Grammar import Ident import qualified Macros as C +import PrGrammar (prt) import Operations import List import qualified Modules as M @@ -38,16 +39,16 @@ shareModule opt (i,m) = case m of (i,M.ModMod (M.Module mt st fs me ops (mapTree (shareInfo opt) js))) _ -> (i,m) -shareInfo opt (c, CncCat ty (Yes t) m) = (c, CncCat ty (Yes (shareOptim opt t)) m) -shareInfo opt (c, CncFun kxs (Yes t) m) = (c, CncFun kxs (Yes (shareOptim opt t)) m) -shareInfo opt (c, ResOper ty (Yes t)) = (c, ResOper ty (Yes (shareOptim opt t))) +shareInfo opt (c, CncCat ty (Yes t) m) = (c,CncCat ty (Yes (shareOptim opt c t)) m) +shareInfo opt (c, CncFun kxs (Yes t) m) = (c,CncFun kxs (Yes (shareOptim opt c t)) m) +shareInfo opt (c, ResOper ty (Yes t)) = (c,ResOper ty (Yes (shareOptim opt c t))) shareInfo _ i = i -- the function putting together optimizations -shareOptim :: OptSpec -> Term -> Term -shareOptim opt - | doOptFactor opt && doOptValues opt = values . factor 0 - | doOptFactor opt = share . factor 0 +shareOptim :: OptSpec -> Ident -> Term -> Term +shareOptim opt c + | doOptFactor opt && doOptValues opt = values . factor c 0 + | doOptFactor opt = share . factor c 0 | doOptValues opt = values | otherwise = share @@ -73,17 +74,17 @@ share t = case t of -- do even more: factor parametric branches -factor :: Int -> Term -> Term -factor i t = case t of +factor :: Ident -> Int -> Term -> Term +factor c i t = case t of T _ [_] -> t T _ [] -> t T (TComp ty) cs -> - T (TTyped ty) $ factors i [(p, factor (i+1) v) | (p, v) <- cs] - _ -> C.composSafeOp (factor i) t + T (TTyped ty) $ factors i [(p, factor c (i+1) v) | (p, v) <- cs] + _ -> C.composSafeOp (factor c i) t where factors i psvs = -- we know psvs has at least 2 elements - let p = qqIdent i + let p = qqIdent c i vs' = map (mkFun p) psvs in if allEqs vs' then mkCase p vs' @@ -97,7 +98,7 @@ factor i t = case t of --- we hope this will be fresh and don't check... in GFC would be safe -qqIdent i = identC ("q4q__" ++ show i) +qqIdent c i = identC ("q_" ++ prt c ++ "__" ++ show i) -- we need to replace subterms diff --git a/src/GF/Compile/MkResource.hs b/src/GF/Compile/MkResource.hs index 1c0bdb21c..84c58fc0b 100644 --- a/src/GF/Compile/MkResource.hs +++ b/src/GF/Compile/MkResource.hs @@ -18,6 +18,7 @@ import Grammar import Ident import Modules import Macros +import Lockfield import PrGrammar import Operations @@ -118,19 +119,6 @@ mkResDefs hasT isC gr r a mext maext abs cnc = mapMTree (mkOne a maext) abs wher Q n c | n == a || [n] == mae -> return $ Q r c ---- FIX for non-singleton exts _ -> composOp (redirTyp always a mae) ty -lockRecType :: Ident -> Type -> Err Type -lockRecType c t = plusRecType t $ RecType [(lockLabel c, RecType [])] - -unlockRecord :: Ident -> Term -> Err Term -unlockRecord c ft = do - let (xs,t) = termFormCnc ft - t' <- plusRecord t $ R [(lockLabel c, (Just (RecType []),R []))] - return $ mkAbs xs t' - -lockLabel :: Ident -> Label -lockLabel c = LIdent $ "lock_" ++ prt c ---- - - -- no reuse for functions of HO/dep types isHardType t = case t of diff --git a/src/GF/Compile/ModDeps.hs b/src/GF/Compile/ModDeps.hs index 10f2e012e..7e65239e4 100644 --- a/src/GF/Compile/ModDeps.hs +++ b/src/GF/Compile/ModDeps.hs @@ -9,7 +9,7 @@ -- > CVS $Author $ -- > CVS $Revision $ -- --- (Description of the module) +-- Check correctness of module dependencies. Incomplete. ----------------------------------------------------------------------------- module ModDeps where @@ -81,8 +81,8 @@ moduleDeps ms = mapM deps ms where chDep it es ety os oty = do ests <- mapM (lookupModuleType gr) es testErr (all (compatMType ety) ests) "inappropriate extension module type" - osts <- mapM (lookupModuleType gr . openedModule) os - testErr (all (compatOType oty) osts) "inappropriate open module type" +---- osts <- mapM (lookupModuleType gr . openedModule) os +---- testErr (all (compatOType oty) osts) "inappropriate open module type" let ab = case it of IdentM _ (MTConcrete a) -> [IdentM a MTAbstract] _ -> [] ---- diff --git a/src/GF/Grammar/AppPredefined.hs b/src/GF/Grammar/AppPredefined.hs index 17358f1f3..e640feaf2 100644 --- a/src/GF/Grammar/AppPredefined.hs +++ b/src/GF/Grammar/AppPredefined.hs @@ -9,7 +9,7 @@ -- > CVS $Author $ -- > CVS $Revision $ -- --- (Description of the module) +-- Predefined function type signatures and definitions. ----------------------------------------------------------------------------- module AppPredefined where @@ -18,7 +18,7 @@ import Operations import Grammar import Ident import Macros -import PrGrammar (prt,prtBad) +import PrGrammar (prt,prt_,prtBad) ---- import PGrammar (pTrm) -- predefined function type signatures and definitions. AR 12/3/2003. @@ -42,7 +42,10 @@ typPredefined c@(IC f) = case f of "occur" -> return $ mkFunType [typeTok,typeTok] (cnPredef "PBool") "plus" -> return $ mkFunType [cnPredef "Int",cnPredef "Int"] (cnPredef "Int") ---- "read" -> (P : Type) -> Tok -> P ----- "show" -> (P : Type) -> P -> Tok + "show" -> return $ mkProd -- (P : PType) -> P -> Tok + ([(zIdent "P",typePType),(wildIdent,Vr (zIdent "P"))],typeStr,[]) + "toStr" -> return $ mkProd -- (L : Type) -> L -> Str + ([(zIdent "L",typeType),(wildIdent,Vr (zIdent "L"))],typeStr,[]) "take" -> return $ mkFunType [cnPredef "Int",typeTok] typeTok "tk" -> return $ mkFunType [cnPredef "Int",typeTok] typeTok _ -> prtBad "unknown in Predef:" c @@ -69,8 +72,10 @@ appPredefined t = case t of ("eqInt",EInt i, EInt j) -> if i==j then predefTrue else predefFalse ("lessInt",EInt i, EInt j) -> if i EInt $ i+j - ("show", _, t) -> K $ prt t + ("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 + _ -> t _ -> t _ -> t @@ -97,3 +102,14 @@ substring s t = case (s,t) of ([],_) -> True _ -> False +trm2str :: Term -> Term +trm2str t = case t of + 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 + diff --git a/src/GF/Grammar/Lockfield.hs b/src/GF/Grammar/Lockfield.hs new file mode 100644 index 000000000..fb9043b00 --- /dev/null +++ b/src/GF/Grammar/Lockfield.hs @@ -0,0 +1,37 @@ +---------------------------------------------------------------------- +-- | +-- Module : (Module) +-- Maintainer : (Maintainer) +-- Stability : (stable) +-- Portability : (portable) +-- +-- > CVS $Date $ +-- > CVS $Author $ +-- > CVS $Revision $ +-- +-- Creating and using lock fields in reused resource grammars. +----------------------------------------------------------------------------- + +module Lockfield where + +import Grammar +import Ident +import Macros +import PrGrammar + +import Operations + +-- AR 8/2/2005 detached from compile/MkResource + +lockRecType :: Ident -> Type -> Err Type +lockRecType c t = plusRecType t $ RecType [(lockLabel c, RecType [])] + +unlockRecord :: Ident -> Term -> Err Term +unlockRecord c ft = do + let (xs,t) = termFormCnc ft + t' <- plusRecord t $ R [(lockLabel c, (Just (RecType []),R []))] + return $ mkAbs xs t' + +lockLabel :: Ident -> Label +lockLabel c = LIdent $ "lock_" ++ prt c ---- + diff --git a/src/GF/Grammar/Lookup.hs b/src/GF/Grammar/Lookup.hs index 1cfb63be6..06672cb72 100644 --- a/src/GF/Grammar/Lookup.hs +++ b/src/GF/Grammar/Lookup.hs @@ -17,6 +17,7 @@ module Lookup where import Operations import Abstract import Modules +import Lockfield import List (nub) import Monad @@ -34,6 +35,11 @@ lookupResDef gr = look True where ResOper _ (Yes t) -> return $ qualifAnnot m t ResOper _ Nope -> return (Q m c) ---- if isTop then lookExt m c ---- else prtBad "cannot find in exts" c + + CncCat (Yes ty) _ _ -> lockRecType c $ ty + CncCat _ _ _ -> lockRecType c $ defLinType + CncFun _ (Yes tr) _ -> unlockRecord c tr + AnyInd _ n -> look False n c ResParam _ -> return $ QC m c ResValue _ -> return $ QC m c @@ -51,6 +57,11 @@ lookupResType gr m c = do case info of ResOper (Yes t) _ -> return $ qualifAnnot m t ResOper (May n) _ -> lookupResType gr n c + + -- used in reused concrete + CncCat _ _ _ -> return typeType + CncFun (Just (_,(cont,val))) _ _ -> return $ mkProd (cont, val, []) + AnyInd _ n -> lookupResType gr n c ResParam _ -> return $ typePType ResValue (Yes t) -> return $ qualifAnnotPar m t diff --git a/src/GF/UseGrammar/Custom.hs b/src/GF/UseGrammar/Custom.hs index 4ec37d1ae..12b9b2ca9 100644 --- a/src/GF/UseGrammar/Custom.hs +++ b/src/GF/UseGrammar/Custom.hs @@ -75,6 +75,7 @@ import MoreCustom -- either small/ or big/. The one in Small is empty. import UseIO import Monad +import Char -- character codings import Unicode @@ -365,6 +366,7 @@ customUntokenizer = (strCI "unwords", const $ id) -- DEFAULT ,(strCI "text", const $ formatAsText) ,(strCI "code", const $ formatAsCode) + ,(strCI "concat", const $ filter (not . isSpace)) ,(strCI "textlit", const $ formatAsTextLit) ,(strCI "codelit", const $ formatAsCodeLit) ,(strCI "concat", const $ concatRemSpace) diff --git a/src/GF/UseGrammar/Randomized.hs b/src/GF/UseGrammar/Randomized.hs index 200e69104..d2e26a18b 100644 --- a/src/GF/UseGrammar/Randomized.hs +++ b/src/GF/UseGrammar/Randomized.hs @@ -45,7 +45,7 @@ mkTreeFromInts ints gr catfun = do return $ loc2tree state mkStateFromInts :: [Int] -> CGrammar -> Action -mkStateFromInts ints gr = mkRandomState ints where +mkStateFromInts ints gr z = mkRandomState ints z >>= reCheckState gr where mkRandomState [] state = do testErr (isCompleteState state) "not completed" return state