mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-17 00:39:32 -06:00
readfiles
This commit is contained in:
@@ -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
|
||||
|
||||
@@ -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)])
|
||||
|
||||
@@ -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"
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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"
|
||||
|
||||
Reference in New Issue
Block a user