From c4c92053de1c980f9ba4abc53969db15e237057e Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Thu, 31 May 2018 00:10:45 -0400 Subject: [PATCH] cleanup --- src/Analysis/IdentifierName.hs | 59 ------------------------------- src/Assigning/Assignment.hs | 2 ++ src/Control/Abstract/Primitive.hs | 5 ++- src/Language/Go/Syntax.hs | 4 +-- 4 files changed, 6 insertions(+), 64 deletions(-) delete mode 100644 src/Analysis/IdentifierName.hs diff --git a/src/Analysis/IdentifierName.hs b/src/Analysis/IdentifierName.hs deleted file mode 100644 index a0fddbbe7..000000000 --- a/src/Analysis/IdentifierName.hs +++ /dev/null @@ -1,59 +0,0 @@ -{-# LANGUAGE ScopedTypeVariables, TypeFamilies, TypeOperators, UndecidableInstances #-} -module Analysis.IdentifierName -( IdentifierName(..) -, IdentifierLabel(..) -, identifierLabel -) where - -import Data.Abstract.Name (unName) -import Data.Aeson -import Data.JSON.Fields -import Data.Sum -import qualified Data.Syntax -import Data.Term -import Prologue - --- | Compute a 'IdentifierLabel' label for a 'Term'. -identifierLabel :: IdentifierName syntax => TermF syntax a b -> Maybe IdentifierLabel -identifierLabel (In _ s) = IdentifierLabel <$> identifierName s - -newtype IdentifierLabel = IdentifierLabel Text - deriving (Show) - -instance ToJSONFields IdentifierLabel where - toJSONFields (IdentifierLabel s) = [ "name" .= s ] - - --- | A typeclass to retrieve the name of syntax identifiers. --- --- This typeclass employs the Advanced Overlap techniques designed by Oleg Kiselyov & Simon Peyton Jones: https://wiki.haskell.org/GHC/AdvancedOverlap; see also src/Analysis/Declaration.hs for discussion of the details of the mechanism. -class IdentifierName syntax where - identifierName :: syntax a -> Maybe Text - -instance (IdentifierNameStrategy syntax ~ strategy, IdentifierNameWithStrategy strategy syntax) => IdentifierName syntax where - identifierName = identifierNameWithStrategy (Proxy :: Proxy strategy) - -class CustomIdentifierName syntax where - customIdentifierName :: syntax a -> Maybe Text - -instance Apply IdentifierName fs => CustomIdentifierName (Sum fs) where - customIdentifierName = apply @IdentifierName identifierName - -instance CustomIdentifierName Data.Syntax.Identifier where - customIdentifierName (Data.Syntax.Identifier name) = Just (unName name) - -data Strategy = Default | Custom - -type family IdentifierNameStrategy syntax where - IdentifierNameStrategy (Sum _) = 'Custom - IdentifierNameStrategy Data.Syntax.Identifier = 'Custom - IdentifierNameStrategy syntax = 'Default - -class IdentifierNameWithStrategy (strategy :: Strategy) syntax where - identifierNameWithStrategy :: proxy strategy -> syntax a -> Maybe Text - -instance IdentifierNameWithStrategy 'Default syntax where - identifierNameWithStrategy _ _ = Nothing - -instance (CustomIdentifierName syntax) => IdentifierNameWithStrategy 'Custom syntax where - identifierNameWithStrategy _ = customIdentifierName diff --git a/src/Assigning/Assignment.hs b/src/Assigning/Assignment.hs index b55267b10..4d83a6b5c 100644 --- a/src/Assigning/Assignment.hs +++ b/src/Assigning/Assignment.hs @@ -167,6 +167,8 @@ symbol s = tracing (Choose (Table.singleton s location) Nothing Nothing) `Then` rawSource :: HasCallStack => Assignment ast grammar ByteString rawSource = tracing Source `Then` return +-- | A rule to produce a node's source as Text. Fails if the node's source +-- can't be parsed as UTF-8. source :: HasCallStack => Assignment ast grammar Text source = rawSource >>= \b -> case decodeUtf8' b of Right t -> pure t diff --git a/src/Control/Abstract/Primitive.hs b/src/Control/Abstract/Primitive.hs index b07778884..75db05e8e 100644 --- a/src/Control/Abstract/Primitive.hs +++ b/src/Control/Abstract/Primitive.hs @@ -1,7 +1,5 @@ module Control.Abstract.Primitive where -import Prologue - import Control.Abstract.Addressable import Control.Abstract.Context import Control.Abstract.Environment @@ -11,7 +9,8 @@ import Control.Abstract.Value import Data.Abstract.Name import Data.Semigroup.Reducer hiding (unit) import Data.Semilattice.Lower -import qualified Data.Text as T +import Data.Text (pack, unpack) +import Prologue builtin :: ( HasCallStack , Member (Allocator address value) effects diff --git a/src/Language/Go/Syntax.hs b/src/Language/Go/Syntax.hs index 447389f79..edb8f3ec1 100644 --- a/src/Language/Go/Syntax.hs +++ b/src/Language/Go/Syntax.hs @@ -41,7 +41,7 @@ resolveGoImport (ImportPath path Relative) = do paths <- listModulesInDir (joinPaths (takeDirectory modulePath) path) case paths of [] -> throwResumable $ GoImportError path - _ -> pure paths + _ -> pure paths resolveGoImport (ImportPath path NonRelative) = do package <- T.unpack . unName . Package.packageName <$> currentPackage trace ("attempting to resolve " <> show path <> " for package " <> package) @@ -50,7 +50,7 @@ resolveGoImport (ImportPath path NonRelative) = do -- First two are source, next is package name, remaining are path to package -- (e.g. github.com/golang//path...). (_ : _ : p : xs) | p == package -> listModulesInDir (joinPath xs) - _ -> throwResumable $ GoImportError path + _ -> throwResumable $ GoImportError path -- | Import declarations (symbols are added directly to the calling environment). --