language-ats 1.7.0.1 → 1.7.0.2
raw patch · 6 files changed
+62/−38 lines, 6 filesdep +recursiondep −recursion-schemesPVP: minor bump suggested
API additions: PVP suggests at least a minor version bump
Dependencies added: recursion
Dependencies removed: recursion-schemes
API changes (from Hackage documentation)
+ Language.ATS: LinearLambdaAt :: a -> (StackFunction a) -> Expression a
Files
- CHANGELOG.md +10/−0
- language-ats.cabal +6/−6
- src/Language/ATS/Parser.y +1/−0
- src/Language/ATS/PrettyPrint.hs +15/−7
- src/Language/ATS/Rewrite.hs +1/−1
- src/Language/ATS/Types.hs +29/−24
CHANGELOG.md view
@@ -1,5 +1,15 @@ # language-ats +## 1.7.0.2++Bug fixes:+ + * Support `llam@` keyword++Enhancements:+ + * Use `recursion` library to incur fewer dependencies + ## 1.7.0.0 Bug Fixes:
language-ats.cabal view
@@ -1,12 +1,12 @@ cabal-version: 1.18 name: language-ats-version: 1.7.0.1+version: 1.7.0.2 license: BSD3 license-file: LICENSE copyright: Copyright: (c) 2018 Vanessa McHale maintainer: vamchale@gmail.com author: Vanessa McHale-stability: experimental+stability: stable synopsis: Parser and pretty-printer for ATS. description: Parser and pretty-printer for [ATS](http://www.ats-lang.org/), written with Happy and Alex.@@ -47,14 +47,14 @@ Language.ATS.Rewrite default-language: Haskell2010 other-extensions: OverloadedStrings DeriveGeneric DeriveAnyClass- FlexibleContexts FlexibleInstances PatternSynonyms- StandaloneDeriving GeneralizedNewtypeDeriving DerivingStrategies- DuplicateRecordFields DeriveFunctor TypeFamilies+ FlexibleContexts PatternSynonyms StandaloneDeriving+ GeneralizedNewtypeDeriving DerivingStrategies DuplicateRecordFields+ DeriveFunctor ScopedTypeVariables ghc-options: -Wall -O2 build-depends: base >=4.9 && <5, array -any,- recursion-schemes >=5.0.1,+ recursion -any, microlens -any, deepseq -any, ansi-wl-pprint >=0.6.8,
src/Language/ATS/Parser.y view
@@ -945,6 +945,7 @@ | var Pattern colon Type { Var (Just $4) $2 Nothing Nothing } | var Pattern eq fixAt IdentifierOr StackFunction { Var Nothing $2 (Just $ FixAt $4 $5 $6) Nothing } | var Pattern eq lamAt StackFunction { Var Nothing $2 (Just $ LambdaAt $4 $5) Nothing }+ | var Pattern eq llamAt StackFunction { Var Nothing $2 (Just $ LinearLambdaAt $4 $5) Nothing } | implement FunArgs Implementation { Impl $2 $3 } | StaticDeclaration { $1 } | overload doubleSqBrackets with IdentifierOr { OverloadIdent $1 "[]" (Unqualified $4) Nothing }
src/Language/ATS/PrettyPrint.hs view
@@ -1,11 +1,10 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} -{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving #-} module Language.ATS.PrettyPrint ( printATS , printATSCustom@@ -13,9 +12,9 @@ ) where import Control.Composition hiding ((&))+import Control.Recursion (cata) import Data.Bool (bool) import Data.Foldable (toList)-import Data.Functor.Foldable (cata) import Data.List (isPrefixOf) import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.List.NonEmpty as NE@@ -128,6 +127,7 @@ instance Eq a => Pretty (Expression a) where pretty = cata a where+ a :: Eq a => ExpressionF a Doc -> Doc a (IfF e e' (Just e'')) = "if" <+> e <+> "then" <$> indent 2 e' <$> "else" <$> indent 2 e'' a (IfF e e' Nothing) = "if" <+> e <+> "then" <$> indent 2 e' a (LetF _ e e') = flatAlt@@ -152,9 +152,12 @@ a (CallF nam [] [] Nothing []) = pretty nam <> "()" a (CallF nam [] [] e xs) = pretty nam <> prettyArgsProof e xs a (CallF nam [] us Nothing []) = pretty nam <> prettyTypes us+ a (CallF nam [] us Nothing ["()"]) = pretty nam <> prettyTypes us <> "()" a (CallF nam [] us e xs) = pretty nam <> prettyTypes us <> prettyArgsProof e xs a (CallF nam is [] Nothing []) = pretty nam <> prettyImplicits is+ a (CallF nam is [] Nothing ["()"]) = pretty nam <> prettyImplicits is <> "()" a (CallF nam is [] e xs) = pretty nam <> prettyImplicits is <> prettyArgsProof e xs+ a (CallF nam is us Nothing ["()"]) = pretty nam <> prettyImplicits is <> prettyTypes us <> "()" a (CallF nam is us e xs) = pretty nam <> prettyImplicits is <> prettyTypes us <> prettyArgsProof e xs a (CaseF _ add' e cs) = "case" <> pretty add' <+> e <+> "of" <$> indent 2 (prettyCases cs) a (IfCaseF _ cs) = "ifcase" <$> indent 2 (prettyIfCase cs)@@ -189,6 +192,7 @@ | otherwise = e a (FixAtF _ n (StackF s as t e)) = "fix@" <+> text n <+> prettyArgs as <+> ":" <> pretty s <+> pretty t <+> "=>" <$> indent 2 (pretty e) a (LambdaAtF _ (StackF s as t e)) = "lam@" <+> prettyArgs as <+> ":" <> pretty s <+> pretty t <+> "=>" <$> indent 2 (pretty e)+ a (LinearLambdaAtF _ (StackF s as t e)) = "llam@" <+> 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@@ -213,6 +217,7 @@ instance Eq a => Pretty (Pattern a) where pretty = cata a where+ a :: Eq a => PatternF a Doc -> Doc a (PSumF s x) = string s <+> x a (PLiteralF e) = pretty e a (PNameF s []) = pretty s@@ -266,6 +271,7 @@ instance Eq a => Pretty (StaticExpression a) where pretty = cata a where+ a :: Eq a => StaticExpressionF a Doc -> Doc a (StaticValF n) = pretty n a (StaticBinaryF op se se') | squish op = se <> pretty op <> se'@@ -292,6 +298,7 @@ instance Eq a => Pretty (Sort a) where pretty = cata a where+ a :: Eq a => SortF a Doc -> Doc a (T0pF ad) = "t@ype" <> pretty ad a (Vt0pF ad) = "vt@ype" <> pretty ad a (NamedSortF s) = text s@@ -303,6 +310,7 @@ instance Eq a => Pretty (Type a) where pretty = cata a where+ a :: Eq a => TypeF a Doc -> Doc a (NamedF n) = pretty n a (ViewTypeF _ t) = "view@" <> parens t a (ExF e (Just t))
src/Language/ATS/Rewrite.hs view
@@ -6,8 +6,8 @@ ) where import Control.Composition+import Control.Recursion import Data.Function (on)-import Data.Functor.Foldable import qualified Data.Map as M import Data.Maybe (isJust) import Language.ATS.Types
src/Language/ATS/Types.hs view
@@ -1,12 +1,13 @@ {-# OPTIONS_GHC -fno-warn-duplicate-exports #-}+ {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE PatternSynonyms #-}-{-# LANGUAGE TypeFamilies #-} -- | This is a module containing types to model the ATS syntax tree. As it is -- collapsed by the pretty printer, you may see that in some places it is@@ -49,14 +50,14 @@ , FixityState ) where -import Control.DeepSeq (NFData)-import Data.Function (on)-import Data.Functor.Foldable hiding (Fix (..))-import Data.List.NonEmpty (NonEmpty)-import qualified Data.Map as M-import Data.Semigroup (Semigroup)-import GHC.Generics (Generic)-import Language.ATS.Lexer (Addendum (..))+import Control.DeepSeq (NFData)+import Control.Recursion hiding (Fix (..))+import Data.Function (on)+import Data.List.NonEmpty (NonEmpty)+import qualified Data.Map as M+import Data.Semigroup (Semigroup)+import GHC.Generics (Generic)+import Language.ATS.Lexer (Addendum (..)) type Fix = Either Int String @@ -181,9 +182,9 @@ | AddrTypeF a deriving (Functor) -type instance Base (Type a) = TypeF a+instance Base (Type a) (TypeF b) -instance Recursive (Type a) where+instance Recursive (TypeF a) (Type a) where project (Tuple x tys) = TupleF x tys project (BoxTuple x tys) = BoxTupleF x tys project (Named n) = NamedF n@@ -253,9 +254,9 @@ | BinPatternF a (BinOp a) x x deriving (Functor) -type instance Base (Pattern a) = PatternF a+instance Base (Pattern a) (PatternF b) -instance Recursive (Pattern a) where+instance Recursive (PatternF a) (Pattern a) where project (PName x ps) = PNameF x ps project (PSum x p) = PSumF x p project (PLiteral e) = PLiteralF e@@ -305,9 +306,9 @@ | ArrowSortF a x x deriving (Functor) -type instance Base (Sort a) = SortF a+instance Base (Sort a) (SortF b) -instance Recursive (Sort a) where+instance Recursive (SortF a) (Sort a) where project (NamedSort s) = NamedSortF s project (T0p a) = T0pF a project (Vt0p a) = Vt0pF a@@ -368,8 +369,8 @@ | SCase Addendum (StaticExpression a) [(Pattern a, LambdaType a, StaticExpression a)] | SString String -- ^ @ext#@ | Witness a (StaticExpression a) (StaticExpression a) -- ^ @#[ m | () ]@- | ProofLambda a (LambdaType a) (Pattern a) (StaticExpression a) -- TODO: are linear proof-level lambdas allowed?- | ProofLinearLambda a (LambdaType a) (Pattern a) (StaticExpression a) -- TODO: are linear proof-level lambdas allowed?+ | ProofLambda a (LambdaType a) (Pattern a) (StaticExpression a)+ | ProofLinearLambda a (LambdaType a) (Pattern a) (StaticExpression a) | WhereStaExp (StaticExpression a) (ATS a) deriving (Show, Eq, Generic, NFData) @@ -391,9 +392,9 @@ | WhereStaExpF x (ATS a) deriving (Functor) -type instance Base (StaticExpression a) = StaticExpressionF a+instance Base (StaticExpression a) (StaticExpressionF b) -instance Recursive (StaticExpression a) where+instance Recursive (StaticExpressionF a) (StaticExpression a) where project (StaticVal n) = StaticValF n project (StaticBinary b x x') = StaticBinaryF b x x' project (StaticHex h) = StaticHexF h@@ -411,7 +412,7 @@ project (ProofLinearLambda a l p e) = ProofLinearLambdaF a l p e project (WhereStaExp e ds) = WhereStaExpF e ds -instance Corecursive (StaticExpression a) where+instance Corecursive (StaticExpressionF a) (StaticExpression a) where embed (StaticValF n) = StaticVal n embed (StaticBinaryF b e e') = StaticBinary b e e' embed (StaticHexF h) = StaticHex h@@ -449,7 +450,7 @@ | IntLit Int | HexLit String | UnderscoreLit a- | Lambda a (LambdaType a) (Pattern a) (Expression a)+ | Lambda a (LambdaType a) (Pattern a) (Expression a) -- TODO: Fix | LinearLambda a (LambdaType a) (Pattern a) (Expression a) | Index a (Name a) (Expression a) -- ^ E.g. @array[0]@. | Access a (Expression a) (Name a)@@ -485,6 +486,7 @@ | PrecedeList { _exprs :: [Expression a] } | FixAt a String (StackFunction a) | LambdaAt a (StackFunction a)+ | LinearLambdaAt a (StackFunction a) | ParenExpr a (Expression a) | CommentExpr String (Expression a) | MacroVar a String@@ -531,14 +533,15 @@ | PrecedeListF [x] | FixAtF a String (StackFunction a) | LambdaAtF a (StackFunction a)+ | LinearLambdaAtF a (StackFunction a) | ParenExprF a x | CommentExprF String x | MacroVarF a String deriving (Functor) -type instance Base (Expression a) = ExpressionF a+instance Base (Expression a) (ExpressionF b) -instance Recursive (Expression a) where+instance Recursive (ExpressionF a) (Expression a) where project (Let l ds me) = LetF l ds me project (VoidLiteral l) = VoidLiteralF l project (Call n is us mps as) = CallF n is us mps as@@ -580,11 +583,12 @@ project (PrecedeList es) = PrecedeListF es project (FixAt a s sfun) = FixAtF a s sfun project (LambdaAt a sfun) = LambdaAtF a sfun+ project (LinearLambdaAt a sfun) = LinearLambdaAtF a sfun project (ParenExpr l e) = ParenExprF l e project (CommentExpr s e) = CommentExprF s e project (MacroVar l s) = MacroVarF l s -instance Corecursive (Expression a) where+instance Corecursive (ExpressionF a) (Expression a) where embed (LetF l ds me) = Let l ds me embed (VoidLiteralF l) = VoidLiteral l embed (CallF n is us mps as) = Call n is us mps as@@ -626,6 +630,7 @@ embed (PrecedeListF es) = PrecedeList es embed (FixAtF a s sfun) = FixAt a s sfun embed (LambdaAtF a sfun) = LambdaAt a sfun+ embed (LinearLambdaAtF a sfun) = LinearLambdaAt a sfun embed (ParenExprF l e) = ParenExpr l e embed (CommentExprF s e) = CommentExpr s e embed (MacroVarF l s) = MacroVar l s