Skip to content

Commit

Permalink
release
Browse files Browse the repository at this point in the history
  • Loading branch information
Vanessa McHale committed Jul 29, 2018
1 parent 1c8f90d commit 8781a7b
Show file tree
Hide file tree
Showing 15 changed files with 1,411 additions and 54 deletions.
14 changes: 7 additions & 7 deletions README.md
View file
Original file line number Diff line number Diff line change
Expand Up @@ -36,19 +36,19 @@ More to come!
-------------------------------------------------------------------------------
Language Files Lines Code Comments Blanks
-------------------------------------------------------------------------------
Alex 2 766 658 16 92
Alex 2 784 676 16 92
Bash 1 8 6 0 2
Cabal 10 834 790 0 44
Cabal Project 1 34 30 0 4
Dhall 4 478 416 0 62
Happy 1 979 834 34 111
Haskell 52 5232 4257 224 751
Cabal Project 1 35 30 0 5
Dhall 4 518 452 0 66
Happy 1 1009 863 34 112
Haskell 54 5450 4447 220 783
Justfile 1 56 44 0 12
Markdown 23 837 607 0 230
Markdown 23 841 610 0 231
TeX 1 66 46 0 20
TOML 1 3 3 0 0
YAML 4 182 166 0 16
-------------------------------------------------------------------------------
Total 101 9475 7857 274 1344
Total 103 9786 8133 270 1383
-------------------------------------------------------------------------------
```
2 changes: 1 addition & 1 deletion ats-pkg/ats-pkg.cabal
View file
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
cabal-version: 2.0
name: ats-pkg
version: 3.1.0.3
version: 3.1.0.4
license: BSD3
license-file: LICENSE
copyright: Copyright: (c) 2018 Vanessa McHale
Expand Down
2 changes: 1 addition & 1 deletion dependency/dependency.cabal
View file
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
cabal-version: 1.18
name: dependency
version: 1.2.0.1
version: 1.2.0.2
license: BSD3
license-file: LICENSE
copyright: Copyright: (c) 2018 Vanessa McHale
Expand Down
1 change: 0 additions & 1 deletion hs2ats/hs2ats.cabal
View file
Original file line number Diff line number Diff line change
Expand Up @@ -6,7 +6,6 @@ license-file: LICENSE
copyright: Copyright: (c) 2018 Vanessa McHale
maintainer: [email protected]
author: Vanessa McHale
homepage: https://github.com/vmchale/hs2ats#readme
synopsis: Create ATS types from Haskell types
description:
This package enables scanning Haskell source files for data types and then generating [ATS](http://www.ats-lang.org/) types from them.
Expand Down
4 changes: 2 additions & 2 deletions language-ats/src/Language/ATS/Lexer.x
View file
Original file line number Diff line number Diff line change
Expand Up @@ -83,8 +83,8 @@ $br = [\<\>]
@signature = ":<" @inner_signature_mult ">" | ":"
@func_type = "->" | "-<" @inner_signature_mult ">"

@at_brace = \@ ($white | @block_comment)* \{
@at_tuple = \@ ($white | @block_comment)* \(
@at_brace = \@ (@block_comment)* \{
@at_tuple = \@ (@block_comment)* \(

@box_tuple = \' ($white | @block_comment)* \(
@box_record = \' ($white | @block_comment)* \{
Expand Down
29 changes: 19 additions & 10 deletions language-ats/src/Language/ATS/Parser.y
View file
Original file line number Diff line number Diff line change
Expand Up @@ -63,6 +63,7 @@ import Text.PrettyPrint.ANSI.Leijen hiding ((<$>))
%nonassoc mutateEq
%nonassoc maybeProof
%nonassoc prfTransform
%nonassoc raise

%token
fun { Keyword $$ KwFun }
Expand Down Expand Up @@ -290,18 +291,19 @@ Type : Name parens(TypeInExpr) { Dependent $1 $2 }
| Existential { Ex $1 Nothing }
| Universal Type { ForA $1 $2 }
| Type at StaticExpression { AtExpr $2 $1 $3 }
| at Type { AtType $1 $2 }
| at lsqbracket Type rsqbracket lsqbracket StaticExpression rsqbracket { ArrayType $1 $3 $6 }
| atbrace Records rbrace { AnonymousRecord $1 $2 }
| openParen TypeIn vbar Type closeParen { ProofType $1 $2 $4 }
| openParen TypeIn vbar TypeIn closeParen { ProofType $1 $2 $4 }
| identifierSpace identifier { Dependent (Unqualified $ to_string $1) [Named (Unqualified $ to_string $2)] }
| openParen TypeIn closeParen { Tuple $1 (toList $2) }
| openParen TypeIn closeParen lineComment { Tuple $1 (toList $2) }
| boxTuple TypeIn closeParen { BoxTuple $1 $2 }
| boxTuple TypeIn closeParen lineComment { BoxTuple $1 $2 }
| openParen Type closeParen { ParenType $1 $2 }
| openParen TypeIn rbrace {% left $ Expected $3 ")" "}" }
| addr { AddrType $1 }
| doubleParens { Tuple $1 mempty }
| Type where IdentifierOr SortArgs eq Type { WhereType $2 $1 $3 $4 $6 }
| openParen TypeIn rbrace {% left $ Expected $3 ")" "}" }
| dollar {% left $ Expected $1 "Type" "$" }
| identifierSpace identifier openParen {% left $ Expected (token_posn $2) "Static integer expression" (to_string $2) }
| Type identifierSpace {% left $ Expected (token_posn $2) "," (to_string $2) }
Expand All @@ -321,7 +323,7 @@ TypeArg : IdentifierOr { Arg (First $1) }
| exclamation IdentifierOr colon {% left $ OneOf $3 [",", ")"] ":" }

Arg : TypeArg { $1 }
| StaticExpression { Arg (Second (ConcreteType $1)) }
| StaticExpression { Arg (Second (ConcreteType $1)) } -- TODO: have some sort of stop showing bound variables that we can use to disambiguate types vs. static expressions?

-- | Parse a literal
Literal : uintLit { UintLit $1 }
Expand Down Expand Up @@ -441,6 +443,8 @@ StaticDecls : StaticDeclaration { [$1] }
StaticExpression : Name { StaticVal $1 }
| StaticExpression BinOp StaticExpression { StaticBinary $2 $1 $3 }
| intLit { StaticInt $1 }
| hexLit { StaticHex $1 }
| string { SString $1 }
| doubleParens { StaticVoid $1 }
| sif StaticExpression then StaticExpression else StaticExpression { Sif $2 $4 $6 }
| identifierSpace { StaticVal (Unqualified $ to_string $1) }
Expand All @@ -453,6 +457,7 @@ StaticExpression : Name { StaticVal $1 }
| let StaticDecls comment_after(in) end { SLet $1 $2 Nothing }
| let StaticDecls in StaticExpression end { SLet $1 $2 (Just $4) }
| openParen StaticExpression closeParen { $2 }
| openParen lineComment StaticExpression closeParen { $3 }
| case StaticExpression of StaticCase { SCase $1 $2 $4 }

-- | Parse an expression that can be called without parentheses
Expand Down Expand Up @@ -701,7 +706,7 @@ OptType : Signature Type { Just ($1, $2) }
| { Nothing }

-- | Parse a type signature and optional function body
PreFunction : FunName openParen Args closeParen OptType OptExpression { (PreF $1 (fmap fst $5) [] [] (Just $3) (fmap snd $5) Nothing $6) }
PreFunction : FunName openParen Args closeParen OptType OptExpression { PreF $1 (fmap fst $5) [] [] (Just $3) (fmap snd $5) Nothing $6 }
| FunName Universals OptTermetric OptType OptExpression { PreF $1 (fmap fst $4) [] $2 Nothing (fmap snd $4) $3 $5 }
| FunName Universals OptTermetric doubleParens OptType OptExpression { PreF $1 (fmap fst $5) [] $2 (Just []) (fmap snd $5) $3 $6 }
| FunName Universals OptTermetric openParen Args closeParen OptType OptExpression { PreF $1 (fmap fst $7) [] $2 (Just $5) (fmap snd $7) $3 $8 }
Expand All @@ -720,13 +725,15 @@ AndSort : AndSort and IdentifierOr eq Sort { AndD $1 (SortDef $2 $3 (Left $5)) }
| sortdef IdentifierOr eq Sort { SortDef $1 $2 (Left $4) }
| sortdef IdentifierOr eq Universal { SortDef $1 $2 (Right $4) }

StaticDef : eq Type { Right $2 }
StaticDef : eq Type { Right (Nothing, $2) }
| eq StaticExpression MaybeAnnot { Left ($2, $3) }
| colon Type eq StaticExpression { Right (Just $2, ConcreteType $4) } -- FIXME wrong wrong bad!!

MaybeAnnot : colon Sort { Just $2 }
| { Nothing }

AndStadef : stadef IdentifierOr SortArgs StaticDef { Stadef $2 $3 $4 }
| stadef IdentifierOr lineComment SortArgs StaticDef { Stadef $2 $4 $5 }
| stadef Operator SortArgs StaticDef { Stadef $2 $3 $4 }
| AndStadef and IdentifierOr SortArgs StaticDef { AndD $1 (Stadef $3 $4 $5) }
| AndStadef and Operator SortArgs StaticDef { AndD $1 (Stadef $3 $4 $5) }
Expand Down Expand Up @@ -889,6 +896,10 @@ Names : Name { [$1] }
Load : staload { (True, $1) }
| dynload { (False, $1) }

MacroArgs : doubleParens { Just [] }
| openParen IdentifiersIn closeParen { Just $2 }
| { Nothing }

-- | Parse a declaration
Declaration : include string { Include $2 }
| define { Define $1 }
Expand All @@ -898,10 +909,8 @@ Declaration : include string { Include $2 }
| define identifierSpace intLit { Define ($1 ++ " " ++ to_string $2 ++ " " ++ show $3) }
| cblock { CBlock $1 }
| datasort identifierSpace eq DataSortLeaves { DataSort $1 (to_string $2) $4 }
| macdef IdentifierOr doubleParens eq Expression { MacDecl $1 $2 [] $5 }
| macdef customOperator doubleParens eq Expression { MacDecl $1 (to_string $2) [] $5 }
| macdef IdentifierOr openParen IdentifiersIn closeParen eq Expression { MacDecl $1 $2 $4 $7 }
| macdef customOperator openParen IdentifiersIn closeParen eq Expression { MacDecl $1 (to_string $2) $4 $7 }
| macdef IdentifierOr MacroArgs eq Expression { MacDecl $1 $2 $3 $5 }
| macdef customOperator MacroArgs eq Expression { MacDecl $1 (to_string $2) $3 $5 }
| lineComment { Comment (to_string $1) }
| Comment { $1 }
| Load underscore eq string { Load (fst $1) (get_staload $ snd $1) (Just "_") $4 }
Expand Down
34 changes: 20 additions & 14 deletions language-ats/src/Language/ATS/PrettyPrint.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -260,6 +260,7 @@ instance Eq a => Pretty (StaticExpression a) where
| squish op = se <> pretty op <> se'
| otherwise = se <+> pretty op <+> se'
a (StaticIntF i) = pretty i
a (StaticHexF h) = text h
a StaticVoidF{} = "()"
a (SifF e e' e'') = "sif" <+> e <+> "then" <$> indent 2 e' <$> "else" <$> indent 2 e''
a (SCallF n cs) = pretty n <> parens (mconcat (punctuate "," . fmap pretty $ cs))
Expand All @@ -269,6 +270,7 @@ instance Eq a => Pretty (StaticExpression a) where
("let" <$> indent 2 (pretty e) <$> endLet e')
("let" <+> pretty e <$> endLet e')
a (SCaseF ad e sls) = "case" <> pretty ad <+> e <+> "of" <$> indent 2 (prettyCases sls)
a (SStringF s) = text s

instance Eq a => Pretty (Sort a) where
pretty = cata a where
Expand Down Expand Up @@ -298,9 +300,9 @@ instance Eq a => Pretty (Type a) where
a (FromVTF t) = t <> "?!"
a (MaybeValF t) = t <> "?"
a (AtExprF _ t t') = t <+> "@" <+> pretty t'
a (AtTypeF _ t) = "@" <> t
a (ProofTypeF _ t t') = parens (pre' `op` "|" <+> t')
where pre' = prettyArgsG mempty mempty (toList t)
a (ArrayTypeF _ t n) = "@[" <> t <> "][" <> pretty n <> "]"
a (ProofTypeF _ t t') = parens (pre' `op` "|" <+> prettyArgsG mempty mempty t')
where pre' = prettyArgsG mempty mempty t
op = bool (<+>) (<>) ('\n' `elem` showFast pre')
a (ConcreteTypeF e) = pretty e
a (TupleF _ ts) = parens (mconcat (punctuate ", " (fmap pretty (reverse ts))))
Expand All @@ -312,6 +314,7 @@ instance Eq a => Pretty (Type a) where
a (AnonymousRecordF _ rs) = prettyRecord rs
a (ParenTypeF _ t) = parens t
a (WhereTypeF _ t i sa t') = t <#> indent 2 ("where" </> pretty i <+> prettySortArgs sa <+> "=" <+> pretty t')
a AddrTypeF{} = "addr"

gan :: Eq a => Maybe (Sort a) -> Doc
gan (Just t) = " : " <> pretty t <> " "
Expand Down Expand Up @@ -473,23 +476,23 @@ prettyBody :: Doc -> Doc -> [Doc] -> Doc
prettyBody c1 c2 [d] = c1 <> d <> c2
prettyBody c1 c2 ds = (c1 <>) . align . indent (-1) . cat . (<> pure c2) $ ds

prettyArgsG' :: Doc -> Doc -> Doc -> [Doc] -> Doc
prettyArgsG' c3 c1 c2 = prettyBody c1 c2 . prettyHelper c3 . reverse
prettyArgsG' :: Foldable t => Doc -> Doc -> Doc -> t Doc -> Doc
prettyArgsG' c3 c1 c2 = prettyBody c1 c2 . prettyHelper c3 . reverse . toList

prettyArgsList :: Doc -> Doc -> Doc -> [Doc] -> Doc
prettyArgsList c3 c1 c2 = prettyBody c1 c2 . va . prettyHelper c3
prettyArgsList :: Foldable t => Doc -> Doc -> Doc -> t Doc -> Doc
prettyArgsList c3 c1 c2 = prettyBody c1 c2 . va . prettyHelper c3 . toList
where va = (& _tail.traverse %~ group)

prettyArgsG :: Doc -> Doc -> [Doc] -> Doc
prettyArgsG :: Foldable t => Doc -> Doc -> t Doc -> Doc
prettyArgsG = prettyArgsG' ", "

prettyArgsU :: (Pretty a) => Doc -> Doc -> [a] -> Doc
prettyArgsU :: (Pretty a, Foldable f, Functor f) => Doc -> Doc -> f a -> Doc
prettyArgsU = prettyArgs' ","

prettyArgs' :: (Pretty a) => Doc -> Doc -> Doc -> [a] -> Doc
prettyArgs' :: (Pretty a, Functor f, Foldable f) => Doc -> Doc -> Doc -> f a -> Doc
prettyArgs' = fmap pretty -.*** prettyArgsG'

prettyArgs :: (Pretty a) => [a] -> Doc
prettyArgs :: (Pretty a, Foldable f, Functor f) => f a -> Doc
prettyArgs = prettyArgs' ", " "(" ")"

prettyArgsNil :: Eq a => Maybe [Arg a] -> Doc
Expand Down Expand Up @@ -622,9 +625,11 @@ instance Eq a => Pretty (Declaration a) where
pretty (Local _ d d') = "local" <$> indent 2 (pretty d) <$> "in" <$> indent 2 (pretty d') <$> "end"
pretty (FixityDecl f ss) = pretty f <+> hsep (fmap text ss)
pretty (StaVal us i t) = "val" </> mconcat (fmap pretty us) <+> text i <+> ":" <+> pretty t
pretty (Stadef i as (Right t)) = "stadef" <+> text i <+> prettySortArgs as <+> "=" <+> pretty t
pretty (Stadef i as (Right (Nothing, t))) = "stadef" <+> text i <+> prettySortArgs as <+> "=" <+> pretty t
pretty (Stadef i as (Right (Just ty, t))) = "stadef" <+> text i <+> prettySortArgs as <+> ":" <+> pretty ty <+> "=" <+> pretty t
pretty (Stadef i as (Left (se, mt))) = "stadef" <+> text i <+> prettySortArgs as <+> "=" <+> pretty se <> maybeT mt
pretty (AndD d (Stadef i as (Right t))) = pretty d <+> "and" <+> text i <+> prettySortArgs as <+> "=" <+> pretty t
pretty (AndD d (Stadef i as (Right (Nothing, t)))) = pretty d <+> "and" <+> text i <+> prettySortArgs as <+> "=" <+> pretty t
pretty (AndD d (Stadef i as (Right (Just ty, t)))) = pretty d <+> "and" <+> text i <+> prettySortArgs as <+> ":" <+> pretty ty <+> "=" <+> pretty t
pretty (AndD d (Stadef i as (Left (se, mt)))) = pretty d <+> "and" <+> text i <+> prettySortArgs as <+> "=" <+> pretty se <> maybeT mt
pretty (AbsView _ i as t) = "absview" <+> text i <> prettySortArgs as <> prettyMaybeType t
pretty (AbsVT0p _ i as t) = "absvt@ype" <+> text i <> prettySortArgs as <> prettyMaybeType t
Expand All @@ -634,7 +639,8 @@ instance Eq a => Pretty (Declaration a) where
pretty (TKind _ n s) = pretty n <+> "=" <+> text s
pretty (SortDef _ s t) = "sortdef" <+> text s <+> "=" <+> either pretty pretty t
pretty (AndD d (SortDef _ i t)) = pretty d <+> "and" <+> text i <+> "=" <+> either pretty pretty t
pretty (MacDecl _ n is e) = "macdef" <+> text n <> "(" <> mconcat (punctuate ", " (fmap text is)) <> ") =" <+> pretty e
pretty (MacDecl _ n (Just is) e) = "macdef" <+> text n <> "(" <> mconcat (punctuate ", " (fmap text is)) <> ") =" <+> pretty e
pretty (MacDecl _ n Nothing e) = "macdef" <+> text n <+> "=" <+> pretty e
pretty (ExtVar _ s e) = "extvar" <+> text s <+> "=" <+> pretty e
pretty (AbsImpl _ n as e) = "absimpl" </> pretty n <> prettySortArgs as <+> "=" </> pretty e
pretty AndD{} = undefined -- probably not valid syntax if we get to this point
Loading

0 comments on commit 8781a7b

Please sign in to comment.