Skip to content

GitLab

  • Projects
  • Groups
  • Snippets
  • Help
    • Loading...
  • Help
    • Help
    • Support
    • Community forum
    • Submit feedback
  • Sign in / Register
GHC
GHC
  • Project overview
    • Project overview
    • Details
    • Activity
    • Releases
  • Repository
    • Repository
    • Files
    • Commits
    • Branches
    • Tags
    • Contributors
    • Graph
    • Compare
    • Locked Files
  • Issues 4,262
    • Issues 4,262
    • List
    • Boards
    • Labels
    • Service Desk
    • Milestones
    • Iterations
  • Merge Requests 419
    • Merge Requests 419
  • Requirements
    • Requirements
    • List
  • CI / CD
    • CI / CD
    • Pipelines
    • Jobs
    • Schedules
  • Security & Compliance
    • Security & Compliance
    • Dependency List
    • License Compliance
  • Operations
    • Operations
    • Incidents
    • Environments
  • Analytics
    • Analytics
    • CI / CD
    • Code Review
    • Insights
    • Issue
    • Repository
    • Value Stream
  • Wiki
    • Wiki
  • Snippets
    • Snippets
  • Members
    • Members
  • Collapse sidebar
  • Activity
  • Graph
  • Create a new issue
  • Jobs
  • Commits
  • Issue Boards
  • Glasgow Haskell Compiler
  • GHCGHC
  • Wiki
    • Safe roles
  • pre78 gnd

Last edited by dterei Apr 30, 2015
Page history New page

pre78 gnd

GND Pre-GHC-7.8

We will ignore the type-safety issues as they have been resolved, instead we'll just look at the module boundary / abstraction issues.

In GHC 7.6 or earlier, assume a library author writes the following MinList data type:

module MinList (
        MinList, newMinList, insertMinList,
    ) where

data MinList a = MinList a [a] deriving (Show)

newMinList :: Ord a => a -> MinList a
newMinList n = MinList n []

insertMinList :: Ord a => MinList a -> a -> MinList a
insertMinList s@(MinList m xs) n | n > m     = MinList m (n:xs)
                                 | otherwise = s

The MinList data type has an invariant (that depends on the Ord typeclass for the type parameter a that MinList is instantiated at) that after initialization it doesn't accept any element less than the initial element.

In GHC 7.6 and earlier, we could use GND to violate this invariant:

{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Main where

import MinList

class IntIso t where
    intIso :: c t -> c Int

instance IntIso Int where
    intIso = id

newtype Down a = Down a deriving (Eq, IntIso)

instance Ord a => Ord (Down a) where
    compare (Down a) (Down b) = compare b a

fine :: MinList (Down Int)
fine = foldl (\x y -> insertMinList x $ Down y) (newMinList $ Down 0) [-1,-2,-3,-4,1,2,3,4]

unsafeCast :: MinList (Down Int) -> MinList Int
unsafeCast = intIso

bad :: MinList Int
bad = unsafeCast fine

main = do
    print bad

Essentially, through GND we have created the function unsafeCast :: MinList (Down Int) -> MinList Int. This is a function we can't write by hand since we don't have access to the MinList constructor and so can't "see" into the data type.

Safe Haskell Pre-GHC-7.8

Due to both the type-safety and abstraction issues, GND was considered unsafe in Safe Haskell.

Clone repository

GHC Home
GHC User's Guide

Joining In

Newcomers info
Mailing Lists & IRC
The GHC Team

Documentation

GHC Status Info
Working conventions
Building Guide
Debugging
Commentary

Wiki

Title Index
Recent Changes