GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-04-22 19:22:50 -06:00
Code Issues Packages Projects Releases Wiki Activity

last-minute bug fixes

Browse Source
This commit is contained in:
aarne
2004-06-24 14:06:09 +00:00
parent 767690b903
commit bddc88156f
20 changed files with 536 additions and 404 deletions
Download Patch File Download Diff File Expand all files Collapse all files

3
src/GF/Source/AbsGF.hs
View File

@@ -100,6 +100,9 @@ data TopDef =
| DefPrintOld [PrintDef]
| DefLintype [Def]
| DefPattern [Def]
| DefPackage Ident [TopDef]
| DefVars [Def]
| DefTokenizer Ident
deriving (Eq,Ord,Show)
data CatDef =

9
src/GF/Source/GF.cf
View File

@@ -270,7 +270,7 @@ separator DDecl "" ;
-- for backward compatibility
OldGr. OldGrammar ::= Include [TopDef] ;
OldGr. OldGrammar ::= Include [TopDef] ;
NoIncl. Include ::= ;
Incl. Include ::= "include" [FileName] ;
@@ -292,3 +292,10 @@ ELin. Exp2 ::= "Lin" Ident ;
DefPrintOld. TopDef ::= "printname" [PrintDef] ;
DefLintype. TopDef ::= "lintype" [Def] ;
DefPattern. TopDef ::= "pattern" [Def] ;
-- deprecated packages are attempted to be interpreted
DefPackage. TopDef ::= "package" Ident "=" "{" [TopDef] "}" ";" ;
-- these two are just ignored after parsing
DefVars. TopDef ::= "var" [Def] ;
DefTokenizer. TopDef ::= "tokenizer" Ident ";" ;

8
src/GF/Source/LexGF.hs
View File

@@ -35,13 +35,17 @@ tokenPos (PT (Pn _ l _) _ :_) = "line " ++ show l
tokenPos (Err (Pn _ l _) :_) = "line " ++ show l
tokenPos _ = "end of file"
posLineCol (Pn _ l c) = (l,c)
mkPosToken t@(PT p _) = (posLineCol p, prToken t)
prToken t = case t of
PT _ (TS s) -> s
PT _ (TI s) -> s
PT _ (TV s) -> s
PT _ (TD s) -> s
PT _ (TC s) -> s
_ -> show t
PT _ (T_LString s) -> s
tokens:: String -> [Token]
tokens inp = scan tokens_scan inp
@@ -55,7 +59,7 @@ tokens_scan = load_scan (tokens_acts,stop_act) tokens_lx
eitherResIdent :: (String -> Tok) -> String -> Tok
eitherResIdent tv s = if isResWord s then (TS s) else (tv s) where
isResWord s = isInTree s $
B "let" (B "data" (B "Type" (B "Str" (B "PType" (B "Lin" N N) N) (B "Tok" (B "Strs" N N) N)) (B "cat" (B "case" (B "abstract" N N) N) (B "concrete" N N))) (B "in" (B "fn" (B "flags" (B "def" N N) N) (B "grammar" (B "fun" N N) N)) (B "instance" (B "incomplete" (B "include" N N) N) (B "interface" N N)))) (B "pre" (B "open" (B "lindef" (B "lincat" (B "lin" N N) N) (B "of" (B "lintype" N N) N)) (B "param" (B "out" (B "oper" N N) N) (B "pattern" N N))) (B "transfer" (B "reuse" (B "resource" (B "printname" N N) N) (B "table" (B "strs" N N) N)) (B "where" (B "variants" (B "union" N N) N) (B "with" N N))))
B "lincat" (B "def" (B "Type" (B "Str" (B "PType" (B "Lin" N N) N) (B "Tok" (B "Strs" N N) N)) (B "cat" (B "case" (B "abstract" N N) N) (B "data" (B "concrete" N N) N))) (B "include" (B "fun" (B "fn" (B "flags" N N) N) (B "in" (B "grammar" N N) N)) (B "interface" (B "instance" (B "incomplete" N N) N) (B "lin" (B "let" N N) N)))) (B "resource" (B "out" (B "of" (B "lintype" (B "lindef" N N) N) (B "oper" (B "open" N N) N)) (B "pattern" (B "param" (B "package" N N) N) (B "printname" (B "pre" N N) N))) (B "union" (B "table" (B "strs" (B "reuse" N N) N) (B "transfer" (B "tokenizer" N N) N)) (B "where" (B "variants" (B "var" N N) N) (B "with" N N))))
data BTree = N | B String BTree BTree deriving (Show)

734
src/GF/Source/ParGF.hs
View File

File diff suppressed because one or more lines are too long

3
src/GF/Source/PrintGF.hs
View File

@@ -210,6 +210,9 @@ instance Print TopDef where
DefPrintOld printdefs -> prPrec i 0 (concat [["printname"] , prt 0 printdefs])
DefLintype defs -> prPrec i 0 (concat [["lintype"] , prt 0 defs])
DefPattern defs -> prPrec i 0 (concat [["pattern"] , prt 0 defs])
DefPackage id topdefs -> prPrec i 0 (concat [["package"] , prt 0 id , ["="] , ["{"] , prt 0 topdefs , ["}"] , [";"]])
DefVars defs -> prPrec i 0 (concat [["var"] , prt 0 defs])
DefTokenizer id -> prPrec i 0 (concat [["tokenizer"] , prt 0 id , [";"]])
prtList es = case es of
[] -> (concat [])

3
src/GF/Source/SkelGF.hs
View File

@@ -128,6 +128,9 @@ transTopDef x = case x of
DefPrintOld printdefs -> failure x
DefLintype defs -> failure x
DefPattern defs -> failure x
DefPackage id topdefs -> failure x
DefVars defs -> failure x
DefTokenizer id -> failure x
transCatDef :: CatDef -> Result

58
src/GF/Source/SourceToGrammar.hs
View File

@@ -505,28 +505,34 @@ transOldGrammar opts name0 x = case x of
g1 <- transGrammar $ Gr moddefs
removeLiT g1 --- needed for bw compatibility with an obsolete feature
where
sortTopDefs ds = [mkAbs a,mkRes r,mkCnc c]
where (a,r,c) = foldr srt ([],[],[]) ds
srt d (a,r,c) = case d of
DefCat catdefs -> (d:a,r,c)
DefFun fundefs -> (d:a,r,c)
DefDef defs -> (d:a,r,c)
DefData pardefs -> (d:a,r,c)
DefPar pardefs -> (a,d:r,c)
DefOper defs -> (a,d:r,c)
DefLintype defs -> (a,d:r,c)
DefLincat defs -> (a,r,d:c)
DefLindef defs -> (a,r,d:c)
DefLin defs -> (a,r,d:c)
DefPattern defs -> (a,r,d:c)
DefFlag defs -> (a,r,d:c) --- a guess
DefPrintCat printdefs -> (a,r,d:c)
DefPrintFun printdefs -> (a,r,d:c)
DefPrintOld printdefs -> (a,r,d:c)
mkAbs a = MModule q (MTAbstract absName) (MBody ne (Opens []) (topDefs a))
mkRes r = MModule q (MTResource resName) (MBody ne (Opens []) (topDefs r))
mkCnc r = MModule q (MTConcrete cncName absName)
(MBody ne (Opens [OName resName]) (topDefs r))
sortTopDefs ds = [mkAbs a,mkRes ops r,mkCnc ops c] ++ map mkPack ps
where
ops = map fst ps
(a,r,c,ps) = foldr srt ([],[],[],[]) ds
srt d (a,r,c,ps) = case d of
DefCat catdefs -> (d:a,r,c,ps)
DefFun fundefs -> (d:a,r,c,ps)
DefDef defs -> (d:a,r,c,ps)
DefData pardefs -> (d:a,r,c,ps)
DefPar pardefs -> (a,d:r,c,ps)
DefOper defs -> (a,d:r,c,ps)
DefLintype defs -> (a,d:r,c,ps)
DefLincat defs -> (a,r,d:c,ps)
DefLindef defs -> (a,r,d:c,ps)
DefLin defs -> (a,r,d:c,ps)
DefPattern defs -> (a,r,d:c,ps)
DefFlag defs -> (a,r,d:c,ps) --- a guess
DefPrintCat printdefs -> (a,r,d:c,ps)
DefPrintFun printdefs -> (a,r,d:c,ps)
DefPrintOld printdefs -> (a,r,d:c,ps)
DefPackage m ds -> (a,r,c,(m,ds):ps)
_ -> (a,r,c,ps)
mkAbs a = MModule q (MTAbstract absName) (MBody ne (Opens []) (topDefs a))
mkRes ps r = MModule q (MTResource resName) (MBody ne (Opens ops) (topDefs r))
where ops = map OName ps
mkCnc ps r = MModule q (MTConcrete cncName absName)
(MBody ne (Opens (map OName (resName:ps))) (topDefs r))
mkPack (m, ds) = MModule q (MTResource m) (MBody ne (Opens []) (topDefs ds))
topDefs t = t
ne = NoExt
q = CMCompl
@@ -551,12 +557,18 @@ transInclude x = case x of
where
trans f = case f of
FString s -> s
FIdent (IC s) -> s
FIdent (IC s) -> let s' = init s ++ [toLower (last s)] in
if elem s' newReservedWords then s' else s
--- unsafe hack ; cf. GetGrammar.oldLexer
FSlash filename -> '/' : trans filename
FDot filename -> '.' : trans filename
FMinus filename -> '-' : trans filename
FAddId (IC s) filename -> s ++ trans filename
newReservedWords =
words $ "abstract concrete interface incomplete " ++
"instance out open resource reuse transfer union with where"
termInPattern :: G.Term -> G.Term
termInPattern t = M.mkAbs xx $ G.R [(s, (Nothing, toP body))] where
toP t = case t of

18
src/GF/Source/TestGF.hs
View File

@@ -1,5 +1,9 @@
-- automatically generated by BNF Converter
module TestGF where
module Main where
import IO ( stdin, hGetContents )
import System ( getArgs, getProgName )
import LexGF
import ParGF
@@ -13,13 +17,21 @@ type ParseFun a = [Token] -> Err a
myLLexer = myLexer
runFile :: (Print a, Show a) => ParseFun a -> FilePath -> IO()
runFile :: (Print a, Show a) => ParseFun a -> FilePath -> IO ()
runFile p f = readFile f >>= run p
run :: (Print a, Show a) => ParseFun a -> String -> IO()
run :: (Print a, Show a) => ParseFun a -> String -> IO ()
run p s = case (p (myLLexer s)) of
Bad s -> do putStrLn "\nParse Failed...\n"
putStrLn s
Ok tree -> do putStrLn "\nParse Successful!"
putStrLn $ "\n[Abstract Syntax]\n\n" ++ show tree
putStrLn $ "\n[Linearized tree]\n\n" ++ printTree tree
main :: IO ()
main = do args <- getArgs
case args of
[] -> hGetContents stdin >>= run pGrammar
[f] -> runFile pGrammar f
_ -> do progName <- getProgName
putStrLn $ progName ++ ": excess arguments."