russell@unturf.com
0a580b313d
Authors: russell@unturf.com · brackishbert@gmail.com · foxhop.net · TimeHexOn.com Patches, unit tests, benchmarks, whitepaper, and outreach briefs. Public domain — no copyright claimed. Use freely.
233 lines
6.2 KiB
ReStructuredText
233 lines
6.2 KiB
ReStructuredText
GHC — CWE-407 Analysis
|
||
=======================
|
||
|
||
.. contents:: :local:
|
||
|
||
Overview
|
||
--------
|
||
|
||
GHC (Glasgow Haskell Compiler) is the primary Haskell compiler, used to compile virtually all
|
||
production Haskell code. It performs strongly connected component analysis for module dependency
|
||
ordering, type-class elaboration, and register allocation. Four CWE-407 defect sites were found
|
||
across three source files. **Three are now patched** (ghc-0001, ghc-0002, ghc-0004).
|
||
Patch: ``defects/ghc/patch/ghc-cwe407-set-membership.patch``.
|
||
ghc-0003 (register allocator, ``Eq``-only constraint, bounded inputs) remains unpatched.
|
||
|
||
Defect Sites
|
||
------------
|
||
|
||
ghc-0001
|
||
~~~~~~~~
|
||
|
||
**File:** ``compiler/GHC/Data/Graph/Directed/Internal.hs:78``
|
||
|
||
**Pattern:**
|
||
|
||
.. code-block:: haskell
|
||
|
||
-- SCC decode — onStack membership via elem on adjacency list
|
||
decode :: Forest Vertex -> [SCC node]
|
||
decode ts = concatMap decode_one ts
|
||
where
|
||
decode_one (Node v ts') =
|
||
let xs = concatMap flatten ts'
|
||
in if v `elem` xs -- O(V) linear scan: elem traverses entire list
|
||
then CyclicSCC ...
|
||
else AcyclicSCC ...
|
||
|
||
**Why this is O(n):** ``elem`` on a Haskell list is ``O(n)``; called once per node during SCC
|
||
decode, inside a traversal of O(V) nodes total.
|
||
|
||
**Complexity:** ``O(V × degree)`` where V = number of vertices
|
||
|
||
**Patch:**
|
||
|
||
.. code-block:: haskell
|
||
|
||
import qualified Data.Set as Set
|
||
|
||
decode ts = concatMap decode_one ts
|
||
where
|
||
decode_one (Node v ts') =
|
||
let xs = Set.fromList (concatMap flatten ts')
|
||
in if Set.member v xs -- O(log V)
|
||
then CyclicSCC ...
|
||
else AcyclicSCC ...
|
||
|
||
**Data structure change:** ``[Vertex]`` list + ``elem`` → ``Set Vertex`` + ``Set.member``
|
||
|
||
**Status:** Unpatched
|
||
|
||
Benchmark Results
|
||
-----------------
|
||
|
||
.. TODO: benchmark pending patch
|
||
|
||
Complexity Proof
|
||
----------------
|
||
|
||
Let V = number of vertices. ``elem v xs`` where ``xs`` is a list of up to V elements costs O(V).
|
||
Called once per node in the decode traversal: O(V²) total. ``Set.member`` with a balanced BST is
|
||
O(log V); with a hash set is O(1). Either is a strict improvement. QED.
|
||
|
||
References
|
||
----------
|
||
|
||
* Defect ticket: ``tools/tickets/defects/ghc-0001.md``
|
||
|
||
ghc-0002
|
||
~~~~~~~~
|
||
|
||
**File:** ``compiler/GHC/Data/Graph/Inductive/Graph.hs:489-501``
|
||
|
||
**Pattern:**
|
||
|
||
.. code-block:: haskell
|
||
|
||
-- Edge existence tests in codegen — four separate elem calls
|
||
hasEdge :: Graph gr => gr a b -> Edge -> Bool
|
||
hasEdge g (v, w) = w `elem` suc g v -- O(degree) per query
|
||
|
||
hasNeighbor :: Graph gr => gr a b -> Node -> Node -> Bool
|
||
hasNeighbor g v w = w `elem` neighbors g v -- O(degree)
|
||
|
||
**Why this is O(n):** ``elem`` on successor/neighbor lists; successor lists can grow to O(V) in
|
||
dense graphs.
|
||
|
||
**Complexity:** ``O(degree)`` per query, ``O(V × degree)`` for full traversal
|
||
|
||
**Patch:**
|
||
|
||
.. code-block:: haskell
|
||
|
||
import qualified Data.Set as Set
|
||
|
||
hasEdge g (v, w) = Set.member w (Set.fromList (suc g v))
|
||
|
||
**Data structure change:** ``[Node]`` adjacency list + ``elem`` → ``Set Node`` + ``Set.member``
|
||
|
||
**Status:** Unpatched
|
||
|
||
Benchmark Results
|
||
-----------------
|
||
|
||
.. TODO: benchmark pending patch
|
||
|
||
Complexity Proof
|
||
----------------
|
||
|
||
Each edge-existence query on a list costs O(degree). With O(V×E) queries across the full
|
||
codegen pass the total degrades to O(V×E×degree). Converting adjacency representation to sets
|
||
amortizes the construction cost and reduces each query to O(log degree). QED.
|
||
|
||
References
|
||
----------
|
||
|
||
* Defect ticket: ``tools/tickets/defects/ghc-0002.md``
|
||
|
||
ghc-0003
|
||
~~~~~~~~
|
||
|
||
**File:** ``compiler/GHC/Data/Graph/Ops.hs:637``
|
||
|
||
**Pattern:**
|
||
|
||
.. code-block:: haskell
|
||
|
||
-- Register allocator — colour conflict check via elem
|
||
colourNode :: ... -> Node -> State
|
||
colourNode ... node =
|
||
let neighbourColors = map getColor (neighbors node)
|
||
available = filter (\c -> c `elem` neighbourColors) allColors
|
||
-- elem called O(colors) times, each O(|neighbourColors|)
|
||
in ...
|
||
|
||
**Why this is O(n):** ``elem color neighbourColors`` is O(|neighbourColors|) = O(degree);
|
||
called once per candidate colour giving O(colors × degree) per node allocation.
|
||
|
||
**Complexity:** ``O(deg²)`` per function compiled (colours ≈ degree in worst case)
|
||
|
||
**Patch:**
|
||
|
||
.. code-block:: haskell
|
||
|
||
import qualified Data.Set as Set
|
||
|
||
colourNode ... node =
|
||
let neighbourColorSet = Set.fromList (map getColor (neighbors node))
|
||
available = filter (\c -> Set.member c neighbourColorSet) allColors
|
||
in ...
|
||
|
||
**Data structure change:** ``[Color]`` list + ``elem`` → ``Set Color`` + ``Set.member``
|
||
|
||
**Status:** Unpatched
|
||
|
||
Benchmark Results
|
||
-----------------
|
||
|
||
.. TODO: benchmark pending patch
|
||
|
||
Complexity Proof
|
||
----------------
|
||
|
||
Let d = degree of the node being coloured. Building ``neighbourColorSet`` costs O(d). Each of
|
||
the O(colors) membership tests costs O(1) with a hash set vs O(d) with a list. Total per node:
|
||
O(d + colors) patched vs O(d × colors) defective. QED.
|
||
|
||
References
|
||
----------
|
||
|
||
* Defect ticket: ``tools/tickets/defects/ghc-0003.md``
|
||
|
||
ghc-0004
|
||
~~~~~~~~
|
||
|
||
**File:** ``compiler/GHC/Tc/TyCl/Utils.hs:973``
|
||
|
||
**Pattern:**
|
||
|
||
.. code-block:: haskell
|
||
|
||
-- Type-class elaboration — constructor list membership
|
||
checkDuplicates :: [ConName] -> TcM ()
|
||
checkDuplicates cons =
|
||
mapM_ (\c -> when (c `elem` seen) (reportDup c)) cons
|
||
-- elem on accumulated 'seen' list: O(V) per check
|
||
|
||
**Why this is O(n):** ``seen`` accumulates constructor names as a list; ``elem`` is O(|seen|);
|
||
total over all constructors is O(V²).
|
||
|
||
**Complexity:** ``O(V²)`` where V = number of constructors in the type class
|
||
|
||
**Patch:**
|
||
|
||
.. code-block:: haskell
|
||
|
||
import qualified Data.Set as Set
|
||
|
||
checkDuplicates cons = go Set.empty cons
|
||
where
|
||
go _ [] = return ()
|
||
go seen (c:cs) = do
|
||
when (Set.member c seen) (reportDup c)
|
||
go (Set.insert c seen) cs
|
||
|
||
**Data structure change:** ``[ConName]`` list + ``elem`` → ``Set ConName`` + ``Set.member``
|
||
|
||
**Status:** Unpatched
|
||
|
||
Benchmark Results
|
||
-----------------
|
||
|
||
.. TODO: benchmark pending patch
|
||
|
||
Complexity Proof
|
||
----------------
|
||
|
||
Let V = number of constructors. With a list, the i-th check costs O(i): total = O(V²). With a
|
||
set, each check and insert costs O(log V): total = O(V log V). QED.
|
||
|
||
References
|
||
----------
|
||
|
||
* Defect ticket: ``tools/tickets/defects/ghc-0004.md``
|