language-ats 0.2.0.5 → 0.3.0.0

raw patch · 10 files changed

+393/−318 lines, 10 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• bench/Bench.hs +6/−6
• language-ats.cabal +1/−1
• src/Language/ATS.hs +7/−5
• src/Language/ATS/Lexer.x +142/−122
• src/Language/ATS/Parser.y +26/−16
• src/Language/ATS/PrettyPrint.hs +46/−39
• src/Language/ATS/Types.hs +59/−23
• test/Spec.hs +1/−1
• test/data/cli.out +14/−14
• test/data/polyglot.out +91/−91

@@ -7,12 +7,12 @@ main =     defaultMain [ env envFiles $ \ ~(l, m) ->                   bgroup "format"-                      [ bench "lexATS (large)" $ nf lexATS l-                      , bench "parseATS . lexATS (large)" $ nf (parseATS . lexATS) l-                      , bench "printATS . parseATS . lexATS (large)" $ nf (fmap printATS . parseATS . lexATS) l-                      , bench "lexATS (medium)" $ nf lexATS m-                      , bench "parseATS . lexATS (medium)" $ nf (parseATS . lexATS) m-                      , bench "printATS . parseATS . lexATS (medium)" $ nf (fmap printATS . parseATS . lexATS) m+                      [ bench "lexATS (large)" $ nf lex l+                      , bench "parseATS . lexATS (large)" $ nf parse l+                      , bench "printATS . parseATS . lexATS (large)" $ nf (fmap printATS . parse) l+                      , bench "lexATS (medium)" $ nf lex m+                      , bench "parseATS . lexATS (medium)" $ nf parse m+                      , bench "printATS . parseATS . lexATS (medium)" $ nf (fmap printATS . parse) m                       ]                 ]     where large = readFile "test/data/polyglot.dats"

@@ -1,5 +1,5 @@ name:                language-ats-version:             0.2.0.5+version:             0.3.0.0 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

@@ -1,8 +1,7 @@ -- | Main module for the library module Language.ATS ( -- * Functions for working with syntax-                      lexATS-                    , parseATS-                    , parseATS'+                      lex+                    , parse                     , printATS                     , printATSCustom                     , printATSFast@@ -53,9 +52,12 @@ import           Language.ATS.PrettyPrint import           Language.ATS.Types +rewriteATS' :: ATS -> ATS+rewriteATS' (ATS ds) = ATS (rewriteDecl <$> ds)+ -- | Parse a string containing ATS source.-parseATS' :: String -> Either (ATSError String) ATS-parseATS' = parseATS . lexATS+parse :: String -> Either (ATSError String) ATS+parse = fmap rewriteATS' . parseATS . lexATS  -- TODO use Language.C.Parser here? getDependencies :: ATS -> [FilePath]

@@ -35,7 +35,7 @@ $octal = 0-7  -- Characters-$special = [\+\-\&\|\[\]\{\}\(\)\_\=\!\%\^\$\@\;\~\,\.\\\#]+$special = [\+\-\&\|\[\]\{\}\(\)\_\=\!\%\^\$\@\;\~\,\.\\\#\<\>\:\?] $alpha = [a-zA-Z] $terminal = $printable # $white $esc_char = \27@@ -85,9 +85,10 @@  @at_brace = \@ ($white | @block_comment)* \{ --- TODO should be followed by a space; symbols like @..@ should have their own--- thing.-@operator = "**" | "+" | "-" | "*" | "/" | ".." | "!=" | ">=" | "<=" | "==" | "=" | "~" | "%" | "&&" | "||" | ":=" | ".<" | ">." | "<" | ">" | ">>" | "?" | "?!" | "#["+$in_operator = $special # [\)\(\}\{\_\[\]\,]+$in_l = $in_operator # [\<]+$in_r = $in_operator # [\>]+@operator = "+" | "-" | "*" | "/" | "<" | ">" | "=" | "~" | "?" | "%" | "#[" | $in_r{2,} | $in_l{2,}  @double_parens = "(" (@block_comment | $white+ | \n | "//".*)+ ")" | "()" @double_braces = "{" @block_comment "}" | "{}"@@ -99,126 +100,142 @@  @builtin = \$ (("effmask_" (wrt | all | ref)) | "extfcall" | "ldelay" | "delay" | "list_vt" | "tempenver" | "extype" | "mylocation" | "showtype") +@block_comment_start = \(\* | \*\/+@block_comment_end = \*\) | \*\/++@comment_in = [\*\)\(\/$white]+ tokens :- -    $white+                  ;-    @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 $ SpecialIdentifier p (tail 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) }+    <0> $white+                  ;+    -- <0> @block_comment_start     { begin one }+    -- <one> @block_comment_end     { begin 0 }+    -- <one> @block_comment_start   { begin two }+    -- <one> [^\*\)\/]+             ;+    -- <one> @comment_in+ / [^\)]   ;+    -- <one> @comment_in            ;+    -- <two> @block_comment_end     { begin one }+    -- <two> [^\*\)\/]+             ;+    -- <two> @comment_in+ / [^\)]   ;+    -- <two> @comment_in            ;+    @block_comment               { tok (\p s -> alex $ CommentLex p s) }+    <0> "//".*                   { tok (\p s -> alex $ CommentLex p s) }+    <0> "#define".*              { tok (\p s -> alex $ MacroBlock p s) }      +    <0> @if_block                { tok (\p s -> alex $ MacroBlock p s) }      +    <0> @c_block                 { tok (\p s -> alex $ CBlockLex p s) }+    <0> fun                      { tok (\p s -> alex $ Keyword p KwFun) }+    <0> fn                       { tok (\p s -> alex $ Keyword p KwFn) }+    <0> fnx                      { tok (\p s -> alex $ Keyword p KwFnx) }+    <0> and                      { tok (\p s -> alex $ Keyword p KwAnd) }+    <0> prval                    { tok (\p s -> alex $ Keyword p KwPrval) }+    <0> prfn                     { tok (\p s -> alex $ Keyword p KwPrfn) }+    <0> prfun                    { tok (\p s -> alex $ Keyword p KwPrfun) }+    <0> datatype                 { tok (\p s -> alex $ Keyword p KwDatatype) }+    <0> data @view type          { tok (\p s -> alex $ Keyword p KwDatavtype) }+    <0> @view type               { tok (\p s -> alex $ Keyword p (KwVtype None)) }+    <0> @view type"+"            { tok (\p s -> alex $ Keyword p (KwVtype Plus)) }+    <0> @view type"-"            { tok (\p s -> alex $ Keyword p (KwVtype Minus)) }+    <0> dataview                 { tok (\p s -> alex $ Keyword p KwDataview) }+    <0> dataprop                 { tok (\p s -> alex $ Keyword p KwDataprop) }+    <0> assume                   { tok (\p s -> alex $ Keyword p KwAssume) }+    <0> typedef                  { tok (\p s -> alex $ Keyword p KwTypedef) }+    <0> @view typedef            { tok (\p s -> alex $ Keyword p KwVtypedef) }+    <0> absprop                  { tok (\p s -> alex $ Keyword p KwAbsprop) }+    <0> llam                     { tok (\p s -> alex $ Keyword p KwLinearLambda) }+    <0> lam                      { tok (\p s -> alex $ Keyword p KwLambda) }+    <0> staload                  { tok (\p s -> alex $ Keyword p (KwStaload False)) }+    <0> "#"staload               { tok (\p s -> alex $ Keyword p (KwStaload True)) }+    <0> let                      { tok (\p s -> alex $ Keyword p KwLet) }+    <0> in                       { tok (\p s -> alex $ Keyword p KwIn) }+    <0> end                      { tok (\p s -> alex $ Keyword p KwEnd) }+    <0> case"+"                  { tok (\p s -> alex $ Keyword p (KwCase Plus)) }+    <0> case"-"                  { tok (\p s -> alex $ Keyword p (KwCase Minus)) }+    <0> case                     { tok (\p s -> alex $ Keyword p (KwCase None)) }+    <0> castfn                   { tok (\p s -> alex $ Keyword p KwCastfn) }+    <0> val"+"                   { tok (\p s -> alex $ Keyword p (KwVal Plus)) }+    <0> val"-"                   { tok (\p s -> alex $ Keyword p (KwVal Minus)) }+    <0> val                      { tok (\p s -> alex $ Keyword p (KwVal None)) }+    <0> var                      { tok (\p s -> alex $ Keyword p KwVar) }+    <0> if                       { tok (\p s -> alex $ Keyword p KwIf) }+    <0> sif                      { tok (\p s -> alex $ Keyword p KwSif) }+    <0> then                     { tok (\p s -> alex $ Keyword p KwThen) }+    <0> else                     { tok (\p s -> alex $ Keyword p KwElse) }+    <0> implement                { tok (\p s -> alex $ Keyword p KwImplement) }+    <0> implmnt                  { tok (\p s -> alex $ Keyword p KwImplement) }+    <0> primplmnt                { tok (\p s -> alex $ Keyword p KwProofImplement) }+    <0> primplement              { tok (\p s -> alex $ Keyword p KwProofImplement) }+    <0> abst"@"ype               { tok (\p s -> alex $ Keyword p (KwAbst0p None)) }+    <0> abst"@ype+"              { tok (\p s -> alex $ Keyword p (KwAbst0p Plus)) }+    <0> abst"@type-"             { tok (\p s -> alex $ Keyword p (KwAbst0p Minus)) }+    <0> abs@view"t@ype"          { tok (\p s -> alex $ Keyword p (KwAbsvt0p None)) }+    <0> t"@"ype"+"               { tok (\p s -> alex $ Keyword p (KwT0p Plus)) }+    <0> t"@"ype"-"               { tok (\p s -> alex $ Keyword p (KwT0p Minus)) }+    <0> t"@"ype                  { tok (\p s -> alex $ Keyword p (KwT0p None)) }+    <0> @view"t@ype+"            { tok (\p s -> alex $ Keyword p (KwVt0p Plus)) }+    <0> @view"t@ype-"            { tok (\p s -> alex $ Keyword p (KwVt0p Minus)) }+    <0> @view"t@ype"             { tok (\p s -> alex $ Keyword p (KwVt0p None)) }+    <0> abstype                  { tok (\p s -> alex $ Keyword p KwAbstype) }+    <0> abs @view type           { tok (\p s -> alex $ Keyword p KwAbsvtype) }+    <0> absview                  { tok (\p s -> alex $ Keyword p KwAbsview) }+    <0> view                     { tok (\p s -> alex $ Keyword p (KwView None)) }+    <0> view"+"                  { tok (\p s -> alex $ Keyword p (KwView Plus)) }+    <0> view"-"                  { tok (\p s -> alex $ Keyword p (KwView Minus)) }+    <0> viewdef                  { tok (\p s -> alex $ Keyword p KwViewdef) }+    <0> "#"include               { tok (\p s -> alex $ Keyword p KwInclude) }+    <0> when                     { tok (\p s -> alex $ Keyword p KwWhen) }+    <0> of                       { tok (\p s -> alex $ Keyword p KwOf) }+    <0> ifcase                   { tok (\p s -> alex $ Keyword p KwIfCase) }+    <0> stadef                   { tok (\p s -> alex $ Keyword p KwStadef) }+    <0> stacst                   { tok (\p s -> alex $ Keyword p KwStacst) }+    <0> local                    { tok (\p s -> alex $ Keyword p KwLocal) }+    <0> praxi                    { tok (\p s -> alex $ Keyword p KwPraxi) }+    <0> while                    { tok (\p s -> alex $ Keyword p KwWhile) }+    <0> where                    { tok (\p s -> alex $ Keyword p KwWhere) }+    <0> begin                    { tok (\p s -> alex $ Keyword p KwBegin) }+    <0> overload                 { tok (\p s -> alex $ Keyword p KwOverload) }+    <0> with                     { tok (\p s -> alex $ Keyword p KwWith) }+    <0> extern                   { tok (\p s -> alex $ Keyword p KwExtern) }+    <0> sortdef                  { tok (\p s -> alex $ Keyword p KwSortdef) }+    <0> propdef                  { tok (\p s -> alex $ Keyword p KwPropdef) }+    <0> tkindef                  { tok (\p s -> alex $ Keyword p KwTKind) }+    <0> typekindef               { tok (\p s -> alex $ Keyword p KwTKind) }+    <0> "$raise"                 { tok (\p s -> alex $ Keyword p KwRaise) }+    <0> macdef                   { tok (\p s -> alex $ Keyword p KwMacdef) }+    <0> mod                      { tok (\p s -> alex $ Keyword p KwMod) }+    <0> datasort                 { tok (\p s -> alex $ Keyword p KwDatasort) }+    <0> "println!"               { tok (\p s -> alex $ Identifier p s) }+    <0> "prerrln!"               { tok (\p s -> alex $ Identifier p s) }+    <0> "fix@"                   { tok (\p s -> alex $ Keyword p KwFixAt) }+    <0> "lam@"                   { tok (\p s -> alex $ Keyword p KwLambdaAt) }+    <0> "addr"                   { tok (\p s -> alex $ Keyword p KwAddr) }+    <0> "addr@"                  { tok (\p s -> alex $ Keyword p KwAddrAt) }+    <0> "view@"                  { tok (\p s -> alex $ Keyword p KwViewAt) }+    <0> sta                      { tok (\p s -> alex $ Keyword p KwSta) }+    <0> symintr                  { tok (\p s -> alex $ Keyword p KwSymintr) }+    <0> absview                  { tok (\p s -> alex $ Keyword p KwAbsview) }+    <0> "$list"                  { tok (\p s -> alex $ Keyword p (KwListLit "")) }+    <0> "$list_vt"               { tok (\p s -> alex $ Keyword p (KwListLit "_vt")) }+    <0> "fold@"                  { tok (\p s -> alex $ IdentifierSpace p s) }+    <0> "free@"                  { tok (\p s -> alex $ Identifier p s) }+    <0> @fixity_decl             { tok (\p s -> alex $ FixityTok p s) }+    <0> @double_parens           { tok (\p s -> alex $ DoubleParenTok p) }+    <0> @double_braces           { tok (\p s -> alex $ DoubleBracesTok p) }+    <0> @double_brackets         { tok (\p s -> alex $ DoubleBracketTok p) }+    <0> @char_lit                { tok (\p s -> alex $ CharTok p (toChar s)) }+    <0> @lambda                  { tok (\p s -> alex $ Arrow p s) }+    <0> @func_type               { tok (\p s -> alex $ FuncType p s) }+    <0> @time_lit                { tok (\p s -> alex $ TimeTok p s) }+    <0> @integer                 { tok (\p s -> alex $ IntTok p (read s)) } -- FIXME shouldn't fail silenty on overflow+    <0> @float                   { tok (\p s -> alex $ FloatTok p (read s)) }+    <0> @at_brace                { tok (\p s -> alex $ Operator p "@{") } -- FIXME this is kinda sloppy+    <0> $br / @ref_call          { tok (\p s -> alex $ SpecialBracket p) }+    <0> @signature               { tok (\p s -> alex $ SignatureTok p (tail s)) }+    <0> @operator                { tok (\p s -> alex $ Operator p s) }+    <0> @builtin                 { tok (\p s -> alex $ SpecialIdentifier p (tail s)) }+    <0> $special                 { tok (\p s -> alex $ Special p s) }+    <0> @identifier / " "        { tok (\p s -> alex $ IdentifierSpace p s) }+    <0> @identifier              { tok (\p s -> alex $ Identifier p s) }+    <0> @string                  { tok (\p s -> alex $ StringTok p s) }  { @@ -319,6 +336,7 @@              | KwStacst              | KwListLit String              | KwMacdef+             | KwDatasort              deriving (Eq, Show, Generic, NFData)  data Token = Identifier AlexPosn String@@ -367,6 +385,7 @@     pretty KwLocal = "local"     pretty KwEnd = "end"     pretty KwBegin = "begin"+    pretty KwDatasort = "datasort"     pretty KwIn = "in"     pretty KwImplement = "implement"     pretty (KwCase c) = "case" <> pretty c@@ -455,6 +474,7 @@ to_string (Identifier _ s) = s to_string (IdentifierSpace _ s) = s to_string (SpecialIdentifier _ s) = s+to_string (Operator _ s) = s to_string _ = undefined  token_posn (SpecialIdentifier p _) = p

@@ -103,6 +103,7 @@     propdef { Keyword $$ KwPropdef }     list { Keyword $$ (KwListLit "") }     list_vt { Keyword $$ (KwListLit "_vt") }+    datasort { Keyword $$ KwDatasort }     timeLit { TimeTok _ $$ }     intLit { IntTok _ $$ }     floatLit { FloatTok _ $$ }@@ -167,7 +168,6 @@     lineComment { $$@CommentLex{} }     lspecial { SpecialBracket $$ }     atbrace { Operator $$ "@{" }-    exp { Operator $$ "**" }     macdef { Keyword $$ KwMacdef }     mod { Keyword $$ KwMod }     fixAt { Keyword $$ KwFixAt }@@ -176,6 +176,7 @@     infixl { FixityTok $$ "infixr" }     prefix { FixityTok $$ "prefix" }     postfix { FixityTok $$ "postfix" }+    customOperator { $$@Operator{} }  %% @@ -216,7 +217,7 @@      | viewPlusMinus { ViewLiteral $1 }      | Existential Type { Ex $1 $2 }      | Universal Type { ForA $1 $2 }-     | Type at StaticExpression { At $2 $1 $3 }+     | Type at StaticExpression { AtExpr $2 $1 $3 }      | at Type { AtType $1 $2 }      | atbrace Records rbrace { AnonymousRecord $1 $2 }      | openParen TypeIn vbar Type closeParen { ProofType $1 $2 $4 } -- FIXME can have multiple first parts@@ -391,14 +392,8 @@               | llambda Pattern LambdaArrow Expression { LinearLambda $1 $3 $2 $4 }               | addrAt PreExpression { AddrAt $1 $2 }               | viewAt PreExpression { ViewAt $1 $2 }-              | PreExpression at PreExpression { AtExpr $1 $3 }               | atbrace RecordVal rbrace { RecordValue $1 $2 Nothing }               | atbrace RecordVal rbrace colon Type { RecordValue $1 $2 (Just $5) }-              | exclamation PreExpression { Deref $1 $2 }-              | PreExpression mutateArrow PreExpression { PlainMutate $1 $3 }-              | PreExpression mutateArrow identifierSpace mutateEq PreExpression { FieldMutate $2 $1 (to_string $3) $5 }-              | PreExpression mutateArrow identifier mutateEq PreExpression { FieldMutate $2 $1 (to_string $3) $5 }-              | PreExpression mutateEq PreExpression { Mutate $1 $3 }               | PreExpression where lbrace Declarations rbrace { WhereExp $1 $4 }               | begin Expression end { Begin $1 $2 }               | identifierSpace { NamedVal (Unqualified $ to_string $1) }@@ -535,6 +530,7 @@  -- | Parse a unary operator UnOp : tilde { Negate }+     | exclamation { Deref }  -- | Parse a binary operator BinOp : plus { Add }@@ -553,12 +549,19 @@       | mod { Mod }       | percent { Mod }       | doubleBrackets { NotEq }+      | mutateEq { Mutate }+      | at { At }+      | mutateArrow { SpearOp }+      | customOperator { SpecialInfix (token_posn $1) (to_string $1) }  -- | Optionally parse a function body OptExpression : { Nothing }-              | eq Expression { Just $2 } -- FIXME only let this happen for external declarations+              | eq Expression { Just $2 } -- FIXME only let this happen for external declarations (?)               | let {% Left $ Expected $1 "=" "let" } -- TODO is this actually a good idea?               | ifcase {% Left $ Expected $1 "=" "ifcase" }+              | eq fun {% Left $ Expected $2 "Expression" "=" }+              | eq lineComment fun {% Left $ Expected $3 "Expression" "=" }+              | lbrace {% Left $ Expected $1 "Expression" "{" }  -- | Parse a constructor for a 'dataprop' DataPropLeaf : vbar Universals Expression { DataPropLeaf $2 $3 Nothing }@@ -679,14 +682,15 @@          | datavtype IdentifierOr SortArgs vbar {% Left $ Expected $4 "=" "|" }          | datatype IdentifierOr SortArgs vbar {% Left $ Expected $4 "=" "|" } -Fixity : infixr { RightFix $1 }-       | infixl { LeftFix $1 }-       | prefix { Pre $1 }-       | postfix { Post $1 }+Fixity : infixr intLit { RightFix $1 $2 }+       | infixl intLit { LeftFix $1 $2 }+       | prefix intLit { Pre $1 $2 }+       | postfix intLit { Post $1 $2 }  -- FIXME adopt a principled approach+-- perhaps match operators? Operator : identifierSpace { to_string $1 }-         | exp { "**" }+         | customOperator { to_string $1 }          | mutateArrow { "->" }  Operators : Operator { [$1] }@@ -707,6 +711,12 @@                   | StafunDecl { $1 }                   | extern StaticDeclaration { Extern $1 $2 } +DataSortLeaf : vbar Universals Sort { DataSortLeaf $2 $3 Nothing }+             | vbar Universals Sort of Sort { DataSortLeaf $2 $3 (Just $5) }++DataSortLeaves : DataSortLeaf { [$1] }+               | DataSortLeaves DataSortLeaf { $2 : $1 }+ -- | Parse a declaration Declaration : include string { Include $2 }             | define { Define $1 }@@ -714,6 +724,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 }+            | datasort identifierSpace eq DataSortLeaves { DataSort $1 (to_string $2) $4 }             | macdef IdentifierOr doubleParens eq Expression { MacDecl $1 $2 [] $5 }             | macdef IdentifierOr openParen IdentifiersIn closeParen eq Expression { MacDecl $1 $2 $4 $7 }             | lineComment { Comment (to_string $1) }@@ -747,8 +758,7 @@             | symintr Name { SymIntr $1 $2 }             | stacst IdentifierOr colon Type OptExpression { Stacst $1 (Unqualified $2) $4 $5 }             | propdef IdentifierOr openParen Args closeParen eq Type { PropDef $1 $2 $4 $7 }-            | Fixity intLit Operators { FixityDecl $1 (Right $2) $3 }-            | Fixity openParen Operator closeParen Operators { FixityDecl $1 (Left $3) $5 } -- FIXME+            | Fixity Operators { FixityDecl $1 $2 }             | val Universals IdentifierOr colon Type { StaVal $2 $3 $5 }             | lambda {% Left $ Expected $1 "Declaration" "lam" }             | llambda {% Left $ Expected $1 "Declaration" "llam" }

@@ -75,22 +75,25 @@     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 (SpecialInfix s) = text s+    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 Mutate             = ":="+    pretty SpearOp            = "->"+    pretty At                 = "@"+    pretty (SpecialInfix _ s) = text s  splits :: BinOp -> Bool splits Mult       = True@@ -130,6 +133,7 @@  instance Pretty UnOp where     pretty Negate        = "~"+    pretty Deref         = "!"     pretty (SpecialOp s) = text s  instance Pretty Expression where@@ -171,10 +175,6 @@         a (RecordValueF _ es (Just x))  = prettyRecord es <+> ":" <+> pretty x         a (PrecedeF e e')               = parens (e <+> ";" </> e')         a (PrecedeListF es)             = lineAlt (prettyArgsList "; " "(" ")" es) ("(" <> mconcat (punctuate " ; " es) <> ")")-        a (FieldMutateF _ o f v)        = pretty o <> "->" <> string f <+> ":=" <+> v-        a (PlainMutateF e e')           = e <> "->" <> e'-        a (MutateF e e')                = e <+> ":=" <+> e'-        a (DerefF _ e)                  = "!" <> e         a (AccessF _ e n)             | noParens e = e <> "." <> pretty n             | otherwise = parens e <> "." <> pretty n@@ -189,7 +189,6 @@         a (WhileF _ e e')              = "while" <> parens e <> e'         a (ActionsF as)                = "{" <$> indent 2 (pretty ((\(ATS x) -> ATS $ reverse x) as)) <$> "}"         a UnderscoreLitF{}             = "_"-        a (AtExprF e e')               = e <> "@" <> e'         a (BeginF _ e)             | not (startsParens e) = linebreak <> indent 2 ("begin" <$> indent 2 e <$> "end")             | otherwise = e@@ -293,7 +292,7 @@         a (AsProofF t Nothing)    = t <+> ">> _"         a (FromVTF t)             = t <> "?!"         a (MaybeValF t)           = t <> "?"-        a (AtF _ t t')            = t <+> "@" <+> pretty t'+        a (AtExprF _ t t')        = t <+> "@" <+> pretty t'         a (AtTypeF _ t)           = "@" <> t         a (ProofTypeF _ t t')     = parens (prettyArgsG "" "" t <+> "|" <+> t')         a (ConcreteTypeF e)       = pretty e@@ -344,8 +343,8 @@     pretty (Implement _ [] is [] n NoA e)  = pretty n <> prettyOr is <+> "=" <$> indent 2 (prettyImplExpr e)     pretty (Implement _ [] is [] n ias e) = pretty n <> prettyOr is <+> prettyArgs ias <+> "=" <$> indent 2 (prettyImplExpr e)     pretty (Implement _ [] is us n ias e) = pretty n <> prettyOr is <+> foldMap pretty us </> prettyArgs ias <+> "=" <$> indent 2 (prettyImplExpr e)-    pretty (Implement _ ps is [] n ias e) = foldMap pretty ps </> pretty n <> prettyOr is <+> prettyArgs ias <+> "=" <$> indent 2 (prettyImplExpr e)-    pretty (Implement _ ps is us n ias e) = foldMap pretty ps </> pretty n <> prettyOr is </> foldMap pretty us <+> prettyArgs ias <+> "=" <$> indent 2 (prettyImplExpr e)+    pretty (Implement _ ps is [] n ias e) = foldMap pretty (reverse ps) </> pretty n <> prettyOr is <+> prettyArgs ias <+> "=" <$> indent 2 (prettyImplExpr e)+    pretty (Implement _ ps is us n ias e) = foldMap pretty (reverse ps) </> pretty n <> prettyOr is </> foldMap pretty us <+> prettyArgs ias <+> "=" <$> indent 2 (prettyImplExpr e)  isVal :: Declaration -> Bool isVal Val{}   = True@@ -403,20 +402,27 @@ prettyRecordF True ((s, t):xs) = prettyRecordF False xs $$ indent 1 ("," <+> text s <+> align ("=" <+> pretty t) <$> "}") prettyRecordF x ((s, t):xs)    = prettyRecordF x xs $$ indent 1 ("," <+> text s <+> align ("=" <+> pretty t)) +prettyUsNil :: [Universal] -> Doc+prettyUsNil [] = space+prettyUsNil us = space <> foldMap pretty (reverse us) <> space++prettyOf :: (Pretty a) => Maybe a -> Doc+prettyOf Nothing  = mempty+prettyOf (Just x) = space <> "of" <+> pretty x+ prettyDL :: [DataPropLeaf] -> Doc-prettyDL []                               = mempty-prettyDL [DataPropLeaf [] e Nothing]      = indent 2 ("|" <+> pretty e)-prettyDL [DataPropLeaf [] e (Just e')]    = indent 2 ("|" <+> pretty e <+> "of" <+> pretty e')-prettyDL (DataPropLeaf [] e Nothing:xs)   = prettyDL xs $$ indent 2 ("|" <+> pretty e)-prettyDL (DataPropLeaf [] e (Just e'):xs) = prettyDL xs $$ indent 2 ("|" <+> pretty e <+> "of" <+> pretty e')-prettyDL [DataPropLeaf us e Nothing]      = indent 2 ("|" <+> foldMap pretty (reverse us) <+> pretty e)-prettyDL [DataPropLeaf us e (Just e')]    = indent 2 ("|" <+> foldMap pretty (reverse us) <+> pretty e <+> "of" <+> pretty e')-prettyDL (DataPropLeaf us e Nothing:xs)   = prettyDL xs $$ indent 2 ("|" <+> foldMap pretty (reverse us) <+> pretty e)-prettyDL (DataPropLeaf us e (Just e'):xs) = prettyDL xs $$ indent 2 ("|" <+> foldMap pretty (reverse us) <+> pretty e <+> "of" <+> pretty e')+prettyDL []                        = mempty+prettyDL [DataPropLeaf us e e']    = indent 2 ("|" <> prettyUsNil us <> pretty e <> prettyOf e')+prettyDL (DataPropLeaf us e e':xs) = prettyDL xs $$ indent 2 ("|" <> prettyUsNil us <> pretty e <> prettyOf e')  universalHelper :: [Universal] -> Doc universalHelper = mconcat . fmap pretty . reverse +prettyDSL :: [DataSortLeaf] -> Doc+prettyDSL []                          = mempty+prettyDSL [DataSortLeaf us sr sr']    = indent 2 ("|" <> prettyUsNil us <> pretty sr <> prettyOf sr')+prettyDSL (DataSortLeaf us sr sr':xs) = prettyDSL xs $$ indent 2 ("|" <> prettyUsNil us <> pretty sr <> prettyOf sr')+ prettyLeaf :: [Leaf] -> Doc prettyLeaf []                         = mempty prettyLeaf [Leaf [] s [] Nothing]     = indent 2 ("|" <+> text s)@@ -503,10 +509,11 @@     pretty (DataPropLeaf us e (Just e')) = "|" <+> foldMap pretty (reverse us) <+> pretty e <+> "of" <+> pretty e'  instance Pretty Fixity where-    pretty RightFix{} = "infixr"-    pretty LeftFix{}  = "infixl"-    pretty Pre{}      = "prefix"-    pretty Post{}     = "postfix"+    pretty (Infix _ i)    = "infix" <+> pretty i+    pretty (RightFix _ i) = "infixr" <+> pretty i+    pretty (LeftFix _ i)  = "infixl" <+> pretty i+    pretty (Pre _ i)      = "prefix" <+> pretty i+    pretty (Post _ i)     = "postfix" <+> pretty i  prettyMaybeType :: (Pretty a) => Maybe a -> Doc prettyMaybeType (Just a) = " =" <+> pretty a@@ -525,6 +532,7 @@     pretty (AbsViewType _ s as (Just t))   = "absvtype" <+> text s <> prettySortArgs as <+> "=" <+> pretty t     pretty (SumViewType s as ls)           = "datavtype" <+> text s <> prettySortArgs as <+> "=" <$> prettyLeaf ls     pretty (SumType s as ls)               = "datatype" <+> text s <> prettySortArgs as <+> "=" <$> prettyLeaf ls+    pretty (DataSort _ s ls)               = "datasort" <+> text s <+> "=" <$> prettyDSL ls     pretty (Impl as i)                     = "implement" <+> prettyArgsNil as <> pretty i -- mconcat (fmap pretty us) <+> pretty i     pretty (ProofImpl as i)                = "primplmnt" <+> prettyArgsNil as <> pretty i     pretty (PrVal p e)                     = "prval" <+> pretty p <+> "=" <+> pretty e@@ -566,8 +574,7 @@     pretty (Stacst _ n t (Just e))         = "stacst" </> pretty n <+> ":" </> pretty t <+> "=" </> pretty e     pretty (PropDef _ s as t)              = "propdef" </> text s <+> prettyArgsNil as <+> "=" </> pretty t     pretty (Local _ d d')                  = "local" <$> indent 2 (pretty d) <$> "in" <$> indent 2 (pretty d') <$> "end"-    pretty (FixityDecl f (Left s) ss)      = pretty f <+> "(" <> text s <> ")" <+> hsep (fmap text ss)-    pretty (FixityDecl f (Right i) ss)     = pretty f <+> pretty i <+> hsep (fmap text ss)+    pretty (FixityDecl f ss)               = pretty f <+> hsep (fmap text ss)     pretty (StaVal us i t)                 = "val" </> mconcat (fmap pretty us) <+> text i <+> ":" <+> pretty t     pretty (Stadef i n [])                 = "stadef" <+> text i <+> pretty n     pretty (Stadef i n as)                 = "stadef" <+> text i <+> pretty n <> prettyArgs as

@@ -5,6 +5,7 @@ {-# LANGUAGE DeriveGeneric              #-} {-# LANGUAGE DeriveTraversable          #-} {-# LANGUAGE DerivingStrategies         #-}+{-# LANGUAGE DuplicateRecordFields      #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE LambdaCase                 #-} {-# LANGUAGE PatternSynonyms            #-}@@ -44,6 +45,7 @@     , Sort (..)     , SortArg (..)     , SortArgs+    , DataSortLeaf (..)     , rewriteATS     , rewriteDecl     -- * Lenses@@ -53,6 +55,7 @@     , typeCallArgs     ) where +import           Control.Composition import           Control.DeepSeq          (NFData) import           Control.Lens import           Data.Functor.Foldable    (ListF (Cons), ana, cata, embed, project)@@ -62,10 +65,13 @@ import           GHC.Generics             (Generic) import           Language.ATS.Lexer       (Addendum (..), AlexPosn) -data Fixity = RightFix AlexPosn-            | LeftFix AlexPosn-            | Pre AlexPosn-            | Post AlexPosn+-- uses an 'Int' because you fully deserve what you get if your+-- fixity declarations overflow.+data Fixity = RightFix { pos :: AlexPosn, ifix :: Int }+            | LeftFix { pos :: AlexPosn, ifix :: Int }+            | Pre { pos :: AlexPosn, ifix :: Int }+            | Post { pos :: AlexPosn, ifix :: Int }+            | Infix { pos :: AlexPosn, ifix :: Int }             deriving (Show, Eq, Generic, NFData)  -- | Newtype wrapper containing a list of declarations@@ -116,12 +122,14 @@                  | SymIntr AlexPosn Name                  | Stacst AlexPosn Name Type (Maybe Expression)                  | PropDef AlexPosn String [Arg] Type-                 -- uses an 'Int' because you fully deserve what you get if your-                 -- fixity declarations overflow.-                 | FixityDecl Fixity (Either String Int) [String]+                 | FixityDecl Fixity [String]                  | MacDecl AlexPosn String [String] Expression+                 | DataSort AlexPosn String [DataSortLeaf]                  deriving (Show, Eq, Generic, NFData) +data DataSortLeaf = DataSortLeaf [Universal] Sort (Maybe Sort)+                  deriving (Show, Eq, Generic, NFData)+ data DataPropLeaf = DataPropLeaf [Universal] Expression (Maybe Expression)                   deriving (Show, Eq, Generic, NFData) @@ -135,7 +143,7 @@           | AsProof Type (Maybe Type) -- a >> b           | FromVT Type -- For a viewtype VT, we can prove there exist a view V and type T such that `VT` is equivalent to `(V | T)` - that T is `VT?!`           | MaybeVal Type -- This is just `a?` or the like-          | At AlexPosn Type StaticExpression+          | AtExpr AlexPosn Type StaticExpression           | AtType AlexPosn Type           | ProofType AlexPosn [Type] Type -- Aka (prf | val)           | ConcreteType StaticExpression@@ -213,6 +221,7 @@  -- | @~@ is used to negate numbers in ATS data UnOp = Negate+          | Deref           | SpecialOp String     deriving (Show, Eq, Generic, NFData) @@ -232,7 +241,10 @@            | StaticEq            | Mod            | NotEq-           | SpecialInfix String+           | Mutate -- ^ @:=@+           | At+           | SpearOp -- ^ @->@+           | SpecialInfix AlexPosn String            deriving (Show, Eq, Generic, NFData)  -- FIXME add position information?@@ -271,7 +283,6 @@                 | Access AlexPosn Expression Name                 | StringLit String                 | CharLit Char-                | AtExpr Expression Expression                 | AddrAt AlexPosn Expression                 | ViewAt AlexPosn Expression                 | Binary BinOp Expression Expression@@ -286,16 +297,6 @@                        }                 | RecordValue AlexPosn [(String, Expression)] (Maybe Type)                 | Precede Expression Expression-                | PlainMutate { old :: Expression-                              , new :: Expression-                              }-                | FieldMutate { posE  :: AlexPosn-                              , old   :: Expression -- ^ Record to modify-                              , field :: String -- ^ Field being modified-                              , new   :: Expression -- ^ New value of the field-                              }-                | Mutate Expression Expression-                | Deref AlexPosn Expression                 | ProofExpr AlexPosn Expression Expression                 | TypeSignature Expression Type                 | WhereExp Expression [Declaration]@@ -372,15 +373,50 @@             c y = project y rewriteDecl x = x --- precedence: rewrite n + 2 * x to n + (2 * x)--- TODO: rewrite multiple universals when it's the right context?+-- FIXME left vs. right shouldn't be treated the same+instance Ord Fixity where+    compare = on compare ifix++leftFix :: Int -> Fixity+leftFix = LeftFix undefined++rightFix :: Int -> Fixity+rightFix = RightFix undefined++infix_ :: Int -> Fixity+infix_ = Infix undefined++-- | Default fixities from @fixity.ats@+getFixity :: BinOp -> Fixity+getFixity Add           = leftFix 50+getFixity Sub           = leftFix 50+getFixity Mutate        = infix_ 0+getFixity Mult          = leftFix 60+getFixity Div           = leftFix 60+getFixity SpearOp       = rightFix 10+getFixity LogicalAnd    = leftFix 21+getFixity LogicalOr     = leftFix 20+getFixity At            = rightFix 40+getFixity GreaterThan   = infix_ 40+getFixity GreaterThanEq = infix_ 40+getFixity LessThanEq    = infix_ 40+getFixity Equal         = infix_ 30+getFixity NotEqual      = infix_ 30+getFixity StaticEq      = infix_ 30+getFixity Mod           = leftFix 60+getFixity _             = leftFix 100++instance Ord BinOp where+    compare = on compare getFixity+ rewriteATS :: Expression -> Expression rewriteATS = cata a where     a (CallF n ts ts' me [ParenExpr _ e@NamedVal{}]) = Call n ts ts' me [e]     a (CallF n ts ts' me [ParenExpr _ e@Call{}])     = Call n ts ts' me [e]     a (PrecedeF e e'@PrecedeList{})                  = PrecedeList (e : _exprs e')     a (PrecedeF e e')                                = PrecedeList [e, e']-    a (BinaryF Mult (Binary Add e e') e'')           = Binary Add e (Binary Mult e' e'')+    a (BinaryF op' (Binary op'' e e') e'')+        | op' > op'' = Binary op'' e (Binary op' e' e'')     a (BinaryF Add e (BinList Add es))               = BinList Add (e : es)     a (BinaryF Add e e')                             = BinList Add [e, e']     a (ParenExprF _ e@Precede{})                     = e

@@ -11,5 +11,5 @@ main :: IO () main = hspec $     describe "pretty-print" $ parallel $-        mapM_ (\x -> testFiles x isATS (fmap printATS . parseATS . lexATS))+        mapM_ (\x -> testFiles x isATS (fmap printATS . parse))             ["test/data", "test/data/stdlib", "test/data/stdlib/DATS"]

@@ -67,11 +67,11 @@     var str = string_make_substring(s, i2sz(0), i2sz(1))     var acc_r = ref<command_line>(acc)     val () = case+ str of-      | "h" => acc_r->help := true-      | "p" => acc_r->no_parallel := true-      | "t" => acc_r->no_table := true+      | "h" => acc_r -> help := true+      | "p" => acc_r -> no_parallel := true+      | "t" => acc_r -> no_table := true       | "e" => bad_exclude(s)-      | "V" => acc_r->version := true+      | "V" => acc_r -> version := true       | "-" => ()       | _ => ( println!("\33[31mError:\33[0m flag '" + s + "' not recognized")              ; exit(0)@@ -98,26 +98,26 @@     var acc_r = ref<command_line>(acc)     val () = if is_flag(s) then       case+ s of-        | "--help" => acc_r->help := true-        | "-h" => acc_r->help := true+        | "--help" => acc_r -> help := true+        | "-h" => acc_r -> help := true         | "--no-table" => if not(acc.no_table) then-          acc_r->no_table := true+          acc_r -> no_table := true         else           ( println!("\33[31mError:\33[0m flag " + s + " cannot appear twice")           ; exit(0)           ; ()           )         | "-t" => if not(acc.no_table) then-          acc_r->no_table := true+          acc_r -> no_table := true         else           ( println!("\33[31mError:\33[0m flag " + s + " cannot appear twice")           ; exit(0)           ; ()           )-        | "--no-parallel" => acc_r->no_parallel := true-        | "-p" => acc_r->no_parallel := true-        | "--version" => acc_r->version := true-        | "-V" => acc_r->version := true+        | "--no-parallel" => acc_r -> no_parallel := true+        | "-p" => acc_r -> no_parallel := true+        | "--version" => acc_r -> version := true+        | "-V" => acc_r -> version := true         | "-e" => bad_exclude(s)         | "--exclude" => bad_exclude(s)         | _ => ( println!("\33[31mError:\33[0m flag '" + s + "' not recognized")@@ -126,7 +126,7 @@                )     else       if not(is_first) then-        acc_r->includes := list_cons(s, acc.includes)+        acc_r -> includes := list_cons(s, acc.includes)       else         ()   in@@ -142,7 +142,7 @@       ; ()       )     else-      acc_r->excludes := list_cons(s, acc.excludes)+      acc_r -> excludes := list_cons(s, acc.excludes)   in     !acc_r   end

@@ -748,87 +748,87 @@   let     val sc_r = ref<source_contents>(prev)     val _ = case+ scf of-      | ~haskell n => sc_r->haskell := prev.haskell + n-      | ~ats n => sc_r->ats := prev.ats + n-      | ~rust n => sc_r->rust := prev.rust + n-      | ~markdown n => sc_r->markdown := prev.markdown + n-      | ~python n => sc_r->python := prev.python + n-      | ~vimscript n => sc_r->vimscript := prev.vimscript + n-      | ~yaml n => sc_r->yaml := prev.yaml + n-      | ~toml n => sc_r->toml := prev.toml + n-      | ~happy n => sc_r->happy := prev.happy + n-      | ~alex n => sc_r->alex := prev.alex + n-      | ~idris n => sc_r->idris := prev.idris + n-      | ~madlang n => sc_r->madlang := prev.madlang + n-      | ~elm n => sc_r->elm := prev.elm + n-      | ~c n => sc_r->c := prev.c + n-      | ~go n => sc_r->go := prev.go + n-      | ~cabal n => sc_r->cabal := prev.cabal + n-      | ~verilog n => sc_r->verilog := prev.verilog + n-      | ~vhdl n => sc_r->vhdl := prev.vhdl + n-      | ~html n => sc_r->html := prev.html + n-      | ~css n => sc_r->css := prev.css + n-      | ~purescript n => sc_r->purescript := prev.purescript + n-      | ~futhark n => sc_r->futhark := prev.futhark + n-      | ~brainfuck n => sc_r->brainfuck := prev.brainfuck + n-      | ~ruby n => sc_r->ruby := prev.ruby + n-      | ~julia n => sc_r->julia := prev.julia + n-      | ~tex n => sc_r->tex := prev.tex + n-      | ~perl n => sc_r->perl := prev.perl + n-      | ~ocaml n => sc_r->ocaml := prev.ocaml + n-      | ~agda n => sc_r->agda := prev.agda + n-      | ~cobol n => sc_r->cobol := prev.cobol + n-      | ~tcl n => sc_r->tcl := prev.tcl + n-      | ~r n => sc_r->r := prev.r + n-      | ~lua n => sc_r->lua := prev.lua + n-      | ~cpp n => sc_r->cpp := prev.cpp + n-      | ~lalrpop n => sc_r->lalrpop := prev.lalrpop + n-      | ~header n => sc_r->header := prev.header + n-      | ~sixten n => sc_r->sixten := prev.sixten + n-      | ~dhall n => sc_r->dhall := prev.dhall + n-      | ~ipkg n => sc_r->ipkg := prev.ipkg + n-      | ~justfile n => sc_r->justfile := prev.justfile + n-      | ~makefile n => sc_r->makefile := prev.makefile + n-      | ~ion n => sc_r->ion := prev.ion + n-      | ~bash n => sc_r->bash := prev.bash + n-      | ~hamlet n => sc_r->hamlet := prev.hamlet + n-      | ~cassius n => sc_r->cassius := prev.cassius + n-      | ~lucius n => sc_r->lucius := prev.lucius + n-      | ~julius n => sc_r->julius := prev.julius + n-      | ~mercury n => sc_r->mercury := prev.mercury + n-      | ~yacc n => sc_r->yacc := prev.yacc + n-      | ~lex n => sc_r->lex := prev.lex + n-      | ~coq n => sc_r->coq := prev.coq + n-      | ~jupyter n => sc_r->jupyter := prev.jupyter + n-      | ~java n => sc_r->java := prev.java + n-      | ~scala n => sc_r->scala := prev.scala + n-      | ~erlang n => sc_r->erlang := prev.erlang + n-      | ~elixir n => sc_r->elixir := prev.elixir + n-      | ~pony n => sc_r->pony := prev.pony + n-      | ~clojure n => sc_r->clojure := prev.clojure + n-      | ~cabal_project n => sc_r->cabal_project := prev.cabal_project + n-      | ~assembly n => sc_r->assembly := prev.assembly + n-      | ~nix n => sc_r->nix := prev.nix + n-      | ~php n => sc_r->php := prev.php + n-      | ~javascript n => sc_r->javascript := prev.javascript + n-      | ~kotlin n => sc_r->kotlin := prev.kotlin + n-      | ~fsharp n => sc_r->fsharp := prev.fsharp + n-      | ~fortran n => sc_r->fortran := prev.fortran + n-      | ~swift n => sc_r->swift := prev.swift + n-      | ~csharp n => sc_r->csharp := prev.csharp + n-      | ~nim n => sc_r->nim := prev.nim + n-      | ~cpp_header n => sc_r->cpp_header := prev.cpp_header + n-      | ~elisp n => sc_r->elisp := prev.elisp + n-      | ~plaintext n => sc_r->plaintext := prev.plaintext + n-      | ~rakefile n => sc_r->rakefile := prev.rakefile + n-      | ~llvm n => sc_r->llvm := prev.llvm + n-      | ~autoconf n => sc_r->autoconf := prev.autoconf + n-      | ~batch n => sc_r->batch := prev.batch + n-      | ~powershell n => sc_r->powershell := prev.powershell + n-      | ~m4 n => sc_r->m4 := prev.m4 + n-      | ~objective_c n => sc_r->objective_c := prev.objective_c + n-      | ~automake n => sc_r->automake := prev.automake + n-      | ~margaret n => sc_r->margaret := prev.margaret + n+      | ~haskell n => sc_r -> haskell := prev.haskell + n+      | ~ats n => sc_r -> ats := prev.ats + n+      | ~rust n => sc_r -> rust := prev.rust + n+      | ~markdown n => sc_r -> markdown := prev.markdown + n+      | ~python n => sc_r -> python := prev.python + n+      | ~vimscript n => sc_r -> vimscript := prev.vimscript + n+      | ~yaml n => sc_r -> yaml := prev.yaml + n+      | ~toml n => sc_r -> toml := prev.toml + n+      | ~happy n => sc_r -> happy := prev.happy + n+      | ~alex n => sc_r -> alex := prev.alex + n+      | ~idris n => sc_r -> idris := prev.idris + n+      | ~madlang n => sc_r -> madlang := prev.madlang + n+      | ~elm n => sc_r -> elm := prev.elm + n+      | ~c n => sc_r -> c := prev.c + n+      | ~go n => sc_r -> go := prev.go + n+      | ~cabal n => sc_r -> cabal := prev.cabal + n+      | ~verilog n => sc_r -> verilog := prev.verilog + n+      | ~vhdl n => sc_r -> vhdl := prev.vhdl + n+      | ~html n => sc_r -> html := prev.html + n+      | ~css n => sc_r -> css := prev.css + n+      | ~purescript n => sc_r -> purescript := prev.purescript + n+      | ~futhark n => sc_r -> futhark := prev.futhark + n+      | ~brainfuck n => sc_r -> brainfuck := prev.brainfuck + n+      | ~ruby n => sc_r -> ruby := prev.ruby + n+      | ~julia n => sc_r -> julia := prev.julia + n+      | ~tex n => sc_r -> tex := prev.tex + n+      | ~perl n => sc_r -> perl := prev.perl + n+      | ~ocaml n => sc_r -> ocaml := prev.ocaml + n+      | ~agda n => sc_r -> agda := prev.agda + n+      | ~cobol n => sc_r -> cobol := prev.cobol + n+      | ~tcl n => sc_r -> tcl := prev.tcl + n+      | ~r n => sc_r -> r := prev.r + n+      | ~lua n => sc_r -> lua := prev.lua + n+      | ~cpp n => sc_r -> cpp := prev.cpp + n+      | ~lalrpop n => sc_r -> lalrpop := prev.lalrpop + n+      | ~header n => sc_r -> header := prev.header + n+      | ~sixten n => sc_r -> sixten := prev.sixten + n+      | ~dhall n => sc_r -> dhall := prev.dhall + n+      | ~ipkg n => sc_r -> ipkg := prev.ipkg + n+      | ~justfile n => sc_r -> justfile := prev.justfile + n+      | ~makefile n => sc_r -> makefile := prev.makefile + n+      | ~ion n => sc_r -> ion := prev.ion + n+      | ~bash n => sc_r -> bash := prev.bash + n+      | ~hamlet n => sc_r -> hamlet := prev.hamlet + n+      | ~cassius n => sc_r -> cassius := prev.cassius + n+      | ~lucius n => sc_r -> lucius := prev.lucius + n+      | ~julius n => sc_r -> julius := prev.julius + n+      | ~mercury n => sc_r -> mercury := prev.mercury + n+      | ~yacc n => sc_r -> yacc := prev.yacc + n+      | ~lex n => sc_r -> lex := prev.lex + n+      | ~coq n => sc_r -> coq := prev.coq + n+      | ~jupyter n => sc_r -> jupyter := prev.jupyter + n+      | ~java n => sc_r -> java := prev.java + n+      | ~scala n => sc_r -> scala := prev.scala + n+      | ~erlang n => sc_r -> erlang := prev.erlang + n+      | ~elixir n => sc_r -> elixir := prev.elixir + n+      | ~pony n => sc_r -> pony := prev.pony + n+      | ~clojure n => sc_r -> clojure := prev.clojure + n+      | ~cabal_project n => sc_r -> cabal_project := prev.cabal_project + n+      | ~assembly n => sc_r -> assembly := prev.assembly + n+      | ~nix n => sc_r -> nix := prev.nix + n+      | ~php n => sc_r -> php := prev.php + n+      | ~javascript n => sc_r -> javascript := prev.javascript + n+      | ~kotlin n => sc_r -> kotlin := prev.kotlin + n+      | ~fsharp n => sc_r -> fsharp := prev.fsharp + n+      | ~fortran n => sc_r -> fortran := prev.fortran + n+      | ~swift n => sc_r -> swift := prev.swift + n+      | ~csharp n => sc_r -> csharp := prev.csharp + n+      | ~nim n => sc_r -> nim := prev.nim + n+      | ~cpp_header n => sc_r -> cpp_header := prev.cpp_header + n+      | ~elisp n => sc_r -> elisp := prev.elisp + n+      | ~plaintext n => sc_r -> plaintext := prev.plaintext + n+      | ~rakefile n => sc_r -> rakefile := prev.rakefile + n+      | ~llvm n => sc_r -> llvm := prev.llvm + n+      | ~autoconf n => sc_r -> autoconf := prev.autoconf + n+      | ~batch n => sc_r -> batch := prev.batch + n+      | ~powershell n => sc_r -> powershell := prev.powershell + n+      | ~m4 n => sc_r -> m4 := prev.m4 + n+      | ~objective_c n => sc_r -> objective_c := prev.objective_c + n+      | ~automake n => sc_r -> automake := prev.automake + n+      | ~margaret n => sc_r -> margaret := prev.margaret + n       | ~unknown _ => ()   in     !sc_r@@ -1397,7 +1397,7 @@       ; ()       )     else-      acc_r->excludes := list_cons(s, acc.excludes)+      acc_r -> excludes := list_cons(s, acc.excludes)   in     !acc_r   end@@ -1408,26 +1408,26 @@     val acc_r = ref<command_line>(acc)     val () = if is_flag(s) then       case+ s of-        | "--help" => acc_r->help := true-        | "-h" => acc_r->help := true+        | "--help" => acc_r -> help := true+        | "-h" => acc_r -> help := true         | "--no-table" => if not(acc.no_table) then-          acc_r->no_table := true+          acc_r -> no_table := true         else           ( println!("\33[31mError:\33[0m flag " + s + " cannot appear twice")           ; exit(0)           ; ()           )         | "-t" => if not(acc.no_table) then-          acc_r->no_table := true+          acc_r -> no_table := true         else           ( println!("\33[31mError:\33[0m flag " + s + " cannot appear twice")           ; exit(0)           ; ()           )-        | "--parallel" => acc_r->parallel := true-        | "-p" => acc_r->parallel := true-        | "--version" => acc_r->version := true-        | "-V" => acc_r->version := true+        | "--parallel" => acc_r -> parallel := true+        | "-p" => acc_r -> parallel := true+        | "--version" => acc_r -> version := true+        | "-V" => acc_r -> version := true         | "-e" => ( println!("\33[31mError:\33[0m flag " + s + " must be followed by an argument")                   ; exit(0)                   ; ()@@ -1442,7 +1442,7 @@                )     else       if not(is_first) then-        acc_r->includes := list_cons(s, acc.includes)+        acc_r -> includes := list_cons(s, acc.includes)       else         ()   in