Merge branch 'master' into add-php

Author: joshvera

.travis.yml

@@ -37,6 +37,7 @@ script:
 - cabal new-build
 - cabal new-run semantic:test
 - cabal new-run semantic-core:spec
+- cabal new-run semantic-core:doctest
 # parse-examples is disabled because it slaughters our CI
 # - cabal new-run semantic:parse-examples
 

cabal.project

@@ -1,4 +1,4 @@
-packages: . semantic-core
+packages: . semantic-core semantic-python
 
 jobs: $ncpus
 

semantic-core/semantic-core.cabal

@@ -3,16 +3,17 @@ cabal-version:       2.4
 name:                semantic-core
 version:             0.0.0.0
 synopsis:            Semantic core intermediate language
--- description:
-homepage:            https://github.com/github/semantic-core
--- bug-reports:
+description:         Core intermediate language for program analysis using abstract definitional interpretation.
+homepage:            https://github.com/github/semantic/tree/master/semantic-core#readme
+bug-reports:         https://github.com/github/semantic/issues
 license:             MIT
 license-file:        LICENSE
-author:              Rob Rix
-maintainer:          robrix@github.com
--- copyright:
+author:              The Semantic authors
+maintainer:          opensource+semantic@github.com
+copyright:           (c) 2019 GitHub, Inc.
 category:            Language
 build-type:          Simple
+stability:           alpha
 extra-source-files:  README.md
 
 tested-with:         GHC == 8.6.4
@@ -46,14 +47,24 @@ library
                      , prettyprinter-ansi-terminal ^>= 1.1.1
                      , recursion-schemes           ^>= 5.1
                      , semigroupoids               ^>= 5.3
+                     , text                        ^>= 1.2.3.1
                      , transformers                ^>= 0.5.6
                      , trifecta                    ^>= 2
                      , unordered-containers        ^>= 0.2.10
   hs-source-dirs:      src
   default-language:    Haskell2010
-  ghc-options:         -Weverything -Wno-missing-local-signatures -Wno-missing-import-lists -Wno-implicit-prelude -Wno-safe -Wno-unsafe -Wno-name-shadowing -Wno-monomorphism-restriction -Wno-missed-specialisations -Wno-all-missed-specialisations
-  if (impl(ghc >= 8.6))
-    ghc-options:       -Wno-star-is-type
+  ghc-options:
+    -Weverything
+    -Wno-missing-local-signatures
+    -Wno-missing-import-lists
+    -Wno-implicit-prelude
+    -Wno-safe
+    -Wno-unsafe
+    -Wno-name-shadowing
+    -Wno-monomorphism-restriction
+    -Wno-missed-specialisations
+    -Wno-all-missed-specialisations
+    -Wno-star-is-type
 
 test-suite doctest
   type:                exitcode-stdio-1.0

semantic-core/src/Analysis/Concrete.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE FlexibleContexts, FlexibleInstances, LambdaCase, MultiParamTypeClasses, NamedFieldPuns, RecordWildCards, TypeOperators, UndecidableInstances #-}
+{-# LANGUAGE FlexibleContexts, FlexibleInstances, LambdaCase, MultiParamTypeClasses, NamedFieldPuns, OverloadedStrings, RecordWildCards, TypeOperators, UndecidableInstances #-}
 module Analysis.Concrete
 ( Concrete(..)
 , concrete
@@ -29,6 +29,7 @@ import           Data.Loc
 import qualified Data.Map as Map
 import           Data.Monoid (Alt(..))
 import           Data.Name
+import           Data.Text (Text, pack)
 import           Prelude hiding (fail)
 
 type Precise = Int
@@ -41,7 +42,7 @@ data Concrete
   = Closure Loc Name Core.Core Precise
   | Unit
   | Bool Bool
-  | String String
+  | String Text
   | Obj Frame
   deriving (Eq, Ord, Show)
 
@@ -60,7 +61,7 @@ type Heap = IntMap.IntMap Concrete
 
 -- | Concrete evaluation of a term to a value.
 --
---   >>> snd (concrete [File (Loc "bool" emptySpan) (Core.Bool True)])
+--   >>> map fileBody (snd (concrete [File (Loc "bool" emptySpan) (Core.Bool True)]))
 --   [Right (Bool True)]
 concrete :: [File Core.Core] -> (Heap, [File (Either (Loc, String) Concrete)])
 concrete
@@ -184,28 +185,32 @@ heapValueGraph h = heapGraph (const id) (const fromAddr) h
 heapAddressGraph :: Heap -> G.Graph (EdgeType, Precise)
 heapAddressGraph = heapGraph (\ addr v -> (Value v, addr)) (fmap G.vertex . (,) . either Edge Slot)
 
-addressStyle :: Heap -> G.Style (EdgeType, Precise) String
+addressStyle :: Heap -> G.Style (EdgeType, Precise) Text
 addressStyle heap = (G.defaultStyle vertex) { G.edgeAttributes }
-  where vertex (_, addr) = maybe (show addr <> " = ?") (((show addr <> " = ") <>) . fromConcrete) (IntMap.lookup addr heap)
+  where vertex (_, addr) = pack (show addr) <> " = " <> maybe "?" fromConcrete (IntMap.lookup addr heap)
         edgeAttributes _ (Slot name,         _) = ["label" G.:= fromName name]
         edgeAttributes _ (Edge Core.Import,  _) = ["color" G.:= "blue"]
         edgeAttributes _ (Edge Core.Lexical, _) = ["color" G.:= "green"]
         edgeAttributes _ _                      = []
         fromConcrete = \case
           Unit ->  "()"
-          Bool b -> show b
-          String s -> show s
+          Bool b -> pack $ show b
+          String s -> pack $ show s
           Closure (Loc p (Span s e)) n _ _ -> "\\\\ " <> fromName n <> " [" <> p <> ":" <> showPos s <> "-" <> showPos e <> "]"
           Obj _ -> "{}"
-        showPos (Pos l c) = show l <> ":" <> show c
+        showPos (Pos l c) = pack (show l) <> ":" <> pack (show c)
         fromName (User s)  = s
         fromName (Gen sym) = fromGensym sym
-        fromName (Path p)  = show p
+        fromName (Path p)  = pack $ show p
         fromGensym (Root s) = s
-        fromGensym (ss :/ (s, i)) = fromGensym ss <> "." <> s <> show i
+        fromGensym (ss :/ (s, i)) = fromGensym ss <> "." <> s <> pack (show i)
 
 data EdgeType
   = Edge Core.Edge
   | Slot Name
   | Value Concrete
   deriving (Eq, Ord, Show)
+
+
+-- $setup
+-- >>> :seti -XOverloadedStrings

semantic-core/src/Analysis/Eval.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE FlexibleContexts, LambdaCase, RankNTypes, RecordWildCards #-}
+{-# LANGUAGE FlexibleContexts, LambdaCase, OverloadedStrings, RankNTypes, RecordWildCards #-}
 module Analysis.Eval
 ( eval
 , prog1
@@ -21,6 +21,7 @@ import Data.Functor
 import Data.Loc
 import Data.Maybe (fromJust)
 import Data.Name
+import Data.Text (Text)
 import GHC.Stack
 import Prelude hiding (fail)
 
@@ -207,8 +208,8 @@ data Analysis address value m = Analysis
   , unit        :: m value
   , bool        :: Bool -> m value
   , asBool      :: value -> m Bool
-  , string      :: String -> m value -- FIXME: Text
-  , asString    :: value -> m String
+  , string      :: Text -> m value
+  , asString    :: value -> m Text
   , frame       :: m value
   , edge        :: Edge -> address -> m ()
   , (...)       :: forall a . address -> m a -> m a

semantic-core/src/Analysis/FlowInsensitive.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE FlexibleContexts, ScopedTypeVariables #-}
+{-# LANGUAGE FlexibleContexts, OverloadedStrings, ScopedTypeVariables #-}
 module Analysis.FlowInsensitive
 ( Heap
 , FrameId(..)

semantic-core/src/Analysis/ImportGraph.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE FlexibleContexts, RecordWildCards #-}
+{-# LANGUAGE FlexibleContexts, OverloadedStrings, RecordWildCards #-}
 module Analysis.ImportGraph
 ( ImportGraph
 , importGraph
@@ -22,9 +22,10 @@ import           Data.Loc
 import qualified Data.Map as Map
 import           Data.Name
 import qualified Data.Set as Set
+import           Data.Text (Text)
 import           Prelude hiding (fail)
 
-type ImportGraph = Map.Map FilePath (Set.Set FilePath)
+type ImportGraph = Map.Map Text (Set.Set Text)
 
 data Value = Value
   { valueSemi  :: Semi
@@ -41,7 +42,7 @@ instance Monoid Value where
 data Semi
   = Closure Loc Name Core.Core Name
   -- FIXME: Bound String values.
-  | String String
+  | String Text
   | Abstract
   deriving (Eq, Ord, Show)
 
@@ -98,7 +99,7 @@ importGraphAnalysis = Analysis{..}
         asBool _ = pure True <|> pure False
         string s = pure (Value (String s) mempty)
         asString (Value (String s) _) = pure s
-        asString _ = pure ""
+        asString _ = pure mempty
         frame = pure mempty
         edge Core.Import (Path to) = do
           Loc{locPath=from} <- ask

semantic-core/src/Analysis/Typecheck.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveFunctor, FlexibleContexts, FlexibleInstances, LambdaCase, RecordWildCards, ScopedTypeVariables, TypeApplications #-}
+{-# LANGUAGE DeriveFunctor, FlexibleContexts, FlexibleInstances, LambdaCase, OverloadedStrings, RecordWildCards, ScopedTypeVariables, TypeApplications #-}
 module Analysis.Typecheck
 ( Monotype (..)
 , Meta
@@ -160,7 +160,7 @@ typecheckingAnalysis = Analysis{..}
         bool _ = pure MBool
         asBool b = unify MBool b >> pure True <|> pure False
         string _ = pure MString
-        asString s = unify MString s $> ""
+        asString s = unify MString s $> mempty
         frame = fail "unimplemented"
         edge _ _ = pure ()
         _ ... m = m

semantic-core/src/Data/Core.hs

@@ -20,6 +20,7 @@ import           Data.Foldable (foldl')
 import           Data.Loc
 import           Data.Name
 import           Data.Stack
+import           Data.Text (Text)
 import           GHC.Stack
 
 data Edge = Lexical | Import
@@ -36,7 +37,7 @@ data Core
   | Unit
   | Bool Bool
   | If Core Core Core
-  | String String -- FIXME: Text
+  | String Text
   -- | Load the specified file (by path).
   | Load Core
   | Edge Edge Core

semantic-core/src/Data/Core/Parser.hs

@@ -14,6 +14,7 @@ import           Data.Core
 import           Data.Name
 import           Data.Semigroup
 import           Data.String
+import           Data.Text (pack)
 import qualified Text.Parser.Token as Token
 import qualified Text.Parser.Token.Highlight as Highlight
 import           Text.Trifecta hiding (ident)
@@ -94,7 +95,7 @@ lvalue = choice
 name :: (TokenParsing m, Monad m) => m Name
 name = choice [regular, strpath] <?> "name" where
   regular = User <$> identifier
-  strpath = Path <$> between (symbolic '"') (symbolic '"') (some $ noneOf "\"")
+  strpath = Path . pack <$> between (symbolic '"') (symbolic '"') (some $ noneOf "\"")
 
 lit :: (TokenParsing m, Monad m) => m Core
 lit = let x `given` n = x <$ reserved n in choice
@@ -112,4 +113,3 @@ lambda = Lam <$ lambduh <*> name <* arrow <*> core <?> "lambda" where
 
 ident :: (Monad m, TokenParsing m) => m Core
 ident = Var <$> name <?> "identifier"
-