summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/GF/Devel/Compile/CheckGrammar.hs3
-rw-r--r--src/GF/Devel/Compile/SourceToGF.hs6
-rw-r--r--src/GF/Devel/Grammar/Construct.hs2
-rw-r--r--src/GF/Devel/Grammar/Grammar.hs14
-rw-r--r--src/GF/Devel/README-testgf313
-rw-r--r--src/GF/Infra/CompactPrint.hs3
-rw-r--r--src/GF/Shell.hs6
7 files changed, 32 insertions, 15 deletions
diff --git a/src/GF/Devel/Compile/CheckGrammar.hs b/src/GF/Devel/Compile/CheckGrammar.hs
index e9daa1f64..30ea0a70e 100644
--- a/src/GF/Devel/Compile/CheckGrammar.hs
+++ b/src/GF/Devel/Compile/CheckGrammar.hs
@@ -68,7 +68,7 @@ showCheckModule mos m = do
checkModule :: GF -> SourceModule -> Check SourceModule
checkModule gf0 (name,mo) = checkIn ("checking module" +++ prt name) $ do
let gr = gf0 {gfmodules = Map.insert name mo (gfmodules gf0)}
----- checkRestrictedInheritance gr (name, mo)
+ ---- checkRestrictedInheritance gr (name, mo)
mo1 <- case mtype mo of
MTAbstract -> judgementOpModule (checkAbsInfo gr name) mo
MTGrammar -> entryOpModule (checkResInfo gr name) mo
@@ -83,7 +83,6 @@ checkModule gf0 (name,mo) = checkIn ("checking module" +++ prt name) $ do
MTInstance iname -> do
intf <- checkErr $ lookupModule gr iname
- -- checkCompleteInstance abs mo -- this is done in Rebuild
entryOpModule (checkResInfo gr name) mo
return $ (name, mo1)
diff --git a/src/GF/Devel/Compile/SourceToGF.hs b/src/GF/Devel/Compile/SourceToGF.hs
index 7e3228dc1..a62179c18 100644
--- a/src/GF/Devel/Compile/SourceToGF.hs
+++ b/src/GF/Devel/Compile/SourceToGF.hs
@@ -266,7 +266,8 @@ transResDef x = case x of
returnl [(f, resOper pt pe) | (f,(pt,pe)) <- defs']
DefFlag defs -> liftM (Right . concat) $ mapM transFlagDef defs
- _ -> Bad $ "illegal definition form in resource" +++ printTree x
+ _ -> return $ Left [] ----
+---- _ -> Bad $ "illegal definition form in resource" +++ printTree x
where
mkParamDefs (p,pars) =
@@ -317,7 +318,8 @@ transCncDef x = case x of
let defs2 = [(f, termInPattern t) | (f,(_,Yes t)) <- defs']
returnl [(f, G.CncFun Nothing (yes t) nope) | (f,t) <- defs2]
-}
- _ -> errIn ("illegal definition in concrete syntax:") $ transResDef x
+ _ -> return $ Left [] ----
+---- _ -> errIn ("illegal definition in concrete syntax:") $ transResDef x
transPrintDef :: Def -> Err [(Ident,G.Term)]
transPrintDef x = case x of
diff --git a/src/GF/Devel/Grammar/Construct.hs b/src/GF/Devel/Grammar/Construct.hs
index eb4ce857d..5b4215843 100644
--- a/src/GF/Devel/Grammar/Construct.hs
+++ b/src/GF/Devel/Grammar/Construct.hs
@@ -69,7 +69,7 @@ isLink j = jform j == JLink
-- constructing judgements from parse tree
emptyJudgement :: JudgementForm -> Judgement
-emptyJudgement form = Judgement form meta meta meta (identC "#NOLINK") 0 where
+emptyJudgement form = Judgement form meta meta meta (identC "#") 0 where
meta = Meta 0
addJType :: Type -> Judgement -> Judgement
diff --git a/src/GF/Devel/Grammar/Grammar.hs b/src/GF/Devel/Grammar/Grammar.hs
index 9a9855f8e..df5a3907e 100644
--- a/src/GF/Devel/Grammar/Grammar.hs
+++ b/src/GF/Devel/Grammar/Grammar.hs
@@ -22,7 +22,7 @@ data Module = Module {
mtype :: ModuleType,
miscomplete :: Bool,
minterfaces :: [(Ident,Ident)], -- non-empty for functors
- minstances :: [((Ident,MInclude),[(Ident,Ident)])], -- non-empty for instant'ions
+ minstances :: [((Ident,MInclude),[(Ident,Ident)])], -- non-empty for inst'ions
mextends :: [(Ident,MInclude)],
mopens :: [(Ident,Ident)], -- used name, original name
mflags :: Map Ident String,
@@ -49,8 +49,8 @@ data Judgement = Judgement {
jtype :: Type, -- context type lincat - type PType
jdef :: Term, -- lindef def lindef lin def constrs
jprintname :: Term, -- - - prname prname - -
- jlink :: Ident,
- jposition :: Int
+ jlink :: Ident, -- if inherited, the supermodule name, else #
+ jposition :: Int -- line number where def begins
}
deriving Show
@@ -136,11 +136,11 @@ data Patt =
| PAlt Patt Patt -- ^ disjunctive pattern: p1 | p2
| PSeq Patt Patt -- ^ sequence of token parts: p + q
| PRep Patt -- ^ repetition of token part: p*
- | PChar -- ^ string of length one
- | PChars String -- ^ list of characters
+ | PChar -- ^ string of length one: ?
+ | PChars String -- ^ list of characters: ["aeiou"]
- | PMacro Ident --
- | PM Ident Ident
+ | PMacro Ident -- #p
+ | PM Ident Ident -- #m.p
deriving (Read, Show, Eq, Ord)
diff --git a/src/GF/Devel/README-testgf3 b/src/GF/Devel/README-testgf3
index 15f1be449..0d1b6e80a 100644
--- a/src/GF/Devel/README-testgf3
+++ b/src/GF/Devel/README-testgf3
@@ -34,3 +34,16 @@ More options (debugging flags):
-4 -- ... type checking
-5 -- ... refreshing
+==Compiler Phases==
+
+LexGF
+ParGF
+SourceToGF
+Extend
+Rename
+CheckGrammar
+Refresh
+Optimize
+Factorize
+GFtoGFCC
+
diff --git a/src/GF/Infra/CompactPrint.hs b/src/GF/Infra/CompactPrint.hs
index 7b37679ee..486c9e183 100644
--- a/src/GF/Infra/CompactPrint.hs
+++ b/src/GF/Infra/CompactPrint.hs
@@ -12,7 +12,8 @@ dps = dropWhile isSpace
spaceIf pre post w = case w of
_ | pre w -> "\n" ++ w
_ | post w -> w ++ "\n"
- c:cs | isAlpha c || isDigit c -> " " ++ w
+ c:_ | isAlpha c || isDigit c -> " " ++ w
+ '_':_ -> " " ++ w
_ -> w
keywordGF w = elem w ["cat","fun","lin","lincat","lindef","oper","param"]
diff --git a/src/GF/Shell.hs b/src/GF/Shell.hs
index e0b01f18f..b884534bd 100644
--- a/src/GF/Shell.hs
+++ b/src/GF/Shell.hs
@@ -365,9 +365,10 @@ execC co@(comm, opts0) sa@(sh@(st,(h,_,_,_)),a) = checkOptions st co >> case com
CShowTreeGraph | oElem emitCode opts -> do -- -o
returnArg (AString $ visualizeTrees opts $ strees $ s2t a) sa
CShowTreeGraph -> do
+ let gv = if oElem (iOpt "mac") opts then "open" else "gv" ---- config!
let g0 = writeFile "grphtmp.dot" $ visualizeTrees opts $ strees $ s2t a
g1 = system "dot -Tps grphtmp.dot >grphtmp.ps"
- g2 = system "gv grphtmp.ps &"
+ g2 = system (gv +++ "grphtmp.ps &")
g3 = return () ---- system "rm -f grphtmp.*"
justOutput opts (g0 >> g1 >> g2 >> g3 >> return ()) sa
@@ -453,9 +454,10 @@ execC co@(comm, opts0) sa@(sh@(st,(h,_,_,_)),a) = checkOptions st co >> case com
returnArg (AString (optPrintMultiGrammar opts cgr')) sa
CShowGrammarGraph -> do
---- sa' <- changeState purgeShellState sa
+ let gv = if oElem (iOpt "mac") opts then "open" else "gv" ---- config!
let g0 = writeFile "grphtmp.dot" $ visualizeCanonGrammar opts cgr
g1 = system "dot -Tps grphtmp.dot >grphtmp.ps"
- g2 = system "gv grphtmp.ps &"
+ g2 = system (gv +++ "grphtmp.ps &")
g3 = return () ---- system "rm -f grphtmp.*"
justOutput opts (g0 >> g1 >> g2 >> g3 >> return ()) sa
CPrintSourceGrammar ->