mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-23 19:42:50 -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 showRecord opts = liftM prt . linearizeNoMark g c
|
||||||
| oElem tableLin opts = liftM (unlines . map untok . prLinTable) .
|
| oElem tableLin opts = liftM (unlines . map untok . prLinTable) .
|
||||||
allLinTables g c
|
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
|
g = grammar gr
|
||||||
c = cncId gr
|
c = cncId gr
|
||||||
untok = customOrDefault opts useUntokenizer customUntokenizer gr
|
untok = customOrDefault opts useUntokenizer customUntokenizer gr
|
||||||
|
optIntOrOne = take $ optIntOrN opts flagNumber 1
|
||||||
|
|
||||||
{- ----
|
{- ----
|
||||||
untoksl . lin where
|
untoksl . lin where
|
||||||
|
|||||||
@@ -98,7 +98,8 @@ needCompile opts headers sfiles0 = paths $ res $ mark $ iter changed where
|
|||||||
let us = uses f in
|
let us = uses f in
|
||||||
if not (all noComp us) then
|
if not (all noComp us) then
|
||||||
fp else
|
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
|
(f,(p,CSDont)) else
|
||||||
fp
|
fp
|
||||||
|
|
||||||
@@ -124,7 +125,8 @@ needCompile opts headers sfiles0 = paths $ res $ mark $ iter changed where
|
|||||||
-- Also read res if the option "retain" is present
|
-- Also read res if the option "retain" is present
|
||||||
res cs = map mkRes cs where
|
res cs = map mkRes cs where
|
||||||
mkRes x@(f,(path,st)) | elem st [CSRead,CSEnv] = case typ f of
|
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])
|
Just ms <- [lookup m allDeps], elem f ms])
|
||||||
|| oElem retainOpers opts
|
|| oElem retainOpers opts
|
||||||
-> (f,(path,CSRes))
|
-> (f,(path,CSRes))
|
||||||
@@ -177,6 +179,7 @@ data ModUse =
|
|||||||
data ModTyp =
|
data ModTyp =
|
||||||
MTyResource
|
MTyResource
|
||||||
| MTyIncomplete
|
| MTyIncomplete
|
||||||
|
| MTyIncResource -- interface, incomplete resource
|
||||||
| MTyOther
|
| MTyOther
|
||||||
deriving (Eq,Show)
|
deriving (Eq,Show)
|
||||||
|
|
||||||
@@ -205,10 +208,12 @@ importsOfFile =
|
|||||||
|
|
||||||
getModuleHeader :: [String] -> ModuleHeader -- with, reuse
|
getModuleHeader :: [String] -> ModuleHeader -- with, reuse
|
||||||
getModuleHeader ws = case ws of
|
getModuleHeader ws = case ws of
|
||||||
"incomplete":ws2 -> let ((_,name),us) = getModuleHeader ws2 in
|
"incomplete":ws2 -> let ((ty,name),us) = getModuleHeader ws2 in
|
||||||
((MTyIncomplete,name),us)
|
case ty of
|
||||||
|
MTyResource -> ((MTyIncResource,name),us)
|
||||||
|
_ -> ((MTyIncomplete,name),us)
|
||||||
"interface":ws2 -> let ((_,name),us) = getModuleHeader ("resource":ws2) in
|
"interface":ws2 -> let ((_,name),us) = getModuleHeader ("resource":ws2) in
|
||||||
((MTyIncomplete,name),us)
|
((MTyIncResource,name),us)
|
||||||
|
|
||||||
"resource":name:ws2 -> case ws2 of
|
"resource":name:ws2 -> case ws2 of
|
||||||
"reuse":m:_ -> ((MTyResource,name),[(m,MUReuse)])
|
"reuse":m:_ -> ((MTyResource,name),[(m,MUReuse)])
|
||||||
|
|||||||
@@ -91,7 +91,7 @@ isValidOption st co op = case op of
|
|||||||
testValidFlag st o x
|
testValidFlag st o x
|
||||||
_ -> Bad $ "impossible option" +++ prOpt op
|
_ -> Bad $ "impossible option" +++ prOpt op
|
||||||
where
|
where
|
||||||
optsOf co = fst $ optionsOfCommand co
|
optsOf co = ("tr" :) $ fst $ optionsOfCommand co
|
||||||
flagsOf co = snd $ optionsOfCommand co
|
flagsOf co = snd $ optionsOfCommand co
|
||||||
|
|
||||||
testValidFlag :: ShellState -> OptFunId -> String -> Err ()
|
testValidFlag :: ShellState -> OptFunId -> String -> Err ()
|
||||||
@@ -134,7 +134,7 @@ optionsOfCommand co = case co of
|
|||||||
CTransformGrammar _ -> flags "printer"
|
CTransformGrammar _ -> flags "printer"
|
||||||
CConvertLatex _ -> none
|
CConvertLatex _ -> none
|
||||||
CLinearize _ -> both "table struct record" "lang number unlexer"
|
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"
|
CTranslate _ _ -> opts "cat lexer parser"
|
||||||
CGenerateRandom -> flags "cat lang number depth"
|
CGenerateRandom -> flags "cat lang number depth"
|
||||||
CGenerateTrees -> both "metas" "depth alts cat lang number"
|
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
|
-- finally, a top-level function to get a string from an expression
|
||||||
linTree2string :: Marker -> CanonGrammar -> Ident -> A.Tree -> String
|
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
|
t <- linearizeToRecord gr mk m e
|
||||||
r <- expandLinTables gr t
|
r <- expandLinTables gr t
|
||||||
ts <- rec2strTables r
|
ts <- rec2strTables r
|
||||||
let ss = strs2strings $ sTables2strs $ strTables2sTables ts
|
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
|
-- 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