8000 Merge branch 'main' into SamB-patch-1 · github/semantic@36c6eae · GitHub
[go: up one dir, main page]
Skip to content
This repository was archived by the owner on Apr 1, 2025. It is now read-only.

Commit 36c6eae

Browse files
robrixrobrix
authored
Merge branch 'main' into SamB-patch-1
2 parents c0f11bf + 3baf0b4 commit 36c6eae

File tree

11 files changed

+283
-245
lines changed

11 files changed

+283
-245
lines changed

‎.github/workflows/haskell.yml

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -46,6 +46,7 @@ jobs:
4646
run: |
4747
cabal v2-update
4848
cabal v2-configure --project-file=cabal.project.ci --disable-optimization --enable-tests --write-ghc-environment-files=always -j2
49+
cd semantic-source && cabal v2-configure --project-file=cabal.project.ci --disable-optimization --enable-tests --write-ghc-environment-files=always -j2
4950
5051
- name: Restore from cache
5152
run: ./cabal-cache sync-from-archive --threads=2 --archive-uri=dist-cache || true

‎semantic-analysis/cabal.project

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -2,3 +2,4 @@
22

33
-- Local packages
44
packages: .
5+
../semantic-source

‎semantic-analysis/script/ghci-flags

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -64,9 +64,9 @@ function flags {
6464
echo "-Wno-name-shadowing"
6565
echo "-Wno-safe"
6666
echo "-Wno-unsafe"
67-
[[ "$ghc_version" = 8.8.* ]] || [[ "$ghc_version" = 8.10.* ]] || [[ "$ghc_version" = 9.2.* ]] && echo "-Wno-missing-deriving-strategies" || true
68-
[[ "$ghc_version" = 8.10.* ]] || [[ "$ghc_version" = 9.2.* ]] && echo "-Wno-missing-safe-haskell-mode" && echo "-Wno-prepositive-qualified-module" && echo "-Wno-unused-packages" || true
69-
[[ "$ghc_version" = 9.2.* ]] && echo "-Wno-missing-kind-signatures" || true
67+
[[ "$ghc_version" = 9.4.* ]] || [[ "$ghc_version" = 8.8.* ]] || [[ "$ghc_version" = 8.10.* ]] || [[ "$ghc_version" = 9.2.* ]] && echo "-Wno-missing-deriving-strategies" || true
68+
[[ "$ghc_version" = 9.4.* ]] || [[ "$ghc_version" = 8.10.* ]] || [[ "$ghc_version" = 9.2.* ]] && echo "-Wno-missing-safe-haskell-mode" && echo "-Wno-prepositive-qualified-module" && echo "-Wno-unused-packages" || true
69+
[[ "$ghc_version" = 9.4.* ]] || [[ "$ghc_version" = 9.2.* ]] && echo "-Wno-missing-kind-signatures" || true
7070
}
7171

7272
flags > "$output_file"

‎semantic-analysis/semantic-analysis.cabal

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -48,6 +48,7 @@ library
4848
hs-source-dirs: src
4949
exposed-modules:
5050
Analysis.Analysis.Concrete
51+
Analysis.Analysis.DeadCode
5152
Analysis.Analysis.Exception
5253
Analysis.Analysis.Typecheck
5354
Analysis.Blob
@@ -68,15 +69,15 @@ library
6869
Analysis.Project
6970
Analysis.Reference
7071
Analysis.Syntax
72+
Analysis.Syntax.Python
73+
Analysis.VM
7174
build-depends:
7275
, aeson >= 1.4 && < 3
7376
, base >= 4.13 && < 5
74-
, bytestring >= 0.10.8.2 && < 0.13
7577
, containers ^>= 0.6
7678
, filepath
7779
, fused-effects ^>= 1.1
7880
, hashable
7981
, semantic-source ^>= 0.2
8082
, text ^>= 1.2.3.1
8183
, transformers ^>= 0.5
82-
, vector ^>= 0.12.3

‎semantic-analysis/src/Analysis/Analysis/DeadCode.hs

Lines changed: 120 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,120 @@
1+
{-# LANGUAGE FlexibleContexts #-}
2+
{-# LANGUAGE FlexibleInstances #-}
3+
{-# LANGUAGE GADTs #-}
4+
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
5+
{-# LANGUAGE MultiParamTypeClasses #-}
6+
{-# LANGUAGE RankNTypes #-}
7+
{-# LANGUAGE TypeApplications #-}
8+
{-# LANGUAGE TypeOperators #-}
9+
{-# LANGUAGE UndecidableInstances #-}
10+
module Analysis.Analysis.DeadCode
11+
( deadCodeFlowInsensitive
12+
) where
13+
14+
import Analysis.Carrier.Fail.WithLoc
15+
import qualified Analysis.Carrier.Statement.State as A
16+
import qualified Analysis.Carrier.Store.Monovariant as A
17+
import Analysis.Effect.Domain as A
18+
import Analysis.File
19+
import Analysis.FlowInsensitive
20+
import Analysis.Reference
21+
import Control.Applicative (Alternative (..))
22+
import Control.Carrier.Fresh.Church
23+
import Control.Carrier.Reader
24+
import Control.Carrier.State.Church
25+
import Control.Effect.Labelled
26+
import Control.Monad (zipWithM_)
27+
import Control.Monad.Trans.Class
28+
import Data.Function (fix)
29+
import qualified Data.Set as Set
30+
31+
deadCodeFlowInsensitive
32+
:: Ord term
33+
=> (forall sig m
34+
. (Has (A.Dom Unit) sig m, Has (A.Env A.MAddr) sig m, Has (Reader Reference) sig m, Has A.Statement sig m, HasLabelled A.Store (A.Store A.MAddr Unit) sig m, MonadFail m)
35+
=> (term -> m Unit)
36+
-> (term -> m Unit)
37+
)
38+
-> (term -> Set.Set term)
39+
-> [File term]
40+
-> ( Set.Set term
41+
, A.MStore Unit
42+
, [File (Either (Reference, String) (Set.Set Unit))]
43+
)
44+
deadCodeFlowInsensitive eval subterms
45+
= run
46+
. runState (\ dead (store, files) -> pure (dead, store, files)) Set.empty
47+
. evalFresh 0
48+
. A.runStoreState
49+
. traverse (runFile eval subterms)
50+
51+
runFile
52+
:: ( Has Fresh sig m
53+
, Has (State (A.MStore Unit)) sig m
54+
, Has (State (Set.Set term)) sig m
55+
, Ord term
56+
)
57+
=> (forall sig m
58+
. (Has (A.Dom Unit) sig m, Has (A.Env A.MAddr) sig m, Has (Reader Reference) sig m, Has A.Statement sig m, HasLabelled A.Store (A.Store A.MAddr Unit) sig m, MonadFail m)
59+
=> (term -> m Unit)
60+
-> (term -> m Unit)
61+
)
62+
-> (term -> Set.Set term)
63+
-> File term
64+
-> m (File (Either (Reference, String) (Set.Set Unit)))
65+
runFile eval subterms file = traverse run file
66+
where run term = do
67+
modify (<> subterms term)
68+
A.runStatement (const pure)
69+
. runReader (fileRef file)
70+
. A.runEnv @Unit
71+
. runFail
72+
. convergeTerm (A.runStore @Unit . runDomain . fix (cacheTerm . evalDead))
73+
$ term
74+
evalDead eval' subterm = do
75+
modify (Set.delete subterm)
76+
eval eval' subterm
77+
78+
79+
data Unit = Unit
80+
deriving (Eq, Ord, Show)
81+
82+
83+
newtype DomainC m a = DomainC { runDomain :: m a }
84+
deriving (Alternative, Applicative, Functor, Monad, MonadFail)
85+
86+
instance MonadTrans DomainC where
87+
lift = DomainC
88+
89+
90+
instance ( Alternative m
91+
, Has (A.Env A.MAddr) sig m
92+
, Has Fresh sig m
93+
, HasLabelled A.Store (A.Store A.MAddr Unit) sig m
94+
, MonadFail m
95+
)
96+
=> Algebra (A.Dom Unit :+: sig) (DomainC m) where
97+
alg hdl sig ctx = case sig of
98+
L (DVar _) -> pure (Unit <$ ctx)
99+
100+
L (DInt _) -> pure (Unit <$ ctx)
101+
102+
L DUnit -> pure (Unit <$ ctx)
103+
104+
L (DBool _) -> pure (Unit <$ ctx)
105+
L (DIf _ t e) -> hdl (t <$ ctx) <|> hdl (e <$ ctx)
106+
107+
L (DString _) -> pure (Unit <$ ctx)
108+
109+
L (DAbs n b) -> do
110+
addrs <- traverse A.alloc n
111+
let args = Unit <$ n
112+
zipWithM_ (A..=) addrs args
113+
hdl (b args <$ ctx)
114+
L (DApp _ _) -> pure (Unit <$ ctx)
115+
116+
L (_ :>>> t) -> pure (t <$ ctx)
117+
118+
L (DDie msg) -> fail (show msg)
119+
120+
R other -> DomainC (alg (runDomain . hdl) other ctx)

‎semantic-analysis/src/Analysis/Name.hs

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,4 @@
11
{-# LANGUAGE FlexibleContexts #-}
2-
{-# LANGUAGE OverloadedStrings #-}
32
module Analysis.Name
43
( Name
54
-- * Constructors

0 commit comments

Comments
 (0)
0