mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-22 11:19:32 -06:00
GF/src is now for 2.9, and the new sources are in src-3.0 - keep it this way until the release of GF 3
This commit is contained in:
29
src-3.0/Transfer/Syntax/ResolveLayout.hs
Normal file
29
src-3.0/Transfer/Syntax/ResolveLayout.hs
Normal file
@@ -0,0 +1,29 @@
|
||||
module Main where
|
||||
|
||||
import System.Environment (getArgs)
|
||||
|
||||
import Transfer.Syntax.Lex
|
||||
import Transfer.Syntax.Layout
|
||||
|
||||
prTokens :: [Token] -> String
|
||||
prTokens = prTokens_ 1 1
|
||||
where
|
||||
prTokens_ _ _ [] = ""
|
||||
prTokens_ l c (t@(PT (Pn _ l' c') _):ts) =
|
||||
replicate (l'-l) '\n'
|
||||
++ replicate (if l' == l then c'-c else c'-1) ' '
|
||||
++ s ++ prTokens_ l' (c'+length s) ts
|
||||
where s = prToken t
|
||||
-- prTokens_ l c (Err p:ts) =
|
||||
|
||||
layout :: String -> String
|
||||
layout s = prTokens ts'
|
||||
-- ++ "\n" ++ show ts'
|
||||
where ts = tokens s
|
||||
ts' = resolveLayout True ts
|
||||
|
||||
main :: IO ()
|
||||
main = do args <- getArgs
|
||||
case args of
|
||||
[] -> getContents >>= putStrLn . layout
|
||||
fs -> mapM_ (\f -> readFile f >>= putStrLn . layout) fs
|
||||
Reference in New Issue
Block a user