-----------------------------------------------------------------------------

-----------------------------------------------------------------------------

-- |
-- Module      :  Disco.Pretty.Prec
-- Copyright   :  disco team and contributors
-- Maintainer  :  [email protected]
--
-- SPDX-License-Identifier: BSD-3-Clause
--
-- Precedence and associativity for pretty-printing.
module Disco.Pretty.Prec where

import Disco.Syntax.Operators

-- Types for storing precedence + associativity together

type Prec = Int

data PA = PA Prec BFixity
  deriving (Prec -> PA -> ShowS
[PA] -> ShowS
PA -> String
(Prec -> PA -> ShowS)
-> (PA -> String) -> ([PA] -> ShowS) -> Show PA
forall a.
(Prec -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Prec -> PA -> ShowS
showsPrec :: Prec -> PA -> ShowS
$cshow :: PA -> String
show :: PA -> String
$cshowList :: [PA] -> ShowS
showList :: [PA] -> ShowS
Show, PA -> PA -> Bool
(PA -> PA -> Bool) -> (PA -> PA -> Bool) -> Eq PA
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PA -> PA -> Bool
== :: PA -> PA -> Bool
$c/= :: PA -> PA -> Bool
/= :: PA -> PA -> Bool
Eq) -- Do NOT derive Ord, see note below.

lowerPrec :: PA -> PA -> Bool
lowerPrec :: PA -> PA -> Bool
lowerPrec (PA Prec
p1 BFixity
a1) (PA Prec
p2 BFixity
a2) = Prec
p1 Prec -> Prec -> Bool
forall a. Ord a => a -> a -> Bool
< Prec
p2 Bool -> Bool -> Bool
|| (Prec
p1 Prec -> Prec -> Bool
forall a. Eq a => a -> a -> Bool
== Prec
p2 Bool -> Bool -> Bool
&& BFixity
a1 BFixity -> BFixity -> Bool
forall a. Eq a => a -> a -> Bool
/= BFixity
a2)

-- Note re: lowerPrec: we used to have an unlawful Ord instance defined by
--
--   compare (PA p1 a1) (PA p2 a2) = compare p1 p2 `mappend` (if a1 == a2 then EQ else LT)
--
-- with the idea that we could test whether one precedence was lower
-- than another simply using (<).
--
-- However, this was unlawful since e.g. it does not satisfy x < y ==
-- y > x: If x and y have the same Prec value but different BFixity
-- values, we would have both x < y and y < x.
--
-- In base-4.18 apparently something in the default implementations of
-- Ord methods changed so that e.g. not (PA 2 InR < PA 2 InL).  Hence
-- the 'mparens' method in such cases of nested same-precedence
-- operators was not emitting parentheses in cases where it should.

-- Standard precedence levels

initPA :: PA
initPA :: PA
initPA = Prec -> BFixity -> PA
PA Prec
0 BFixity
InL

ascrPA :: PA
ascrPA :: PA
ascrPA = Prec -> BFixity -> PA
PA Prec
1 BFixity
InL

funPA :: PA
funPA :: PA
funPA = Prec -> BFixity -> PA
PA Prec
funPrec BFixity
InL

rPA :: Int -> PA
rPA :: Prec -> PA
rPA Prec
n = Prec -> BFixity -> PA
PA Prec
n BFixity
InR

tarrPA, taddPA, tmulPA, tfunPA :: PA
tarrPA :: PA
tarrPA = Prec -> PA
rPA Prec
1
taddPA :: PA
taddPA = Prec -> PA
rPA Prec
6
tmulPA :: PA
tmulPA = Prec -> PA
rPA Prec
7
tfunPA :: PA
tfunPA = Prec -> BFixity -> PA
PA Prec
9 BFixity
InL

-- Converting UOp and BOp

ugetPA :: UOp -> PA
ugetPA :: UOp -> PA
ugetPA UOp
op = Prec -> BFixity -> PA
PA (UOp -> Prec
uPrec UOp
op) BFixity
In

getPA :: BOp -> PA
getPA :: BOp -> PA
getPA BOp
op = Prec -> BFixity -> PA
PA (BOp -> Prec
bPrec BOp
op) (BOp -> BFixity
assoc BOp
op)