diff --git a/.travis.yml b/.travis.yml --- a/.travis.yml +++ b/.travis.yml @@ -45,8 +45,7 @@ - stack --no-terminal --install-ghc test --only-dependencies script: - - stack --no-terminal build --haddock --no-haddock-deps - - stack test --no-run-tests + - stack --no-terminal build --haddock --no-haddock-deps --test --bench --no-run-tests --no-run-benchmarks - curl -sL https://raw.githubusercontent.com/vmchale/tomlcheck/master/sh/check | sh -s .atsfmt.toml - | if [ `uname` = "Linux" ] @@ -57,8 +56,8 @@ yamllint .travis.yml yamllint .hlint.yaml yamllint .stylish-haskell.yaml - # curl -sL https://raw.github.com/ndmitchell/hlint/master/misc/travis.sh | sh -s src app test bench - # curl -sL https://raw.github.com/ndmitchell/weeder/master/misc/travis.sh | sh -s src app test bench + curl -sL https://raw.github.com/ndmitchell/hlint/master/misc/travis.sh | sh -s src app test bench + curl -sL https://raw.github.com/ndmitchell/weeder/master/misc/travis.sh | sh -s . else echo "skipping yaml verification..." fi diff --git a/Justfile b/Justfile --- a/Justfile +++ b/Justfile @@ -1,13 +1,24 @@ approve FILE: @atsfmt test/data/{{ FILE }} -o > test/data/$(echo {{ FILE }} | sed 's/\(dats\|sats\)/out/') +next: + @export VERSION=$(ac ats-format.cabal | grep -P -o '\d+\.\d+\.\d+\.\d+' ats-format.cabal | head -n1 | awk -F. '{$NF+=1; print $0}' | sed 's/ /\./g') && echo $VERSION && sed -i "2s/[0-9]\+\.[0-9]\+\.[0-9]\+\.[0-9]\+/$VERSION/" ats-format.cabal + git commit -am "next" + sn c . + +release: + git tag "$(grep -P -o '\d+\.\d+\.\d+\.\d+' ats-format.cabal | head -n1)" + git push origin --tags + git tag -d "$(grep -P -o '\d+\.\d+\.\d+\.\d+' ats-format.cabal | head -n1)" + git push origin master + +upload: + rm -rf dist/ .ghc.environment.* + cabal sdist + cabal upload --publish $(fd '\.tar\.gz$' -I) + diff FILE: @diff <(atsfmt test/data/{{ FILE }} -o) test/data/$(echo {{ FILE }} | sed 's/\(dats\|sats\)/out/') | ac -s - -darcs: - @darcs optimize clean - @darcs optimize pristine - @darcs optimize cache clean: sn c . diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -21,6 +21,11 @@ $ atsfmt --default-config ``` +### Vim + +You can use [this](https://github.com/vmchale/ats-vim) plugin to enable +automatic formatting on write. + ## Installation ### Binary Releases 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.0.5 +version: 0.1.0.6 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 @@ -58,7 +58,6 @@ , directory , process , file-embed - , bytestring build-tools: happy , alex default-language: Haskell2010 @@ -92,7 +91,6 @@ , system-filepath , pipes-safe , filepath - , mtl , hspec-core if flag(development) ghc-options: -Werror diff --git a/src/Language/ATS/Lexer.x b/src/Language/ATS/Lexer.x --- a/src/Language/ATS/Lexer.x +++ b/src/Language/ATS/Lexer.x @@ -70,7 +70,7 @@ @if_block = "#if" ([^\#] | "#then" | "#print" | \n)+ "#endif" .* -- FIXME this is a disaster lol -@ref_call = ($alpha | $digit | "(" | ")" | _ | ($white* "," $white*))+ ">" +@ref_call = ($alpha | $digit | "(" | ")" | _ | (","))+ ">" @not_close_c = \% [^\}] @c_block = \%\{ ("#" | "$" | "^" | "") ([^\%] | @not_close_c | \n)* \%\} -- TODO include %{# and %{$ @@ -80,6 +80,8 @@ -- FIXME whatever the fuck this is: - @func_type = "-" | "-" | "-" | "-" | "-" | "-" | "-<>" | "-" -- FIXME allow spaces after comma? +@at_brace = \@ ($white | @block_comment)* \{ + @operator = "+" | "-" | "*" | "/" | ".." | "!=" | ">=" | "<=" | "==" | "=" | "~" | "&&" | "||" | "->" | ":=" | ".<" | ">." | "<" | ">" | ">>" | "?" | "?!" | "#[" -- TODO context so tilde doesn't follow | @double_parens = "(" @block_comment ")" | "()" @@ -167,6 +169,8 @@ propdef { tok (\p s -> Keyword p KwPropdef) } tkindef { tok (\p s -> Keyword p KwTKind) } "$raise" { tok (\p s -> Keyword p KwRaise) } + "println!" { tok (\p s -> Identifier p s) } + "prerrln!" { tok (\p s -> Identifier p s) } @double_parens { tok (\p s -> DoubleParenTok p) } @double_braces { tok (\p s -> DoubleBracesTok p) } @double_brackets { tok (\p s -> DoubleBracketTok p) } @@ -178,6 +182,7 @@ @integer { tok (\p s -> IntTok p (read s)) } @float { tok (\p s -> FloatTok p (read s)) } $br / @ref_call { tok (\p s -> SpecialBracket p) } + @at_brace { tok (\p s -> Operator p "@{") } -- FIXME this is kinda sloppy @operator { tok (\p s -> Operator p s) } @signature { tok (\p s -> SignatureTok p (tail s)) } $special { tok (\p s -> Special p s) } 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 @@ -150,6 +150,7 @@ define { MacroBlock _ $$ } lineComment { CommentLex _ $$ } lspecial { SpecialBracket $$ } + atbrace { Operator $$ "@{" } %% @@ -168,6 +169,7 @@ -- | Several comma-separated types or static expressions TypeInExpr : TypeIn { $1 } | Expression { [ConcreteType $1] } + | TypeInExpr comma Type { $3 : $1 } | TypeInExpr comma Expression { ConcreteType $3 : $1 } -- | Parse a type @@ -187,7 +189,6 @@ | int openParen PreExpression closeParen { DependentInt $3 } | bool openParen PreExpression closeParen { DependentBool $3 } | identifier { Named $1 } - | int Expression { DependentInt $2 } | exclamation Type { Unconsumed $2 } | Type funcArrow Type { FunctionType $2 $1 $3 } | refType Type { RefType $2 } @@ -203,12 +204,17 @@ | Name identifier { Dependent $1 [Named $2] } | openParen TypeIn closeParen { Tuple $1 $2 } | openParen Type closeParen { $2 } + | int StaticExpression { DependentInt $2 } | doubleParens { NoneType $1 } | minus {% Left $ Expected $1 "Type" "-" } | dollar {% Left $ Expected $1 "Type" "$" } FullArgs : Args { $1 } +FunArgs : Arg { Comma $1 Nil } + | FunArgs comma Arg { Comma $3 $1 } + | FunArgs vbar Arg { Bar $3 $1 } + -- | A comma-separated list of arguments Args : Arg { [$1] } | Args comma Arg { $3 : $1 } @@ -286,6 +292,7 @@ | Expression semicolon { $1 } | openParen Expression closeParen { $2 } | Expression signature Type { TypeSignature $1 $3 } + | openParen Expression vbar Expression closeParen { ProofExpr $1 $2 $4 } TypeArgs : lbrace Type rbrace { [$2] } | lbrace TypeIn rbrace { $2 } @@ -304,11 +311,15 @@ | Name lspecial TypeIn rbracket { Call $1 $3 [] Nothing [] } | dollar raise PreExpression { Call (SpecialName $1 "raise") [] [] Nothing [$3] } -- we do this because a $raise can have at most one argument +StaticExpression : Name { NamedVal $1 } + | StaticExpression BinOp StaticExpression { Binary $2 $1 $3 } + | intLit { IntLit $1 } + | sif StaticExpression then StaticExpression else StaticExpression { Sif $2 $4 $6 } -- TODO separate type for static expressions + -- | Parse an expression that can be called without parentheses PreExpression : identifier lsqbracket PreExpression rsqbracket { Index $2 (Unqualified $1) $3 } | Literal { $1 } | Call { $1 } - | openParen PreExpression vbar PreExpression closeParen { ProofExpr $1 $2 $4 } | case PreExpression of Case { Case $3 $1 $2 $4 } | PreExpression BinOp PreExpression { Binary $2 $1 $3 } | UnOp PreExpression { Unary $1 $2 } -- FIXME throw error when we try to negate a string literal/time @@ -319,8 +330,9 @@ | let ATS in Expression end { Let $1 $2 (Just $4) } | lambda Pattern LambdaArrow Expression { Lambda $1 $3 $2 $4 } | llambda Pattern LambdaArrow Expression { LinearLambda $1 $3 $2 $4 } - | at lbrace RecordVal rbrace { RecordValue $1 $3 Nothing } - | at lbrace RecordVal rbrace signature Type { RecordValue $1 $3 (Just $6) } + | PreExpression at PreExpression { AtExpr $1 $3 } + | atbrace RecordVal rbrace { RecordValue $1 $2 Nothing } + | atbrace RecordVal rbrace signature Type { RecordValue $1 $2 (Just $5) } | exclamation PreExpression { Deref $1 $2 } | PreExpression mutateArrow identifier mutateEq PreExpression { FieldMutate $2 $1 $3 $5 } | PreExpression mutateEq PreExpression { Mutate $1 $3 } @@ -328,7 +340,6 @@ | Name { NamedVal $1 } | lbrace ATS rbrace { Actions $2 } | while openParen PreExpression closeParen PreExpression { While $1 $3 $5 } - | sif PreExpression then Expression else Expression { Sif $2 $4 $6 } -- TODO separate type for static expressions | include {% Left $ Expected $1 "Expression" "include" } | staload {% Left $ Expected $1 "Expression" "staload" } | overload {% Left $ Expected $1 "Expression" "overload" } @@ -338,6 +349,7 @@ | fromVT {% Left $ Expected $1 "Expression" "?!" } | prfTransform {% Left $ Expected $1 "Expression" ">>" } | maybeProof {% Left $ Expected $1 "Expression" "?" } + | let openParen {% Left $ Expected $1 "Declaration" "(" } -- | Parse a termetric Termetric : openTermetric Expression closeTermetric { ($1, $2) } @@ -353,10 +365,8 @@ | lsqbracket Expression rsqbracket { Existential [] Nothing (Just $2) } -- | Parse a universal quantifier on a type -Universal : lbrace Args vbar PreExpression rbrace { Universal $2 Nothing (Just $4) } - | lbrace Args rbrace { Universal $2 Nothing Nothing } - | lbrace Args signature Type vbar Expression rbrace { Universal $2 (Just $4) (Just $6) } - | lbrace Args signature Type { Universal $2 (Just $4) Nothing } +Universal : lbrace Args rbrace { Universal $2 Nothing Nothing } + | lbrace Args vbar StaticExpression rbrace { Universal $2 Nothing (Just $4) } -- | Parse the details of an implementation Implementation : FunName doubleParens eq Expression { Implement $2 [] [] $1 [] $4 } @@ -466,18 +476,16 @@ | fnx PreFunction { [ Func $1 (Fnx $2) ] } | extern FunDecl { over _head (Extern $1) $2 } | FunDecl and PreFunction { Func $2 (And $3) : $1 } + | extern fun PreFunction eq {% Left $ Expected $1 "Declaration" "Function body" } | lambda {% Left $ Expected $1 "Function declaration" "lam" } | llambda {% Left $ Expected $1 "Function declaration" "llam" } -- | Parse a declaration defining a type -TypeDecl : typedef identifier eq at lbrace Records rbrace { RecordType $2 [] $6 } - | typedef identifier eq Type { TypeDef $1 $2 [] $4 } - | typedef identifier openParen FullArgs closeParen eq Type { TypeDef $1 $2 $4 $7 } - | typedef identifier openParen FullArgs closeParen eq at lbrace Records rbrace { RecordType $2 $4 $9 } - | vtypedef identifier eq at lbrace Records rbrace { RecordViewType $2 [] $6 } - | vtypedef identifier eq Type { ViewTypeDef $1 $2 [] $4 } - | vtypedef identifier openParen FullArgs closeParen eq Type { ViewTypeDef $1 $2 $4 $7 } - | vtypedef identifier openParen FullArgs closeParen eq at lbrace Records rbrace { RecordViewType $2 $4 $9 } +TypeDecl : typedef identifier eq Universals atbrace Records rbrace { RecordType $2 [] $4 $6 } + | typedef identifier openParen FullArgs closeParen eq Universals atbrace Records rbrace { RecordType $2 $4 $7 $9 } + | vtypedef identifier eq Universals atbrace Records rbrace { RecordViewType $2 [] $4 $6 } + | vtypedef identifier openParen FullArgs closeParen eq Universal atbrace Records rbrace { RecordViewType $2 $4 [$7] $9 } + | vtypedef identifier openParen FullArgs closeParen eq Universals atbrace Records rbrace { RecordViewType $2 $4 $7 $9 } | datatype identifier eq Leaves { SumType $2 [] $4 } | datatype identifier openParen Args closeParen eq Leaves { SumType $2 $4 $7 } | datavtype identifier eq Leaves { SumViewType $2 [] $4 } @@ -486,6 +494,10 @@ | absvtype identifier openParen FullArgs closeParen eq Type { AbsViewType $1 $2 $4 $7 } | dataprop identifier openParen FullArgs closeParen eq DataPropLeaves { DataProp $1 $2 $4 $7 } | absprop identifier openParen FullArgs closeParen { AbsProp $1 $2 [] } + | typedef identifier eq Type { TypeDef $1 $2 [] $4 } + | typedef identifier openParen FullArgs closeParen eq Type { TypeDef $1 $2 $4 $7 } + | vtypedef identifier eq Type { ViewTypeDef $1 $2 [] $4 } + | vtypedef identifier openParen FullArgs closeParen eq Type { ViewTypeDef $1 $2 $4 $7 } | stadef identifier eq Name { Stadef $2 $4 [] } | stadef identifier eq Name openParen TypeIn closeParen { Stadef $2 $4 $6 } | sortdef identifier eq Type { SortDef $1 $2 $4 } @@ -500,11 +512,12 @@ | staload string { Staload Nothing $2 } | staload identifier eq string { Staload (Just $2) $4 } | extern Declaration { Extern $1 $2 } - | var Pattern signature Type eq PreExpression { Var (Just $4) $2 (Just $6) } + | var Pattern signature Type with PreExpression { Var (Just $4) $2 Nothing (Just $6) } -- FIXME + | var Pattern signature Type eq PreExpression { Var (Just $4) $2 (Just $6) Nothing } | val Pattern signature Type eq PreExpression { Val $1 (Just $4) $2 $6 } | val Pattern eq Expression { Val $1 Nothing $2 $4 } - | var Pattern eq PreExpression { Var Nothing $2 (Just $4) } - | var Pattern signature Type { Var (Just $4) $2 Nothing } + | var Pattern eq PreExpression { Var Nothing $2 (Just $4) Nothing } + | var Pattern signature Type { Var (Just $4) $2 Nothing Nothing } | prval Pattern eq PreExpression { PrVal $2 $4 } | praxi PreFunction { Func $1 (Praxi $2) } | primplmnt Implementation { ProofImpl $2 } 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 @@ -15,7 +15,7 @@ ) where import Control.Arrow hiding ((<+>)) -import Control.Composition +import Control.Composition hiding ((&)) import Control.DeepSeq (NFData) import Control.Lens hiding (op) #if __GLASGOW_HASKELL__ >= 801 @@ -145,6 +145,7 @@ a (CallF name [] [] Nothing []) = pretty name <> "()" a (CallF name [] [] Nothing [x]) | startsParens x = pretty name <> pretty x + a (CallF name [] [] (Just e) xs) = pretty name <> prettyArgsG ("(" <> pretty e <+> "| ") ")" xs a (CallF name [] [] Nothing xs) = pretty name <> prettyArgsG "(" ")" xs a (CallF name [] us Nothing []) = pretty name <> prettyArgsU "{" "}" us a (CallF name is [] Nothing []) = pretty name <> prettyArgsU "<" ">" is @@ -169,7 +170,7 @@ a (CharLitF c) = "'" <> char c <> "'" a (ProofExprF _ e e') = "(" <> e <+> "|" <+> e' <> ")" a (TypeSignatureF e t) = e <+> ":" <+> pretty t - a (WhereExpF e d) = e <+> "where" <$> braces (" " <> pretty (ATS d) <> " ") + a (WhereExpF e d) = e <+> "where" <$> braces (" " <> nest 2 (pretty (ATS d)) <> " ") a (TupleExF _ es) = prettyArgs es -- parens (mconcat $ punctuate ", " (reverse es)) a (WhileF _ e e') = "while" <> parens e <> e' a (ActionsF as) = "{" <$> indent 2 (pretty ((\(ATS x) -> ATS $ reverse x) as)) <$> "}" @@ -225,14 +226,14 @@ a DoubleF = "double" a FloatF = "float" a (ForAF u t) = pretty u <+> t - a (UnconsumedF t) = "!" <> parens t + a (UnconsumedF t) = "!" <> t a (AsProofF t (Just t')) = t <+> ">>" <+> t' a (AsProofF t Nothing) = t <+> ">> _" a (FromVTF t) = t <> "?!" a (MaybeValF t) = t <> "?" a (T0pF ad) = "t@ype" <> pretty ad a (Vt0pF ad) = "vt@ype" <> pretty ad - a (AtF _ t t') = t <> "@" <> t' + a (AtF _ t t') = t <+> "@" <+> t' a (ProofTypeF _ t t') = parens (t <+> "|" <+> t') a (ConcreteTypeF e) = pretty e a (TupleF _ ts) = parens (mconcat (punctuate ", " (fmap pretty (reverse ts)))) @@ -369,6 +370,9 @@ pretty (PreF i si pus [] as rt (Just t) (Just e)) = fancyU pus pretty i <+> ".<" <> pretty t <> ">." prettyArgs as <+> ":" <> string 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 <+> ":" <> string 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 <+> ":" <> string si pretty rt <+> "=" <$> indent 2 (pretty e) + pretty (PreF i si [] [] as rt Nothing Nothing) = pretty i <> prettyArgs as <+> ":" <> string si pretty rt + pretty (PreF i si [] us [] rt Nothing Nothing) = pretty i fancyU us <+> ":" <> string si pretty rt + pretty (PreF i si [] us as rt Nothing Nothing) = pretty i fancyU us prettyArgs as <+> ":" <> string si pretty rt pretty (PreF i si pus us as rt Nothing Nothing) = fancyU pus pretty i fancyU us prettyArgs as <+> ":" <> string si pretty rt pretty _ = "FIXME" @@ -376,10 +380,11 @@ pretty (DataPropLeaf us e) = "|" <+> foldMap pretty (reverse us) <+> pretty e instance Pretty Declaration where - pretty (RecordType s [] rs) = "typedef" <+> string s <+> "=" <+> prettyRecord rs - pretty (RecordType s as rs) = "typedef" <+> string s <> prettyArgs as <+> "=" <+> prettyRecord rs - pretty (RecordViewType s [] rs) = "vtypedef" <+> string s <+> "=" <+> prettyRecord rs - pretty (RecordViewType s as rs) = "vtypedef" <+> string s <> prettyArgs as <+> "=" <+> prettyRecord rs + pretty (RecordType s [] [] rs) = "typedef" <+> string s <+> "=" <+> prettyRecord rs + pretty (RecordType s as [] rs) = "typedef" <+> string s <> prettyArgs as <+> "=" <+> prettyRecord rs + pretty (RecordViewType s [] [] rs) = "vtypedef" <+> string s <+> "=" <+> prettyRecord rs + pretty (RecordViewType s as [] rs) = "vtypedef" <+> string s <> prettyArgs as <+> "=" <+> prettyRecord rs + pretty (RecordViewType s as us rs) = "vtypedef" <+> string s <> prettyArgs as <+> "=" <+> fancyU us prettyRecord rs pretty (SumViewType s [] ls) = "datavtype" <+> string s <+> "=" <$> prettyLeaf ls pretty (SumViewType s as ls) = "datavtype" <+> string s <> prettyArgs as <+> "=" <$> prettyLeaf ls pretty (SumType s [] ls) = "datatype" <+> string s <+> "=" <$> prettyLeaf ls @@ -389,8 +394,9 @@ pretty (PrVal p e) = "prval" <+> pretty p <+> "=" <+> pretty e pretty (Val a Nothing p e) = "val" <> pretty a <+> pretty p <+> "=" <+> pretty e pretty (Val a (Just t) p e) = "val" <> pretty a <+> pretty p <> ":" <+> pretty t <+> "=" <+> pretty e - pretty (Var Nothing p e) = "var" <+> pretty p <+> "=" <+> pretty e - pretty (Var (Just t) p e) = "var" <+> pretty p <> ":" <+> pretty t <+> "=" <+> pretty e + pretty (Var (Just t) p Nothing e) = "var" <+> pretty p <> ":" <+> pretty t <+> "with" <+> pretty e + pretty (Var Nothing p e Nothing) = "var" <+> pretty p <+> "=" <+> pretty e + pretty (Var (Just t) p e Nothing) = "var" <+> pretty p <> ":" <+> pretty t <+> "=" <+> pretty e pretty (Include s) = "#include" <+> pretty s pretty (Staload Nothing s) = "staload" <+> pretty s pretty (Staload (Just q) s) = "staload" <+> pretty q <+> "=" <+> pretty s @@ -401,6 +407,7 @@ pretty (Func _ (Fnx pref)) = "fnx" pretty pref pretty (Func _ (And pref)) = "and" pretty pref pretty (Func _ (Praxi pref)) = "praxi" pretty pref + pretty (Func _ (PrFun pref)) = "prfun" pretty pref pretty (Extern _ d) = "extern" <$> pretty d pretty (Define s) = string s pretty (DataProp _ s as ls) = "dataprop" <+> string s <> prettyArgs as <+> "=" <$> prettyDL ls 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 @@ -33,6 +33,7 @@ , DataPropLeaf (..) , PreFunction (..) , Paired (..) + , Bifurcated (..) , rewriteATS ) where @@ -42,6 +43,10 @@ import GHC.Generics (Generic) import Language.ATS.Lexer (Addendum (..), AlexPosn) +data Bifurcated a = Nil + | Comma a (Bifurcated a) + | Bar a (Bifurcated a) + -- | Newtype wrapper containing a list of declarations newtype ATS = ATS { unATS :: [Declaration] } deriving (Show, Eq, Generic, NFData) @@ -52,14 +57,14 @@ | ProofImpl Implementation -- primplmnt -- TODO add args | Val Addendum (Maybe Type) Pattern Expression -- TODO expression should be optional? | PrVal Pattern Expression - | Var (Maybe Type) Pattern (Maybe Expression) -- TODO AlexPosn + | Var (Maybe Type) Pattern (Maybe Expression) (Maybe Expression) -- TODO AlexPosn | AndDecl (Maybe Type) Pattern Expression | Include String | Staload (Maybe String) String | Stadef String Name [Type] | CBlock String - | RecordType String [Arg] [(String, Type)] - | RecordViewType String [Arg] [(String, Type)] + | RecordType String [Arg] [Universal] [(String, Type)] + | RecordViewType String [Arg] [Universal] [(String, Type)] | TypeDef AlexPosn String [Arg] Type | ViewTypeDef AlexPosn String [Arg] Type | SumType String [Arg] [(String, Maybe Type)] -- TODO [Arg] for here