language-ats 0.2.0.2 → 0.2.0.3
raw patch · 5 files changed
+191/−160 lines, 5 filesPVP: minor bump suggested
API additions: PVP suggests at least a minor version bump
API changes (from Hackage documentation)
+ Language.ATS: End :: Token
+ Language.ATS: KwMacdef :: Keyword
+ Language.ATS: MacDecl :: AlexPosn -> String -> [String] -> Expression -> Declaration
+ Language.ATS: MacroVar :: AlexPosn -> String -> Expression
+ Language.ATS: SpecialInfix :: String -> BinOp
+ Language.ATS: SpecialOp :: String -> UnOp
Files
- language-ats.cabal +1/−1
- src/Language/ATS/Lexer.x +141/−123
- src/Language/ATS/Parser.y +21/−19
- src/Language/ATS/PrettyPrint.hs +24/−17
- src/Language/ATS/Types.hs +4/−0
language-ats.cabal view
@@ -1,5 +1,5 @@ name: language-ats-version: 0.2.0.2+version: 0.2.0.3 synopsis: Parser and pretty-printer for ATS. description: Parser and pretty-printer for [ATS](http://www.ats-lang.org/), written with Happy and Alex. license: BSD3
src/Language/ATS/Lexer.x view
@@ -1,6 +1,6 @@ { - {-# OPTIONS_GHC -fno-warn-unused-matches -fno-warn-incomplete-uni-patterns #-}+ {-# OPTIONS_GHC -fno-warn-unused-matches -fno-warn-incomplete-uni-patterns -fno-warn-unused-imports #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveDataTypeable #-}@@ -28,7 +28,7 @@ } -%wrapper "posn"+%wrapper "monad" -- Digits $digit = 0-9@@ -87,7 +87,7 @@ -- TODO should be followed by a space; symbols like @..@ should have their own -- thing.-@operator = "**" | "+" | "-" | "*" | "/" | ".." | "!=" | ">=" | "<=" | "==" | "=" | "~" | "%" | "&&" | "||" | ":=" | ".<" | ">." | "<" | ">" | ">>" | "?" | "?!" | "#[" | "->>"+@operator = "**" | "+" | "-" | "*" | "/" | ".." | "!=" | ">=" | "<=" | "==" | "=" | "~" | "%" | "&&" | "||" | ":=" | ".<" | ">." | "<" | ">" | ">>" | "?" | "?!" | "#[" @double_parens = "(" (@block_comment | $white+ | \n | "//".*)+ ")" | "()" @double_braces = "{" @block_comment "}" | "{}"@@ -97,136 +97,140 @@ @fixity_decl = "infixr" | "infixl" | "prefix" | "postfix" +@builtin = \$ (("effmask_" (wrt | all | ref)) | "extfcall" | "ldelay" | "delay" | "list_vt" | "tempenver" | "extype")+ tokens :- $white+ ;- @block_comment { tok (\p s -> CommentLex p s) }- "//".* { tok (\p s -> CommentLex p s) }- "#define".* { tok (\p s -> MacroBlock p s) } - @if_block { tok (\p s -> MacroBlock p s) } - @c_block { tok (\p s -> CBlockLex p s) }- fun { tok (\p s -> Keyword p KwFun) }- fn { tok (\p s -> Keyword p KwFn) }- fnx { tok (\p s -> Keyword p KwFnx) }- and { tok (\p s -> Keyword p KwAnd) }- prval { tok (\p s -> Keyword p KwPrval) }- prfn { tok (\p s -> Keyword p KwPrfn) }- prfun { tok (\p s -> Keyword p KwPrfun) }- datatype { tok (\p s -> Keyword p KwDatatype) }- data @view type { tok (\p s -> Keyword p KwDatavtype) }- @view type { tok (\p s -> Keyword p (KwVtype None)) }- @view type"+" { tok (\p s -> Keyword p (KwVtype Plus)) }- @view type"-" { tok (\p s -> Keyword p (KwVtype Minus)) }- dataview { tok (\p s -> Keyword p KwDataview) }- dataprop { tok (\p s -> Keyword p KwDataprop) }- assume { tok (\p s -> Keyword p KwAssume) }- typedef { tok (\p s -> Keyword p KwTypedef) }- @view typedef { tok (\p s -> Keyword p KwVtypedef) }- absprop { tok (\p s -> Keyword p KwAbsprop) }- llam { tok (\p s -> Keyword p KwLinearLambda) }- lam { tok (\p s -> Keyword p KwLambda) }- staload { tok (\p s -> Keyword p (KwStaload False)) }- "#"staload { tok (\p s -> Keyword p (KwStaload True)) }- let { tok (\p s -> Keyword p KwLet) }- in { tok (\p s -> Keyword p KwIn) }- end { tok (\p s -> Keyword p KwEnd) }- case"+" { tok (\p s -> Keyword p (KwCase Plus)) }- case"-" { tok (\p s -> Keyword p (KwCase Minus)) }- case { tok (\p s -> Keyword p (KwCase None)) }- castfn { tok (\p s -> Keyword p KwCastfn) }- val"+" { tok (\p s -> Keyword p (KwVal Plus)) }- val"-" { tok (\p s -> Keyword p (KwVal Minus)) }- val { tok (\p s -> Keyword p (KwVal None)) }- var { tok (\p s -> Keyword p KwVar) }- if { tok (\p s -> Keyword p KwIf) }- sif { tok (\p s -> Keyword p KwSif) }- then { tok (\p s -> Keyword p KwThen) }- else { tok (\p s -> Keyword p KwElse) }- implement { tok (\p s -> Keyword p KwImplement) }- implmnt { tok (\p s -> Keyword p KwImplement) }- primplmnt { tok (\p s -> Keyword p KwProofImplement) }- primplement { tok (\p s -> Keyword p KwProofImplement) }- abst"@"ype { tok (\p s -> Keyword p (KwAbst0p None)) }- abst"@ype+" { tok (\p s -> Keyword p (KwAbst0p Plus)) }- abst"@type-" { tok (\p s -> Keyword p (KwAbst0p Minus)) }- abs@view"t@ype" { tok (\p s -> Keyword p (KwAbsvt0p None)) }- t"@"ype"+" { tok (\p s -> Keyword p (KwT0p Plus)) }- t"@"ype"-" { tok (\p s -> Keyword p (KwT0p Minus)) }- t"@"ype { tok (\p s -> Keyword p (KwT0p None)) }- @view"t@ype+" { tok (\p s -> Keyword p (KwVt0p Plus)) }- @view"t@ype-" { tok (\p s -> Keyword p (KwVt0p Minus)) }- @view"t@ype" { tok (\p s -> Keyword p (KwVt0p None)) }- abstype { tok (\p s -> Keyword p KwAbstype) }- abs @view type { tok (\p s -> Keyword p KwAbsvtype) }- absview { tok (\p s -> Keyword p KwAbsview) }- view { tok (\p s -> Keyword p (KwView None)) }- view"+" { tok (\p s -> Keyword p (KwView Plus)) }- view"-" { tok (\p s -> Keyword p (KwView Minus)) }- viewdef { tok (\p s -> Keyword p KwViewdef) }- "#"include { tok (\p s -> Keyword p KwInclude) }- when { tok (\p s -> Keyword p KwWhen) }- of { tok (\p s -> Keyword p KwOf) }- ifcase { tok (\p s -> Keyword p KwIfCase) }- stadef { tok (\p s -> Keyword p KwStadef) }- stacst { tok (\p s -> Keyword p KwStacst) }- local { tok (\p s -> Keyword p KwLocal) }- praxi { tok (\p s -> Keyword p KwPraxi) }- while { tok (\p s -> Keyword p KwWhile) }- where { tok (\p s -> Keyword p KwWhere) }- begin { tok (\p s -> Keyword p KwBegin) }- overload { tok (\p s -> Keyword p KwOverload) }- with { tok (\p s -> Keyword p KwWith) }- extern { tok (\p s -> Keyword p KwExtern) }- sortdef { tok (\p s -> Keyword p KwSortdef) }- propdef { tok (\p s -> Keyword p KwPropdef) }- tkindef { tok (\p s -> Keyword p KwTKind) }- typekindef { tok (\p s -> Keyword p KwTKind) }- "$raise" { tok (\p s -> Keyword p KwRaise) }- mod { tok (\p s -> Keyword p KwMod) }- "println!" { tok (\p s -> Identifier p s) }- "prerrln!" { tok (\p s -> Identifier p s) }- "fix@" { tok (\p s -> Keyword p KwFixAt) }- "lam@" { tok (\p s -> Keyword p KwLambdaAt) }- "addr" { tok (\p s -> Keyword p KwAddr) }- "addr@" { tok (\p s -> Keyword p KwAddrAt) }- "view@" { tok (\p s -> Keyword p KwViewAt) }- sta { tok (\p s -> Keyword p KwSta) }- symintr { tok (\p s -> Keyword p KwSymintr) }- absview { tok (\p s -> Keyword p KwAbsview) }- "$list" { tok (\p s -> Keyword p (KwListLit "")) }- "$list_vt" { tok (\p s -> Keyword p (KwListLit "_vt")) }- "fold@" { tok (\p s -> IdentifierSpace p s) }- "free@" { tok (\p s -> Identifier p s) }- @fixity_decl { tok (\p s -> FixityTok p s) }- @double_parens { tok (\p s -> DoubleParenTok p) }- @double_braces { tok (\p s -> DoubleBracesTok p) }- @double_brackets { tok (\p s -> DoubleBracketTok p) }- @char_lit { tok (\p s -> CharTok p (toChar s)) }- @lambda { tok (\p s -> Arrow p s) }- @func_type { tok (\p s -> FuncType p s) }- @time_lit { tok (\p s -> TimeTok p s) }- @integer { tok (\p s -> IntTok p (read s)) } -- FIXME shouldn't fail silenty on overflow- @float { tok (\p s -> FloatTok p (read s)) }- @at_brace { tok (\p s -> Operator p "@{") } -- FIXME this is kinda sloppy- $br / @ref_call { tok (\p s -> SpecialBracket p) }- @operator { tok (\p s -> Operator p s) }- @signature { tok (\p s -> SignatureTok p (tail s)) }- $special { tok (\p s -> Special p s) }- "effmask_all" { tok (\p s -> Identifier p s) }- "effmask_wrt" { tok (\p s -> Identifier p s) }- "extype" { tok (\p s -> Identifier p s) }- @identifier / " " { tok (\p s -> IdentifierSpace p s) }- @identifier { tok (\p s -> Identifier p s) }- @string { tok (\p s -> StringTok p s) }+ @block_comment { tok (\p s -> alex $ CommentLex p s) }+ "//".* { tok (\p s -> alex $ CommentLex p s) }+ "#define".* { tok (\p s -> alex $ MacroBlock p s) } + @if_block { tok (\p s -> alex $ MacroBlock p s) } + @c_block { tok (\p s -> alex $ CBlockLex p s) }+ fun { tok (\p s -> alex $ Keyword p KwFun) }+ fn { tok (\p s -> alex $ Keyword p KwFn) }+ fnx { tok (\p s -> alex $ Keyword p KwFnx) }+ and { tok (\p s -> alex $ Keyword p KwAnd) }+ prval { tok (\p s -> alex $ Keyword p KwPrval) }+ prfn { tok (\p s -> alex $ Keyword p KwPrfn) }+ prfun { tok (\p s -> alex $ Keyword p KwPrfun) }+ datatype { tok (\p s -> alex $ Keyword p KwDatatype) }+ data @view type { tok (\p s -> alex $ Keyword p KwDatavtype) }+ @view type { tok (\p s -> alex $ Keyword p (KwVtype None)) }+ @view type"+" { tok (\p s -> alex $ Keyword p (KwVtype Plus)) }+ @view type"-" { tok (\p s -> alex $ Keyword p (KwVtype Minus)) }+ dataview { tok (\p s -> alex $ Keyword p KwDataview) }+ dataprop { tok (\p s -> alex $ Keyword p KwDataprop) }+ assume { tok (\p s -> alex $ Keyword p KwAssume) }+ typedef { tok (\p s -> alex $ Keyword p KwTypedef) }+ @view typedef { tok (\p s -> alex $ Keyword p KwVtypedef) }+ absprop { tok (\p s -> alex $ Keyword p KwAbsprop) }+ llam { tok (\p s -> alex $ Keyword p KwLinearLambda) }+ lam { tok (\p s -> alex $ Keyword p KwLambda) }+ staload { tok (\p s -> alex $ Keyword p (KwStaload False)) }+ "#"staload { tok (\p s -> alex $ Keyword p (KwStaload True)) }+ let { tok (\p s -> alex $ Keyword p KwLet) }+ in { tok (\p s -> alex $ Keyword p KwIn) }+ end { tok (\p s -> alex $ Keyword p KwEnd) }+ case"+" { tok (\p s -> alex $ Keyword p (KwCase Plus)) }+ case"-" { tok (\p s -> alex $ Keyword p (KwCase Minus)) }+ case { tok (\p s -> alex $ Keyword p (KwCase None)) }+ castfn { tok (\p s -> alex $ Keyword p KwCastfn) }+ val"+" { tok (\p s -> alex $ Keyword p (KwVal Plus)) }+ val"-" { tok (\p s -> alex $ Keyword p (KwVal Minus)) }+ val { tok (\p s -> alex $ Keyword p (KwVal None)) }+ var { tok (\p s -> alex $ Keyword p KwVar) }+ if { tok (\p s -> alex $ Keyword p KwIf) }+ sif { tok (\p s -> alex $ Keyword p KwSif) }+ then { tok (\p s -> alex $ Keyword p KwThen) }+ else { tok (\p s -> alex $ Keyword p KwElse) }+ implement { tok (\p s -> alex $ Keyword p KwImplement) }+ implmnt { tok (\p s -> alex $ Keyword p KwImplement) }+ primplmnt { tok (\p s -> alex $ Keyword p KwProofImplement) }+ primplement { tok (\p s -> alex $ Keyword p KwProofImplement) }+ abst"@"ype { tok (\p s -> alex $ Keyword p (KwAbst0p None)) }+ abst"@ype+" { tok (\p s -> alex $ Keyword p (KwAbst0p Plus)) }+ abst"@type-" { tok (\p s -> alex $ Keyword p (KwAbst0p Minus)) }+ abs@view"t@ype" { tok (\p s -> alex $ Keyword p (KwAbsvt0p None)) }+ t"@"ype"+" { tok (\p s -> alex $ Keyword p (KwT0p Plus)) }+ t"@"ype"-" { tok (\p s -> alex $ Keyword p (KwT0p Minus)) }+ t"@"ype { tok (\p s -> alex $ Keyword p (KwT0p None)) }+ @view"t@ype+" { tok (\p s -> alex $ Keyword p (KwVt0p Plus)) }+ @view"t@ype-" { tok (\p s -> alex $ Keyword p (KwVt0p Minus)) }+ @view"t@ype" { tok (\p s -> alex $ Keyword p (KwVt0p None)) }+ abstype { tok (\p s -> alex $ Keyword p KwAbstype) }+ abs @view type { tok (\p s -> alex $ Keyword p KwAbsvtype) }+ absview { tok (\p s -> alex $ Keyword p KwAbsview) }+ view { tok (\p s -> alex $ Keyword p (KwView None)) }+ view"+" { tok (\p s -> alex $ Keyword p (KwView Plus)) }+ view"-" { tok (\p s -> alex $ Keyword p (KwView Minus)) }+ viewdef { tok (\p s -> alex $ Keyword p KwViewdef) }+ "#"include { tok (\p s -> alex $ Keyword p KwInclude) }+ when { tok (\p s -> alex $ Keyword p KwWhen) }+ of { tok (\p s -> alex $ Keyword p KwOf) }+ ifcase { tok (\p s -> alex $ Keyword p KwIfCase) }+ stadef { tok (\p s -> alex $ Keyword p KwStadef) }+ stacst { tok (\p s -> alex $ Keyword p KwStacst) }+ local { tok (\p s -> alex $ Keyword p KwLocal) }+ praxi { tok (\p s -> alex $ Keyword p KwPraxi) }+ while { tok (\p s -> alex $ Keyword p KwWhile) }+ where { tok (\p s -> alex $ Keyword p KwWhere) }+ begin { tok (\p s -> alex $ Keyword p KwBegin) }+ overload { tok (\p s -> alex $ Keyword p KwOverload) }+ with { tok (\p s -> alex $ Keyword p KwWith) }+ extern { tok (\p s -> alex $ Keyword p KwExtern) }+ sortdef { tok (\p s -> alex $ Keyword p KwSortdef) }+ propdef { tok (\p s -> alex $ Keyword p KwPropdef) }+ tkindef { tok (\p s -> alex $ Keyword p KwTKind) }+ typekindef { tok (\p s -> alex $ Keyword p KwTKind) }+ "$raise" { tok (\p s -> alex $ Keyword p KwRaise) }+ macdef { tok (\p s -> alex $ Keyword p KwMacdef) }+ mod { tok (\p s -> alex $ Keyword p KwMod) }+ "println!" { tok (\p s -> alex $ Identifier p s) }+ "prerrln!" { tok (\p s -> alex $ Identifier p s) }+ "fix@" { tok (\p s -> alex $ Keyword p KwFixAt) }+ "lam@" { tok (\p s -> alex $ Keyword p KwLambdaAt) }+ "addr" { tok (\p s -> alex $ Keyword p KwAddr) }+ "addr@" { tok (\p s -> alex $ Keyword p KwAddrAt) }+ "view@" { tok (\p s -> alex $ Keyword p KwViewAt) }+ sta { tok (\p s -> alex $ Keyword p KwSta) }+ symintr { tok (\p s -> alex $ Keyword p KwSymintr) }+ absview { tok (\p s -> alex $ Keyword p KwAbsview) }+ "$list" { tok (\p s -> alex $ Keyword p (KwListLit "")) }+ "$list_vt" { tok (\p s -> alex $ Keyword p (KwListLit "_vt")) }+ "fold@" { tok (\p s -> alex $ IdentifierSpace p s) }+ "free@" { tok (\p s -> alex $ Identifier p s) }+ @fixity_decl { tok (\p s -> alex $ FixityTok p s) }+ @double_parens { tok (\p s -> alex $ DoubleParenTok p) }+ @double_braces { tok (\p s -> alex $ DoubleBracesTok p) }+ @double_brackets { tok (\p s -> alex $ DoubleBracketTok p) }+ @char_lit { tok (\p s -> alex $ CharTok p (toChar s)) }+ @lambda { tok (\p s -> alex $ Arrow p s) }+ @func_type { tok (\p s -> alex $ FuncType p s) }+ @time_lit { tok (\p s -> alex $ TimeTok p s) }+ @integer { tok (\p s -> alex $ IntTok p (read s)) } -- FIXME shouldn't fail silenty on overflow+ @float { tok (\p s -> alex $ FloatTok p (read s)) }+ @at_brace { tok (\p s -> alex $ Operator p "@{") } -- FIXME this is kinda sloppy+ $br / @ref_call { tok (\p s -> alex $ SpecialBracket p) }+ @operator { tok (\p s -> alex $ Operator p s) }+ @signature { tok (\p s -> alex $ SignatureTok p (tail s)) }+ @builtin { tok (\p s -> alex $ Identifier p s) }+ $special { tok (\p s -> alex $ Special p s) }+ @identifier / " " { tok (\p s -> alex $ IdentifierSpace p s) }+ @identifier { tok (\p s -> alex $ Identifier p s) }+ @string { tok (\p s -> alex $ StringTok p s) } { +alex :: a -> Alex a+alex = pure+ deriving instance Generic AlexPosn deriving instance NFData AlexPosn deriving instance Data AlexPosn deriving instance Typeable AlexPosn -tok f p s = f p s+tok f (p,_,_,s) len = f p (take len s) -- | Determines the default behavior for incomplete pattern matches data Addendum = None@@ -314,6 +318,7 @@ | KwInfixl | KwStacst | KwListLit String+ | KwMacdef deriving (Eq, Show, Generic, NFData) data Token = Identifier AlexPosn String@@ -337,6 +342,7 @@ | DoubleBracketTok AlexPosn | SpecialBracket AlexPosn | FixityTok AlexPosn String+ | End deriving (Eq, Show, Generic, NFData) instance Pretty Addendum where@@ -417,6 +423,7 @@ pretty KwInfixr = "infixr" pretty KwInfixl = "infixl" pretty (KwListLit s) = "list" <> string s+ pretty KwMacdef = "macdef" instance Pretty Token where pretty (Identifier _ s) = text s@@ -440,6 +447,7 @@ pretty DoubleBracketTok{} = "<>" pretty SpecialBracket{} = "<" pretty (FixityTok _ s) = text s+ pretty End = mempty to_string (CommentLex _ s) = s to_string (Identifier _ s) = s@@ -467,6 +475,7 @@ token_posn (DoubleBracketTok p) = p token_posn (SpecialBracket p) = p token_posn (FixityTok p _) = p+token_posn End = undefined toChar :: String -> Char toChar "'\\n'" = '\n'@@ -474,8 +483,17 @@ toChar "'\\\\'" = '\\' toChar x = x !! 1 +alexEOF :: Alex Token+alexEOF = pure End+ -- | This function turns a string into a stream of tokens for the parser. lexATS :: String -> [Token]-lexATS = alexScanTokens+lexATS str = either error id . runAlex str $ loop++loop :: Alex [Token]+loop = do+ tok' <- alexMonadScan+ if tok' == End then pure []+ else (tok' :) <$> loop }
src/Language/ATS/Parser.y view
@@ -105,14 +105,15 @@ timeLit { TimeTok _ $$ } intLit { IntTok _ $$ } floatLit { FloatTok _ $$ }- effmaskWrt { Identifier $$ "effmask_wrt" }- effmaskAll { Identifier $$ "effmask_all" }- effmaskRef { Identifier $$ "effmask_ref" }- extfcall { Identifier $$ "extfcall" }- tempenver { Identifier $$ "tempenver" }- extype { Identifier $$ "extype" }- ldelay { Identifier $$ "ldelay" }- listVT { Identifier $$ "list_vt" }+ effmaskWrt { Identifier $$ "$effmask_wrt" }+ effmaskAll { Identifier $$ "$effmask_all" }+ effmaskRef { Identifier $$ "$effmask_ref" }+ extfcall { Identifier $$ "$extfcall" }+ tempenver { Identifier $$ "$tempenver" }+ extype { Identifier $$ "$extype" }+ ldelay { Identifier $$ "$ldelay" }+ delay { Identifier $$ "$delay" }+ listVT { Identifier $$ "$list_vt" } foldAt { Identifier $$ "fold@" } identifier { $$@Identifier{} } identifierSpace { $$@IdentifierSpace{} }@@ -174,7 +175,7 @@ lspecial { SpecialBracket $$ } atbrace { Operator $$ "@{" } exp { Operator $$ "**" }- stabby { Operator $$ "->>" }+ macdef { Keyword $$ KwMacdef } mod { Keyword $$ KwMod } fixAt { Keyword $$ KwFixAt } lamAt { Keyword $$ KwLambdaAt }@@ -331,6 +332,7 @@ | openParen Expression vbar Expression closeParen { ProofExpr $1 $2 $4 } | list_vt lbrace Type rbrace openParen ExpressionIn closeParen { ListLiteral $1 "vt" $3 $6 } | list lbrace Type rbrace openParen ExpressionIn closeParen { ListLiteral $1 "" $3 $6 } -- TODO is this legal??+ | comma openParen identifier closeParen { MacroVar $1 (to_string $3) } | begin Expression extern {% Left $ Expected $3 "end" "extern" } | Expression prfTransform underscore {% Left $ Expected $2 "Rest of expression or declaration" ">>" } @@ -489,7 +491,6 @@ -- | Parse a general name Name : identifier { Unqualified (to_string $1) } | underscore { Unqualified "_" }- | listVT { Unqualified "list_vt" } | foldAt { Unqualified "fold@" } | identifier dollar IdentifierOr { Unqualified (to_string $1 ++ ('$' : $3)) } | identifier dot identifier { FieldName (token_posn $1) (to_string $1) (to_string $3) }@@ -498,14 +499,15 @@ | dollar identifier dot identifier { Qualified $1 (to_string $4) (to_string $2) } | dollar identifier dot identifierSpace { Qualified $1 (to_string $4) (to_string $2) } | dollar identifier dot identifier dollar IdentifierOr { Qualified $1 (to_string $4 ++ ('$' : $6)) (to_string $2) }- | dollar effmaskWrt { SpecialName $1 "effmask_wrt" }- | dollar effmaskAll { SpecialName $1 "effmask_all" }- | dollar effmaskRef { SpecialName $1 "effmask_ref" }- | dollar extfcall { SpecialName $1 "extfcall" }- | dollar tempenver { SpecialName $1 "tempenver" }- | dollar extype { SpecialName $1 "effmask_all" }- | dollar listVT { SpecialName $1 "list_vt" }- | dollar ldelay { SpecialName $1 "ldelay" } -- FIXME there is probably a better way of doing this+ | effmaskWrt { SpecialName $1 "effmask_wrt" }+ | effmaskAll { SpecialName $1 "effmask_all" }+ | effmaskRef { SpecialName $1 "effmask_ref" }+ | extfcall { SpecialName $1 "extfcall" }+ | tempenver { SpecialName $1 "tempenver" }+ | extype { SpecialName $1 "effmask_all" }+ | listVT { SpecialName $1 "list_vt" }+ | ldelay { SpecialName $1 "ldelay" } -- FIXME there is probably a better way of doing this+ | delay { SpecialName $1 "delay" } | dollar {% Left $ Expected $1 "Name" "$" } -- | Parse a list of values in a record@@ -697,7 +699,6 @@ -- FIXME adopt a principled approach Operator : identifierSpace { to_string $1 } | exp { "**" }- | stabby { "->>" } | mutateArrow { "->" } Operators : Operator { [$1] }@@ -725,6 +726,7 @@ | define identifier string { Define ($1 ++ " " ++ to_string $2 ++ $3) } -- FIXME better approach? | define identifierSpace intLit { Define ($1 ++ " " ++ to_string $2 ++ " " ++ show $3) } | cblock { CBlock $1 }+ | macdef IdentifierOr openParen IdentifiersIn closeParen eq Expression { MacDecl $1 $2 $4 $7 } | lineComment { Comment (to_string $1) } | staload underscore eq string { Staload (get_staload $1) (Just "_") $4 } | staload string { Staload (get_staload $1) Nothing $2 }
src/Language/ATS/PrettyPrint.hs view
@@ -75,21 +75,22 @@ pretty (Full _ v) = "=<" <> text v <> ">" instance Pretty BinOp where- pretty Mult = "*"- pretty Add = "+"- pretty Div = "/"- pretty Sub = "-"- pretty GreaterThan = ">"- pretty LessThan = "<"- pretty Equal = "="- pretty NotEqual = "!="- pretty LogicalAnd = "&&"- pretty LogicalOr = "||"- pretty LessThanEq = "<="- pretty GreaterThanEq = ">="- pretty StaticEq = "=="- pretty Mod = "%"- pretty NotEq = "<>"+ pretty Mult = "*"+ pretty Add = "+"+ pretty Div = "/"+ pretty Sub = "-"+ pretty GreaterThan = ">"+ pretty LessThan = "<"+ pretty Equal = "="+ pretty NotEqual = "!="+ pretty LogicalAnd = "&&"+ pretty LogicalOr = "||"+ pretty LessThanEq = "<="+ pretty GreaterThanEq = ">="+ pretty StaticEq = "=="+ pretty Mod = "%"+ pretty NotEq = "<>"+ pretty (SpecialInfix s) = text s splits :: BinOp -> Bool splits Mult = True@@ -127,6 +128,10 @@ prettyArgsProof (Just e) = prettyArgsG ("(" <> prettyArgsG mempty mempty (fmap pretty e) <+> "| ") ")" prettyArgsProof Nothing = prettyArgs +instance Pretty UnOp where+ pretty Negate = "~"+ pretty (SpecialOp s) = text s+ instance Pretty Expression where pretty = cata a . rewriteATS where a (IfF e e' (Just e'')) = "if" <+> e <+> "then" <$> indent 2 e' <$> "else" <$> indent 2 e''@@ -143,12 +148,12 @@ a (FloatLitF f) = pretty f a (StringLitF s) = text s -- FIXME escape indentation in multi-line strings. a (ParenExprF _ e) = parens e+ a (UnaryF op e) = pretty op <> pretty e a (BinListF op@Add es) = prettyBinary (pretty op) es a (BinaryF op e e') | splits op = e </> pretty op <+> e' | otherwise = e <+> pretty op <+> e' a (IndexF _ n e) = pretty n <> "[" <> e <> "]"- a (UnaryF Negate e) = "~" <> e a (NamedValF nam) = pretty nam a (CallF nam [] [] Nothing []) = pretty nam <> "()" a (CallF nam [] [] e xs) = pretty nam <> prettyArgsProof e xs@@ -194,6 +199,7 @@ a (ViewAtF _ e) = "view@" <> e a (ListLiteralF _ s t es) = "list" <> string s <> "{" <> pretty t <> "}" <> prettyArgs es a (CommentExprF c e) = text c <$> e+ a (MacroVarF _ s) = ",(" <> text s <> ")" a BinListF{} = undefined -- Shouldn't happen prettyImplicits = mconcat . fmap (prettyArgsU "<" ">") . reverse prettyIfCase [] = mempty@@ -262,7 +268,7 @@ a (StaticBoolF False) = "false" a (SCallF n cs) = pretty n <> parens (mconcat (punctuate "," . reverse . fmap pretty $ cs)) a (SPrecedeF e e') = e <> ";" <+> e'- a (SUnaryF Negate e) = "~" <> e+ a (SUnaryF op e) = pretty op <> e a (SLetF _ e e') = flatAlt ("let" <$> indent 2 (pretty ((ATS . reverse) e)) <$> endLet e') ("let" <+> pretty ((ATS . reverse) e) <$> endLet e')@@ -576,4 +582,5 @@ pretty (TKind _ n s) = pretty n <+> "=" <+> text s pretty (SortDef _ s t) = "sortdef" <+> text s <+> "=" <+> either pretty pretty t pretty (AndD d (SortDef _ i t)) = pretty d <+> "and" <+> text i <+> "=" <+> either pretty pretty t+ pretty (MacDecl _ n is e) = "macdef" <+> text n <> "(" <> mconcat (punctuate ", " (fmap text is)) <> ") =" <+> pretty e pretty AndD{} = undefined -- probably not valid syntax if we get to this point
src/Language/ATS/Types.hs view
@@ -119,6 +119,7 @@ -- uses an 'Int' because you fully deserve what you get if your -- fixity declarations overflow. | FixityDecl Fixity (Either String Int) [String]+ | MacDecl AlexPosn String [String] Expression deriving (Show, Eq, Generic, NFData) data DataPropLeaf = DataPropLeaf [Universal] Expression (Maybe Expression)@@ -211,6 +212,7 @@ -- | @~@ is used to negate numbers in ATS data UnOp = Negate+ | SpecialOp String deriving (Show, Eq, Generic, NFData) -- | Binary operators on expressions@@ -229,6 +231,7 @@ | StaticEq | Mod | NotEq+ | SpecialInfix String deriving (Show, Eq, Generic, NFData) -- FIXME add position information?@@ -305,6 +308,7 @@ | LambdaAt StackFunction | ParenExpr AlexPosn Expression | CommentExpr String Expression+ | MacroVar AlexPosn String deriving (Show, Eq, Generic, NFData) -- | An 'implement' declaration