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

1 files changed, 148 insertions, 0 deletions

diff --git a/old-examples/big/MAP/TransBig.hs b/old-examples/big/MAP/TransBig.hs
new file mode 100644
index 000000000..ea59dcc6c
--- /dev/null
+++ b/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"
+  ]