diff --git a/ats-format.cabal b/ats-format.cabal --- a/ats-format.cabal +++ b/ats-format.cabal @@ -1,5 +1,5 @@ name: ats-format -version: 0.1.3.3 +version: 0.1.3.5 synopsis: A source-code formatter for ATS description: An opinionated source-code formatter for [ATS](http://www.ats-lang.org/). homepage: https://hub.darcs.net/vmchale/ats-format#readme diff --git a/man/atsfmt.1 b/man/atsfmt.1 --- a/man/atsfmt.1 +++ b/man/atsfmt.1 @@ -1,4 +1,4 @@ -.\" Automatically generated by Pandoc 2.1 +.\" Automatically generated by Pandoc 2.1.1 .\" .TH "atsfmt (1)" "" "" "" "" .hy diff --git a/src/Language/ATS/Parser.y b/src/Language/ATS/Parser.y --- a/src/Language/ATS/Parser.y +++ b/src/Language/ATS/Parser.y @@ -115,6 +115,7 @@ extfcall { Identifier $$ "extfcall" } ldelay { Identifier $$ "ldelay" } listVT { Identifier $$ "list_vt" } + foldAt { Identifier $$ "fold@" } identifier { $$@Identifier{} } identifierSpace { $$@IdentifierSpace{} } closeParen { Special $$ ")" } @@ -328,10 +329,9 @@ | closeParen {% Left $ Expected $1 "Arrow" ")" } -- | Expression or named call to an expression -Expression : PreExpression { $1 } +Expression : identifierSpace PreExpression { Call (Unqualified $ to_string $1) [] [] Nothing [$2] } + | PreExpression { $1 } | openParen Tuple closeParen { TupleEx $1 $2 } - | identifierSpace PreExpression { Call (Unqualified $ to_string $1) [] [] Nothing [$2] } - | begin Expression end { Begin $1 $2 } | Expression semicolon Expression { Precede $1 $3 } | Expression semicolon { $1 } | openParen Expression closeParen { $2 } @@ -381,7 +381,7 @@ PreExpression : identifier lsqbracket PreExpression rsqbracket { Index $2 (Unqualified $ to_string $1) $3 } | Literal { $1 } | Call { $1 } - | case PreExpression of Case { Case $3 $1 $2 $4 } + | case Expression of Case { Case $3 $1 $2 $4 } | openParen Expression closeParen { ParenExpr $1 $2 } | PreExpression BinOp PreExpression { Binary $2 $1 $3 } | UnOp PreExpression { Unary $1 $2 } -- FIXME throw error when we try to negate a string literal/time @@ -392,6 +392,7 @@ | if Expression then Expression else Expression { If $2 $4 (Just $6) } | let ATS in end { Let $1 $2 Nothing } | let ATS in Expression end { Let $1 $2 (Just $4) } + | let ATS in Expression vbar {% Left $ Expected $5 "end" "|" } | lambda Pattern LambdaArrow Expression { Lambda $1 $3 $2 $4 } | llambda Pattern LambdaArrow Expression { LinearLambda $1 $3 $2 $4 } | addrAt PreExpression { AddrAt $1 $2 } @@ -405,6 +406,7 @@ | PreExpression mutateEq PreExpression { Mutate $1 $3 } | PreExpression where lbrace Declarations rbrace { WhereExp $1 $4 } | identifierSpace { NamedVal (Unqualified $ to_string $1) } + | begin Expression end { Begin $1 $2 } | Name { NamedVal $1 } | lbrace ATS rbrace { Actions $2 } | while openParen PreExpression closeParen PreExpression { While $1 $3 $5 } @@ -454,6 +456,7 @@ Name : identifier { Unqualified (to_string $1) } | underscore { Unqualified "_" } | listVT { Unqualified "list_vt" } + | foldAt { Unqualified "fold@" } | 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 effmaskWrt { SpecialName $1 "effmask_wrt" } diff --git a/src/Language/ATS/PrettyPrint.hs b/src/Language/ATS/PrettyPrint.hs --- a/src/Language/ATS/PrettyPrint.hs +++ b/src/Language/ATS/PrettyPrint.hs @@ -172,13 +172,13 @@ a (NamedValF nam) = pretty nam a (CallF nam [] [] Nothing []) = pretty nam <> "()" a (CallF nam [] [] (Just e) xs) = pretty nam <> prettyArgsG ("(" <> pretty e <+> "| ") ")" xs -- FIXME split eagerly on "|" - a (CallF nam [] [] Nothing xs) = pretty nam <> prettyArgsG "(" ")" xs + a (CallF nam [] [] Nothing xs) = pretty nam <> prettyArgs xs a (CallF nam [] us Nothing []) = pretty nam <> prettyArgsU "{" "}" us a (CallF nam [] us Nothing xs) = pretty nam <> prettyArgsU "{" "}" us <> prettyArgsG "(" ")" xs a (CallF nam is [] Nothing []) = pretty nam <> prettyArgsU "<" ">" is a (CallF nam is [] Nothing [x]) | startsParens x = pretty nam <> prettyArgsU "<" ">" is <> pretty x - a (CallF nam is [] Nothing xs) = pretty nam <> prettyArgsU "<" ">" is <> prettyArgsG "(" ")" xs + a (CallF nam is [] Nothing xs) = pretty nam <> prettyArgsU "<" ">" is <> prettyArgs xs a (CaseF _ add e cs) = "case" <> pretty add <+> e <+> "of" <$> indent 2 (prettyCases cs) a (VoidLiteralF _) = "()" a (RecordValueF _ es Nothing) = prettyRecord es @@ -468,20 +468,21 @@ (<#>) a b = lineAlt (a <$> indent 2 b) (a <+> b) -- FIXME figure out a nicer algorithm for when/how to split lines. +-- aka don't use '' in places. instance Pretty PreFunction where pretty (PreF i si [] [] [NoArgs] rt Nothing (Just e)) = pretty i <+> ":" <> text si <#> pretty rt <+> "=" <$> indent 2 (pretty e) -- FIXME this is an awful hack pretty (PreF i si [] [] as rt Nothing (Just e)) = pretty i <> prettyArgs as <+> ":" <> text si <#> pretty rt <+> "=" <$> indent 2 (pretty e) - pretty (PreF i si [] [] as rt (Just t) (Just e)) = pretty i ".<" <> pretty t <> ">." <#> prettyArgs as <+> ":" <> text si <#> pretty rt <+> "=" <$> indent 2 (pretty e) - pretty (PreF i si [] us as rt (Just t) (Just e)) = pretty i fancyU us ".<" <> pretty t <> ">." <#> prettyArgs as <+> ":" <> text si <#> pretty rt <+> "=" <$> indent 2 (pretty e) + pretty (PreF i si [] [] as rt (Just t) (Just e)) = pretty i ".<" <> pretty t <> ">." prettyArgs as <+> ":" <> text si <#> pretty rt <+> "=" <$> indent 2 (pretty e) + pretty (PreF i si [] us as rt (Just t) (Just e)) = pretty i fancyU us ".<" <> pretty t <> ">." prettyArgs as <+> ":" <> text si <#> pretty rt <+> "=" <$> indent 2 (pretty e) pretty (PreF i si [] us [NoArgs] rt Nothing (Just e)) = pretty i fancyU us <+> ":" <> text si <#> pretty rt <+> "=" <$> indent 2 (pretty e) - pretty (PreF i si [] us as rt Nothing (Just e)) = pretty i fancyU us <#> prettyArgs as <+> ":" <> text si <#> pretty rt <+> "=" <$> indent 2 (pretty e) + pretty (PreF i si [] us as rt Nothing (Just e)) = pretty i fancyU us prettyArgs as <+> ":" <> text si <#> pretty rt <+> "=" <$> indent 2 (pretty e) pretty (PreF i si pus [] as rt Nothing (Just e)) = fancyU pus pretty i <> prettyArgs as <+> ":" <> text si <#> pretty rt <+> "=" <$> indent 2 (pretty e) - pretty (PreF i si pus [] as rt (Just t) (Just e)) = fancyU pus pretty i <+> ".<" <> pretty t <> ">." <#> prettyArgs as <+> ":" <> text si <#> pretty rt <+> "=" <$> indent 2 (pretty e) - pretty (PreF i si pus us as rt (Just t) (Just e)) = fancyU pus pretty i fancyU us ".<" <> pretty t <> ">." <#> prettyArgs as <+> ":" <> text si <#> pretty rt <+> "=" <$> indent 2 (pretty e) - pretty (PreF i si pus us as rt Nothing (Just e)) = fancyU pus pretty i fancyU us <#> prettyArgs as <+> ":" <> text si <#> pretty rt <+> "=" <$> indent 2 (pretty e) + pretty (PreF i si pus [] as rt (Just t) (Just e)) = fancyU pus pretty i <+> ".<" <> pretty t <> ">." prettyArgs as <+> ":" <> text si <#> pretty rt <+> "=" <$> indent 2 (pretty e) + pretty (PreF i si pus us as rt (Just t) (Just e)) = fancyU pus pretty i fancyU us ".<" <> pretty t <> ">." prettyArgs as <+> ":" <> text si <#> pretty rt <+> "=" <$> indent 2 (pretty e) + pretty (PreF i si pus us as rt Nothing (Just e)) = fancyU pus pretty i fancyU us prettyArgs as <+> ":" <> text si <#> pretty rt <+> "=" <$> indent 2 (pretty e) pretty (PreF i si [] [] as rt Nothing Nothing) = pretty i <> prettyArgs as <+> ":" <> text si <#> pretty rt pretty (PreF i si [] us [] rt Nothing Nothing) = pretty i fancyU us <+> ":" <> text si <#> pretty rt - pretty (PreF i si [] us as rt Nothing Nothing) = pretty i fancyU us <#> prettyArgs as <+> ":" <> text si <#> pretty rt + pretty (PreF i si [] us as rt Nothing Nothing) = pretty i fancyU us prettyArgs as <+> ":" <> text si <#> pretty rt pretty (PreF i si pus us as rt Nothing Nothing) = fancyU pus pretty i fancyU us prettyArgs as <+> ":" <> text si <#> pretty rt pretty _ = undefined diff --git a/src/Language/ATS/Types.hs b/src/Language/ATS/Types.hs --- a/src/Language/ATS/Types.hs +++ b/src/Language/ATS/Types.hs @@ -337,11 +337,13 @@ -- TODO: rewrite multiple universals when it's the right context? rewriteATS :: Expression -> Expression rewriteATS = cata a where - 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 Add e (BinList Add es)) = BinList Add (e : es) - a (BinaryF Add e e') = BinList Add [e, e'] - a (ParenExprF _ e@Precede{}) = e - a (ParenExprF _ e@PrecedeList{}) = e - a x = embed x + 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 Add e (BinList Add es)) = BinList Add (e : es) + a (BinaryF Add e e') = BinList Add [e, e'] + a (ParenExprF _ e@Precede{}) = e + a (ParenExprF _ e@PrecedeList{}) = e + a x = embed x diff --git a/test/data/concurrency.out b/test/data/concurrency.out --- a/test/data/concurrency.out +++ b/test/data/concurrency.out @@ -127,7 +127,7 @@ val (prf | ()) = spin_lock(spin) val () = ch.refcount := ch.refcount + 1 val () = spin_unlock(prf | spin) - prval () = fold@((chan)) + prval () = fold@(chan) in $UN.castvwtp1{channel(a)}(chan) end @@ -166,7 +166,7 @@ val @CHANNEL{ l0, l1, l2, l3 }(ch) = chan val refcount = ch.refcount in - (fold@((chan)) ; refcount) + (fold@(chan) ; refcount) end implement {a} channel_make (cap) = @@ -209,7 +209,7 @@ val () = ch.queue := $UN.castvwtp0{ptr}(queue_make(cap)) in - (fold@((chan)) ; chan) + (fold@(chan) ; chan) end implement {a} channel_insert (chan, x) = diff --git a/test/data/number-theory.out b/test/data/number-theory.out --- a/test/data/number-theory.out +++ b/test/data/number-theory.out @@ -143,7 +143,7 @@ begin let fnx loop { k : nat | k >= 2 }{ m : nat | m > 0 && k >= m } .. - (i : int(m), n : int(k)) : int = + (i : int(m), n : int(k)) : int = if i >= n then if is_prime(n) then n - 1 diff --git a/test/data/polyglot.out b/test/data/polyglot.out --- a/test/data/polyglot.out +++ b/test/data/polyglot.out @@ -93,7 +93,7 @@ // Pad a string of bounded length on the right by adding spaces. fnx right_pad { k : int | k >= 0 }{ m : int | m <= k } .. - (s : string(m), n : int(k)) : string = +(s : string(m), n : int(k)) : string = case+ length(s) < n of | true when n > 0 => right_pad(s, n - 1) + " " | _ => s @@ -1450,12 +1450,12 @@ end fnx get_cli { n : int | n >= 1 }{ m : nat | m < n } .. - ( argc : int(n) - , argv : !argv(n) - , current : int(m) - , prev_is_exclude : bool - , acc : command_line - ) : command_line = +( argc : int(n) +, argv : !argv(n) +, current : int(m) +, prev_is_exclude : bool +, acc : command_line +) : command_line = let var arg = argv[current] in