From 5fc3a21c54c065ffd98755fb364f1faaa84c32ec Mon Sep 17 00:00:00 2001 From: Iavor Diatchki Date: Wed, 28 Apr 2021 17:25:40 -0700 Subject: [PATCH 1/6] Checkpoint: improvements to layout --- src/Cryptol/Parser/LexerUtils.hs | 191 +++++++++++++++++++++++++++---- 1 file changed, 169 insertions(+), 22 deletions(-) diff --git a/src/Cryptol/Parser/LexerUtils.hs b/src/Cryptol/Parser/LexerUtils.hs index 7b18c515e..42eed9871 100644 --- a/src/Cryptol/Parser/LexerUtils.hs +++ b/src/Cryptol/Parser/LexerUtils.hs @@ -377,9 +377,121 @@ startsLayout (KW KW_private) = True startsLayout (KW KW_parameter) = True startsLayout _ = False +endsLayout :: TokenT -> Bool +endsLayout ty = + case ty of + Sym Comma -> True + Sym BracketL -> True + Sym ParenR -> True + Sym BracketR -> True + _ -> False + +{- + +We assume the existence of an explicit EOF token at the end of the input. This token is *less* indented +than all other tokens (i.e., it is at column 0) + +Explicit Layout Blocks + + * The symbols `(`, `{`, and `[` start an explicit layout block. + * While in an explicit layout block we pass through tokens, except: + - We may start new implicit or explicit layout blocks + - We terminate the current layout block if we encounter the matching + closing symbol `)`, `}`, `]` + +Implicit Layout Blocks + + * The keywords `where`, `private`, and `parameter` start an implicit + layout block. + * The layout block starts at the column of the *following* token and we + insert "virtual start block" between the current and the following tokens. + * While in an implicit layout block: + - We may start new implicit or explicit layout blocks + - We insert a "virtual separator" before tokens starting at the same + column as the layout block, EXCEPT: + * we do not insert a separator if the previous token was a + "documentation comment" + * we do not insert a separator before the first token in the block + + - The implicit layout block is ended by one of the tokens + `,`, `)`, `}`, `]`, or a token than is less indented that the + block's column. + - When an implicit layout block ends, we insert a "virtual end block" + token just before the token that caused the block to end. + +Examples: + +f = x where x = 0x1 -- end implicit layout by layout (`g` is less indented than `x`) +g = 0x3 + +f (x where x = 2) -- end implicit layout by `)` + +[ x where x = 2, 3 ] -- end implicit layout by `,` + +module A where -- two implicit layout blocks with the *same* indentation (`where` and `private`) +private +x = 0x2 +-} + + + + +layout' :: Config -> [Located Token] -> [Located Token] +layout' cfg = go [] 0 False -- XXX: consult CFG for initial state + where + {- State parameters: + stack: the stack of implicit and explicit blocks + lastVirt: the indentation of the outer most implicit block (or 0, if none) + noVirtSep: do not emit a virtual separator even if token matches block alignment + tokens: remaining tokens to process + -} + + go stack lastVirt noVirtSep tokens + + -- End implicit layout due to indentation. + -- Note that the outermost layout block, even if we have + -- some explicit layout blocks due to parens. + | col curLoc < lastVirt = endImplictBlock + + -- End implicit layout block due to a symbol + | Virtual {} <- curBlock, endsLayout curTokTy = endImplictBlock + + -- Insert a virtual separator + | Virtual blockCol <- curBlock + , col curLoc == blockCol && not noVirtSep = + virt cfg curLoc VSemi : go stack lastVirt True tokens + + -- Start a new implicit layout + | startsLayout curTokTy = startImplicitBlock + + where + curTok : rest = (tokens :: [Located Token]) + curTokTy = tokenType (thing curTok) + curLoc = from (srcRange curTok) + + curBlock : popStack = stack + + + startImplicitBlock = + let nextLoc = from (srcRange (head rest)) + blockCol = col nextLoc + in curTok + : virt cfg nextLoc VCurlyL + : go (Virtual blockCol : stack) blockCol True rest + + endImplictBlock = + case curBlock of + Virtual {} -> go popStack newVirt False tokens + where newVirt = case [ n | Virtual n <- popStack ] of + n : _ -> n + _ -> 0 + + Explicit {} -> errTok cfg curLoc InvalidIndentation : rest + + -- Add separators computed from layout layout :: Config -> [Located Token] -> [Located Token] -layout cfg ts0 = loop False implicitScope [] ts0 +layout cfg ts0 = loop cfg False implicitScope [] ts0 where (_pos0,implicitScope) = case ts0 of @@ -387,40 +499,59 @@ layout cfg ts0 = loop False implicitScope [] ts0 _ -> (start,False) - loop :: Bool -> Bool -> [Block] -> [Located Token] -> [Located Token] - loop afterDoc startBlock stack (t : ts) - | startsLayout ty = toks ++ loop False True stack' ts +loop :: Config -> Bool -> Bool -> [Block] -> [Located Token] -> [Located Token] +loop cfg afterDoc startBlock stack (t : ts) = + toks ++ + case tokenType (thing t) of + EOF -> [] + + -- Tokens between parens, curlies, and brackets introduce a new explicit-layout block + Sym ParenL -> continue False False (Explicit (Sym ParenR) : stack') + Sym CurlyL -> continue False False (Explicit (Sym CurlyR) : stack') + Sym BracketL -> continue False False (Explicit (Sym BracketR) : stack') - -- We don't do layout within these delimeters - | Sym ParenL <- ty = toks ++ loop False False (Explicit (Sym ParenR) : stack') ts - | Sym CurlyL <- ty = toks ++ loop False False (Explicit (Sym CurlyR) : stack') ts - | Sym BracketL <- ty = toks ++ loop False False (Explicit (Sym BracketR) : stack') ts + White DocStr -> continue True False stack' + + curTok | startsLayout curTok -> continue False True stack' + | otherwise -> continue False False stack' - | EOF <- ty = toks - | White DocStr <- ty = toks ++ loop True False stack' ts - | otherwise = toks ++ loop False False stack' ts where - ty = tokenType (thing t) + continue newAfterDoc newStartBlock newStack = loop cfg newAfterDoc newStartBlock newStack ts + + + curToken = tokenType (thing t) pos = srcRange t (toks,offStack) + + {- This special case is here to avoid, for example, adding a virtual semi in an example like this: + + /** Hello */ + world = x + + This assumes that document comments would only appear in a grammar where there is no need for + special layout handling. + -} + | afterDoc = ([t], stack) - | otherwise = offsides startToks t stack + + + | otherwise = offsides cfg startToks t stack -- add any block start tokens, and push a level on the stack (startToks,stack') - | startBlock && ty == EOF = ( [ virt cfg (to pos) VCurlyR - , virt cfg (to pos) VCurlyL ] - , offStack ) + | startBlock && curToken == EOF = ( [ virt cfg (to pos) VCurlyR, virt cfg (to pos) VCurlyL ] + , offStack + ) | startBlock = ( [ virt cfg (to pos) VCurlyL ], Virtual (col (from pos)) : offStack ) | otherwise = ( [], offStack ) - loop _ _ _ [] = panic "[Lexer] layout" ["Missing EOF token"] +loop _ _ _ _ [] = panic "[Lexer] layout" ["Missing EOF token"] - offsides :: [Located Token] -> Located Token -> [Block] -> ([Located Token], [Block]) - offsides startToks t = go startToks +offsides :: Config -> [Located Token] -> Located Token -> [Block] -> ([Located Token], [Block]) +offsides cfg startToks curTok = go startToks where go virts stack = case stack of @@ -443,13 +574,15 @@ layout cfg ts0 = loop False implicitScope [] ts0 _ -> done virts stack - ty = tokenType (thing t) - pos = srcRange t + ty = tokenType (thing curTok) + pos = srcRange curTok - done ts s = (reverse (t:ts), s) + done ts s = (reverse (curTok:ts), s) closingToken = ty `elem` [ Sym ParenR, Sym BracketR, Sym CurlyR ] + +-- | Make a virtual token of the given type virt :: Config -> Position -> TokenV -> Located Token virt cfg pos x = Located { srcRange = Range { from = pos @@ -462,6 +595,19 @@ virt cfg pos x = Located { srcRange = Range VCurlyR -> "end of layout block" VSemi -> "layout block separator" +errTok :: Config -> Position -> TokenErr -> Located Token +errTok cfg pos x = + Located { srcRange = Range + { from = pos + , to = pos + , source = cfgSource cfg + } + , thing = Token { tokenType = Err x, tokenText = "" } + } + + + + -------------------------------------------------------------------------------- data Token = Token { tokenType :: !TokenT, tokenText :: !Text } @@ -544,6 +690,7 @@ data TokenErr = UnterminatedComment | LexicalError | MalformedLiteral | MalformedSelector + | InvalidIndentation deriving (Eq, Show, Generic, NFData) data SelectorType = RecordSelectorTok Text | TupleSelectorTok Int From 76429aaffa6ef561638ba5cd2baebde5587e2395 Mon Sep 17 00:00:00 2001 From: Iavor Diatchki Date: Thu, 29 Apr 2021 10:37:45 -0700 Subject: [PATCH 2/6] Revert to version on `master` --- src/Cryptol/Parser/LexerUtils.hs | 191 ++++--------------------------- 1 file changed, 22 insertions(+), 169 deletions(-) diff --git a/src/Cryptol/Parser/LexerUtils.hs b/src/Cryptol/Parser/LexerUtils.hs index 42eed9871..7b18c515e 100644 --- a/src/Cryptol/Parser/LexerUtils.hs +++ b/src/Cryptol/Parser/LexerUtils.hs @@ -377,121 +377,9 @@ startsLayout (KW KW_private) = True startsLayout (KW KW_parameter) = True startsLayout _ = False -endsLayout :: TokenT -> Bool -endsLayout ty = - case ty of - Sym Comma -> True - Sym BracketL -> True - Sym ParenR -> True - Sym BracketR -> True - _ -> False - -{- - -We assume the existence of an explicit EOF token at the end of the input. This token is *less* indented -than all other tokens (i.e., it is at column 0) - -Explicit Layout Blocks - - * The symbols `(`, `{`, and `[` start an explicit layout block. - * While in an explicit layout block we pass through tokens, except: - - We may start new implicit or explicit layout blocks - - We terminate the current layout block if we encounter the matching - closing symbol `)`, `}`, `]` - -Implicit Layout Blocks - - * The keywords `where`, `private`, and `parameter` start an implicit - layout block. - * The layout block starts at the column of the *following* token and we - insert "virtual start block" between the current and the following tokens. - * While in an implicit layout block: - - We may start new implicit or explicit layout blocks - - We insert a "virtual separator" before tokens starting at the same - column as the layout block, EXCEPT: - * we do not insert a separator if the previous token was a - "documentation comment" - * we do not insert a separator before the first token in the block - - - The implicit layout block is ended by one of the tokens - `,`, `)`, `}`, `]`, or a token than is less indented that the - block's column. - - When an implicit layout block ends, we insert a "virtual end block" - token just before the token that caused the block to end. - -Examples: - -f = x where x = 0x1 -- end implicit layout by layout (`g` is less indented than `x`) -g = 0x3 - -f (x where x = 2) -- end implicit layout by `)` - -[ x where x = 2, 3 ] -- end implicit layout by `,` - -module A where -- two implicit layout blocks with the *same* indentation (`where` and `private`) -private -x = 0x2 --} - - - - -layout' :: Config -> [Located Token] -> [Located Token] -layout' cfg = go [] 0 False -- XXX: consult CFG for initial state - where - {- State parameters: - stack: the stack of implicit and explicit blocks - lastVirt: the indentation of the outer most implicit block (or 0, if none) - noVirtSep: do not emit a virtual separator even if token matches block alignment - tokens: remaining tokens to process - -} - - go stack lastVirt noVirtSep tokens - - -- End implicit layout due to indentation. - -- Note that the outermost layout block, even if we have - -- some explicit layout blocks due to parens. - | col curLoc < lastVirt = endImplictBlock - - -- End implicit layout block due to a symbol - | Virtual {} <- curBlock, endsLayout curTokTy = endImplictBlock - - -- Insert a virtual separator - | Virtual blockCol <- curBlock - , col curLoc == blockCol && not noVirtSep = - virt cfg curLoc VSemi : go stack lastVirt True tokens - - -- Start a new implicit layout - | startsLayout curTokTy = startImplicitBlock - - where - curTok : rest = (tokens :: [Located Token]) - curTokTy = tokenType (thing curTok) - curLoc = from (srcRange curTok) - - curBlock : popStack = stack - - - startImplicitBlock = - let nextLoc = from (srcRange (head rest)) - blockCol = col nextLoc - in curTok - : virt cfg nextLoc VCurlyL - : go (Virtual blockCol : stack) blockCol True rest - - endImplictBlock = - case curBlock of - Virtual {} -> go popStack newVirt False tokens - where newVirt = case [ n | Virtual n <- popStack ] of - n : _ -> n - _ -> 0 - - Explicit {} -> errTok cfg curLoc InvalidIndentation : rest - - -- Add separators computed from layout layout :: Config -> [Located Token] -> [Located Token] -layout cfg ts0 = loop cfg False implicitScope [] ts0 +layout cfg ts0 = loop False implicitScope [] ts0 where (_pos0,implicitScope) = case ts0 of @@ -499,59 +387,40 @@ layout cfg ts0 = loop cfg False implicitScope [] ts0 _ -> (start,False) -loop :: Config -> Bool -> Bool -> [Block] -> [Located Token] -> [Located Token] -loop cfg afterDoc startBlock stack (t : ts) = - toks ++ - case tokenType (thing t) of - EOF -> [] - - -- Tokens between parens, curlies, and brackets introduce a new explicit-layout block - Sym ParenL -> continue False False (Explicit (Sym ParenR) : stack') - Sym CurlyL -> continue False False (Explicit (Sym CurlyR) : stack') - Sym BracketL -> continue False False (Explicit (Sym BracketR) : stack') + loop :: Bool -> Bool -> [Block] -> [Located Token] -> [Located Token] + loop afterDoc startBlock stack (t : ts) + | startsLayout ty = toks ++ loop False True stack' ts - White DocStr -> continue True False stack' - - curTok | startsLayout curTok -> continue False True stack' - | otherwise -> continue False False stack' + -- We don't do layout within these delimeters + | Sym ParenL <- ty = toks ++ loop False False (Explicit (Sym ParenR) : stack') ts + | Sym CurlyL <- ty = toks ++ loop False False (Explicit (Sym CurlyR) : stack') ts + | Sym BracketL <- ty = toks ++ loop False False (Explicit (Sym BracketR) : stack') ts + | EOF <- ty = toks + | White DocStr <- ty = toks ++ loop True False stack' ts + | otherwise = toks ++ loop False False stack' ts where - continue newAfterDoc newStartBlock newStack = loop cfg newAfterDoc newStartBlock newStack ts - - - curToken = tokenType (thing t) + ty = tokenType (thing t) pos = srcRange t (toks,offStack) - - {- This special case is here to avoid, for example, adding a virtual semi in an example like this: - - /** Hello */ - world = x - - This assumes that document comments would only appear in a grammar where there is no need for - special layout handling. - -} - | afterDoc = ([t], stack) - - - | otherwise = offsides cfg startToks t stack + | otherwise = offsides startToks t stack -- add any block start tokens, and push a level on the stack (startToks,stack') - | startBlock && curToken == EOF = ( [ virt cfg (to pos) VCurlyR, virt cfg (to pos) VCurlyL ] - , offStack - ) + | startBlock && ty == EOF = ( [ virt cfg (to pos) VCurlyR + , virt cfg (to pos) VCurlyL ] + , offStack ) | startBlock = ( [ virt cfg (to pos) VCurlyL ], Virtual (col (from pos)) : offStack ) | otherwise = ( [], offStack ) -loop _ _ _ _ [] = panic "[Lexer] layout" ["Missing EOF token"] + loop _ _ _ [] = panic "[Lexer] layout" ["Missing EOF token"] -offsides :: Config -> [Located Token] -> Located Token -> [Block] -> ([Located Token], [Block]) -offsides cfg startToks curTok = go startToks + offsides :: [Located Token] -> Located Token -> [Block] -> ([Located Token], [Block]) + offsides startToks t = go startToks where go virts stack = case stack of @@ -574,15 +443,13 @@ offsides cfg startToks curTok = go startToks _ -> done virts stack - ty = tokenType (thing curTok) - pos = srcRange curTok + ty = tokenType (thing t) + pos = srcRange t - done ts s = (reverse (curTok:ts), s) + done ts s = (reverse (t:ts), s) closingToken = ty `elem` [ Sym ParenR, Sym BracketR, Sym CurlyR ] - --- | Make a virtual token of the given type virt :: Config -> Position -> TokenV -> Located Token virt cfg pos x = Located { srcRange = Range { from = pos @@ -595,19 +462,6 @@ virt cfg pos x = Located { srcRange = Range VCurlyR -> "end of layout block" VSemi -> "layout block separator" -errTok :: Config -> Position -> TokenErr -> Located Token -errTok cfg pos x = - Located { srcRange = Range - { from = pos - , to = pos - , source = cfgSource cfg - } - , thing = Token { tokenType = Err x, tokenText = "" } - } - - - - -------------------------------------------------------------------------------- data Token = Token { tokenType :: !TokenT, tokenText :: !Text } @@ -690,7 +544,6 @@ data TokenErr = UnterminatedComment | LexicalError | MalformedLiteral | MalformedSelector - | InvalidIndentation deriving (Eq, Show, Generic, NFData) data SelectorType = RecordSelectorTok Text | TupleSelectorTok Int From 7727197800e74b5d6a63ff703a9fb7372aa6c202 Mon Sep 17 00:00:00 2001 From: Iavor Diatchki Date: Thu, 29 Apr 2021 11:17:34 -0700 Subject: [PATCH 3/6] Split off tokens and new layout in a separate modules --- cryptol.cabal | 2 + src/Cryptol/Parser.y | 1 + src/Cryptol/Parser/Layout.hs | 216 ++++++++++++++++++++++++++++++ src/Cryptol/Parser/Lexer.x | 1 + src/Cryptol/Parser/LexerUtils.hs | 119 +--------------- src/Cryptol/Parser/ParserUtils.hs | 8 +- src/Cryptol/Parser/Token.hs | 116 ++++++++++++++++ 7 files changed, 349 insertions(+), 114 deletions(-) create mode 100644 src/Cryptol/Parser/Layout.hs create mode 100644 src/Cryptol/Parser/Token.hs diff --git a/cryptol.cabal b/cryptol.cabal index df4207922..8e68eb274 100644 --- a/cryptol.cabal +++ b/cryptol.cabal @@ -81,6 +81,8 @@ library Exposed-modules: Cryptol.Parser, Cryptol.Parser.Lexer, + Cryptol.Parser.Token, + Cryptol.Parser.Layout, Cryptol.Parser.AST, Cryptol.Parser.Position, Cryptol.Parser.Names, diff --git a/src/Cryptol/Parser.y b/src/Cryptol/Parser.y index dfc982931..a9fb04d1b 100644 --- a/src/Cryptol/Parser.y +++ b/src/Cryptol/Parser.y @@ -35,6 +35,7 @@ import Control.Monad(liftM2,msum) import Cryptol.Parser.AST import Cryptol.Parser.Position import Cryptol.Parser.LexerUtils hiding (mkIdent) +import Cryptol.Parser.Token import Cryptol.Parser.ParserUtils import Cryptol.Parser.Unlit(PreProc(..), guessPreProc) import Cryptol.Utils.Ident(paramInstModName) diff --git a/src/Cryptol/Parser/Layout.hs b/src/Cryptol/Parser/Layout.hs new file mode 100644 index 000000000..40dc2bab5 --- /dev/null +++ b/src/Cryptol/Parser/Layout.hs @@ -0,0 +1,216 @@ +{-# Language BlockArguments #-} +{-# Language OverloadedStrings #-} +module Cryptol.Parser.Layout where + +import Cryptol.Parser.Position +import Cryptol.Parser.Token + +{- + +We assume the existence of an explicit EOF token at the end of the input. This token is *less* indented +than all other tokens (i.e., it is at column 0) + +Explicit Layout Blocks + + * The symbols `(`, `{`, and `[` start an explicit layout block. + * While in an explicit layout block we pass through tokens, except: + - We may start new implicit or explicit layout blocks + - We terminate the current layout block if we encounter the matching + closing symbol `)`, `}`, `]` + +Implicit Layout Blocks + + * The keywords `where`, `private`, and `parameter` start an implicit + layout block. + * The layout block starts at the column of the *following* token and we + insert "virtual start block" between the current and the following tokens. + * While in an implicit layout block: + - We may start new implicit or explicit layout blocks + - We insert a "virtual separator" before tokens starting at the same + column as the layout block, EXCEPT: + * we do not insert a separator if the previous token was a + "documentation comment" + * we do not insert a separator before the first token in the block + + - The implicit layout block is ended by one of the tokens + `,`, `)`, `}`, `]`, or a token than is less indented that the + block's column. + - When an implicit layout block ends, we insert a "virtual end block" + token just before the token that caused the block to end. + +Examples: + +f = x where x = 0x1 -- end implicit layout by layout +g = 0x3 -- (`g` is less indented than `x`) + +f (x where x = 2) -- end implicit layout by `)` + +[ x where x = 2, 3 ] -- end implicit layout by `,` + +module A where -- two implicit layout blocks with the +private -- *same* indentation (`where` and `private`) +x = 0x2 +-} + + +layout :: Bool -> [Located Token] -> [Located Token] +layout isMod ts0 + + -- Star an implicit layout block at the top of the module + | let t = head ts0 + blockCol = col (from (srcRange t)) + , isMod && tokenType (thing t) /= KW KW_module = + go [ Virtual blockCol ] blockCol True ts0 + + | otherwise = + go [] 0 False ts0 + + where + + {- State parameters for `go`: + + stack: + The stack of implicit and explicit blocks + + lastVirt: + The indentation of the outer most implicit block, or 0 if none. + This can be computed from the stack but we cache + it here as we need to check it on each token. + + noVirtSep: + Do not emit a virtual separator even if token matches block alignment. + This is enabled at the beginning of a block, or after a doc string, + or if we just emitted a separtor, but have not yet consumed the + next token. + + tokens: + remaining tokens to process + -} + + go stack lastVirt noVirtSep tokens + + -- End implicit layout due to indentation. If the outermost block + -- is a lyout block we just end it. If the outermost block is an + -- explicit layout block we report a lexical error. + | col curLoc < lastVirt = + endImplictBlock + + -- End implicit layout block due to a symbol + | Virtual {} <- curBlock, endsLayout curTokTy = + endImplictBlock + + -- Insert a virtual separator + | Virtual {} <- curBlock + , col curLoc == lastVirt && not noVirtSep = + virt curRange VSemi : go stack lastVirt True tokens + + -- Start a new implicit layout. Advances token position. + | startsLayout curTokTy = startImplicitBlock + + -- Start a paren block. Advances token position + | Just close <- startsParenBlock curTokTy = + curTok : go (Explicit close : stack) lastVirt False advanceTokens + + -- End a paren block. Advances token position + | Explicit close <- curBlock, close == curTokTy = + curTok : go popStack lastVirt False advanceTokens + + -- Disable virtual separator after doc string. Advances token position + | White DocStr <- curTokTy = + curTok : go stack lastVirt True advanceTokens + + -- Check to see if we are done. Note that if we got here, implicit layout + -- blocks should have already been closed, as `EOF` is less indented than + -- all other tokens + | EOF <- curTokTy = + [curTok] + + -- Any other token, just emit. Advances token position + | otherwise = + curTok : go stack lastVirt False advanceTokens + + where + curTok : advanceTokens = tokens + curTokTy = tokenType (thing curTok) + curRange = srcRange curTok + curLoc = from curRange + + curBlock : popStack = stack + + + startImplicitBlock = + let nextRng = srcRange (head advanceTokens) + nextLoc = from nextRng + blockCol = col nextLoc + in curTok + : virt nextRng VCurlyL + : go (Virtual blockCol : stack) blockCol True advanceTokens + + + endImplictBlock = + case curBlock of + Virtual {} -> go popStack newVirt False tokens + where newVirt = case [ n | Virtual n <- popStack ] of + n : _ -> n + _ -> 0 + + Explicit c -> errTok curRange (InvalidIndentation c) : advanceTokens + + +-------------------------------------------------------------------------------- + +data Block = + Virtual Int -- ^ Virtual layout block + | Explicit TokenT -- ^ An explicit layout block, expecting this ending token. + deriving (Show) + +-- | These tokens start an implicit layout block +startsLayout :: TokenT -> Bool +startsLayout ty = + case ty of + KW KW_where -> True + KW KW_private -> True + KW KW_parameter -> True + _ -> False + +-- | These tokens end an implicit layout block +endsLayout :: TokenT -> Bool +endsLayout ty = + case ty of + Sym Comma -> True + Sym BracketR -> True + Sym ParenR -> True + Sym CurlyR -> True + _ -> False + +-- | These tokens start an explicit "paren" layout block. +-- If so, the result contains the corresponding closing paren. +startsParenBlock :: TokenT -> Maybe TokenT +startsParenBlock ty = + case ty of + Sym BracketL -> Just (Sym BracketR) + Sym ParenL -> Just (Sym ParenR) + Sym CurlyL -> Just (Sym CurlyR) + _ -> Nothing + + +-------------------------------------------------------------------------------- + +-- | Make a virtual token of the given type +virt :: Range -> TokenV -> Located Token +virt rng x = Located { srcRange = rng { to = from rng }, thing = t } + where + t = Token (Virt x) + case x of + VCurlyL -> "beginning of layout block" + VCurlyR -> "end of layout block" + VSemi -> "layout block separator" + +errTok :: Range -> TokenErr -> Located Token +errTok rng x = Located { srcRange = rng { to = from rng }, thing = t } + where + t = Token { tokenType = Err x, tokenText = "" } + + + + diff --git a/src/Cryptol/Parser/Lexer.x b/src/Cryptol/Parser/Lexer.x index 36eba1275..9bd3a0809 100644 --- a/src/Cryptol/Parser/Lexer.x +++ b/src/Cryptol/Parser/Lexer.x @@ -21,6 +21,7 @@ module Cryptol.Parser.Lexer ) where import Cryptol.Parser.Position +import Cryptol.Parser.Token import Cryptol.Parser.LexerUtils import Cryptol.Parser.Unlit(unLit) import Data.Text (Text) diff --git a/src/Cryptol/Parser/LexerUtils.hs b/src/Cryptol/Parser/LexerUtils.hs index 7b18c515e..15f527630 100644 --- a/src/Cryptol/Parser/LexerUtils.hs +++ b/src/Cryptol/Parser/LexerUtils.hs @@ -6,18 +6,10 @@ -- Stability : provisional -- Portability : portable -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternGuards #-} -{-# LANGUAGE BlockArguments #-} module Cryptol.Parser.LexerUtils where -import Cryptol.Parser.Position -import Cryptol.Parser.Unlit(PreProc(None)) -import Cryptol.Utils.PP -import Cryptol.Utils.Panic - import Control.Monad(guard) import Data.Char(toLower,generalCategory,isAscii,ord,isSpace, isAlphaNum,isAlpha) @@ -27,8 +19,12 @@ import qualified Data.Text as T import qualified Data.Text.Read as T import Data.Word(Word8) -import GHC.Generics (Generic) -import Control.DeepSeq +import Cryptol.Utils.Panic +import Cryptol.Parser.Position +import Cryptol.Parser.Token +import Cryptol.Parser.Unlit(PreProc(None)) + + data Config = Config { cfgSource :: !FilePath -- ^ File that we are working on @@ -464,109 +460,6 @@ virt cfg pos x = Located { srcRange = Range -------------------------------------------------------------------------------- -data Token = Token { tokenType :: !TokenT, tokenText :: !Text } - deriving (Show, Generic, NFData) - --- | Virtual tokens, inserted by layout processing. -data TokenV = VCurlyL| VCurlyR | VSemi - deriving (Eq, Show, Generic, NFData) - -data TokenW = BlockComment | LineComment | Space | DocStr - deriving (Eq, Show, Generic, NFData) - -data TokenKW = KW_else - | KW_extern - | KW_fin - | KW_if - | KW_private - | KW_include - | KW_inf - | KW_lg2 - | KW_lengthFromThen - | KW_lengthFromThenTo - | KW_max - | KW_min - | KW_module - | KW_submodule - | KW_newtype - | KW_pragma - | KW_property - | KW_then - | KW_type - | KW_where - | KW_let - | KW_x - | KW_import - | KW_as - | KW_hiding - | KW_infixl - | KW_infixr - | KW_infix - | KW_primitive - | KW_parameter - | KW_constraint - | KW_Prop - deriving (Eq, Show, Generic, NFData) - --- | The named operators are a special case for parsing types, and 'Other' is --- used for all other cases that lexed as an operator. -data TokenOp = Plus | Minus | Mul | Div | Exp | Mod - | Equal | LEQ | GEQ - | Complement | Hash | At - | Other [T.Text] T.Text - deriving (Eq, Show, Generic, NFData) - -data TokenSym = Bar - | ArrL | ArrR | FatArrR - | Lambda - | EqDef - | Comma - | Semi - | Dot - | DotDot - | DotDotDot - | DotDotLt - | Colon - | BackTick - | ParenL | ParenR - | BracketL | BracketR - | CurlyL | CurlyR - | TriL | TriR - | Lt - | Underscore - deriving (Eq, Show, Generic, NFData) - -data TokenErr = UnterminatedComment - | UnterminatedString - | UnterminatedChar - | InvalidString - | InvalidChar - | LexicalError - | MalformedLiteral - | MalformedSelector - deriving (Eq, Show, Generic, NFData) - -data SelectorType = RecordSelectorTok Text | TupleSelectorTok Int - deriving (Eq, Show, Generic, NFData) - -data TokenT = Num !Integer !Int !Int -- ^ value, base, number of digits - | Frac !Rational !Int -- ^ value, base. - | ChrLit !Char -- ^ character literal - | Ident ![T.Text] !T.Text -- ^ (qualified) identifier - | StrLit !String -- ^ string literal - | Selector !SelectorType -- ^ .hello or .123 - | KW !TokenKW -- ^ keyword - | Op !TokenOp -- ^ operator - | Sym !TokenSym -- ^ symbol - | Virt !TokenV -- ^ virtual token (for layout) - | White !TokenW -- ^ white space token - | Err !TokenErr -- ^ error token - | EOF - deriving (Eq, Show, Generic, NFData) - -instance PP Token where - ppPrec _ (Token _ s) = text (T.unpack s) - -- | Collapse characters into a single Word8, identifying ASCII, and classes of -- unicode. This came from: -- diff --git a/src/Cryptol/Parser/ParserUtils.hs b/src/Cryptol/Parser/ParserUtils.hs index 0f1ebda36..4b32a872c 100644 --- a/src/Cryptol/Parser/ParserUtils.hs +++ b/src/Cryptol/Parser/ParserUtils.hs @@ -35,7 +35,7 @@ import Prelude.Compat import Cryptol.Parser.AST import Cryptol.Parser.Lexer -import Cryptol.Parser.LexerUtils(SelectorType(..)) +import Cryptol.Parser.Token(SelectorType(..)) import Cryptol.Parser.Position import Cryptol.Parser.Utils (translateExprToNumT,widthIdent) import Cryptol.Utils.Ident(packModName,packIdent,modNameChunks) @@ -81,6 +81,12 @@ lexerP k = P $ \cfg p s -> T.unpack (tokenText it) MalformedSelector -> "malformed selector: " ++ T.unpack (tokenText it) + InvalidIndentation c -> "invalid indentation, expected " ++ + case c of + Sym CurlyR -> "}" + Sym ParenR -> ")" + Sym BracketR -> "]" + _ -> show c -- basically panic ] where it = thing t diff --git a/src/Cryptol/Parser/Token.hs b/src/Cryptol/Parser/Token.hs new file mode 100644 index 000000000..280f8157d --- /dev/null +++ b/src/Cryptol/Parser/Token.hs @@ -0,0 +1,116 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +module Cryptol.Parser.Token where + +import Data.Text(Text) +import qualified Data.Text as Text +import Control.DeepSeq +import GHC.Generics + +import Cryptol.Utils.PP + +data Token = Token { tokenType :: !TokenT, tokenText :: !Text } + deriving (Show, Generic, NFData) + +-- | Virtual tokens, inserted by layout processing. +data TokenV = VCurlyL| VCurlyR | VSemi + deriving (Eq, Show, Generic, NFData) + +data TokenW = BlockComment | LineComment | Space | DocStr + deriving (Eq, Show, Generic, NFData) + +data TokenKW = KW_else + | KW_extern + | KW_fin + | KW_if + | KW_private + | KW_include + | KW_inf + | KW_lg2 + | KW_lengthFromThen + | KW_lengthFromThenTo + | KW_max + | KW_min + | KW_module + | KW_submodule + | KW_newtype + | KW_pragma + | KW_property + | KW_then + | KW_type + | KW_where + | KW_let + | KW_x + | KW_import + | KW_as + | KW_hiding + | KW_infixl + | KW_infixr + | KW_infix + | KW_primitive + | KW_parameter + | KW_constraint + | KW_Prop + deriving (Eq, Show, Generic, NFData) + +-- | The named operators are a special case for parsing types, and 'Other' is +-- used for all other cases that lexed as an operator. +data TokenOp = Plus | Minus | Mul | Div | Exp | Mod + | Equal | LEQ | GEQ + | Complement | Hash | At + | Other [Text] Text + deriving (Eq, Show, Generic, NFData) + +data TokenSym = Bar + | ArrL | ArrR | FatArrR + | Lambda + | EqDef + | Comma + | Semi + | Dot + | DotDot + | DotDotDot + | DotDotLt + | Colon + | BackTick + | ParenL | ParenR + | BracketL | BracketR + | CurlyL | CurlyR + | TriL | TriR + | Lt + | Underscore + deriving (Eq, Show, Generic, NFData) + +data TokenErr = UnterminatedComment + | UnterminatedString + | UnterminatedChar + | InvalidString + | InvalidChar + | LexicalError + | MalformedLiteral + | MalformedSelector + | InvalidIndentation TokenT -- expected closing paren + deriving (Eq, Show, Generic, NFData) + +data SelectorType = RecordSelectorTok Text | TupleSelectorTok Int + deriving (Eq, Show, Generic, NFData) + +data TokenT = Num !Integer !Int !Int -- ^ value, base, number of digits + | Frac !Rational !Int -- ^ value, base. + | ChrLit !Char -- ^ character literal + | Ident ![Text] !Text -- ^ (qualified) identifier + | StrLit !String -- ^ string literal + | Selector !SelectorType -- ^ .hello or .123 + | KW !TokenKW -- ^ keyword + | Op !TokenOp -- ^ operator + | Sym !TokenSym -- ^ symbol + | Virt !TokenV -- ^ virtual token (for layout) + | White !TokenW -- ^ white space token + | Err !TokenErr -- ^ error token + | EOF + deriving (Eq, Show, Generic, NFData) + +instance PP Token where + ppPrec _ (Token _ s) = text (Text.unpack s) + + From 206123aa6c23d8b50603e5ce5073e9f5c4852ebf Mon Sep 17 00:00:00 2001 From: Iavor Diatchki Date: Thu, 29 Apr 2021 12:15:50 -0700 Subject: [PATCH 4/6] Fixes to the algorithm, and remove old code --- src/Cryptol/Parser/Layout.hs | 45 ++++++++++---- src/Cryptol/Parser/Lexer.x | 9 ++- src/Cryptol/Parser/LexerUtils.hs | 101 ------------------------------- 3 files changed, 41 insertions(+), 114 deletions(-) diff --git a/src/Cryptol/Parser/Layout.hs b/src/Cryptol/Parser/Layout.hs index 40dc2bab5..6508de120 100644 --- a/src/Cryptol/Parser/Layout.hs +++ b/src/Cryptol/Parser/Layout.hs @@ -2,6 +2,7 @@ {-# Language OverloadedStrings #-} module Cryptol.Parser.Layout where +import Cryptol.Utils.Panic(panic) import Cryptol.Parser.Position import Cryptol.Parser.Token @@ -15,6 +16,7 @@ Explicit Layout Blocks * The symbols `(`, `{`, and `[` start an explicit layout block. * While in an explicit layout block we pass through tokens, except: - We may start new implicit or explicit layout blocks + - A `,` terminates any *nested* layout blocks - We terminate the current layout block if we encounter the matching closing symbol `)`, `}`, `]` @@ -32,8 +34,10 @@ Implicit Layout Blocks "documentation comment" * we do not insert a separator before the first token in the block - - The implicit layout block is ended by one of the tokens - `,`, `)`, `}`, `]`, or a token than is less indented that the + - The implicit layout block is ended by: + * a token than is less indented that the block, or + * `)`, `}`, `]`, or + * ',' but only if there is an outer paren block block's column. - When an implicit layout block ends, we insert a "virtual end block" token just before the token that caused the block to end. @@ -58,9 +62,10 @@ layout isMod ts0 -- Star an implicit layout block at the top of the module | let t = head ts0 - blockCol = col (from (srcRange t)) + rng = srcRange t + blockCol = max 1 (col (from rng)) -- see startImplicitBlock , isMod && tokenType (thing t) /= KW KW_module = - go [ Virtual blockCol ] blockCol True ts0 + virt rng VCurlyL : go [ Virtual blockCol ] blockCol True ts0 | otherwise = go [] 0 False ts0 @@ -96,11 +101,17 @@ layout isMod ts0 endImplictBlock -- End implicit layout block due to a symbol - | Virtual {} <- curBlock, endsLayout curTokTy = + | Just (Virtual {}) <- curBlock, endsLayout curTokTy = + endImplictBlock + + -- End implicit layout block due to a comma + | Just (Virtual {}) <- curBlock + , Sym Comma <- curTokTy + , not (null [ () | Explicit _ <- popStack ]) = endImplictBlock -- Insert a virtual separator - | Virtual {} <- curBlock + | Just (Virtual {}) <- curBlock , col curLoc == lastVirt && not noVirtSep = virt curRange VSemi : go stack lastVirt True tokens @@ -112,7 +123,7 @@ layout isMod ts0 curTok : go (Explicit close : stack) lastVirt False advanceTokens -- End a paren block. Advances token position - | Explicit close <- curBlock, close == curTokTy = + | Just (Explicit close) <- curBlock, close == curTokTy = curTok : go popStack lastVirt False advanceTokens -- Disable virtual separator after doc string. Advances token position @@ -135,13 +146,19 @@ layout isMod ts0 curRange = srcRange curTok curLoc = from curRange - curBlock : popStack = stack + (curBlock,popStack) = + case stack of + a : b -> (Just a,b) + [] -> (Nothing, panic "layout" ["pop empty stack"]) startImplicitBlock = let nextRng = srcRange (head advanceTokens) nextLoc = from nextRng - blockCol = col nextLoc + blockCol = max 1 (col nextLoc) + -- the `max` ensuraes that indentation is always at least 1, + -- in case we are starting a block at the very end of the input + in curTok : virt nextRng VCurlyL : go (Virtual blockCol : stack) blockCol True advanceTokens @@ -149,12 +166,17 @@ layout isMod ts0 endImplictBlock = case curBlock of - Virtual {} -> go popStack newVirt False tokens + Just (Virtual {}) -> + virt curRange VCurlyR + : go popStack newVirt False tokens where newVirt = case [ n | Virtual n <- popStack ] of n : _ -> n _ -> 0 - Explicit c -> errTok curRange (InvalidIndentation c) : advanceTokens + Just (Explicit c) -> + errTok curRange (InvalidIndentation c) : advanceTokens + + Nothing -> panic "layout" ["endImplictBlock with empty stack"] -------------------------------------------------------------------------------- @@ -177,7 +199,6 @@ startsLayout ty = endsLayout :: TokenT -> Bool endsLayout ty = case ty of - Sym Comma -> True Sym BracketR -> True Sym ParenR -> True Sym CurlyR -> True diff --git a/src/Cryptol/Parser/Lexer.x b/src/Cryptol/Parser/Lexer.x index 9bd3a0809..74063ce0a 100644 --- a/src/Cryptol/Parser/Lexer.x +++ b/src/Cryptol/Parser/Lexer.x @@ -18,11 +18,13 @@ module Cryptol.Parser.Lexer , Located(..) , Config(..) , defaultConfig + , dbgLex ) where import Cryptol.Parser.Position import Cryptol.Parser.Token import Cryptol.Parser.LexerUtils +import qualified Cryptol.Parser.Layout as L import Cryptol.Parser.Unlit(unLit) import Data.Text (Text) import qualified Data.Text as Text @@ -196,7 +198,7 @@ stateToInt (InChar {}) = char -- This stream is fed to the parser. lexer :: Config -> Text -> ([Located Token], Position) lexer cfg cs = ( case cfgLayout cfg of - Layout -> layout cfg lexemes + Layout -> L.layout (cfgModuleScope cfg) lexemes NoLayout -> lexemes , finalPos ) @@ -254,5 +256,10 @@ primLexer cfg cs = run inp Normal (rest,pos) = run i' $! s' in (mtok ++ rest, pos) +dbgLex file = + do txt <- readFile file + let (ts,_) = lexer defaultConfig (Text.pack txt) + mapM_ (print . thing) ts + -- vim: ft=haskell } diff --git a/src/Cryptol/Parser/LexerUtils.hs b/src/Cryptol/Parser/LexerUtils.hs index 15f527630..cc517f603 100644 --- a/src/Cryptol/Parser/LexerUtils.hs +++ b/src/Cryptol/Parser/LexerUtils.hs @@ -358,107 +358,6 @@ dropWhite = filter (notWhite . tokenType . thing) notWhite _ = True -data Block = Virtual Int -- ^ Virtual layout block - | Explicit TokenT -- ^ An explicit layout block, expecting this ending - -- token. - deriving (Show) - -isExplicit :: Block -> Bool -isExplicit Explicit{} = True -isExplicit Virtual{} = False - -startsLayout :: TokenT -> Bool -startsLayout (KW KW_where) = True -startsLayout (KW KW_private) = True -startsLayout (KW KW_parameter) = True -startsLayout _ = False - --- Add separators computed from layout -layout :: Config -> [Located Token] -> [Located Token] -layout cfg ts0 = loop False implicitScope [] ts0 - where - - (_pos0,implicitScope) = case ts0 of - t : _ -> (from (srcRange t), cfgModuleScope cfg && tokenType (thing t) /= KW KW_module) - _ -> (start,False) - - - loop :: Bool -> Bool -> [Block] -> [Located Token] -> [Located Token] - loop afterDoc startBlock stack (t : ts) - | startsLayout ty = toks ++ loop False True stack' ts - - -- We don't do layout within these delimeters - | Sym ParenL <- ty = toks ++ loop False False (Explicit (Sym ParenR) : stack') ts - | Sym CurlyL <- ty = toks ++ loop False False (Explicit (Sym CurlyR) : stack') ts - | Sym BracketL <- ty = toks ++ loop False False (Explicit (Sym BracketR) : stack') ts - - | EOF <- ty = toks - | White DocStr <- ty = toks ++ loop True False stack' ts - | otherwise = toks ++ loop False False stack' ts - - where - ty = tokenType (thing t) - pos = srcRange t - - (toks,offStack) - | afterDoc = ([t], stack) - | otherwise = offsides startToks t stack - - -- add any block start tokens, and push a level on the stack - (startToks,stack') - | startBlock && ty == EOF = ( [ virt cfg (to pos) VCurlyR - , virt cfg (to pos) VCurlyL ] - , offStack ) - | startBlock = ( [ virt cfg (to pos) VCurlyL ], Virtual (col (from pos)) : offStack ) - | otherwise = ( [], offStack ) - - loop _ _ _ [] = panic "[Lexer] layout" ["Missing EOF token"] - - - offsides :: [Located Token] -> Located Token -> [Block] -> ([Located Token], [Block]) - offsides startToks t = go startToks - where - go virts stack = case stack of - - -- delimit or close a layout block - Virtual c : rest - -- commas only close to an explicit marker, so if there is none, the - -- comma doesn't close anything - | Sym Comma == ty -> - if any isExplicit rest - then go (virt cfg (to pos) VCurlyR : virts) rest - else done virts stack - - | closingToken -> go (virt cfg (to pos) VCurlyR : virts) rest - | col (from pos) == c -> done (virt cfg (to pos) VSemi : virts) stack - | col (from pos) < c -> go (virt cfg (to pos) VCurlyR : virts) rest - - -- close an explicit block - Explicit close : rest | close == ty -> done virts rest - | Sym Comma == ty -> done virts stack - - _ -> done virts stack - - ty = tokenType (thing t) - pos = srcRange t - - done ts s = (reverse (t:ts), s) - - closingToken = ty `elem` [ Sym ParenR, Sym BracketR, Sym CurlyR ] - -virt :: Config -> Position -> TokenV -> Located Token -virt cfg pos x = Located { srcRange = Range - { from = pos - , to = pos - , source = cfgSource cfg - } - , thing = t } - where t = Token (Virt x) $ case x of - VCurlyL -> "beginning of layout block" - VCurlyR -> "end of layout block" - VSemi -> "layout block separator" - --------------------------------------------------------------------------------- -- | Collapse characters into a single Word8, identifying ASCII, and classes of -- unicode. This came from: From 3cb97094b9b7b268b6b76f2908f9509141e11396 Mon Sep 17 00:00:00 2001 From: Iavor Diatchki Date: Thu, 29 Apr 2021 14:42:16 -0700 Subject: [PATCH 5/6] Unused extension --- src/Cryptol/Parser/LexerUtils.hs | 2 -- 1 file changed, 2 deletions(-) diff --git a/src/Cryptol/Parser/LexerUtils.hs b/src/Cryptol/Parser/LexerUtils.hs index cc517f603..41bb3ff0c 100644 --- a/src/Cryptol/Parser/LexerUtils.hs +++ b/src/Cryptol/Parser/LexerUtils.hs @@ -5,9 +5,7 @@ -- Maintainer : cryptol@galois.com -- Stability : provisional -- Portability : portable - {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE PatternGuards #-} module Cryptol.Parser.LexerUtils where import Control.Monad(guard) From f43d6523379ecdc9c180524ee23e903913b67c0f Mon Sep 17 00:00:00 2001 From: Iavor Diatchki Date: Thu, 29 Apr 2021 14:42:43 -0700 Subject: [PATCH 6/6] Improve error message and some tests --- src/Cryptol/Parser/ParserUtils.hs | 8 ++++---- tests/issues/T1179.cry | 5 +++++ tests/issues/T1179.icry | 1 + tests/issues/T1179.icry.stdout | 3 +++ tests/regression/Layout02.cry | 4 ++++ tests/regression/layout02.icry | 1 + tests/regression/layout02.icry.stdout | 4 ++++ 7 files changed, 22 insertions(+), 4 deletions(-) create mode 100644 tests/issues/T1179.cry create mode 100644 tests/issues/T1179.icry create mode 100644 tests/issues/T1179.icry.stdout create mode 100644 tests/regression/Layout02.cry create mode 100644 tests/regression/layout02.icry create mode 100644 tests/regression/layout02.icry.stdout diff --git a/src/Cryptol/Parser/ParserUtils.hs b/src/Cryptol/Parser/ParserUtils.hs index 4b32a872c..f64313187 100644 --- a/src/Cryptol/Parser/ParserUtils.hs +++ b/src/Cryptol/Parser/ParserUtils.hs @@ -81,11 +81,11 @@ lexerP k = P $ \cfg p s -> T.unpack (tokenText it) MalformedSelector -> "malformed selector: " ++ T.unpack (tokenText it) - InvalidIndentation c -> "invalid indentation, expected " ++ + InvalidIndentation c -> "invalid indentation, unmatched " ++ case c of - Sym CurlyR -> "}" - Sym ParenR -> ")" - Sym BracketR -> "]" + Sym CurlyR -> "{ ... } " + Sym ParenR -> "( ... )" + Sym BracketR -> "[ ... ]" _ -> show c -- basically panic ] where it = thing t diff --git a/tests/issues/T1179.cry b/tests/issues/T1179.cry new file mode 100644 index 000000000..bb3a376b7 --- /dev/null +++ b/tests/issues/T1179.cry @@ -0,0 +1,5 @@ +module T1179 where + +x = 0x2 +private +y = x diff --git a/tests/issues/T1179.icry b/tests/issues/T1179.icry new file mode 100644 index 000000000..53dec4d9e --- /dev/null +++ b/tests/issues/T1179.icry @@ -0,0 +1 @@ +:load T1179.cry diff --git a/tests/issues/T1179.icry.stdout b/tests/issues/T1179.icry.stdout new file mode 100644 index 000000000..2cfcb9e64 --- /dev/null +++ b/tests/issues/T1179.icry.stdout @@ -0,0 +1,3 @@ +Loading module Cryptol +Loading module Cryptol +Loading module T1179 diff --git a/tests/regression/Layout02.cry b/tests/regression/Layout02.cry new file mode 100644 index 000000000..630348407 --- /dev/null +++ b/tests/regression/Layout02.cry @@ -0,0 +1,4 @@ +module Layout02 where + +x = 0x1 where y = ( 2 + ) diff --git a/tests/regression/layout02.icry b/tests/regression/layout02.icry new file mode 100644 index 000000000..6c47ccd37 --- /dev/null +++ b/tests/regression/layout02.icry @@ -0,0 +1 @@ +:load Layout02.cry diff --git a/tests/regression/layout02.icry.stdout b/tests/regression/layout02.icry.stdout new file mode 100644 index 000000000..f165224c7 --- /dev/null +++ b/tests/regression/layout02.icry.stdout @@ -0,0 +1,4 @@ +Loading module Cryptol + +Parse error at Layout02.cry:4:11--4:11 + invalid indentation, unmatched ( ... )