summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorvmchale <>2018-01-12 19:05:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2018-01-12 19:05:00 (GMT)
commitbe1700ad9567da93ca8ef1825ad444e8cf663ccf (patch)
tree88f3e37a656a1c808a2c5064c035d60937a0c917
parent77cc626c593b312ff34f0849fe2287228e162ba9 (diff)
version 0.1.0.260.1.0.26
-rw-r--r--README.md2
-rw-r--r--ats-format.cabal2
-rw-r--r--src/Language/ATS/Lexer.x2
-rw-r--r--src/Language/ATS/Parser.y105
-rw-r--r--src/Language/ATS/PrettyPrint.hs160
-rw-r--r--test/data/number-theory.out5
-rw-r--r--test/data/polyglot.dats28
-rw-r--r--test/data/polyglot.out175
-rw-r--r--test/data/toml-parse.out40
9 files changed, 264 insertions, 255 deletions
diff --git a/README.md b/README.md
index f4287b7..a8fd8a4 100644
--- a/README.md
+++ b/README.md
@@ -40,7 +40,7 @@ To install, first install [GHC](https://www.haskell.org/ghc/download.html), then
```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
index b26dfe1..886d2f6 100644
--- 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
index 22e94b9..91d7e28 100644
--- a/src/Language/ATS/Lexer.x
+++ b/src/Language/ATS/Lexer.x
@@ -450,6 +450,8 @@ instance Pretty Token where
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
index b01a9b5..5f3bf63 100644
--- a/src/Language/ATS/Parser.y
+++ b/src/Language/ATS/Parser.y
@@ -114,8 +114,8 @@ import Text.PrettyPrint.ANSI.Leijen hiding ((<$>))
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 @@ TypeInExpr : TypeIn { $1 }
-- | 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 @@ Type : Name openParen TypeInExpr closeParen { Dependent $1 $3 }
| 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 : Name openParen TypeInExpr closeParen { Dependent $1 $3 }
| 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 : Arg { [$1] }
| 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 : Pattern { [$1] }
| 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 @@ LambdaArrow : plainArrow { Plain $1 }
-- | 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 @@ Expression : PreExpression { $1 }
| 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 @@ BracketedArgs : lbracket Type rbracket { [$2] }
| 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 @@ Call : Name doubleParens { Call $1 [] [] Nothing [] }
| 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 @@ StaticExpression : Name { StaticVal $1 }
| 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 @@ PreExpression : identifier lsqbracket PreExpression rsqbracket { Index $2 (Unqua
| 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 @@ PreExpression : identifier lsqbracket PreExpression rsqbracket { Index $2 (Unqua
| 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 @@ PreExpression : identifier lsqbracket PreExpression rsqbracket { Index $2 (Unqua
| 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 @@ Implementation : FunName doubleParens eq Expression { Implement $2 [] [] $1 [] $
| 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 @@ Name : identifier { Unqualified $1 }
| 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 @@ FunDecl : fun PreFunction { [ Func $1 (Fun $2) ] }
| 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 @@ Fixity : infixr { RightFix $1 }
| 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 @@ Declaration : include string { Include $2 }
| 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 @@ Declaration : include string { Include $2 }
| 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
index 5ef5478..8a96c87 100644
--- a/src/Language/ATS/PrettyPrint.hs
+++ b/src/Language/ATS/PrettyPrint.hs
@@ -18,7 +18,7 @@ module Language.ATS.PrettyPrint ( printATS
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 @@ printClang = readCreateProcess (shell "clang-format")
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 _ [e] = e
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 @@ instance Pretty Expression where
("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 @@ instance Pretty Expression where
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 @@ instance Pretty Arg where
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 x y
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 @@ prettyRecord es = lineAlt (prettyRecordF True es) (prettyRecordS True es)
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 @@ universalHelper = mconcat . fmap pretty . reverse
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 :: [Universal] -> Doc
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 :: [(String, Type)] -> Doc
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 @@ instance Pretty Declaration where
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 @@ instance Pretty Declaration where
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
index 3195a88..ae32696 100644
--- a/test/data/number-theory.out
+++ b/test/data/number-theory.out
@@ -9,9 +9,8 @@ staload "contrib/atscntrb-hx-intinf/SATS/intinf_vt.sats"
// 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
index 90f4efc..3583cf4 100644
--- a/test/data/polyglot.dats
+++ b/test/data/polyglot.dats
@@ -1112,20 +1112,20 @@ fun version() : void =
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
index 9b80174..73d2928 100644
--- a/test/data/polyglot.out
+++ b/test/data/polyglot.out
@@ -264,21 +264,18 @@ fun make_table(isc : source_contents) : string =
+ 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 @@ fun make_output(isc : source_contents) : string =
, 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 @@ fun make_output(isc : source_contents) : string =
+ 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 @@ fun make_output(isc : source_contents) : string =
)
+ 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 @@ fun make_output(isc : source_contents) : string =
) + 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 free_pl(pl : pl_type) : void =
fun match_keywords { m : nat | m <= 10 } ( keys : list(string, m)
, word : string
) : bool =
- list_foldright_cloref( keys
- , lam (next, acc) =<cloref1> acc || eq_string_string(next, word)
- , false
- )
+ list_foldright_cloref(keys, lam (next, acc) =<cloref1> 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 @@ fun step_keyword( size : file
)
)
in
- if match_keywords(verilog_keywords, word) then
+ if match_keywords( verilog_keywords
+ , word
+ ) then
verilog(size)
else
if let
@@ -771,7 +761,8 @@ fun check_keywords(s : string, size : file, ext : string) : pl_type =
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 @@ and flow_stream( s : string
) : 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 @@ fun map_stream( acc : source_contents
) : 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 version() : void =
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
index d05a829..12f27f8 100644
--- a/test/data/toml-parse.out
+++ b/test/data/toml-parse.out
@@ -32,15 +32,16 @@ parser(b) =
let
val g = x.modify
in
- @{ modify = llam c =<lincloptr1>
- 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 =<lincloptr1>
+
+ 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 pure {a : vtype} (x : a) : parser(a) =
fun chain {a : vtype}{b : vtype} (x : parser(a), y : parser(b)) :
parser(b) =
- @{ modify = llam c =<lincloptr1> 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 =<lincloptr1>
+ 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 =