msyds/gf-core
1
0
Fork 0
forked from GitHub/gf-core
Code Pull Requests Activity

*** empty log message ***

Browse Source
This commit is contained in:
peb
2004-05-26 18:44:40 +00:00
parent 0f30a5a540
commit ddd70c8b35
9 changed files with 106 additions and 42 deletions
Download Patch File Download Diff File Expand all files Collapse all files

3
src/GF/CF/CFIdent.hs
View File

@@ -46,7 +46,8 @@ prCFTok t = case t of
TM i m -> m --- "?" --- m
-- to build trees: the Atom contains a GF function, Cn | Meta | Vr | Literal
newtype CFFun = CFFun (Atom, Profile) deriving (Eq,Show)
newtype CFFun = CFFun (Atom, Profile) deriving (Eq,Ord,Show)
-- - - - - - - - - - - - - - - - - - - - - ^^^ added by peb, 21/5-04
type Profile = [([[Int]],[Int])]

48
src/GF/CF/ChartParser.hs
View File

@@ -1,6 +1,22 @@
{- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Filename: ChartParser.hs
Author: Peter Ljunglöf
Time-stamp: <2004-05-25 02:20:01 peb>
Description: Bottom-up Kilbury chart parser from
"Pure Functional Parsing", chapter 5
DESIRED CHANGES: - The modules OrdSet and OrdMap2 are obsolete
and should be changed to newer versions
- Also, should use the CFG parsers in parsing/
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}
module ChartParser (chartParser) where
import Tracing
import PrintParser
import PrintSimplifiedTerm
import Operations
import CF
import CFIdent
@@ -20,6 +36,10 @@ type Terminal = Token -> [(Category, Maybe Name)]
type GParser = Grammar -> Category -> [Token] -> ([ParseTree],String)
data ParseTree = Node Name Category [ParseTree] | Leaf Token
maxTake :: Int
-- maxTake = 1000
maxTake = maxBound
--------------------------------------------------
-- converting between GF parsing and CFG parsing
@@ -28,7 +48,7 @@ buildParser gparser cf = parse
where
parse = \start input ->
let parse2 = parse' (CFNonterm start) input in
([(parse2tree t, []) | t <- fst parse2], snd parse2)
(take maxTake [(parse2tree t, []) | t <- fst parse2], snd parse2)
parse' = gparser (cf2grammar cf)
cf2grammar :: CF -> Grammar
@@ -95,8 +115,12 @@ chartParser0 (productions, terminal) = cparse
| otherwise = [cats]
cparse :: Category -> [Token] -> ([ParseTree], String)
cparse start input = case lookup (0, length input, start) edgeTrees of
Just trees -> (trees, "Chart:" ++++ prChart passiveEdges)
cparse start input = trace "ChartParser" $
case lookup (0, length input, start) $
tracePrt "#edgeTrees" (prt . map (length.snd)) $
edgeTrees of
Just trees -> tracePrt "#trees" (prt . length . fst) $
(trees, "Chart:" ++++ prChart passiveEdges)
Nothing -> ([], "Chart:" ++++ prChart passiveEdges)
where
finalChart :: Chart
@@ -110,7 +134,8 @@ chartParser0 (productions, terminal) = cparse
(i, b, a:bs) <- elems state ]
initialChart :: Chart
initialChart = emptySet : map initialState (zip [0..] input)
initialChart = tracePrt "#initialChart" (prt . map (length.elems)) $
emptySet : map initialState (zip [0..] input)
where initialState (j, sym) = makeSet [ (j, cat, []) |
(cat, _) <- terminal sym ]
@@ -124,8 +149,13 @@ chartParser0 (productions, terminal) = cparse
a `elemSet` emptyCats ]
passiveEdges :: [Passive]
passiveEdges = [ (i, j, cat) |
(j, state) <- zip [0..] finalChart,
passiveEdges = tracePrt "#passiveEdges" (prt . length) $
[ (i, j, cat) |
(j, state) <- zip [0..] $
tracePrt "#passiveChart"
(prt . map (length.filter (\(_,_,x)->null x).elems)) $
tracePrt "#activeChart" (prt . map (length.elems)) $
finalChart,
(i, cat, []) <- elems state ]
++
[ (i, i, cat) |
@@ -158,9 +188,15 @@ chartParser0 (productions, terminal) = cparse
tree <- trees ]
instance Print ParseTree where
prt (Node name cat trees) = prt name++"."++prt cat++"^{"++prtSep "," trees++"}"
prt (Leaf token) = prt token
-- AR 10/12/2002
prChart :: [Passive] -> String
prChart = unlines . map (unwords . map prOne) . positions where
prOne (i,j,it) = show i ++ "-" ++ show j ++ "-" ++ prCFItem it
positions = groupBy (\ (i,_,_) (j,_,_) -> i == j)

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

@@ -20,6 +20,9 @@ import Option
import Ident
import Arch (ModTime)
-- peb 25/5-04
import CFtoCFG
import List (nub,nubBy)
-- AR 11/11/2001 -- 17/6/2003 (for modules) ---- unfinished
@@ -32,6 +35,8 @@ data ShellState = ShSt {
canModules :: CanonGrammar , -- compiled abstracts and concretes
srcModules :: G.SourceGrammar , -- saved resource modules
cfs :: [(Ident,CF)] , -- context-free grammars
-- peb 25/5-04:
cfParserInfos :: [(Ident, CFParserInfo)], -- parser information
morphos :: [(Ident,Morpho)], -- morphologies
gloptions :: Options, -- global options
readFiles :: [(FilePath,ModTime)],-- files read
@@ -54,6 +59,7 @@ emptyShellState = ShSt {
canModules = M.emptyMGrammar,
srcModules = M.emptyMGrammar,
cfs = [],
cfParserInfos = [], -- peb 25/5-04
morphos = [],
gloptions = noOptions,
readFiles = [],
@@ -72,7 +78,7 @@ data StateGrammar = StGr {
cncId :: Ident,
grammar :: CanonGrammar,
cf :: CF,
---- parser :: StaticParserInfo,
cfParserInfo :: CFParserInfo, -- peb 25/5-04
morpho :: Morpho,
loptions :: Options
}
@@ -82,6 +88,7 @@ emptyStateGrammar = StGr {
cncId = identC "#EMPTY", ---
grammar = M.emptyMGrammar,
cf = emptyCF,
cfParserInfo = emptyParserInfo, -- peb 25/5-04
morpho = emptyMorpho,
loptions = noOptions
}
@@ -89,6 +96,7 @@ emptyStateGrammar = StGr {
-- analysing shell grammar into parts
stateGrammarST = grammar
stateCF = cf
stateParserInfo= cfParserInfo
stateMorpho = morpho
stateOptions = loptions
stateGrammarWords = allMorphoWords . stateMorpho
@@ -119,6 +127,7 @@ updateShellState opts sh (gr,(sgr,rts)) = do
concr0 = ifNull Nothing (return . last) concrs
notInrts f = notElem f $ map fst rts
cfs <- mapM (canon2cf opts cgr) concrs --- would not need to update all...
let parserInfos = map cf2parserInfo cfs -- peb 25/5-04
let funs = funRulesOf cgr
let cats = allCatsOf cgr
@@ -137,6 +146,7 @@ updateShellState opts sh (gr,(sgr,rts)) = do
canModules = cgr,
srcModules = src,
cfs = zip concrs cfs,
cfParserInfos = zip concrs parserInfos, -- peb 25/5-04
morphos = zip concrs (map (mkMorpho cgr) concrs),
gloptions = opts,
readFiles = [ft | ft@(f,_) <- readFiles sh, notInrts f] ++ rts,
@@ -181,6 +191,7 @@ purgeShellState sh = ShSt {
canModules = M.MGrammar $ purge $ M.modules $ canModules sh,
srcModules = M.emptyMGrammar,
cfs = cfs sh,
cfParserInfos = cfParserInfos sh, -- peb 25/5-04
morphos = morphos sh,
gloptions = gloptions sh,
readFiles = [],
@@ -237,6 +248,7 @@ stateGrammarOfLang st l = StGr {
cncId = l,
grammar = can,
cf = maybe emptyCF id (lookup l (cfs st)),
cfParserInfo = maybe emptyParserInfo id (lookup l (cfParserInfos st)), -- peb 25/5-04
morpho = maybe emptyMorpho id (lookup l (morphos st)),
loptions = errVal noOptions $ lookupOptionsCan can
}
@@ -266,6 +278,7 @@ stateAbstractGrammar st = StGr {
cncId = identC "#Cnc", ---
grammar = canModules st, ---- only abstarct ones
cf = emptyCF,
cfParserInfo = emptyParserInfo,
morpho = emptyMorpho,
loptions = gloptions st ----
}
@@ -387,8 +400,8 @@ languageOn = languageOnOff True
languageOff = languageOnOff False
languageOnOff :: Bool -> Language -> ShellStateOper
languageOnOff b lang (ShSt a c cs cg sg cfs ms os fs cats sts) =
ShSt a c cs' cg sg cfs ms os fs cats sts where
languageOnOff b lang (ShSt a c cs cg sg cfs pinfs ms os fs cats sts) =
ShSt a c cs' cg sg cfs pinfs ms os fs cats sts where
cs' = [if lang==l then ((l,c),b) else i | i@((l,c),_) <- cs]
{-
@@ -405,12 +418,12 @@ removeLanguage :: Language -> ShellStateOper
removeLanguage lang (ShSt (ab,gs,os)) = ShSt (ab,removeAssoc lang gs, os)
-}
changeOptions :: (Options -> Options) -> ShellStateOper
changeOptions f (ShSt a c cs can src cfs ms os ff ts ss) =
ShSt a c cs can src cfs ms (f os) ff ts ss
changeOptions f (ShSt a c cs can src cfs pinfs ms os ff ts ss) =
ShSt a c cs can src cfs pinfs ms (f os) ff ts ss
changeModTimes :: [(FilePath,ModTime)] -> ShellStateOper
changeModTimes mfs (ShSt a c cs can src cfs ms os ff ts ss) =
ShSt a c cs can src cfs ms os ff' ts ss
changeModTimes mfs (ShSt a c cs can src cfs pinfs ms os ff ts ss) =
ShSt a c cs can src cfs pinfs ms os ff' ts ss
where
ff' = mfs ++ [mf | mf@(f,_) <- ff, notElem f (map fst mfs)]

17
src/GF/Data/OrdMap2.hs
View File

@@ -1,12 +1,15 @@
{- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Filename: OrdMap2.hs
Author: Peter Ljunglöf
Time-stamp: <2004-05-07 14:16:03 peb>
Description: The class of finite maps, as described in
"Pure Functional Parsing", section 2.2.2
and an example implementation,
derived from appendix A.2
--------------------------------------------------
-- The class of ordered finite maps
-- as described in section 2.2.2
-- and an example implementation,
-- derived from the implementation in appendix A.2
OBSOLETE! this is only used in cf/ChartParser.hs
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}
module OrdMap2 (OrdMap(..), Map) where

17
src/GF/Data/OrdSet.hs
View File

@@ -1,12 +1,15 @@
{- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Filename: OrdSet.hs
Author: Peter Ljunglöf
Time-stamp: <2004-05-07 14:16:12 peb>
Description: The class of ordered sets, as described in
"Pure Functional Parsing", section 2.2.1,
and an example implementation
derived from appendix A.1
--------------------------------------------------
-- The class of ordered sets
-- as described in section 2.2.1
-- and an example implementation,
-- derived from the implementation in appendix A.1
OBSOLETE! this is only used in cf/ChartParser.hs
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}
module OrdSet (OrdSet(..), Set) where

22
src/GF/UseGrammar/Custom.hs
View File

@@ -37,11 +37,12 @@ import GrammarToHaskell
-- the cf parsing algorithms
import ChartParser -- or some other CF Parser
import NewChartParser
import NewerChartParser
-- grammar conversions -- peb 19/4-04
-- see also customGrammarPrinter
import qualified ConvertGrammar as CG
import TestConversions (prRaw)
import qualified ConvertGrammar as Cnv
import MoreCustom -- either small/ or big/. The one in Small is empty.
@@ -170,15 +171,11 @@ customGrammarPrinter =
-}
-- add your own grammar printers here
-- grammar conversions, (peb)
{-
,(strCI "gfc_show", show . grammar2canon . stateGrammarST)
,(strCI "gfc_raw", prRaw . stateGrammarST)
,(strCI "tnf", prCanon . CG.convertCanonToTNF . stateGrammarST)
,(strCI "mcfg", CG.prMCFG . CG.convertCanonToMCFG . stateGrammarST)
,(strCI "mcfg_cf", prCF . CG.convertCanonToCFG . stateGrammarST)
,(strCI "mcfg_canon", prCanon . CG.convertCanonToMCFG . stateGrammarST)
,(strCI "mcfg_raw", prRaw . CG.convertCanonToMCFG . stateGrammarST)
-}
,(strCI "tnf", prCanon . Cnv.convertCanonToTNF . stateGrammarST)
,(strCI "mcfg", Cnv.prMCFG . Cnv.convertCanonToMCFG . stateGrammarST)
,(strCI "mcfg_cf", Cnv.prCFG . Cnv.convertCanonToCFG . stateGrammarST)
,(strCI "mcfg_show", show . Cnv.convertCanonToMCFG . stateGrammarST)
--- also include printing via grammar2syntax!
]
++ moreCustomGrammarPrinter
@@ -262,6 +259,11 @@ customParser =
(strCI "chart", chartParser . stateCF)
-- add your own parsers here
]
-- 21/5-04, peb:
++ [ (strCI ("new"++name), newChartParser descr . stateCF) |
(descr, names) <- newChartParserAlternatives, name <- names ]
++ [ (strCI ("newer"++name), newerChartParser descr . stateParserInfo) |
(descr, names) <- newerChartParserAlternatives, name <- names ]
++ moreCustomParser
customTokenizer =

4
src/GF/UseGrammar/Parsing.hs
View File

@@ -60,7 +60,9 @@ parseStringC opts0 sg cat s
tokens2trms :: Options ->StateGrammar ->Ident -> CFParser -> [CFTok] -> Check [Tree]
tokens2trms opts sg cn parser as = do
let res@(trees,info) = parser as
ts0 <- return $ nub (cfParseResults res)
ts0 <- return $ cfParseResults res -- removed nub, peb 25/5-04
-- ts0 <- return $ nub (cfParseResults res) -- nub gives quadratic behaviour!
-- SortedList.nubsort is O(n log n)
ts <- case () of
_ | null ts0 -> checkWarn "No success in cf parsing" >> return []
_ | raw -> do

8
src/Makefile
View File

@@ -5,8 +5,9 @@ GHCFLAGS=-package lang -package util -fglasgow-exts
GHCOPTFLAGS=-O -package lang -package util -fglasgow-exts
GHCFUDFLAG=-package Fudgets
HUGSINCLUDE =.:for-hugs:api:source:canonical:cf:grammar:infra:shell:useGrammar:compile:parsing:conversions:
BASICINCLUDE =-iapi -icompile -igrammar -iinfra -ishell -isource -icanonical -iuseGrammar -icf -iparsing -iparsers -iconversions
HUGSTRACE = trace
HUGSINCLUDE =.:for-hugs:api:source:canonical:cf:grammar:infra:shell:useGrammar:compile:parsing:conversions:$(HUGSTRACE):
BASICINCLUDE =-iapi -icompile -igrammar -iinfra -ishell -isource -icanonical -iuseGrammar -icf -iparsing -iparsers -iconversions -inotrace
GHCINCLUDE =-ifor-ghc $(BASICINCLUDE)
GHCINCLUDENOFUD=-ifor-ghc-nofud $(BASICINCLUDE)
GHCINCLUDEGFT =-ifor-gft $(BASICINCLUDE)
@@ -37,6 +38,9 @@ justwindows:
$(GHMAKE) $(GHCOPTFLAGS) $(WINDOWSINCLUDE) --make GF.hs -o gf2.exe ; strip gf2.exe ; mv gf2.exe ../bin/
nofud-links:
cd for-ghc-nofud ; rm -f *.hs ; ln -s ../for-ghc/Arch.hs ; ln -s ../for-hugs/ArchEdit.hs ; cd ..
tracing:
make today ; $(GHMAKE) $(GHCFLAGS) -itrace $(GHCINCLUDENOFUD) --make GF.hs -o gf2 ; strip gf2 ; mv gf2 ../bin/
batch:
$(GHMAKE) $(GHCFLAGS) $(GHCINCLUDE) --make GF2.hs -o gf2 ; strip gf2
api:

2
src/Today.hs
View File

@@ -1 +1 @@
module Today where today = "Wed May 26 10:26:30 CEST 2004"
module Today where today = "Wed May 26 21:43:58 CEST 2004"