From 3522b2a3cd8d01ef1b908c1a717b0592332a5737 Mon Sep 17 00:00:00 2001
From: aarne <unknown>
Date: Thu, 10 Jun 2004 14:34:07 +0000
Subject: [PATCH] readfiles

---
 src/GF/API.hs                 |  4 +++-
 src/GF/Infra/ReadFiles.hs     | 15 ++++++++++-----
 src/GF/Shell/ShellCommands.hs |  4 ++--
 src/GF/UseGrammar/Linear.hs   |  8 ++++++--
 src/Today.hs                  |  2 +-
 5 files changed, 22 insertions(+), 11 deletions(-)

diff --git a/src/GF/API.hs b/src/GF/API.hs
index a9f836422..77bd71849 100644
--- a/src/GF/API.hs
+++ b/src/GF/API.hs
@@ -200,10 +200,12 @@ optLinearizeTree opts0 gr t = case getOptVal opts transferFun of
     | oElem showRecord opts = liftM prt . linearizeNoMark g c
     | oElem tableLin opts   = liftM (unlines . map untok . prLinTable) . 
                                 allLinTables g c
-    | otherwise             = return . untok . linTree2string mk g c
+    | oElem showAll opts    = return . unlines . linTree2strings mk g c
+    | otherwise             = return . unlines . optIntOrOne . linTree2strings mk g c
   g = grammar gr
   c = cncId gr
   untok = customOrDefault opts useUntokenizer customUntokenizer gr
+  optIntOrOne = take $ optIntOrN opts flagNumber 1
 
 {- ----
         untoksl . lin where
diff --git a/src/GF/Infra/ReadFiles.hs b/src/GF/Infra/ReadFiles.hs
index 46091c6b5..c4076ba8c 100644
--- a/src/GF/Infra/ReadFiles.hs
+++ b/src/GF/Infra/ReadFiles.hs
@@ -98,7 +98,8 @@ needCompile opts headers sfiles0 = paths $ res $ mark $ iter changed where
     let us = uses f in
     if not (all noComp us) then
       fp else 
-    if (typ f == MTyIncomplete || (not (null us) && all isAux us)) then
+    if (elem (typ f) [MTyIncomplete, MTyIncResource] || 
+        (not (null us) && all isAux us)) then
       (f,(p,CSDont)) else
       fp
 
@@ -124,7 +125,8 @@ needCompile opts headers sfiles0 = paths $ res $ mark $ iter changed where
   -- Also read res if the option "retain" is present
   res cs = map mkRes cs where
     mkRes x@(f,(path,st)) | elem st [CSRead,CSEnv] = case typ f of
-      MTyResource | not (null [m | (m,(_,CSComp)) <- cs,
+      t | elem t [MTyResource,MTyIncResource] &&
+          not (null [m | (m,(_,CSComp)) <- cs,
                                    Just ms <- [lookup m allDeps], elem f ms])
                     || oElem retainOpers opts
         -> (f,(path,CSRes))
@@ -177,6 +179,7 @@ data ModUse =
 data ModTyp =
    MTyResource
  | MTyIncomplete
+ | MTyIncResource -- interface, incomplete resource
  | MTyOther
   deriving (Eq,Show)
 
@@ -205,10 +208,12 @@ importsOfFile =
 
 getModuleHeader :: [String] -> ModuleHeader -- with, reuse
 getModuleHeader ws = case ws of
-  "incomplete":ws2 -> let ((_,name),us) = getModuleHeader ws2 in
-    ((MTyIncomplete,name),us)
+  "incomplete":ws2 -> let ((ty,name),us) = getModuleHeader ws2 in
+    case ty of
+      MTyResource -> ((MTyIncResource,name),us)
+      _ -> ((MTyIncomplete,name),us)
   "interface":ws2 -> let ((_,name),us) = getModuleHeader ("resource":ws2) in
-    ((MTyIncomplete,name),us)
+    ((MTyIncResource,name),us)
  
   "resource":name:ws2 -> case ws2 of
     "reuse":m:_ -> ((MTyResource,name),[(m,MUReuse)])
diff --git a/src/GF/Shell/ShellCommands.hs b/src/GF/Shell/ShellCommands.hs
index a0c40f3a6..650364d45 100644
--- a/src/GF/Shell/ShellCommands.hs
+++ b/src/GF/Shell/ShellCommands.hs
@@ -91,7 +91,7 @@ isValidOption st co op = case op of
        testValidFlag st o x
      _ -> Bad $ "impossible option" +++ prOpt op
   where
-   optsOf  co = fst $ optionsOfCommand co
+   optsOf  co = ("tr" :) $ fst $ optionsOfCommand co
    flagsOf co = snd $ optionsOfCommand co
 
 testValidFlag :: ShellState -> OptFunId -> String -> Err ()
@@ -134,7 +134,7 @@ optionsOfCommand co = case co of
   CTransformGrammar _ -> flags "printer"
   CConvertLatex _ -> none
   CLinearize _ -> both "table struct record" "lang number unlexer"
-  CParse -> both "n ign raw v" "cat lang lexer parser number"
+  CParse -> both "new n ign raw v" "cat lang lexer parser number"
   CTranslate _ _ -> opts "cat lexer parser"
   CGenerateRandom -> flags "cat lang number depth"
   CGenerateTrees -> both "metas" "depth alts cat lang number"
diff --git a/src/GF/UseGrammar/Linear.hs b/src/GF/UseGrammar/Linear.hs
index 8e9deb3c5..954500822 100644
--- a/src/GF/UseGrammar/Linear.hs
+++ b/src/GF/UseGrammar/Linear.hs
@@ -125,12 +125,16 @@ unlex = concat . map sstr . take 1 ----
 
 -- finally, a top-level function to get a string from an expression
 linTree2string :: Marker -> CanonGrammar -> Ident -> A.Tree -> String
-linTree2string mk gr m e = err id id $ do
+linTree2string mk gr m e = head $ linTree2strings mk gr m e -- never empty
+
+-- you can also get many strings
+linTree2strings :: Marker -> CanonGrammar -> Ident -> A.Tree -> [String]
+linTree2strings mk gr m e = err return id $ do
   t  <- linearizeToRecord gr mk m e
   r  <- expandLinTables gr t
   ts <- rec2strTables r
   let ss = strs2strings $ sTables2strs $ strTables2sTables ts
-  ifNull (prtBad "empty linearization of" e) (return . head) ss
+  ifNull (prtBad "empty linearization of" e) return ss   -- thus never empty
 
 -- argument is a Tree, value is a list of strs; needed in Parsing
 
diff --git a/src/Today.hs b/src/Today.hs
index ff873bb57..2a57a3e39 100644
--- a/src/Today.hs
+++ b/src/Today.hs
@@ -1 +1 @@
-module Today where today = "Thu Jun  3 22:31:54 CEST 2004"
+module Today where today = "Thu Jun 10 16:36:31 CEST 2004"