GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-05-28 12:18:54 -06:00
Code Issues Packages Projects Releases Wiki Activity

flags

Browse Source
This commit is contained in:
aarne
2003-11-10 15:16:28 +00:00
parent 7a44450b34
commit a931676d90
4 changed files with 10 additions and 4 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
src/GF/Compile/ShellState.hs
View File

@@ -142,7 +142,7 @@ updateShellState opts sh (gr,(sgr,rts)) = do
prShellStateInfo :: ShellState -> String prShellStateInfo :: ShellState -> String
prShellStateInfo sh = unlines [ prShellStateInfo sh = unlines [
"main abstract : " +++ maybe "(none)" P.prt (abstract sh), "main abstract : " +++ abstractName sh,
"main concrete : " +++ maybe "(none)" P.prt (concrete sh), "main concrete : " +++ maybe "(none)" P.prt (concrete sh),
"all concretes : " +++ unwords (map (P.prt . fst) (concretes sh)), "all concretes : " +++ unwords (map (P.prt . fst) (concretes sh)),
"canonical modules :" +++ unwords (map (P.prt .fst) (M.modules (canModules sh))), "canonical modules :" +++ unwords (map (P.prt .fst) (M.modules (canModules sh))),
@@ -150,6 +150,8 @@ prShellStateInfo sh = unlines [
"global options : " +++ prOpts (gloptions sh) "global options : " +++ prOpts (gloptions sh)
] ]
abstractName sh = maybe "(none)" P.prt (abstract sh)
-- throw away those abstracts that are not needed --- could be more aggressive -- throw away those abstracts that are not needed --- could be more aggressive
filterAbstracts :: Maybe Ident -> CanonGrammar -> CanonGrammar filterAbstracts :: Maybe Ident -> CanonGrammar -> CanonGrammar

7
src/GF/Grammar/Compute.hs
View File

@@ -113,6 +113,9 @@ computeTerm gr = comp where
_ -> returnC $ S t' v' _ -> returnC $ S t' v'
-- normalize away empty tokens
K "" -> return Empty
-- glue if you can -- glue if you can
Glue x0 y0 -> do Glue x0 y0 -> do
x <- comp g x0 x <- comp g x0
@@ -123,8 +126,8 @@ computeTerm gr = comp where
(S (T i cs) e, s) -> prawitz g i (flip Glue s) cs e (S (T i cs) e, s) -> prawitz g i (flip Glue s) cs e
(s, S (T i cs) e) -> prawitz g i (Glue s) cs e (s, S (T i cs) e) -> prawitz g i (Glue s) cs e
(_,K "") -> return x (_,Empty) -> return x
(K "",_) -> return y (Empty,_) -> return y
(K a, K b) -> return $ K (a ++ b) (K a, K b) -> return $ K (a ++ b)
(K a, Alts (d,vs)) -> do (K a, Alts (d,vs)) -> do
let glx = Glue x let glx = Glue x

1
src/GF/Shell/JGF.hs
View File

@@ -51,6 +51,7 @@ welcome =
initEditMsgJavaX env = encodeUTF8 $ unlines $ tagXML "gfinit" $ initEditMsgJavaX env = encodeUTF8 $ unlines $ tagXML "gfinit" $
tagsXML "newcat" [["n" +++ cat] | (_,cat) <- newCatMenu env] ++ tagsXML "newcat" [["n" +++ cat] | (_,cat) <- newCatMenu env] ++
tagXML "topic" [abstractName env] ++
tagXML "language" [prLanguage langAbstract] ++ tagXML "language" [prLanguage langAbstract] ++
concat [tagAttrXML "language" ("file",file) [prLanguage lang] | concat [tagAttrXML "language" ("file",file) [prLanguage lang] |
(file,lang) <- zip (allGrammarFileNames env) (allLanguages env)] (file,lang) <- zip (allGrammarFileNames env) (allLanguages env)]

2
src/Today.hs
View File

@@ -1 +1 @@
module Today where today = "Mon Nov 10 16:45:46 CET 2003" module Today where today = "Mon Nov 10 17:00:26 CET 2003"