diff options
| author | aarne <aarne@cs.chalmers.se> | 2008-06-25 16:54:35 +0000 |
|---|---|---|
| committer | aarne <aarne@cs.chalmers.se> | 2008-06-25 16:54:35 +0000 |
| commit | e9e80fc389365e24d4300d7d5390c7d833a96c50 (patch) | |
| tree | f0b58473adaa670bd8fc52ada419d8cad470ee03 /src-3.0/Transfer/Syntax/Layout.hs | |
| parent | b96b36f43de3e2f8b58d5f539daa6f6d47f25870 (diff) | |
changed names of resource-1.3; added a note on homepage on release
Diffstat (limited to 'src-3.0/Transfer/Syntax/Layout.hs')
| -rw-r--r-- | src-3.0/Transfer/Syntax/Layout.hs | 227 |
1 files changed, 0 insertions, 227 deletions
diff --git a/src-3.0/Transfer/Syntax/Layout.hs b/src-3.0/Transfer/Syntax/Layout.hs deleted file mode 100644 index de5c99870..000000000 --- a/src-3.0/Transfer/Syntax/Layout.hs +++ /dev/null @@ -1,227 +0,0 @@ -module Transfer.Syntax.Layout where - -import Transfer.Syntax.Lex - - -import Data.Maybe (isNothing, fromJust) - --- Generated by the BNF Converter - --- local parameters - -topLayout = True -layoutWords = ["let","where","of","rec","sig","do"] -layoutStopWords = ["in"] - --- layout separators - -layoutOpen = "{" -layoutClose = "}" -layoutSep = ";" - --- | Replace layout syntax with explicit layout tokens. -resolveLayout :: Bool -- ^ Whether to use top-level layout. - -> [Token] -> [Token] -resolveLayout tp = res Nothing [if tl then Implicit 1 else Explicit] - where - -- Do top-level layout if the function parameter and the grammar say so. - tl = tp && topLayout - - res :: Maybe Token -- ^ The previous token, if any. - -> [Block] -- ^ A stack of layout blocks. - -> [Token] -> [Token] - - -- The stack should never be empty. - res _ [] ts = error $ "Layout error: stack empty. Tokens: " ++ show ts - - res _ st (t0:ts) - -- We found an open brace in the input, - -- put an explicit layout block on the stack. - -- This is done even if there was no layout word, - -- to keep opening and closing braces. - | isLayoutOpen t0 = moveAlong (Explicit:st) [t0] ts - - res _ st (t0:ts) - -- Start a new layout block if the first token is a layout word - | isLayout t0 = - case ts of - -- Explicit layout, just move on. The case above - -- will push an explicit layout block. - t1:_ | isLayoutOpen t1 -> moveAlong st [t0] ts - -- at end of file, the start column doesn't matter - _ -> let col = if null ts then column t0 else column (head ts) - -- insert an open brace after the layout word - b:ts' = addToken (nextPos t0) layoutOpen ts - -- save the start column - st' = Implicit col:st - in moveAlong st' [t0,b] ts' - - -- If we encounter a closing brace, exit the first explicit layout block. - | isLayoutClose t0 = - let st' = drop 1 (dropWhile isImplicit st) - in if null st' - then error $ "Layout error: Found " ++ layoutClose ++ " at (" - ++ show (line t0) ++ "," ++ show (column t0) - ++ ") without an explicit layout block." - else moveAlong st' [t0] ts - - -- We are in an implicit layout block - res pt st@(Implicit n:ns) (t0:ts) - - -- End of implicit block by a layout stop word - | isStop t0 = - -- Exit the current block and all implicit blocks - -- more indented than the current token - let (ebs,ns') = span (`moreIndent` column t0) ns - moreIndent (Implicit x) y = x > y - moreIndent Explicit _ = False - -- the number of blocks exited - b = 1 + length ebs - bs = replicate b layoutClose - -- Insert closing braces after the previous token. - (ts1,ts2) = splitAt (1+b) $ addTokens (afterPrev pt) bs (t0:ts) - in moveAlong ns' ts1 ts2 - - -- End of an implicit layout block - | newLine && column t0 < n = - -- Insert a closing brace after the previous token. - let b:t0':ts' = addToken (afterPrev pt) layoutClose (t0:ts) - -- Repeat, with the current block removed from the stack - in moveAlong ns [b] (t0':ts') - - -- Encounted a new line in an implicit layout block. - | newLine && column t0 == n = - -- Insert a semicolon after the previous token. - -- unless we are the beginning of the file, - -- or the previous token is a semicolon or open brace. - if isNothing pt || isTokenIn [layoutSep,layoutOpen] (fromJust pt) - then moveAlong st [t0] ts - else let b:t0':ts' = addToken (afterPrev pt) layoutSep (t0:ts) - in moveAlong st [b,t0'] ts' - where newLine = case pt of - Nothing -> True - Just t -> line t /= line t0 - - -- Nothing to see here, move along. - res _ st (t:ts) = moveAlong st [t] ts - - -- At EOF: skip explicit blocks. - res (Just t) (Explicit:bs) [] | null bs = [] - | otherwise = res (Just t) bs [] - - -- If we are using top-level layout, insert a semicolon after - -- the last token, if there isn't one already - res (Just t) [Implicit n] [] - | isTokenIn [layoutSep] t = [] - | otherwise = addToken (nextPos t) layoutSep [] - - -- At EOF in an implicit, non-top-level block: close the block - res (Just t) (Implicit n:bs) [] = - let c = addToken (nextPos t) layoutClose [] - in moveAlong bs c [] - - -- This should only happen if the input is empty. - res Nothing st [] = [] - - -- | Move on to the next token. - moveAlong :: [Block] -- ^ The layout stack. - -> [Token] -- ^ Any tokens just processed. - -> [Token] -- ^ the rest of the tokens. - -> [Token] - moveAlong st [] ts = error $ "Layout error: moveAlong got [] as old tokens" - moveAlong st ot ts = ot ++ res (Just $ last ot) st ts - -data Block = Implicit Int -- ^ An implicit layout block with its start column. - | Explicit - deriving Show - -type Position = Posn - --- | Check if s block is implicit. -isImplicit :: Block -> Bool -isImplicit (Implicit _) = True -isImplicit _ = False - --- | Insert a number of tokens at the begninning of a list of tokens. -addTokens :: Position -- ^ Position of the first new token. - -> [String] -- ^ Token symbols. - -> [Token] -- ^ The rest of the tokens. These will have their - -- positions updated to make room for the new tokens . - -> [Token] -addTokens p ss ts = foldr (addToken p) ts ss - --- | Insert a new symbol token at the begninning of a list of tokens. -addToken :: Position -- ^ Position of the new token. - -> String -- ^ Symbol in the new token. - -> [Token] -- ^ The rest of the tokens. These will have their - -- positions updated to make room for the new token. - -> [Token] -addToken p s ts = sToken p s : map (incrGlobal p (length s)) ts - --- | Get the position immediately to the right of the given token. --- If no token is given, gets the first position in the file. -afterPrev :: Maybe Token -> Position -afterPrev = maybe (Pn 0 1 1) nextPos - --- | Get the position immediately to the right of the given token. -nextPos :: Token -> Position -nextPos t = Pn (g + s) l (c + s + 1) - where Pn g l c = position t - s = tokenLength t - --- | Add to the global and column positions of a token. --- The column position is only changed if the token is on --- the same line as the given position. -incrGlobal :: Position -- ^ If the token is on the same line - -- as this position, update the column position. - -> Int -- ^ Number of characters to add to the position. - -> Token -> Token -incrGlobal (Pn _ l0 _) i (PT (Pn g l c) t) = - if l /= l0 then PT (Pn (g + i) l c) t - else PT (Pn (g + i) l (c + i)) t -incrGlobal _ _ p = error $ "cannot add token at " ++ show p - --- | Create a symbol token. -sToken :: Position -> String -> Token -sToken p s = PT p (TS s) -- reserved word or symbol - --- | Get the position of a token. -position :: Token -> Position -position t = case t of - PT p _ -> p - Err p -> p - --- | Get the line number of a token. -line :: Token -> Int -line t = case position t of Pn _ l _ -> l - --- | Get the column number of a token. -column :: Token -> Int -column t = case position t of Pn _ _ c -> c - --- | Check if a token is one of the given symbols. -isTokenIn :: [String] -> Token -> Bool -isTokenIn ts t = case t of - PT _ (TS r) | elem r ts -> True - _ -> False - --- | Check if a word is a layout start token. -isLayout :: Token -> Bool -isLayout = isTokenIn layoutWords - --- | Check if a token is a layout stop token. -isStop :: Token -> Bool -isStop = isTokenIn layoutStopWords - --- | Check if a token is the layout open token. -isLayoutOpen :: Token -> Bool -isLayoutOpen = isTokenIn [layoutOpen] - --- | Check if a token is the layout close token. -isLayoutClose :: Token -> Bool -isLayoutClose = isTokenIn [layoutClose] - --- | Get the number of characters in the token. -tokenLength :: Token -> Int -tokenLength t = length $ prToken t - |
