Skip to content

Commit e15ba96

Browse files
committed
document Fst/SndParam safety, fix erroneous instcs
I wrote an erroneous SecondParameter instance for a literal that would always fail at runtime. Along with fixing that, I swapped out an unsafe orphan instance derived for `Value` (since it apparently only saved on writing a couple more lines). I tried putting the safety check in the generic derivation, but I couldn't get it to work. Copying from generic-lens works, but it has to do too much work, and bumps Language.Fortran.AST compilation time x4 and memory usage to x3 - way too much. So instead, I've noted their behaviour in the respective module.
1 parent 41d3e2b commit e15ba96

File tree

5 files changed

+56
-12
lines changed

5 files changed

+56
-12
lines changed
Lines changed: 13 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -1,15 +1,23 @@
11
module Language.Fortran.AST.Literal where
22

33
import Language.Fortran.AST.Common ( Name )
4-
import Language.Fortran.Util.Position ( SrcSpan )
4+
import Language.Fortran.Util.Position ( SrcSpan, Spanned )
5+
import Language.Fortran.Util.FirstParameter ( FirstParameter )
6+
import Language.Fortran.Util.SecondParameter ( SecondParameter )
7+
import Language.Fortran.AST.Annotated ( Annotated )
58

6-
import GHC.Generics ( Generic )
7-
import Data.Data ( Data, Typeable )
8-
import Control.DeepSeq ( NFData )
9-
import Text.PrettyPrint.GenericPretty ( Out )
9+
import GHC.Generics ( Generic )
10+
import Data.Data ( Data, Typeable )
11+
import Control.DeepSeq ( NFData )
12+
import Text.PrettyPrint.GenericPretty ( Out )
1013

1114
data KindParam a
1215
= KindParamInt a SrcSpan String -- ^ @[0-9]+@
1316
| KindParamVar a SrcSpan Name -- ^ @[a-z][a-z0-9]+@ (case insensitive)
1417
deriving stock (Eq, Show, Data, Typeable, Generic, Functor)
1518
deriving anyclass (NFData, Out)
19+
20+
instance FirstParameter (KindParam a) a
21+
instance Annotated KindParam
22+
instance SecondParameter (KindParam a) SrcSpan
23+
instance Spanned (KindParam a)

src/Language/Fortran/AST/Literal/Complex.hs

Lines changed: 8 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -5,7 +5,7 @@ module Language.Fortran.AST.Literal.Complex where
55
import Language.Fortran.AST.Common ( Name )
66
import Language.Fortran.AST.Literal ( KindParam )
77
import Language.Fortran.AST.Literal.Real
8-
import Language.Fortran.Util.Position ( SrcSpan )
8+
import Language.Fortran.Util.Position ( SrcSpan, Spanned )
99

1010
import GHC.Generics ( Generic )
1111
import Data.Data ( Data, Typeable )
@@ -31,8 +31,9 @@ data ComplexLit a = ComplexLit
3131
deriving anyclass (NFData, Out)
3232

3333
instance FirstParameter (ComplexLit a) a
34-
instance SecondParameter (ComplexLit a) a
3534
instance Annotated ComplexLit
35+
instance SecondParameter (ComplexLit a) SrcSpan
36+
instance Spanned (ComplexLit a)
3637

3738
-- | A part (either real or imaginary) of a complex literal.
3839
--
@@ -52,3 +53,8 @@ data ComplexPart a
5253
| ComplexPartNamed a SrcSpan Name -- ^ named constant
5354
deriving stock (Eq, Show, Data, Typeable, Generic, Functor)
5455
deriving anyclass (NFData, Out)
56+
57+
instance FirstParameter (ComplexPart a) a
58+
instance Annotated ComplexPart
59+
instance SecondParameter (ComplexPart a) SrcSpan
60+
instance Spanned (ComplexPart a)

src/Language/Fortran/PrettyPrint.hs

Lines changed: 5 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,5 @@
11
{-# LANGUAGE OverloadedStrings #-}
22
{-# LANGUAGE UndecidableInstances #-}
3-
{-# OPTIONS_GHC -Wno-orphans #-}
43

54
module Language.Fortran.PrettyPrint where
65

@@ -14,7 +13,6 @@ import Language.Fortran.AST.Literal.Real
1413
import Language.Fortran.AST.Literal.Boz
1514
import Language.Fortran.AST.Literal.Complex
1615
import Language.Fortran.Version
17-
import Language.Fortran.Util.FirstParameter
1816

1917
import Text.PrettyPrint
2018

@@ -955,8 +953,6 @@ instance Pretty (Index a) where
955953
pprint' v (IxRange _ _ low up stride) =
956954
pprint' v low <> colon <> pprint' v up <> colon <?> pprint' v stride
957955

958-
-- A subset of Value permit the 'FirstParameter' operation
959-
instance FirstParameter (Value a) String
960956
instance Pretty (Value a) where
961957
pprint' _ ValStar = char '*'
962958
pprint' _ ValColon = char ':'
@@ -975,7 +971,11 @@ instance Pretty (Value a) where
975971
pprint' v (ValInteger i mkp) = text i <> pprint' v mkp
976972
pprint' v (ValReal rl mkp) = text (prettyHsRealLit rl) <> pprint' v mkp
977973
pprint' _ (ValBoz b) = text $ prettyBoz b
978-
pprint' _ valLit = text . getFirstParameter $ valLit
974+
975+
pprint' _ (ValHollerith s) = text s
976+
pprint' _ (ValVariable s) = text s
977+
pprint' _ (ValIntrinsic s) = text s
978+
pprint' _ (ValType s) = text s
979979

980980
instance Pretty (ComplexLit a) where
981981
pprint' v c = parens $ commaSep [realPart, imagPart]

src/Language/Fortran/Util/FirstParameter.hs

Lines changed: 15 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,18 @@
1+
{-|
2+
A convenience class for retrieving the first field of any constructor in a
3+
datatype.
4+
5+
The primary usage for this class is generic derivation:
6+
7+
data D a = D a () String deriving Generic
8+
instance FirstParameter (D a) a
9+
10+
Note that _the deriver does not check you are requesting a valid/safe instance._
11+
Invalid instances propagate the error to runtime. Fixing this requires a lot
12+
more type-level work. (The generic-lens library has a general solution, but it's
13+
slow and memory-consuming.)
14+
-}
15+
116
{-# LANGUAGE DefaultSignatures #-}
217
{-# LANGUAGE TypeOperators #-}
318
{-# LANGUAGE FunctionalDependencies #-}

src/Language/Fortran/Util/SecondParameter.hs

Lines changed: 15 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,18 @@
1+
{-|
2+
A convenience class for retrieving the first field of any constructor in a
3+
datatype.
4+
5+
The primary usage for this class is generic derivation:
6+
7+
data D a = D a () String deriving Generic
8+
instance SecondParameter (D a) ()
9+
10+
Note that _the deriver does not check you are requesting a valid/safe instance._
11+
Invalid instances propagate the error to runtime. Fixing this requires a lot
12+
more type-level work. (The generic-lens library has a general solution, but it's
13+
slow and memory-consuming.)
14+
-}
15+
116
{-# LANGUAGE DefaultSignatures #-}
217
{-# LANGUAGE TypeOperators #-}
318
{-# LANGUAGE FunctionalDependencies #-}

0 commit comments

Comments
 (0)