diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/GF/API.hs | 4 | ||||
| -rw-r--r-- | src/GF/Infra/ReadFiles.hs | 15 | ||||
| -rw-r--r-- | src/GF/Shell/ShellCommands.hs | 4 | ||||
| -rw-r--r-- | src/GF/UseGrammar/Linear.hs | 8 | ||||
| -rw-r--r-- | 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" |