changed names of resource-1.3; added a note on homepage on release

old-examples/big/BigEnglish.gf

@@ -0,0 +1,8 @@
+--# -path=.:alltenses:prelude
+
+concrete BigEnglish of BigEnglishAbs = 
+  GrammarEng,
+---  IrregEng,
+  ExtraEng,
+  BigLexEng
+  ** {} ;

old-examples/big/BigEnglishAbs.gf

@@ -0,0 +1,8 @@
+--# -path=.:alltenses:prelude
+
+abstract BigEnglishAbs = 
+  Grammar,
+---  IrregEngAbs,
+  ExtraEngAbs,
+  BigLexEngAbs
+  ** {} ;

old-examples/big/BigSwedish.gf

@@ -0,0 +1,7 @@
+--# -path=.:alltenses:prelude
+
+concrete BigSwedish of BigSwedishAbs = 
+  GrammarSwe,
+  ExtraSwe,
+  BigLexSwe
+  ** {} ;

old-examples/big/BigSwedishAbs.gf

@@ -0,0 +1,5 @@
+abstract BigSwedishAbs = 
+  Grammar,
+  ExtraSweAbs,
+  BigLexSweAbs
+  ** {} ;

old-examples/big/MAP/Lisp.cf

@@ -0,0 +1,20 @@
+-- Lisp as used in the Alvey grammar
+
+entrypoints Prog, Exp ;
+
+Pro.    Prog ::= [Exp] ;
+
+App.    Exp ::= "(" [Exp] ")" ;
+At.     Exp ::= Id ;
+IdPlus. Exp ::= IdPl ;
+IdStr.  Exp ::= String ;
+Plus.   Exp ::= "+" ;
+Minus.  Exp ::= "-" ;
+Num.    Exp ::= Integer ;
+
+token IdPl ('+' letter (letter | digit | '-' | '_')*) ;
+token Id (letter (letter | digit | '-' | '_')*) ;
+
+terminator Exp "" ;
+
+comment ";;" ;

old-examples/big/MAP/Makefile

@@ -0,0 +1,20 @@
+all: 
+	make big
+	make gf
+	mv Big*.gf ..
+gf:
+	./mkBig
+
+big:
+	ghc --make MkBig -o mkBig
+parser:
+	happy -gca ParLisp.y
+	alex -g LexLisp.x
+	latex DocLisp.tex; dvips DocLisp.dvi -o DocLisp.ps
+	ghc --make TestLisp.hs -o TestLisp
+clean:
+	-rm -f *.log *.aux *.hi *.o *.dvi
+	-rm -f DocLisp.ps
+distclean: clean
+	-rm -f DocLisp.* LexLisp.* ParLisp.* LayoutLisp.* SkelLisp.* PrintLisp.* TestLisp.* AbsLisp.* TestLisp ErrM.* SharedString.* Lisp.dtd XMLLisp.* Makefile*
+

old-examples/big/MAP/MkBig.hs

@@ -0,0 +1,42 @@
+module Main where
+
+import TransBig
+
+import IO ( stdin, hGetContents )
+import System ( getArgs, getProgName )
+
+import LexLisp
+import ParLisp
+import SkelLisp
+import PrintLisp
+import AbsLisp
+import ErrM
+
+type ParseFun a = [Token] -> Err a
+
+myLLexer = myLexer
+
+type Verbosity = Int
+
+putStrV :: Verbosity -> String -> IO ()
+putStrV v s = if v > 1 then putStrLn s else return ()
+
+runFile :: Verbosity -> ParseFun Prog -> FilePath -> IO ()
+runFile v p f = putStrLn f >> readFile f >>= run v p
+
+run :: Verbosity -> ParseFun Prog -> String -> IO ()
+run v p s = let ts = myLLexer s in case p ts of
+           Bad s    -> do putStrLn "\nParse              Failed...\n"
+                          putStrV v "Tokens:"
+                          putStrV v $ show ts
+                          putStrLn s
+           Ok  tree -> do putStrLn "\nParse Successful!"
+                          transTree tree
+
+
+
+main :: IO ()
+main = do 
+  runFile 0 pProg infile
+
+infile = "bigwordlist.en"

old-examples/big/MAP/TransBig.hs

@@ -0,0 +1,148 @@
+module TransBig where
+
+import AbsLisp
+import PrintLisp
+
+import Char
+
+abstrgf = "BigLexEngAbs.gf"
+concrgf = "BigLexEng.gf"
+
+transTree :: Prog -> IO ()
+transTree (Pro ts) = do
+  writeFile abstrgf "abstract BigLexEngAbs = Cat **{\n"
+  writeFile concrgf 
+    "concrete BigLexEng of BigLexEngAbs = CatEng ** open ParadigmsEng, IrregEng in {\n"
+  mapM_ transRule ts
+  appendFile abstrgf "}\n"
+  addOpers
+  appendFile concrgf "}\n"
+
+transRule :: Exp -> IO ()
+transRule e = case e of
+  App (At f : _ : cat : _) | not (discardCat cat) -> catRule (hyph f) cat
+  _ -> notConsidered $ "--! " ++ printTree e
+ where
+  hyph (Id f) = Id (map unhyph f)
+  unhyph '-' = '_'
+  unhyph c = c
+
+discardCat (App cs) = any (flip elem cs) discarded where
+  discarded = [
+    App [At (Id "AUX"),Plus],
+    App [At (Id "PAST"),Plus],
+    App [At (Id "QUA"),Plus],
+    App [At (Id "VFORM"),At (Id "EN")],
+    App [At (Id "AFORM"),At (Id "ER")],
+    App [At (Id "AFORM"),At (Id "EST")]
+    ]
+discardCat _ = False
+
+
+catRule :: Id -> Exp -> IO ()
+catRule (Id f) e = case cleanCat e of
+  App (App [At (Id "V"), Minus] : App [At (Id "N"), Plus] : more) -> case more of 
+    [App [At (Id "SUBCAT"),sub]] -> 
+      let prep = prepSub sub in
+      putRule (f ++ "_N2" ++ prep) "N2" "prepN2" [show f, show prep]
+    [App [At (Id "PLU"),Minus],App [At (Id "SUBCAT"),sub]] -> 
+      let prep = prepSub sub in
+      putRule (f ++ "_N2" ++ prep) "N2" "irregN2" [show f, show f, show prep]
+    [App [At (Id "PLU"),Minus]] -> 
+      putRule (f ++ "_N") "N" "irregN" [show f, show f] --- could find the forms
+    [App [At (Id "PLU"),_]] -> 
+      notConsidered $ "--! " ++ f ++ " " ++ printTree e
+    (App [At (Id "PRO"),Plus]:_) -> 
+      notConsidered $ "--! " ++ f ++ " " ++ printTree e
+    [App [At (Id "COUNT"),Minus]] -> 
+      putRule (f ++ "_N") "N" "massN" [show f]
+    [App [At (Id "PN"),Plus]] -> 
+      putRule (f ++ "_PN") "PN" "regPN" [show f]
+    [] ->
+      putRule (f ++ "_N") "N" "regN" [show f]
+    _ -> putStrLn $ "---- " ++ f ++ " " ++ printTree e
+  App (App [At (Id "V"), Plus] : App [At (Id "N"), Plus] : more) -> case more of 
+    (App [At (Id "ADV"), Plus]:_) -> 
+      putRule (f ++ "_Adv") "Adv" "mkAdv" [show f]
+    [App [At (Id "SUBCAT"),sub]] -> 
+      let prep = prepSub sub in
+      putRule (f ++ "_A2" ++ prep) "A2" "regA2" [show f,show prep]
+    [App [At (Id "AFORM"),At (Id "NONE")],App [At (Id "SUBCAT"),sub]] -> 
+      let prep = prepSub sub in
+      putRule (f ++ "_A2" ++ prep) "A2" "longA2" [show f,show prep]
+    [App [At (Id "SUBCAT"),sub],App [At (Id "AFORM"),At (Id "NONE")]] -> 
+      let prep = prepSub sub in
+      putRule (f ++ "_A2" ++ prep) "A2" "longA2" [show f,show prep]
+    (App [At (Id "AFORM"),At (Id "NONE")]:_) -> 
+      putRule (f ++ "_A") "A" "longA" [show f]
+    [] ->
+      putRule (f ++ "_A") "A" "regA" [show f]
+    _ -> putStrLn $ "---- " ++ f ++ " " ++ printTree e
+  App (App [At (Id "V"), Plus] : App [At (Id "N"), Minus] : more) -> case more of 
+    App [At (Id "SUBCAT"),At (Id "NP_NP")]:form -> 
+      putRule (f ++ "_V3") "V3" "dirdirV3" [verbForm form f]
+    App [At (Id "SUBCAT"),At (Id ('N':'P':'_':sub))]:form -> 
+      let prep = map toLower (drop 2 sub) in
+      putRule (f ++ "_V3" ++ prep) "V3" "dirprepV3" [verbForm form f, show prep]
+    App [At (Id "SUBCAT"),At (Id "SFIN")]:form -> 
+      putRule (f ++ "_VS") "VS" "mkVS" [verbForm form f]
+    App [At (Id "SUBCAT"),At (Id "SE1")]:form -> 
+      putRule (f ++ "_VV") "VV" "mkVV" [verbForm form f]
+    App [At (Id "SUBCAT"),sub]:form -> 
+      let prep = prepSub sub in
+      putRule (f ++ "_V2" ++ prep) "V2" "prepV2" [verbForm form f, show prep]
+    form | length form < 2 ->
+      putRule (f ++ "_V") "V" "useV" [verbForm form f]
+    _ -> putStrLn $ "---- " ++ f ++ " " ++ printTree e
+  App (App [At (Id "V"), Minus] : App [At (Id "N"), Minus] : more) -> case more of 
+    [App [At (Id "SUBCAT"), At (Id "BARE_S")]] -> 
+      putRule (f ++ "_Subj") "Subj" "mkSubj" [show f]
+    [App [At (Id "SUBCAT"), At (Id "NP")]] -> 
+      putRule (f ++ "_Prep") "Prep" "mkPrep" [show f]
+    App [At (Id "PRO"), Plus] : _ ->
+      putRule (f ++ "_Adv") "Adv" "proAdv" [show f]
+    _ -> putStrLn $ "---- " ++ f ++ " " ++ printTree e
+  App (App [At (Id "PRO"), Plus] : 
+    App [At (Id "V"), Minus] : App [At (Id "N"), Minus] :_) ->
+      putRule (f ++ "_Adv") "Adv" "proAdv" [show f]
+  _ -> notConsidered $ "--! " ++ f ++ " " ++ printTree e
+
+cleanCat (App es) = App $ filter (not . irrelevant) es where
+  irrelevant c = elem c [
+    App [At (Id "SUBCAT"), At (Id "NULL")],
+    App [At (Id "AT"), Minus], --- ?
+    App [At (Id "LAT"), Minus],
+    App [At (Id "LAT"), Plus]
+    ]
+cleanCat c = c
+
+notConsidered r = return () --- putStrLn
+
+putRule :: String -> String -> String -> [String] -> IO ()
+putRule fun cat oper args = do
+  appendFile abstrgf $ unwords ["fun",fun,":",cat,";\n"]
+  appendFile concrgf $ unwords $ ["lin",fun,"=",oper] ++ args ++ [";\n"]
+
+prepSub :: Exp -> String
+prepSub s = case s of
+  At (Id ('P':'P':cs)) -> map toLower cs
+  _ -> ""
+
+verbForm form f
+   | elem (App [At (Id "REG"),Minus]) form = "IrregEng." ++ f ++ "_V"
+   | otherwise = "(regV " ++ show f ++ ")"
+
+addOpers = mapM_ (appendFile concrgf) [
+  "oper proAdv : Str -> Adv = \\s -> mkAdv s ;\n",
+  "oper useV : V -> V = \\v -> v ;\n",
+  "oper massN : Str -> N = \\s -> regN s ;\n",
+  "longA : Str -> A = \\s -> compoundADeg (regA s) ;\n",
+  "mkSubj : Str -> Subj = \\s -> {s = s ; lock_Subj = <>} ;\n",
+  "irregN : Str -> Str -> N = \x,y -> mk2N x y ;\",
+  "irregN2 : Str -> Str -> Str -> N2 = \x,y,p -> mkN2 (irregN x y) (mkPrep p) ;\n",
+  "longA2 : Str -> Str -> A2 = \s,p -> mkA2 (compoundADeg (regA s)) (mkPrep p) ;\n",
+  "regA2 : Str -> Str -> A2 = \s,p -> mkA2 (regA s) (mkPrep p) ;\n",
+  "prepV2 : V -> Str -> V2 = \s,p -> mkV2 s (mkPrep p) ;\n",
+  "prepN2 : Str -> Str -> N2 = \s,p -> mkN2 (regN s) (mkPrep p) ;\n",
+  "dirprepV3 : V -> Str -> V3 = \s,p -> dirV3 s (mkPrep p) ;\n"
+  ]

old-examples/big/MAP/log.txt

@@ -0,0 +1,14 @@
+7/11/2006
+
+14.10 write Lisp.cf
+
+14.20 able to parse biglex
+
+14.30 MkBig main program compiles
+
+16.25 writing 5842 lemmas in files
+
+17.15 compiles fine but get conflicts with Irreg and Structural
+
+17.37 compiles fine in BigShallowEng, but not BigEnglish, because the latter
+imports too much conflicting lexicon to remove manually

old-examples/big/MkDict.hs

@@ -0,0 +1,48 @@
+import Char
+
+infile = "mywordlist1"
+
+main = do
+  s <- readFile infile
+  mapM_ (putStrLn . mkOne) $ lines s
+
+mkOne s = case words s of
+  "--":_ -> ""
+  ('(':_):w:cat:ws -> unwords $ mkCatf (nopar cat) (more ws) w
+  _ -> "-- " ++ s
+ where
+  more ws = case ws of
+    _ | elem "(REG" ws -> "irreg"
+    _ -> "reg"
+  nopar = filter (flip notElem "()")
+  mkCatf c r w = case c of
+    "Noun" -> ["N","regN",w]
+    "PRT" -> ["Adv","mkAdv",w] ----
+    "TITLE" -> ["N","regN",w] ----
+    "Adject" -> ["A","regA",w]
+    "AdjInf" -> ["A","regA",w] ----
+    "AdjInf_LONG" -> ["A","longA",w] ----
+    "AdjPrd" -> ["A","regA",w] ----
+    "AdjPrd_LONG" -> ["A","longA",w] ----
+    "Adject_LONG" -> ["A","longA",w]
+    "Verb" | r == "irreg" -> []
+    "Verb"  -> ["V","regV",w]
+    "V2" | r == "irreg" -> ["V2","irreg", w, "_V"]
+    "V2" -> ["V2","regV2", w]
+    "PNoun" -> ["PN","regPN",toUpper (head w): tail w]
+    'V':'2':'_':prep | r == "irreg" -> 
+               let p = map toLower prep in ["V2","mkV2_"++p, w, "_V", p]
+    x:'2':'_':prep -> 
+               let p = map toLower prep in [[x]++"2","prep" ++[x]++"2"++p, w, p]
+    "V3_NP" | r == "irreg" -> ["V3","irreg", w, "_V"]
+    "V3_NP" -> ["V3","regV3", w]
+    'V':'3':'_':'P':'P':prep | r == "irreg" -> 
+               let p = map toLower prep in ["V3","mkV3_"++p, w, "_V", p]
+    'V':'3':'_':'P':'P':prep -> 
+               let p = map toLower prep in ["V3","mkV3_"++p, w, p]
+    'V':'3':'_':'S':_ | r == "irreg" -> ["V2","mkV2_S", w, "_V"] ----
+    'V':'3':'_':'S':_ -> ["V2","mkV2_S", w] ----
+    'V':'3':'_':_ -> ["V3","mkV3", w] ----
+
+    _ -> [c,"mk" ++ c, w]
+

old-examples/big/MoreParadigmsSwe.gf

@@ -0,0 +1,29 @@
+resource MoreParadigmsSwe = ParadigmsSwe ** open Prelude, CatSwe in {
+
+oper
+  s2 : Str -> N = decl2Noun ;
+  s3 : Str -> N = decl3Noun ;
+  s4 : Str -> N = decl4Noun ;
+  s5 : Str -> N = decl5Noun ;
+
+  v2 : Str -> V = conj2 ;
+  v3 : Str -> V = conj3 ;
+
+  aAbstract : Str -> A = \a -> mk2A a a ;
+  aFager : Str -> A = \a -> mk3A a (a + "t") (Predef.tk 2 a + "a") ;
+  aGrund : Str -> A = regA ; -- yes
+  aKorkad : Str -> A = \a -> mk3A a (init a + "t") (a + "e") ;
+  aVaken : Str -> A = \a -> mk3A a (init a + "t") (Predef.tk 2 a + "a") ;
+  aVid : Str -> A = regA ; -- yes
+
+---- to do
+  sParti : Str -> N = regN ;
+  sPapper : Str -> N = regN ;
+  sKikare : Str -> N = regN ;
+  sProgram : Str -> N = regN ;
+  sNyckel : Str -> N = regN ;
+  sMuseum : Str -> N = regN ;
+  sKam : Str -> N = regN ;
+
+
+}

old-examples/big/README

@@ -0,0 +1,9 @@
+BigEngLex.gf adapted from a word list by Alan Black & al.
+http://www.cs.cmu.edu/~awb/pub/map/MAP3.1.tar.gz
+Not to be used for military purposes.
+
+Translation to GF has introduced some errors, e.g. in
+inflection, which have not yet been corrected.
+
+AR 2006.
+

old-examples/big/extract2gf.hs

@@ -0,0 +1,28 @@
+import System
+import Char
+
+-- usage: extract2gf <lang> <extracted>
+
+main = do
+  la:f:_ <- getArgs
+  let cnc = f ++ ".gf" 
+  let abs = f ++ "Abs.gf" 
+  s <- readFile f
+  writeFile abs $ "abstract " ++ f ++ "Abs = Cat ** {\n"
+  writeFile cnc $ "concrete " ++ f ++ " of " ++ f ++ 
+    "Abs = Cat" ++ la ++ " ** open Paradigms" ++ la ++ " in {\n"
+  mapM_ (mkOne abs cnc . words) $ filter (not . empty) $ lines s
+  appendFile abs "}"
+  appendFile cnc "}"
+
+-- format: cat oper args
+
+mkOne abs cnc (cat : oper : args@(a1:_)) = do
+  appendFile abs $ "  fun " ++ fun ++ " : " ++ cat ++ " ;\n"
+  appendFile cnc $ "  lin " ++ fun ++ " = " ++ lin ++ " ;\n"
+ where
+   fun = a1 ++ "_" ++ cat ++ "_" ++ oper
+   lin = unwords $ oper:["\"" ++ s ++ "\"" | s <- args]
+mkOne _ _ ws = putStrLn $ unwords ws
+
+empty s = all isSpace s || take 2 s == "--"

old-examples/big/postedit.hs

@@ -0,0 +1,49 @@
+import Char
+import System
+
+infile = "BigLexEng.gf"
+tmp = "tm"
+
+main = do
+  writeFile tmp ""
+  s <- readFile infile
+  mapM_ (appendFile tmp . mkTwo) $ lines s --- $ chop s
+  system "cp BigLexEng.gf bak"
+  system "mv tm BigLexEng.gf"
+
+chop s = case s of
+  ';':cs -> ";\n"++chop cs
+  c:cs -> c:chop cs
+  _ -> s
+
+mkTwo s = case words s of
+  lin:tie:eq:"dirV3":tie_V:ws ->
+    let prep = case reverse (takeWhile (/='_') (reverse tie)) of
+          "loc" -> "in" ---
+          p -> p
+    in unwords $ 
+      [lin,tie,eq,"dirV3",show (take (length tie_V - 2) tie_V),show prep] ++ 
+      ws ++ ["\n"]
+  _ -> s ++ "\n"
+
+mkOne s = case words s of
+  lin:a2:eq:pa2:ws | take 6 pa2 == "prepA2" -> 
+    unwords $ [lin,a2,eq,"prepA2"] ++ ws ++ ["\n"]
+  lin:a2:eq:pa2:ws | take 6 pa2 == "prepV2" -> 
+    unwords $ [lin,a2,eq,"prepV2"] ++ ws ++ ["\n"]
+  lin:v2:eq:"mkV2":v:_:ws ->
+    unwords $ [lin,v2,eq,"mkV2",(read v ++ "_V")] ++ ws ++ ["\n"]
+  lin:v2:eq:"mkV3":v:_:ws ->
+    unwords $ [lin,v2,eq,"dirV3",(read v ++ "_V")] ++ ws ++ ["\n"]
+  lin:a2:eq:pa2:ws | take 4 pa2 == "mkV2" -> 
+    unwords $ [lin,a2,eq,"mkV2"] ++ ws ++ ["\n"]
+  lin:a2:eq:pa2:ws | take 6 pa2 == "prepN2" -> 
+    unwords $ [lin,a2,eq,"prepN2"] ++ ws ++ ["\n"]
+  lin:a2:eq:pa2:ws | take 4 pa2 == "mkV3" -> 
+    unwords $ [lin,a2,eq,"mkV3"] ++ ws ++ ["\n"]
+
+  lin:v2:eq:"irreg":v:_:ws ->
+    unwords $ [lin,v2,eq,"dirV2",(read v ++ "_V")] ++ ws ++ ["\n"]
+
+
+  _ -> s ++ "\n"