Skip to content

Commit

Permalink
Updates to the lexer
Browse files Browse the repository at this point in the history 
Fixes #713
Fixes #818
Fixes #876
  • Loading branch information
@yav
yav committed Sep 25, 2020
1 parent 8f952d1 commit 5d04936
Show file tree
Hide file tree
Showing 13 changed files with 277 additions and 147 deletions.
50 changes: 25 additions & 25 deletions src/Cryptol/Parser.y
View file
Original file line number Diff line number Diff line change
Expand Up @@ -59,6 +59,8 @@ import Paths_cryptol
IDENT { $$@(Located _ (Token (Ident [] _) _))}
QIDENT { $$@(Located _ (Token Ident{} _))}

SELECTOR { $$@(Located _ (Token (Selector _) _))}

'include' { Located $$ (Token (KW KW_include) _)}
'import' { Located $$ (Token (KW KW_import) _)}
'as' { Located $$ (Token (KW KW_as) _)}
Expand Down Expand Up @@ -95,7 +97,7 @@ import Paths_cryptol
')' { Located $$ (Token (Sym ParenR ) _)}
',' { Located $$ (Token (Sym Comma ) _)}
';' { Located $$ (Token (Sym Semi ) _)}
'.' { Located $$ (Token (Sym Dot ) _)}
-- '.' { Located $$ (Token (Sym Dot ) _)}
'{' { Located $$ (Token (Sym CurlyL ) _)}
'}' { Located $$ (Token (Sym CurlyR ) _)}
'<|' { Located $$ (Token (Sym TriL ) _)}
Expand Down Expand Up @@ -355,6 +357,10 @@ apats_indices :: { ([Pattern PName], [Pattern PName]) }
: apats indices { ($1, $2) }
| '@' indices1 { ([], $2) }

opt_apats_indices :: { ([Pattern PName], [Pattern PName]) }
: {- empty -} { ([],[]) }
| apats_indices { $1 }

decls :: { [Decl PName] }
: decl ';' { [$1] }
| decls decl ';' { $2 : $1 }
Expand Down Expand Up @@ -484,8 +490,8 @@ aexpr :: { Expr PName }
no_sel_aexpr :: { Expr PName }
: qname { at $1 $ EVar (thing $1) }

| NUM { at $1 $ numLit (tokenType (thing $1)) }
| FRAC { at $1 $ fracLit (tokenType (thing $1)) }
| NUM { at $1 $ numLit (thing $1) }
| FRAC { at $1 $ fracLit (thing $1) }
| STRLIT { at $1 $ ELit $ ECString $ getStr $1 }
| CHARLIT { at $1 $ ELit $ ECChar $ getChr $1 }
| '_' { at $1 $ EVar $ mkUnqual $ mkIdent "_" }
Expand All @@ -507,9 +513,11 @@ no_sel_aexpr :: { Expr PName }
| '<|' poly_terms '|>' {% mkPoly (rComb $1 $3) $2 }

sel_expr :: { Expr PName }
: no_sel_aexpr '.' selector { at ($1,$3) $ ESel $1 (thing $3) }
| sel_expr '.' selector { at ($1,$3) $ ESel $1 (thing $3) }
: no_sel_aexpr selector { at ($1,$2) $ ESel $1 (thing $2) }
| sel_expr selector { at ($1,$2) $ ESel $1 (thing $2) }

selector :: { Located Selector }
: SELECTOR { mkSelector `fmap` $1 }

poly_terms :: { [(Bool, Integer)] }
: poly_term { [$1] }
Expand All @@ -520,11 +528,6 @@ poly_term :: { (Bool, Integer) }
| 'x' {% polyTerm $1 1 1 }
| 'x' '^^' NUM {% polyTerm (rComb $1 (srcRange $3))
1 (getNum $3) }

selector :: { Located Selector }
: ident { fmap (`RecordSel` Nothing) $1 }
| NUM {% mkTupleSel (srcRange $1) (getNum $1) }

tuple_exprs :: { [Expr PName] }
: expr ',' expr { [ $3, $1] }
| tuple_exprs ',' expr { $3 : $1 }
Expand All @@ -535,25 +538,22 @@ rec_expr :: { Either (Expr PName) [Named (Expr PName)] }
| '_' '|' field_exprs { Left (EUpd Nothing (reverse $3)) }
| field_exprs {% Right `fmap` mapM ufToNamed $1 }

field_expr :: { UpdField PName }
: selector field_how expr { UpdField $2 [$1] $3 }
| sels field_how expr { UpdField $2 $1 $3 }
| sels apats_indices field_how expr
{ UpdField $3 $1 (mkIndexedExpr $2 $4) }
| selector apats_indices field_how expr
{ UpdField $3 [$1] (mkIndexedExpr $2 $4) }

field_how :: { UpdHow }
: '=' { UpdSet }
| '->' { UpdFun }

sels :: { [ Located Selector ] }
: sel_expr {% selExprToSels $1 }

field_exprs :: { [UpdField PName] }
: field_expr { [$1] }
| field_exprs ',' field_expr { $3 : $1 }

field_expr :: { UpdField PName }
: field_path opt_apats_indices
field_how expr { UpdField $3 $1 (mkIndexedExpr $2 $4) }

field_path :: { [Located Selector] }
: aexpr {% exprToFieldPath $1 }

field_how :: { UpdHow }
: '=' { UpdSet }
| '->' { UpdFun }


list_expr :: { Expr PName }
: expr '|' list_alts { EComp $1 (reverse $3) }
| expr { EList [$1] }
Expand Down
34 changes: 17 additions & 17 deletions src/Cryptol/Parser/AST.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -279,18 +279,18 @@ data TopLevel a = TopLevel { tlExport :: ExportType


-- | Infromation about the representation of a numeric constant.
data NumInfo = BinLit Int -- ^ n-digit binary literal
| OctLit Int -- ^ n-digit octal literal
| DecLit -- ^ overloaded decimal literal
| HexLit Int -- ^ n-digit hex literal
data NumInfo = BinLit Text Int -- ^ n-digit binary literal
| OctLit Text Int -- ^ n-digit octal literal
| DecLit Text -- ^ overloaded decimal literal
| HexLit Text Int -- ^ n-digit hex literal
| PolyLit Int -- ^ polynomial literal
deriving (Eq, Show, Generic, NFData)

-- | Information about fractional literals.
data FracInfo = BinFrac
| OctFrac
| DecFrac
| HexFrac
data FracInfo = BinFrac Text
| OctFrac Text
| DecFrac Text
| HexFrac Text
deriving (Eq,Show,Generic,NFData)

-- | Literals.
Expand Down Expand Up @@ -648,10 +648,10 @@ ppFracLit :: Rational -> FracInfo -> Doc
ppFracLit x i
| toRational dbl == x =
case i of
BinFrac -> frac
OctFrac -> frac
DecFrac -> text (showFloat dbl "")
HexFrac -> text (showHFloat dbl "")
BinFrac _ -> frac
OctFrac _ -> frac
DecFrac _ -> text (showFloat dbl "")
HexFrac _ -> text (showHFloat dbl "")
| otherwise = frac
where
dbl = fromRational x :: Double
Expand All @@ -662,11 +662,11 @@ ppFracLit x i
ppNumLit :: Integer -> NumInfo -> Doc
ppNumLit n info =
case info of
DecLit -> integer n
BinLit w -> pad 2 "0b" w
OctLit w -> pad 8 "0o" w
HexLit w -> pad 16 "0x" w
PolyLit w -> text "<|" <+> poly w <+> text "|>"
DecLit _ -> integer n
BinLit _ w -> pad 2 "0b" w
OctLit _ w -> pad 8 "0o" w
HexLit _ w -> pad 16 "0x" w
PolyLit w -> text "<|" <+> poly w <+> text "|>"
where
pad base pref w =
let txt = showIntAtBase base ("0123456789abcdef" !!) n ""
Expand Down
33 changes: 8 additions & 25 deletions src/Cryptol/Parser/Lexer.x
View file
Original file line number Diff line number Diff line change
Expand Up @@ -45,17 +45,10 @@ $unitick = \x7
@qual_id = @qual @id
@qual_op = @qual @op

@digits2 = (_*[0-1])+
@digits8 = (_*[0-7])+
@digits16 = (_*[0-9A-Fa-f])+
@num2 = "0b" @digits2
@num8 = "0o" @digits8
@num10 = [0-9](_*[0-9])*
@num16 = "0x" @digits16
@fnum2 = @num2 "." @digits2 ([pP] [\+\-]? @num10)?
@fnum8 = @num8 "." @digits8 ([pP] [\+\-]? @num10)?
@fnum10 = @num10 "." @num10 ([eE] [\+\-]? @num10)?
@fnum16 = @num16 "." @digits16 ([pP] [\+\-]? @num10)?
@num = [0-9] @id_next*
@fnum = [0-9] @id_next* "." (@id_next | [pPeE][\+\-])+

@selector = "." @id_next+

@strPart = [^\\\"]+
@chrPart = [^\\\']+
Expand Down Expand Up @@ -130,19 +123,12 @@ $white+ { emit $ White Space }
"Prop" { emit $ KW KW_Prop }
@num2 { emitS (numToken 2 . Text.drop 2) }
@num8 { emitS (numToken 8 . Text.drop 2) }
@num10 { emitS (numToken 10 . Text.drop 0) }
@num16 { emitS (numToken 16 . Text.drop 2) }
@fnum2 { emitS (fnumToken 2 . Text.drop 2) }
@fnum8 { emitS (fnumToken 8 . Text.drop 2) }
@fnum10 { emitS (fnumToken 10 . Text.drop 0) }
@fnum16 { emitS (fnumToken 16 . Text.drop 2) }
@num { emitS numToken }
@fnum { emitFancy fnumTokens }
"_" { emit $ Sym Underscore }
@id { mkIdent }
@selector { emitS selectorToken }
"\" { emit $ Sym Lambda }
"->" { emit $ Sym ArrR }
Expand All @@ -152,7 +138,6 @@ $white+ { emit $ White Space }
"=" { emit $ Sym EqDef }
"," { emit $ Sym Comma }
";" { emit $ Sym Semi }
"." { emit $ Sym Dot }
":" { emit $ Sym Colon }
"`" { emit $ Sym BackTick }
".." { emit $ Sym DotDot }
Expand Down Expand Up @@ -261,9 +246,7 @@ primLexer cfg cs = run inp Normal
let txt = Text.take l (input i)
(mtok,s') = act cfg (alexPos i) txt s
(rest,pos) = run i' $! s'
in case mtok of
Nothing -> (rest, pos)
Just t -> (t : rest, pos)
in (mtok ++ rest, pos)
-- vim: ft=haskell
}
Loading

0 comments on commit 5d04936

Please sign in to comment.