From 27508654c01c5ebad3c495629ccbd49c067429ab Mon Sep 17 00:00:00 2001 From: aarne Date: Thu, 6 Mar 2008 21:27:14 +0000 Subject: [PATCH] option -mac to vt command (uses open with ps) --- src/GF/Devel/Compile/CheckGrammar.hs | 3 +-- src/GF/Devel/Compile/SourceToGF.hs | 6 ++++-- src/GF/Devel/Grammar/Construct.hs | 2 +- src/GF/Devel/Grammar/Grammar.hs | 14 +++++++------- src/GF/Devel/README-testgf3 | 13 +++++++++++++ src/GF/Infra/CompactPrint.hs | 3 ++- src/GF/Shell.hs | 6 ++++-- 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 ->