arbitrary lincat records; noparse pragmas

2 files changed, 54 insertions, 6 deletions

diff --git a/src/GF/Compile/NoParse.hs b/src/GF/Compile/NoParse.hs
new file mode 100644
index 000000000..0e37c9f95
--- /dev/null
+++ b/src/GF/Compile/NoParse.hs
@@ -0,0 +1,47 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : NoParse
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/11/14 16:03:41 $ 
+-- > CVS $Author: aarne $
+-- > CVS $Revision: 1.1 $
+--
+-- Probabilistic abstract syntax. AR 30\/10\/2005
+--
+-- (c) Aarne Ranta 2005 under GNU GPL
+--
+-- Contents: decide what lin rules no parser is generated.
+-- Usually a list of noparse idents from 'i -boparse=file'.
+
+-----------------------------------------------------------------------------
+
+module GF.Compile.NoParse (
+  NoParse             -- =  Ident -> Bool
+ ,getNoparseFromFile  -- :: Opts -> IO NoParse
+ ,doParseAll          -- :: NoParse
+  ) where
+
+import GF.Infra.Ident
+import GF.Data.Operations
+import GF.Infra.Option
+
+
+type NoParse = (Ident -> Bool)
+
+doParseAll :: NoParse
+doParseAll = const False
+
+getNoparseFromFile :: Options -> FilePath -> IO NoParse
+getNoparseFromFile opts file = do 
+  let f = maybe file id $ getOptVal opts noparseFile
+  s <- readFile f
+  return $ igns s
+ where
+   igns s i = isInBinTree i $ buildTree $ flip zip (repeat ()) $ concat $ map getIgnores $ lines s
+-- where
+getIgnores s = case dropWhile (/="--#") (words s) of
+     _:"noparse":fs -> map identC fs
+     _ -> []
diff --git a/src/GF/Compile/ShellState.hs b/src/GF/Compile/ShellState.hs
index 3773d59f9..16285c44c 100644
--- a/src/GF/Compile/ShellState.hs
+++ b/src/GF/Compile/ShellState.hs
@@ -5,9 +5,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/11/11 23:24:34 $ 
+-- > CVS $Date: 2005/11/14 16:03:41 $ 
 -- > CVS $Author: aarne $
--- > CVS $Revision: 1.52 $
+-- > CVS $Revision: 1.53 $
 --
 -- (Description of the module)
 -----------------------------------------------------------------------------
@@ -32,6 +32,7 @@ import GF.CF.CFIdent
 import GF.CF.CanonToCF
 import GF.UseGrammar.Morphology
 import GF.Probabilistic.Probabilistic
+import GF.Compile.NoParse
 import GF.Infra.Option
 import GF.Infra.Ident
 import GF.System.Arch (ModTime)
@@ -174,14 +175,14 @@ cncModuleIdST = stateGrammarST
 -- | form a shell state from a canonical grammar
 grammar2shellState :: Options -> (CanonGrammar, G.SourceGrammar) -> Err ShellState 
 grammar2shellState opts (gr,sgr) = 
-  updateShellState opts Nothing emptyShellState ((0,sgr,gr),[]) --- is 0 safe?
+  updateShellState opts doParseAll Nothing emptyShellState ((0,sgr,gr),[]) --- is 0 safe?
 
 -- | update a shell state from a canonical grammar
-updateShellState :: Options -> Maybe Ident -> ShellState -> 
+updateShellState :: Options -> NoParse -> Maybe Ident -> ShellState -> 
                     ((Int,G.SourceGrammar,CanonGrammar),[(FilePath,ModTime)]) ->
                ---- (CanonGrammar,(G.SourceGrammar,[(FilePath,ModTime)])) -> 
                     Err ShellState 
-updateShellState opts mcnc sh ((_,sgr,gr),rts) = do 
+updateShellState opts ign mcnc sh ((_,sgr,gr),rts) = do 
   let cgr0 = M.updateMGrammar (canModules sh) gr
 
   -- a0 = abstract of old state
@@ -210,7 +211,7 @@ updateShellState opts mcnc sh ((_,sgr,gr),rts) = do
       concr0 = ifNull Nothing (return . head) concrs
       notInrts f = notElem f $ map fst rts
       subcgr = unSubelimCanon cgr
-  cfs <- mapM (canon2cf opts subcgr) concrs --- why need to update all...
+  cfs <- mapM (canon2cf opts ign subcgr) concrs --- why need to update all...
 
   let morphos = map (mkMorpho subcgr) concrs
   let probss = [] -----