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.27 +version: 0.1.0.28 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 @@ -36,6 +36,11 @@ default: False } +Flag library { + Description: Do not build executable + default: False +} + library hs-source-dirs: src exposed-modules: Language.ATS @@ -70,6 +75,8 @@ ghc-options: -Wall executable atsfmt + if flag(library) + buildable: False hs-source-dirs: app main-is: Main.hs build-depends: base diff --git a/src/Language/ATS.hs b/src/Language/ATS.hs --- a/src/Language/ATS.hs +++ b/src/Language/ATS.hs @@ -3,6 +3,8 @@ lexATS , parseATS , printATS + , printATSCustom + , printATSFast -- * Syntax Tree , ATS (..) , Declaration (..) 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 @@ -413,6 +413,7 @@ | let ATS in Expression lineComment {% Left $ Expected (token_posn $5) "end" (take 2 $ to_string $5) } | let ATS in Expression extern {% Left $ Expected $5 "end" "extern" } | let ATS in Expression fun {% Left $ Expected $5 "end" "fun" } + | if Expression then Expression else else {% Left $ Expected $6 "Expression" "else" } -- | Parse a termetric Termetric : openTermetric StaticExpression closeTermetric { ($1, $2) } @@ -560,6 +561,7 @@ | prfn PreFunction { [ Func $1 (PrFn $2) ] } | fnx PreFunction { [ Func $1 (Fnx $2) ] } | castfn PreFunction { [ Func $1 (CastFn $2) ] } + | fn PreFunction identifier {% Left $ Expected (token_posn $3) "=" (to_string $3) } | fn PreFunction { [ Func $1 (Fn $2) ] } | FunDecl and PreFunction { Func $2 (And $3) : $1 } | extern FunDecl { over _head (Extern $1) $2 } @@ -604,7 +606,7 @@ | absprop IdentifierOr openParen FullArgs closeParen { AbsProp $1 $2 [] } | stadef IdentifierOr eq Name { Stadef $2 $4 [] } | stadef IdentifierOr eq Name openParen TypeIn closeParen { Stadef $2 $4 $6 } - | stadef boolLit eq Name { Stadef (over _head toLower (show $2)) $4 [] } + | stadef boolLit eq Name { Stadef (over _head toLower (show $2)) $4 [] } -- TODO identifierSpace | sortdef IdentifierOr eq Type { SortDef $1 $2 $4 } | AndSort { $1 } @@ -645,7 +647,8 @@ | implement Implementation { Impl [] $2 } | implement openParen Args closeParen Implementation { Impl $3 $5 } | overload BinOp with Name { OverloadOp $1 $2 $4 } - | overload identifierSpace with Name { OverloadIdent $1 (to_string $2) $4 } + | overload identifierSpace with Name { OverloadIdent $1 (to_string $2) $4 Nothing } + | overload tilde with identifierSpace of intLit { OverloadIdent $1 "~" (Unqualified $ to_string $4) (Just $6) } -- FIXME figure out a general solution. | assume Name openParen Args closeParen eq Expression { Assume $2 $4 $7 } | tkindef IdentifierOr eq string { TKind $1 (Unqualified $2) $4 } | TypeDecl { $1 } @@ -653,7 +656,7 @@ | 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 (Just $2) $3 } - | val lbrace Universals rbrace IdentifierOr colon Type { StaVal $3 $5 $7 } + | val Universals IdentifierOr colon Type { StaVal $2 $3 $5 } | lambda {% Left $ Expected $1 "Declaration" "lam" } | llambda {% Left $ Expected $1 "Declaration" "llam" } | minus {% Left $ Expected $1 "Declaration" "-" } 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 @@ -12,6 +12,7 @@ module Language.ATS.PrettyPrint ( printATS , printATSCustom + , printATSFast , processClang ) where @@ -66,14 +67,20 @@ printClang :: String -> IO String printClang = readCreateProcess (shell "clang-format") +-- | Pretty-print with sensible defaults. printATS :: ATS -> String -printATS (ATS x) = g mempty - where g = (displayS . renderSmart 0.6 120 . (<> "\n") . pretty) (ATS $ reverse x) +printATS = (<> "\n") . printATSCustom 0.6 120 -printATSCustom :: Float -> Int -> ATS -> String +printATSCustom :: Float -- ^ Ribbon fraction + -> Int -- ^ Ribbon width + -> ATS -> String printATSCustom r i (ATS x) = g mempty where g = (displayS . renderSmart r i . pretty) (ATS $ reverse x) +-- | Fast pretty-printer without indendation. Useful for generating code. +printATSFast :: ATS -> String +printATSFast (ATS x) = g mempty + where g = (displayS . renderCompact . (<> "\n") . pretty) (ATS $ reverse x) instance Pretty Name where pretty (Unqualified n) = text n @@ -485,7 +492,8 @@ pretty (CBlock s) = string s pretty (Comment s) = string s pretty (OverloadOp _ o n) = "overload" <+> pretty o <+> "with" <+> pretty n - pretty (OverloadIdent _ i n) = "overload" <+> text i <+> "with" <+> pretty n + pretty (OverloadIdent _ i n Nothing) = "overload" <+> text i <+> "with" <+> pretty n + pretty (OverloadIdent _ i n (Just n')) = "overload" <+> text i <+> "with" <+> pretty n <+> "of" <+> pretty n' -- We use 'text' here, which means indentation might get fucked up for -- C preprocessor macros, but you absolutely deserve it if you indent your -- macros. 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 @@ -91,7 +91,7 @@ | AbsT0p AlexPosn String Type | ViewDef AlexPosn String [Arg] Type | OverloadOp AlexPosn BinOp Name - | OverloadIdent AlexPosn String Name + | OverloadIdent AlexPosn String Name (Maybe Int) | Comment String | DataProp AlexPosn String [Arg] [DataPropLeaf] | Extern AlexPosn Declaration @@ -148,7 +148,7 @@ | ViewLiteral Addendum deriving (Show, Eq, Generic, NFData) --- | A type for the various lambda arrows (@=>@, @=@, etc.) +-- | A type for the various lambda arrows (@=>@, @=\@, etc.) data LambdaType = Plain AlexPosn | Full AlexPosn String | Spear AlexPosn @@ -214,6 +214,7 @@ | Mod deriving (Show, Eq, Generic, NFData) +-- FIXME add position information? data StaticExpression = StaticVal Name | StaticBinary BinOp StaticExpression StaticExpression | StaticInt Int @@ -303,7 +304,7 @@ deriving (Show, Eq, Generic, NFData) data PreFunction = PreF { fname :: Name -- ^ Function name - , sig :: String -- ^ e.g. <> or + , sig :: String -- ^ e.g. <> or \ , preUniversals :: [Universal] -- ^ Universal quantifiers making a function generic , universals :: [Universal] -- ^ Universal quantifiers/refinement type , args :: [Arg] -- ^ Actual function arguments