ats-format 0.1.0.25 → 0.1.0.26
raw patch · 9 files changed
+264/−255 lines, 9 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- README.md +1/−1
- ats-format.cabal +1/−1
- src/Language/ATS/Lexer.x +2/−0
- src/Language/ATS/Parser.y +54/−51
- src/Language/ATS/PrettyPrint.hs +85/−75
- test/data/number-theory.out +2/−3
- test/data/polyglot.dats +14/−14
- test/data/polyglot.out +84/−91
- test/data/toml-parse.out +21/−19
README.md view
@@ -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
ats-format.cabal view
@@ -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
src/Language/ATS/Lexer.x view
@@ -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
src/Language/ATS/Parser.y view
@@ -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
src/Language/ATS/PrettyPrint.hs view
@@ -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
test/data/number-theory.out view
@@ -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 =
test/data/polyglot.dats view
@@ -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 =
test/data/polyglot.out view
@@ -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) =<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 @@ ) ) 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
test/data/toml-parse.out view
@@ -32,15 +32,16 @@ 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 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 =