diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -40,7 +40,7 @@ ```bash $ cabal update - $ cabal new-install ats-format --happy-options='-gcsa' --alex-options='-g' --symlink-bindir ~/.cabal/bin + $ cabal new-install ats-format --happy-options='-gcsa' --alex-options='-g' --symlink-bindir ~/.cabal/bin -O2 ``` ## License 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.25 +version: 0.1.0.26 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/src/Language/ATS/Lexer.x b/src/Language/ATS/Lexer.x --- a/src/Language/ATS/Lexer.x +++ b/src/Language/ATS/Lexer.x @@ -450,6 +450,8 @@ pretty (FixityTok _ s) = string s to_string (CommentLex _ s) = s +to_string (Identifier _ s) = s +to_string (IdentifierSpace _ s) = s to_string _ = mempty token_posn (Identifier p _) = p 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 @@ -114,8 +114,8 @@ extfcall { Identifier $$ "extfcall" } ldelay { Identifier $$ "ldelay" } listVT { Identifier $$ "list_vt" } - identifier { Identifier _ $$ } - identifierSpace { IdentifierSpace _ $$ } + identifier { $$@Identifier{} } + identifierSpace { $$@IdentifierSpace{} } closeParen { Special $$ ")" } openParen { Special $$ "(" } signature { SignatureTok _ $$ } @@ -203,7 +203,7 @@ -- | Parse a type Type : Name openParen TypeInExpr closeParen { Dependent $1 $3 } - | identifierSpace openParen TypeInExpr closeParen { Dependent (Unqualified $1) $3 } + | identifierSpace openParen TypeInExpr closeParen { Dependent (Unqualified $ to_string $1) $3 } | bool { Bool } | int { Int } | nat { Nat } @@ -219,7 +219,7 @@ | stringType StaticExpression { DepString $2 } | int openParen StaticExpression closeParen { DependentInt $3 } | bool openParen StaticExpression closeParen { DependentBool $3 } - | identifierSpace { Named (Unqualified $1) } + | identifierSpace { Named (Unqualified $ to_string $1) } | Name { Named $1 } | exclamation Type { Unconsumed $2 } | Type mutateArrow Type { FunctionType "->" $1 $3 } @@ -237,13 +237,14 @@ | Type at Type { At $2 (Just $1) $3 } | at Type { At $1 Nothing $2 } | openParen Type vbar Type closeParen { ProofType $1 $2 $4 } - | identifierSpace identifier { Dependent (Unqualified $1) [Named (Unqualified $2)] } + | identifierSpace identifier { Dependent (Unqualified $ to_string $1) [Named (Unqualified $ to_string $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" "$" } + | int identifier openParen {% Left $ Expected (token_posn $2) "Static integer expression" (to_string $2) } FullArgs : Args { $1 } @@ -253,8 +254,8 @@ | Args comma Arg { $3 : $1 } | Arg vbar Arg { [ PrfArg $1 $3 ] } -Arg : identifier { Arg (First $1) } - | identifier signature Type { Arg (Both $1 $3) } +Arg : identifier { Arg (First $ to_string $1) } + | identifier signature Type { Arg (Both (to_string $1) $3) } | underscore { Arg (First "_") } | Type { Arg (Second $1) } | Expression { Arg (Second (ConcreteType $1)) } @@ -273,14 +274,14 @@ | PatternIn comma Pattern { $3 : $1 } -- | Parse a pattern match -Pattern : identifier { PName $1 [] } - | identifierSpace { PName $1 [] } +Pattern : identifier { PName (to_string $1) [] } + | identifierSpace { PName (to_string $1) [] } | underscore { Wildcard $1 } - | identifier doubleParens { PName ($1 ++ "()") [] } + | identifier doubleParens { PName (to_string $1 ++ "()") [] } | tilde Pattern { Free $2 } - | identifier openParen PatternIn closeParen { PName $1 $3 } - | identifier Pattern { PSum $1 $2 } - | identifierSpace Pattern { PSum $1 $2 } + | identifier openParen PatternIn closeParen { PName (to_string $1) $3 } + | identifier Pattern { PSum (to_string $1) $2 } + | identifierSpace Pattern { PSum (to_string $1) $2 } | openParen PatternIn vbar PatternIn closeParen { Proof $1 $2 $4 } | openParen PatternIn closeParen { TuplePattern $2 } | Literal { PLiteral $1 } @@ -322,7 +323,7 @@ -- | Expression or named call to an expression Expression : PreExpression { $1 } | openParen Tuple closeParen { TupleEx $1 $2 } - | identifierSpace PreExpression { Call (Unqualified $1) [] [] Nothing [$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 } @@ -331,6 +332,7 @@ | openParen Expression vbar Expression closeParen { ProofExpr $1 $2 $4 } | list_vt lbrace Type rbrace openParen ExpressionIn closeParen { ListLiteral $1 "vt" $3 $6 } | list lbrace Type rbrace openParen ExpressionIn closeParen { ListLiteral $1 "" $3 $6 } + | begin Expression extern {% Left $ Expected $3 "end" "extern" } TypeArgs : lbrace Type rbrace { [$2] } | lbrace TypeIn rbrace { $2 } @@ -342,7 +344,7 @@ | lbracket TypeIn rbrace { $2 } Call : Name doubleParens { Call $1 [] [] Nothing [] } - | identifierSpace openParen ExpressionPrf closeParen { Call (Unqualified $1) [] [] (fst $3) (snd $3) } + | identifierSpace openParen ExpressionPrf closeParen { Call (Unqualified $ to_string $1) [] [] (fst $3) (snd $3) } | Name openParen ExpressionPrf closeParen { Call $1 [] [] (fst $3) (snd $3) } | Name TypeArgs openParen ExpressionPrf closeParen { Call $1 [] $2 (fst $4) (snd $4) } | Name TypeArgs { Call $1 [] $2 Nothing [] } @@ -350,6 +352,8 @@ | Name lspecial TypeIn rbracket openParen ExpressionPrf closeParen { Call $1 $3 [] (fst $6) (snd $6) } | Name lspecial TypeIn rbracket { Call $1 $3 [] Nothing [] } | raise PreExpression { Call (SpecialName $1 "raise") [] [] Nothing [$2] } -- $raise can have at most one argument + | Name openParen ExpressionPrf end {% Left $ Expected $4 ")" "end"} + | Name openParen ExpressionPrf else {% Left $ Expected $4 ")" "else"} StaticArgs : StaticExpression { [$1] } | StaticArgs comma StaticExpression { $3 : $1 } @@ -360,13 +364,13 @@ | doubleParens { StaticVoid $1 } | boolLit { StaticBool $1 } | sif StaticExpression then StaticExpression else StaticExpression { Sif $2 $4 $6 } -- TODO separate type for static expressions - | identifierSpace { StaticVal (Unqualified $1) } + | identifierSpace { StaticVal (Unqualified $ to_string $1) } | Name openParen StaticArgs closeParen { SCall $1 $3 } - | identifierSpace openParen StaticArgs closeParen { SCall (Unqualified $1) $3 } + | identifierSpace openParen StaticArgs closeParen { SCall (Unqualified $ to_string $1) $3 } | StaticExpression semicolon StaticExpression { SPrecede $1 $3 } -- | Parse an expression that can be called without parentheses -PreExpression : identifier lsqbracket PreExpression rsqbracket { Index $2 (Unqualified $1) $3 } +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 } @@ -375,7 +379,7 @@ | UnOp PreExpression { Unary $1 $2 } -- FIXME throw error when we try to negate a string literal/time | PreExpression dot Name { Access $2 $1 $3 } | PreExpression dot intLit { Access $2 $1 (Unqualified $ show $3) } - | PreExpression dot identifierSpace { Access $2 $1 (Unqualified $3) } + | PreExpression dot identifierSpace { Access $2 $1 (Unqualified $ to_string $3) } | if Expression then Expression { If $2 $4 Nothing} | if Expression then Expression else Expression { If $2 $4 (Just $6) } | let ATS in end { Let $1 $2 Nothing } @@ -388,11 +392,11 @@ | atbrace RecordVal rbrace { RecordValue $1 $2 Nothing } | atbrace RecordVal rbrace signature Type { RecordValue $1 $2 (Just $5) } | exclamation PreExpression { Deref $1 $2 } - | PreExpression mutateArrow identifierSpace mutateEq PreExpression { FieldMutate $2 $1 $3 $5 } - | PreExpression mutateArrow identifier mutateEq PreExpression { FieldMutate $2 $1 $3 $5 } + | 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 } - | identifierSpace { NamedVal (Unqualified $1) } + | identifierSpace { NamedVal (Unqualified $ to_string $1) } | Name { NamedVal $1 } | lbrace ATS rbrace { Actions $2 } | while openParen PreExpression closeParen PreExpression { While $1 $3 $5 } @@ -406,6 +410,8 @@ | maybeProof {% Left $ Expected $1 "Expression" "?" } | let openParen {% Left $ Expected $1 "Expression" "let (" } | 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" } -- | Parse a termetric Termetric : openTermetric StaticExpression closeTermetric { ($1, $2) } @@ -432,15 +438,14 @@ | Universals FunName Universals openParen FullArgs closeParen eq Expression { Implement $4 $1 $3 $2 $5 $8 } -- | Parse a function name -FunName : identifier { Unqualified $1 } - | identifier dollar identifier { Functorial $1 $3 } - | identifierSpace { Unqualified $1 } +FunName : IdentifierOr { Unqualified $1 } + | identifier dollar identifier { Functorial (to_string $1) (to_string $3) } -- | Parse a general name -Name : identifier { Unqualified $1 } +Name : identifier { Unqualified (to_string $1) } | listVT { Unqualified "list_vt" } - | dollar identifier dot identifier { Qualified $1 $4 $2 } - | dollar identifier dot identifierSpace { Qualified $1 $4 $2 } + | 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" } | dollar effmaskAll { SpecialName $1 "effmask_all" } | dollar listVT { SpecialName $1 "list_vt" } @@ -449,34 +454,30 @@ | dollar {% Left $ Expected $1 "Name" "$" } -- | Parse a list of values in a record -RecordVal : identifier eq Expression { [($1, $3)] } - | identifierSpace eq Expression { [($1, $3)] } - | RecordVal comma identifier eq Expression { ($3, $5) : $1 } - | RecordVal comma identifierSpace eq Expression { ($3, $5) : $1 } +RecordVal : IdentifierOr eq Expression { [($1, $3)] } + | RecordVal comma IdentifierOr eq Expression { ($3, $5) : $1 } -- | Parse a list of types in a record -Records : identifier eq Type { [($1, $3)] } - | identifierSpace eq Type { [($1, $3)] } - | Records comma identifier eq Type { ($3, $5) : $1 } - | Records comma identifierSpace eq Type { ($3, $5) : $1 } +Records : IdentifierOr eq Type { [($1, $3)] } + | Records comma IdentifierOr eq Type { ($3, $5) : $1 } -IdentifiersIn : identifier { [$1] } - | IdentifiersIn comma identifier { $3 : $1 } +IdentifiersIn : IdentifierOr { [$1] } + | IdentifiersIn comma IdentifierOr { $3 : $1 } OfType : { Nothing } | of Type { Just $2 } -- | Parse a constructor for a sum type -SumLeaf : vbar Universals identifier { Leaf $2 $3 [] Nothing } - | vbar Universals identifierSpace of Type { Leaf $2 $3 [] (Just $5) } +SumLeaf : vbar Universals identifier { Leaf $2 (to_string $3) [] Nothing } + | vbar Universals identifierSpace of Type { Leaf $2 (to_string $3) [] (Just $5) } | vbar Universals IdentifierOr openParen IdentifiersIn closeParen OfType { Leaf $2 $3 $5 $7 } -- | Parse all constructors of a sum type Leaves : SumLeaf { [$1] } | Leaves SumLeaf { $2 : $1 } - | Universals identifierSpace of Type { [Leaf $1 $2 [] (Just $4)] } - | Universals identifier { [Leaf $1 $2 [] Nothing] } - | Universals identifier openParen IdentifiersIn closeParen OfType { [Leaf $1 $2 $4 $6] } -- FIXME should take any static expression. + | Universals identifierSpace of Type { [Leaf $1 (to_string $2) [] (Just $4)] } + | Universals identifier { [Leaf $1 (to_string $2) [] Nothing] } + | Universals identifier openParen IdentifiersIn closeParen OfType { [Leaf $1 (to_string $2) $4 $6] } -- FIXME should take any static expression. | dollar {% Left $ Expected $1 "|" "$" } Universals : { [] } @@ -567,9 +568,10 @@ | llambda {% Left $ Expected $1 "Function declaration" "llam" } | fun fn {% Left $ Expected $2 "Function name" "fn" } | fn fun {% Left $ Expected $2 "Function name" "fun" } + | extern FunDecl identifier openParen {% Left $ Expected (token_posn $3) "Static integer expression" (to_string $3) } -IdentifierOr : identifier { $1 } - | identifierSpace { $1 } +IdentifierOr : identifier { to_string $1 } + | identifierSpace { to_string $1 } MaybeType : eq Type { Just $2 } | { Nothing } @@ -607,18 +609,18 @@ | prefix { Pre $1 } | postfix { Post $1 } -Operator : identifierSpace { $1 } +Operator : identifierSpace { to_string $1 } | exp { "**" } Operators : Operator { [$1] } | Operators Operator { $2 : $1 } - | Operators identifier { $2 : $1 } + | Operators identifier { to_string $2 : $1 } -- | Parse a declaration Declaration : include string { Include $2 } | define { Define $1 } - | define identifierSpace string { Define ($1 ++ $2 ++ $3) } -- FIXME better approach? - | define identifierSpace intLit { Define ($1 ++ $2 ++ " " ++ show $3) } + | define identifierSpace string { Define ($1 ++ to_string $2 ++ $3) } -- FIXME better approach? + | define identifierSpace intLit { Define ($1 ++ to_string $2 ++ " " ++ show $3) } | cblock { CBlock $1 } | lineComment { Comment (to_string $1) } | staload underscore eq string { Staload (Just "_") $4 } @@ -639,7 +641,7 @@ | 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 $2 $4 } + | overload identifierSpace with Name { OverloadIdent $1 (to_string $2) $4 } | assume Name openParen Args closeParen eq Expression { Assume $2 $4 $7 } | tkindef IdentifierOr eq string { TKind $1 (Unqualified $2) $4 } | TypeDecl { $1 } @@ -655,11 +657,12 @@ | prfTransform {% Left $ Expected $1 "Declaration" ">>" } | maybeProof {% Left $ Expected $1 "Declaration" "?" } | end {% Left $ Expected $1 "Declaration" "end" } + | identifier {% Left $ Expected (token_posn $1) "Declaration" (to_string $1) } { data ATSError a = Expected AlexPosn a a - | Unknown Token + | Unknown Token -- FIXME error type for expression when a static expression was expected (?) deriving (Eq, Show, Generic, NFData) instance Pretty AlexPosn where 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 @@ -18,7 +18,7 @@ import Control.Arrow hiding ((<+>)) import Control.Composition hiding ((&)) import Control.DeepSeq (NFData) -import Control.Lens hiding (op) +import Control.Lens hiding (op, pre) #if __GLASGOW_HASKELL__ >= 801 import Data.Function (on) #endif @@ -68,24 +68,24 @@ printATS :: ATS -> String printATS (ATS x) = g mempty - where g = (displayS . renderPretty 0.6 120 . (<> "\n") . pretty) (ATS $ reverse x) + where g = (displayS . renderSmart 0.6 120 . (<> "\n") . pretty) (ATS $ reverse x) printATSCustom :: Float -> Int -> ATS -> String printATSCustom r i (ATS x) = g mempty - where g = (displayS . renderPretty r i . pretty) (ATS $ reverse x) + where g = (displayS . renderSmart r i . pretty) (ATS $ reverse x) instance Pretty Name where - pretty (Unqualified n) = string n - pretty (Qualified _ i n) = "$" <> string n <> "." <> string i - pretty (SpecialName _ s) = "$" <> string s - pretty (Functorial s s') = string s <> "$" <> string s' + pretty (Unqualified n) = text n + pretty (Qualified _ i n) = "$" <> text n <> "." <> text i + pretty (SpecialName _ s) = "$" <> text s + pretty (Functorial s s') = text s <> "$" <> text s' pretty Unnamed{} = mempty instance Pretty LambdaType where pretty Plain{} = "=>" pretty Spear{} = "=>>" - pretty (Full _ v) = "=<" <> string v <> ">" + pretty (Full _ v) = "=<" <> text v <> ">" instance Pretty BinOp where pretty Mult = "*" @@ -123,6 +123,11 @@ prettyBinary op [e, e'] = e <+> op <+> e' prettyBinary _ _ = undefined +lengthAlt :: Doc -> Doc -> Doc +lengthAlt d1 d2 + | length (show d2) >= 40 = d1 <$> indent 4 d2 + | otherwise = d1 <+> d2 + instance Pretty Expression where pretty = cata a . rewriteATS where a (IfF e e' (Just e'')) = "if" <+> e <+> "then" <$> indent 2 e' <$> "else" <$> indent 2 e'' @@ -135,12 +140,12 @@ ("let" <+> pretty ((\(ATS x) -> ATS $ reverse x) e) <$> "in end") a (BoolLitF True) = "true" a (BoolLitF False) = "false" - a (TimeLitF s) = string s + a (TimeLitF s) = text s a (IntLitF i) = pretty i - a (LambdaF _ lt p e) = "lam" <+> pretty p <+> pretty lt <+> e - a (LinearLambdaF _ lt p e) = "llam" <+> pretty p <+> pretty lt <+> e + a (LambdaF _ lt p e) = let pre = "lam" <+> pretty p <+> pretty lt in flatAlt (lengthAlt pre e) (pre <+> e) + a (LinearLambdaF _ lt p e) = let pre = "llam" <+> pretty p <+> pretty lt in flatAlt (lengthAlt pre e) (pre <+> e) a (FloatLitF f) = pretty f - a (StringLitF s) = string s -- FIXME escape indentation in multi-line strings. + a (StringLitF s) = text s -- FIXME escape indentation in multi-line strings. a (ParenExprF _ e) = parens e a (BinListF op@Add es) = prettyBinary (pretty op) es a (BinaryF op e e') @@ -184,8 +189,8 @@ a (BeginF _ e) | not (startsParens e) = linebreak <> indent 2 ("begin" <$> indent 2 e <$> "end") | otherwise = e - a (FixAtF (PreF n s [] [] as t Nothing (Just e))) = "fix@" <+> pretty n <+> prettyArgs as <+> ":" <> pretty s <+> pretty t <+> "=>" pretty e - a (LambdaAtF (PreF Unnamed{} s [] [] as t Nothing (Just e))) = "lam@" <+> prettyArgs as <+> ":" <> pretty s <+> pretty t <+> "=>" pretty e + a (FixAtF (PreF n s [] [] as t Nothing (Just e))) = "fix@" <+> pretty n <+> prettyArgs as <+> ":" <> pretty s <+> pretty t <+> "=>" <$> indent 2 (pretty e) + a (LambdaAtF (PreF Unnamed{} s [] [] as t Nothing (Just e))) = "lam@" <+> prettyArgs as <+> ":" <> pretty s <+> pretty t <+> "=>" <$> indent 2 (pretty e) a (AddrAtF _ e) = "addr@" <> e a (ViewAtF _ e) = "view@" <> e a (ListLiteralF _ s t es) = "list" <> string s <> "{" <> pretty t <> "}" <> prettyArgs es @@ -222,9 +227,10 @@ pretty NoArgs = undefined squish :: BinOp -> Bool -squish Add = True -squish Sub = True -squish _ = False +squish Add = True +squish Sub = True +squish Mult = True +squish _ = False instance Pretty StaticExpression where pretty = cata a where @@ -322,6 +328,7 @@ glue Staload{} Staload{} = True glue Include{} Include{} = True glue ViewTypeDef{} ViewTypeDef{} = True +glue TypeDef{} TypeDef{} = True glue Comment{} _ = True glue (Func _ Fnx{}) (Func _ And{}) = True glue _ _ = False @@ -347,17 +354,17 @@ prettyRecordS :: (Pretty a) => Bool -> [(String, a)] -> Doc prettyRecordS _ [] = mempty -prettyRecordS True [(s, t)] = "@{" <+> string s <+> "=" <+> pretty t <+> "}" -prettyRecordS _ [(s, t)] = "@{" <+> string s <+> "=" <+> pretty t -prettyRecordS True ((s, t):xs) = prettyRecordS False xs <> ("," <+> string s <+> "=" <+> pretty t <+> "}") -prettyRecordS x ((s, t):xs) = prettyRecordS x xs <> ("," <+> string s <+> "=" <+> pretty t) +prettyRecordS True [(s, t)] = "@{" <+> text s <+> "=" <+> pretty t <+> "}" +prettyRecordS _ [(s, t)] = "@{" <+> text s <+> "=" <+> pretty t +prettyRecordS True ((s, t):xs) = prettyRecordS False xs <> ("," <+> text s <+> "=" <+> pretty t <+> "}") +prettyRecordS x ((s, t):xs) = prettyRecordS x xs <> ("," <+> text s <+> "=" <+> pretty t) prettyRecordF :: (Pretty a) => Bool -> [(String, a)] -> Doc prettyRecordF _ [] = mempty -prettyRecordF True [(s, t)] = "@{" <+> string s <+> "=" <+> pretty t <+> "}" -prettyRecordF _ [(s, t)] = "@{" <+> string s <+> "=" <+> pretty t -prettyRecordF True ((s, t):xs) = prettyRecordF False xs $$ indent 1 ("," <+> string s <+> "=" <+> pretty t <$> "}") -prettyRecordF x ((s, t):xs) = prettyRecordF x xs $$ indent 1 ("," <+> string s <+> "=" <+> pretty t) +prettyRecordF True [(s, t)] = "@{" <+> text s <+> "=" <+> pretty t <+> "}" +prettyRecordF _ [(s, t)] = "@{" <+> text s <+> "=" <+> pretty t +prettyRecordF True ((s, t):xs) = prettyRecordF False xs $$ indent 1 ("," <+> text s <+> "=" <+> pretty t <$> "}") +prettyRecordF x ((s, t):xs) = prettyRecordF x xs $$ indent 1 ("," <+> text s <+> "=" <+> pretty t) prettyDL :: [DataPropLeaf] -> Doc prettyDL [] = mempty @@ -375,22 +382,22 @@ prettyLeaf :: [Leaf] -> Doc prettyLeaf [] = mempty -prettyLeaf [Leaf [] s [] Nothing] = indent 2 ("|" <+> string s) -prettyLeaf [Leaf [] s [] (Just e)] = indent 2 ("|" <+> string s <+> "of" <+> pretty e) -prettyLeaf (Leaf [] s [] Nothing:xs) = prettyLeaf xs $$ indent 2 ("|" <+> string s) -prettyLeaf (Leaf [] s [] (Just e):xs) = prettyLeaf xs $$ indent 2 ("|" <+> string s <+> "of" <+> pretty e) -prettyLeaf [Leaf [] s as Nothing] = indent 2 ("|" <+> string s <> prettyArgs as) -prettyLeaf [Leaf [] s as (Just e)] = indent 2 ("|" <+> string s <> prettyArgs as <+> "of" <+> pretty e) -prettyLeaf (Leaf [] s as Nothing:xs) = prettyLeaf xs $$ indent 2 ("|" <+> string s <> prettyArgs as) -prettyLeaf (Leaf [] s as (Just e):xs) = prettyLeaf xs $$ indent 2 ("|" <+> string s <> prettyArgs as <+> "of" <+> pretty e) -prettyLeaf [Leaf us s [] Nothing] = indent 2 ("|" <+> universalHelper us <+> string s) -prettyLeaf [Leaf us s [] (Just e)] = indent 2 ("|" <+> universalHelper us <+> string s <+> "of" <+> pretty e) -prettyLeaf (Leaf us s [] Nothing:xs) = prettyLeaf xs $$ indent 2 ("|" <+> universalHelper us <+> string s) -prettyLeaf (Leaf us s [] (Just e):xs) = prettyLeaf xs $$ indent 2 ("|" <+> universalHelper us <+> string s <+> "of" <+> pretty e) -prettyLeaf [Leaf us s as Nothing] = indent 2 ("|" <+> universalHelper us <+> string s <> prettyArgs as) -prettyLeaf [Leaf us s as (Just e)] = indent 2 ("|" <+> universalHelper us <+> string s <> prettyArgs as <+> "of" <+> pretty e) -prettyLeaf (Leaf us s as Nothing:xs) = prettyLeaf xs $$ indent 2 ("|" <+> universalHelper us <+> string s <> prettyArgs as) -prettyLeaf (Leaf us s as (Just e):xs) = prettyLeaf xs $$ indent 2 ("|" <+> universalHelper us <+> string s <> prettyArgs as <+> "of" <+> pretty e) +prettyLeaf [Leaf [] s [] Nothing] = indent 2 ("|" <+> text s) +prettyLeaf [Leaf [] s [] (Just e)] = indent 2 ("|" <+> text s <+> "of" <+> pretty e) +prettyLeaf (Leaf [] s [] Nothing:xs) = prettyLeaf xs $$ indent 2 ("|" <+> text s) +prettyLeaf (Leaf [] s [] (Just e):xs) = prettyLeaf xs $$ indent 2 ("|" <+> text s <+> "of" <+> pretty e) +prettyLeaf [Leaf [] s as Nothing] = indent 2 ("|" <+> text s <> prettyArgs as) +prettyLeaf [Leaf [] s as (Just e)] = indent 2 ("|" <+> text s <> prettyArgs as <+> "of" <+> pretty e) +prettyLeaf (Leaf [] s as Nothing:xs) = prettyLeaf xs $$ indent 2 ("|" <+> text s <> prettyArgs as) +prettyLeaf (Leaf [] s as (Just e):xs) = prettyLeaf xs $$ indent 2 ("|" <+> text s <> prettyArgs as <+> "of" <+> pretty e) +prettyLeaf [Leaf us s [] Nothing] = indent 2 ("|" <+> universalHelper us <+> text s) +prettyLeaf [Leaf us s [] (Just e)] = indent 2 ("|" <+> universalHelper us <+> text s <+> "of" <+> pretty e) +prettyLeaf (Leaf us s [] Nothing:xs) = prettyLeaf xs $$ indent 2 ("|" <+> universalHelper us <+> text s) +prettyLeaf (Leaf us s [] (Just e):xs) = prettyLeaf xs $$ indent 2 ("|" <+> universalHelper us <+> text s <+> "of" <+> pretty e) +prettyLeaf [Leaf us s as Nothing] = indent 2 ("|" <+> universalHelper us <+> text s <> prettyArgs as) +prettyLeaf [Leaf us s as (Just e)] = indent 2 ("|" <+> universalHelper us <+> text s <> prettyArgs as <+> "of" <+> pretty e) +prettyLeaf (Leaf us s as Nothing:xs) = prettyLeaf xs $$ indent 2 ("|" <+> universalHelper us <+> text s <> prettyArgs as) +prettyLeaf (Leaf us s as (Just e):xs) = prettyLeaf xs $$ indent 2 ("|" <+> universalHelper us <+> text s <> prettyArgs as <+> "of" <+> pretty e) prettyHelper :: Doc -> [Doc] -> [Doc] prettyHelper _ [x] = [x] @@ -426,20 +433,20 @@ fancyU = foldMap pretty . reverse instance Pretty PreFunction where - pretty (PreF i si [] [] [NoArgs] rt Nothing (Just e)) = pretty i <+> ":" <> string 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 <+> ":" <> string si pretty rt <+> "=" <$> indent 2 (pretty e) - pretty (PreF i si [] [] as rt (Just t) (Just e)) = pretty i ".<" <> pretty t <> ">." prettyArgs as <+> ":" <> string 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 <+> ":" <> string si pretty rt <+> "=" <$> indent 2 (pretty e) - pretty (PreF i si [] us [NoArgs] rt Nothing (Just e)) = pretty i fancyU us <+> ":" <> string si pretty rt <+> "=" <$> indent 2 (pretty e) - pretty (PreF i si [] us as rt Nothing (Just e)) = pretty i fancyU us prettyArgs as <+> ":" <> string si pretty rt <+> "=" <$> indent 2 (pretty e) - pretty (PreF i si pus [] as rt Nothing (Just e)) = fancyU pus pretty i <> prettyArgs as <+> ":" <> string 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 <+> ":" <> 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 (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 [] 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 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 [] [] 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 pus us as rt Nothing Nothing) = fancyU pus pretty i fancyU us prettyArgs as <+> ":" <> text si pretty rt pretty _ = undefined instance Pretty DataPropLeaf where @@ -450,17 +457,17 @@ typeHelper rs = lineAlt ("=" <$> indent 2 (prettyRecord rs)) ("=" <+> prettyRecord rs) instance Pretty Declaration where - pretty (AbsType _ s as Nothing) = "abstype" <+> string s <> prettyArgs as - pretty (AbsViewType _ s as Nothing) = "absvtype" <+> string s <> prettyArgs as - 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 <+> typeHelper 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 - pretty (SumType s as ls) = "datatype" <+> string s <> prettyArgs as <+> "=" <$> prettyLeaf ls + pretty (AbsType _ s as Nothing) = "abstype" <+> text s <> prettyArgs as + pretty (AbsViewType _ s as Nothing) = "absvtype" <+> text s <> prettyArgs as + pretty (RecordType s [] [] rs) = "typedef" <+> text s <+> "=" <+> prettyRecord rs + pretty (RecordType s as [] rs) = "typedef" <+> text s <> prettyArgs as <+> "=" <+> prettyRecord rs + pretty (RecordViewType s [] [] rs) = "vtypedef" <+> text s <+> "=" prettyRecord rs + pretty (RecordViewType s as [] rs) = "vtypedef" <+> text s <> prettyArgs as <+> typeHelper rs + pretty (RecordViewType s as us rs) = "vtypedef" <+> text s <> prettyArgs as <+> "=" fancyU us prettyRecord rs + pretty (SumViewType s [] ls) = "datavtype" <+> text s <+> "=" <$> prettyLeaf ls + pretty (SumViewType s as ls) = "datavtype" <+> text s <> prettyArgs as <+> "=" <$> prettyLeaf ls + pretty (SumType s [] ls) = "datatype" <+> text s <+> "=" <$> prettyLeaf ls + pretty (SumType s as ls) = "datatype" <+> text s <> prettyArgs as <+> "=" <$> prettyLeaf ls pretty (Impl [] i) = pretty i pretty (PrVal p e) = "prval" <+> pretty p <+> "=" <+> pretty e pretty (Val a Nothing p e) = "val" <> pretty a <+> pretty p <+> "=" <+> pretty e @@ -474,7 +481,11 @@ 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" <+> string i <+> "with" <+> pretty n + pretty (OverloadIdent _ i n) = "overload" <+> text i <+> "with" <+> 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. + pretty (Define s) = text s pretty (Func _ (Fn pref)) = "fn" pretty pref pretty (Func _ (Fun pref)) = "fun" pretty pref pretty (Func _ (CastFn pref)) = "castfn" pretty pref @@ -484,16 +495,15 @@ pretty (Func _ (PrFun pref)) = "prfun" pretty pref pretty (Func _ (PrFn pref)) = "prfn" 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 - pretty (ViewTypeDef _ s [] t) = "vtypedef" <+> string s <+> "=" pretty t - pretty (ViewTypeDef _ s as t) = "vtypedef" <+> string s <> prettyArgs as <+> "=" pretty t - pretty (TypeDef _ s [] t) = "typedef" <+> string s <+> "=" <+> pretty t - pretty (TypeDef _ s as t) = "typedef" <+> string s <> prettyArgs as <+> "=" <+> pretty t - pretty (AbsProp _ n as) = "absprop" <+> string n <+> prettyArgs as + pretty (DataProp _ s as ls) = "dataprop" <+> text s <> prettyArgs as <+> "=" <$> prettyDL ls + pretty (ViewTypeDef _ s [] t) = "vtypedef" <+> text s <+> "=" pretty t + pretty (ViewTypeDef _ s as t) = "vtypedef" <+> text s <> prettyArgs as <+> "=" pretty t + pretty (TypeDef _ s [] t) = "typedef" <+> text s <+> "=" <+> pretty t + pretty (TypeDef _ s as t) = "typedef" <+> text s <> prettyArgs as <+> "=" <+> pretty t + pretty (AbsProp _ n as) = "absprop" <+> text n <+> prettyArgs as pretty (Assume n as e) = "assume" pretty n <> prettyArgs as <+> "=" pretty e pretty (SymIntr _ n) = "symintr" <+> pretty n pretty (Stacst _ n t Nothing) = "stacst" pretty n <+> ":" pretty t pretty (Stacst _ n t (Just e)) = "stacst" pretty n <+> ":" pretty t <+> "=" pretty e - pretty (PropDef _ s as t) = "propdef" string s <+> prettyArgs as <+> "=" pretty t + pretty (PropDef _ s as t) = "propdef" text s <+> prettyArgs as <+> "=" pretty t pretty _ = undefined 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 @@ -9,9 +9,8 @@ // Existential types for even and odd numbers. These are only usable with the // ATS library. -typedef Even = [ n : nat ] int(2 * n) - -typedef Odd = [ n : nat ] int(2 * n+1) +typedef Even = [ n : nat ] int(2*n) +typedef Odd = [ n : nat ] int(2*n+1) // TODO jacobi symbol // fn legendre(a: int, p: int) : int = diff --git a/test/data/polyglot.dats b/test/data/polyglot.dats --- a/test/data/polyglot.dats +++ b/test/data/polyglot.dats @@ -1112,20 +1112,20 @@ fun help() : void = print("polyglot - Count lines of code quickly. - - \33[36mUSAGE:\33[0m poly [DIRECTORY] ... [OPTION] ... - - \33[36mFLAGS:\33[0m - -V, --version show version information - -h, --help display this help and exit - -e, --exclude exclude a directory - -p, --parallel execute in parallel - -t, --no-table display results in alternate format - - When no directory is provided poly will execute in the - current directory. - - Bug reports and updates: nest.pijul.com/vamchale/polyglot\n" + +\33[36mUSAGE:\33[0m poly [DIRECTORY] ... [OPTION] ... + +\33[36mFLAGS:\33[0m + -V, --version show version information + -h, --help display this help and exit + -e, --exclude exclude a directory + -p, --parallel execute in parallel + -t, --no-table display results in alternate format + +When no directory is provided poly will execute in the +current directory. + +Bug reports and updates: nest.pijul.com/vamchale/polyglot\n" ) fun head(xs : List0(string)) : string = diff --git a/test/data/polyglot.out b/test/data/polyglot.out --- a/test/data/polyglot.out +++ b/test/data/polyglot.out @@ -264,21 +264,18 @@ + maybe_table("Ion", isc.ion) + maybe_table("Java", isc.java) + maybe_table("JavaScript", isc.javascript) + maybe_table( "Julius" , isc.julius - ) + maybe_table("Julia", isc.julia) + maybe_table( "Jupyter" - , isc.jupyter - ) - + maybe_table("Justfile", isc.justfile) + maybe_table( "Kotlin" - , isc.kotlin - ) + maybe_table("LALRPOP", isc.lalrpop) + maybe_table( "Lex" - , isc.lex - ) - + maybe_table("LLVM", isc.llvm) + maybe_table("Lua", isc.lua) - + maybe_table("Lucius", isc.lucius) + maybe_table("M4", isc.m4) - + maybe_table("Madlang", isc.madlang) + maybe_table( "Makefile" - , isc.makefile - ) + maybe_table("Margaret", isc.margaret) + maybe_table( "Markdown" - , isc.markdown - ) + ) + maybe_table("Julia", isc.julia) + + maybe_table("Jupyter", isc.jupyter) + maybe_table( "Justfile" + , isc.justfile + ) + maybe_table("Kotlin", isc.kotlin) + maybe_table( "LALRPOP" + , isc.lalrpop + ) + + maybe_table("Lex", isc.lex) + maybe_table("LLVM", isc.llvm) + + maybe_table("Lua", isc.lua) + maybe_table("Lucius", isc.lucius) + + maybe_table("M4", isc.m4) + maybe_table("Madlang", isc.madlang) + + maybe_table("Makefile", isc.makefile) + maybe_table( "Margaret" + , isc.margaret + ) + maybe_table("Markdown", isc.markdown) + maybe_table("Mercury", isc.mercury) + maybe_table("Nim", isc.nim) + maybe_table("Nix", isc.nix) + maybe_table( "Objective C" , isc.objective_c @@ -310,32 +307,30 @@ , isc.c.lines ) + maybe_string( "C Header" , isc.header.lines - ) + maybe_string( "C++" - , isc.cpp.lines - ) - + maybe_string("C++ Header", isc.cpp_header.lines) + maybe_string( "C#" - , isc.csharp.lines - ) + maybe_string( "COBOL" - , isc.cobol.lines - ) + maybe_string( "Coq" - , isc.coq.lines - ) - + maybe_string("Elixir", isc.elixir.lines) + maybe_string( "Elm" - , isc.elm.lines - ) + maybe_string("Erlang", isc.erlang.lines) - + maybe_string("F#", isc.fsharp.lines) + maybe_string( "Fortran" - , isc.fortran.lines - ) + maybe_string("Go", isc.go.lines) - + maybe_string("Haskell", isc.haskell.lines) + maybe_string( "Idris" - , isc.idris.lines - ) + maybe_string("Kotline", isc.kotlin.lines) - + maybe_string("Java", isc.java.lines) + maybe_string( "Julia" - , isc.julia.lines - ) + maybe_string("Lua", isc.lua.lines) - + maybe_string("Margaret", isc.margaret.lines) + maybe_string( "Mercury" - , isc.mercury.lines - ) + maybe_string("Nim", isc.nim.lines) - + maybe_string("Objective C", isc.objective_c.lines) + ) + + maybe_string("C++", isc.cpp.lines) + maybe_string( "C++ Header" + , isc.cpp_header.lines + ) + maybe_string("C#", isc.csharp.lines) + + maybe_string("COBOL", isc.cobol.lines) + maybe_string( "Coq" + , isc.coq.lines + ) + maybe_string("Elixir", isc.elixir.lines) + + maybe_string("Elm", isc.elm.lines) + maybe_string( "Erlang" + , isc.erlang.lines + ) + maybe_string("F#", isc.fsharp.lines) + + maybe_string("Fortran", isc.fortran.lines) + maybe_string( "Go" + , isc.go.lines + ) + maybe_string("Haskell", isc.haskell.lines) + + maybe_string("Idris", isc.idris.lines) + maybe_string( "Kotline" + , isc.kotlin.lines + ) + maybe_string("Java", isc.java.lines) + + maybe_string("Julia", isc.julia.lines) + maybe_string( "Lua" + , isc.lua.lines + ) + maybe_string("Margaret", isc.margaret.lines) + + maybe_string("Mercury", isc.mercury.lines) + maybe_string( "Nim" + , isc.nim.lines + ) + maybe_string( "Objective C" + , isc.objective_c.lines + ) + maybe_string("OCaml", isc.ocaml.lines) + maybe_string( "Perl" , isc.perl.lines ) + maybe_string("Pony", isc.pony.lines) @@ -354,18 +349,16 @@ + maybe_string("Vimscript", isc.vimscript.lines) ) + with_nonempty( "\n\33[33mDocumentation:\33[0m\n" , maybe_string("Markdown", isc.markdown.lines) - + maybe_string("Plaintext", isc.plaintext.lines) + maybe_string( "TeX" - , isc.tex.lines - ) + + maybe_string("Plaintext", isc.plaintext.lines) + + maybe_string("TeX", isc.tex.lines) ) + with_nonempty( "\n\33[33mConfiguration:\33[0m\n" , maybe_string("Cabal", isc.cabal.lines) + maybe_string( "Cabal Project" , isc.cabal_project.lines ) + maybe_string( "Dhall" , isc.dhall.lines - ) + maybe_string( "iPKG" - , isc.ipkg.lines - ) + ) + + maybe_string("iPKG", isc.ipkg.lines) + maybe_string("TOML", isc.toml.lines) + maybe_string("YAML", isc.yaml.lines) ) + with_nonempty( "\n\33[33mShell:\33[0m\n" @@ -374,9 +367,8 @@ ) + maybe_string( "Batch" , isc.batch.lines - ) + maybe_string( "Ion" - , isc.ion.lines - ) + ) + + maybe_string("Ion", isc.ion.lines) + maybe_string( "PowerShell" , isc.powershell.lines ) @@ -391,19 +383,17 @@ ) + with_nonempty( "\n\33[33mWeb:\33[0m\n" , maybe_string("Cassius", isc.cassius.lines) + maybe_string( "CSS" , isc.css.lines - ) + maybe_string( "Hamlet" - , isc.hamlet.lines - ) - + maybe_string("HTML", isc.html.lines) + maybe_string( "JavaScript" - , isc.javascript.lines - ) + maybe_string( "Julius" - , isc.julius.lines - ) - + maybe_string("Lucius", isc.lucius.lines) + ) + + maybe_string("Hamlet", isc.hamlet.lines) + maybe_string( "HTML" + , isc.html.lines + ) + + maybe_string("JavaScript", isc.javascript.lines) + + maybe_string("Julius", isc.julius.lines) + maybe_string( "Lucius" + , isc.lucius.lines + ) ) + with_nonempty( "\n\33[33mHardware:\33[0m\n" - , maybe_string("Verilog", isc.verilog.lines) + maybe_string( "VHDL" - , isc.vhdl.lines - ) + , maybe_string("Verilog", isc.verilog.lines) + + maybe_string("VHDL", isc.vhdl.lines) ) + with_nonempty( "\n\33[33mNotebooks:\33[0m\n" , maybe_string("Jupyter", isc.jupyter.lines) ) + with_nonempty( "\n\33[33mOther:\33[0m\n" @@ -659,10 +649,8 @@ fun match_keywords { m : nat | m <= 10 } ( keys : list(string, m) , word : string ) : bool = - list_foldright_cloref( keys - , lam (next, acc) = acc || eq_string_string(next, word) - , false - ) + list_foldright_cloref(keys, lam (next, acc) = acc + || eq_string_string(next, word), false) // TODO use list_vt{int}(0, 1, 2, 3, 4) instead? // helper function for check_keywords @@ -704,7 +692,9 @@ ) ) in - if match_keywords(verilog_keywords, word) then + if match_keywords( verilog_keywords + , word + ) then verilog(size) else if let @@ -771,7 +761,8 @@ var viewstream = $EXTRA.streamize_fileref_word(x) val result = stream_vt_foldleft_cloptr( viewstream , init - , lam (acc, next) => step_keyword(size, acc, next, ext) + , lam (acc, next) => + step_keyword(size, acc, next, ext) ) val _ = fileref_close(x) in @@ -1007,13 +998,14 @@ ) : source_contents = let var files = streamize_dirname_fname(s) - var ffiles = stream_vt_filter_cloptr( files - , lam x => not(bad_dir(x, excludes)) - ) + var ffiles = stream_vt_filter_cloptr(files, lam x => not(bad_dir( x + , excludes + ))) in stream_vt_foldleft_cloptr( ffiles , init - , lam (acc, next) => step_stream(acc, s + "/" + next, next, excludes) + , lam (acc, next) => + step_stream(acc, s + "/" + next, next, excludes) ) end @@ -1111,11 +1103,12 @@ ) : source_contents = list_foldleft_cloref( includes , acc - , lam (acc, next) => if test_file_exists(next) || next = "" then - step_stream(acc, next, next, excludes) - else - (prerr("\33[31mError:\33[0m directory '" + next - + "' does not exist\n") ; exit(1) ; acc) + , lam (acc, next) => + if test_file_exists(next) || next = "" then + step_stream(acc, next, next, excludes) + else + (prerr("\33[31mError:\33[0m directory '" + next + + "' does not exist\n") ; exit(1) ; acc) ) fun is_flag(s : string) : bool = @@ -1211,20 +1204,20 @@ fun help() : void = print("polyglot - Count lines of code quickly. - - \33[36mUSAGE:\33[0m poly [DIRECTORY] ... [OPTION] ... - - \33[36mFLAGS:\33[0m - -V, --version show version information - -h, --help display this help and exit - -e, --exclude exclude a directory - -p, --parallel execute in parallel - -t, --no-table display results in alternate format - - When no directory is provided poly will execute in the - current directory. - - Bug reports and updates: nest.pijul.com/vamchale/polyglot\n") + +\33[36mUSAGE:\33[0m poly [DIRECTORY] ... [OPTION] ... + +\33[36mFLAGS:\33[0m + -V, --version show version information + -h, --help display this help and exit + -e, --exclude exclude a directory + -p, --parallel execute in parallel + -t, --no-table display results in alternate format + +When no directory is provided poly will execute in the +current directory. + +Bug reports and updates: nest.pijul.com/vamchale/polyglot\n") fun head(xs : List0(string)) : string = case+ xs of diff --git a/test/data/toml-parse.out b/test/data/toml-parse.out --- a/test/data/toml-parse.out +++ b/test/data/toml-parse.out @@ -32,15 +32,16 @@ let val g = x.modify in - @{ modify = llam c = - begin - let - val (y, z): (cstream, a) = g(c) - val w: b = f(z) - in - (cloptr_free($UN.castvwtp0(f)); cloptr_free($UN.castvwtp0(g)); (y, w)) - end - end } + @{ modify = llam c = + + begin + let + val (y, z): (cstream, a) = g(c) + val w: b = f(z) + in + (cloptr_free($UN.castvwtp0(f)); cloptr_free($UN.castvwtp0(g)); (y, w)) + end + end } end extern @@ -53,16 +54,17 @@ fun chain {a : vtype}{b : vtype} (x : parser(a), y : parser(b)) : parser(b) = - @{ modify = llam c = let - val f = x.modify - val g = y.modify - val (pre_res, _) = f(c) - val (res, y) = g(pre_res) - val _ = cloptr_free($UN.castvwtp0(f)) - val _ = cloptr_free($UN.castvwtp0(g)) - in - (res, y) - end } + @{ modify = llam c = + let + val f = x.modify + val g = y.modify + val (pre_res, _) = f(c) + val (res, y) = g(pre_res) + val _ = cloptr_free($UN.castvwtp0(f)) + val _ = cloptr_free($UN.castvwtp0(g)) + in + (res, y) + end } fun run_parser {a : vtype} (in_stream : cstream, parser : parser(a)) : a =