module Plugin.Pl.Common (
        Fixity(..), Expr(..), Pattern(..), Decl(..), TopLevel(..),
        bt, sizeExpr, mapTopLevel, mapTopLevel', getExpr,
        operators, reservedOps, lookupOp, lookupFix, minPrec, maxPrec,
        comp, flip', id', const', scomb, cons, nil, fix', if', readM,
        makeList, getList,
        Assoc(..),
        module Data.Maybe,
        module Control.Arrow,
        module Data.List,
        module Control.Monad,
        module GHC.Base
    ) where

import Data.Maybe (isJust, fromJust)
import Data.List (intersperse, minimumBy)
import qualified Data.Map as M

import Control.Monad
import Control.Arrow (first, second, (***), (&&&), (|||), (+++))

import Language.Haskell.Exts (Assoc(..))

import GHC.Base (assert)


-- The rewrite rules can be found at the end of the file Rules.hs

-- Not sure if passing the information if it was used as infix or prefix
-- is worth threading through the whole thing is worth the effort,
-- but it stays that way until the prettyprinting algorithm gets more
-- sophisticated.
data Fixity = Pref | Inf deriving Int -> Fixity -> ShowS
[Fixity] -> ShowS
Fixity -> String
(Int -> Fixity -> ShowS)
-> (Fixity -> String) -> ([Fixity] -> ShowS) -> Show Fixity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Fixity] -> ShowS
$cshowList :: [Fixity] -> ShowS
show :: Fixity -> String
$cshow :: Fixity -> String
showsPrec :: Int -> Fixity -> ShowS
$cshowsPrec :: Int -> Fixity -> ShowS
Show

instance Eq Fixity where
  Fixity
_ == :: Fixity -> Fixity -> Bool
== Fixity
_ = Bool
True

instance Ord Fixity where
  compare :: Fixity -> Fixity -> Ordering
compare Fixity
_ Fixity
_ = Ordering
EQ

data Expr
  = Var Fixity String
  | Lambda Pattern Expr
  | App Expr Expr
  | Let [Decl] Expr
  deriving (Expr -> Expr -> Bool
(Expr -> Expr -> Bool) -> (Expr -> Expr -> Bool) -> Eq Expr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Expr -> Expr -> Bool
$c/= :: Expr -> Expr -> Bool
== :: Expr -> Expr -> Bool
$c== :: Expr -> Expr -> Bool
Eq, Eq Expr
Eq Expr
-> (Expr -> Expr -> Ordering)
-> (Expr -> Expr -> Bool)
-> (Expr -> Expr -> Bool)
-> (Expr -> Expr -> Bool)
-> (Expr -> Expr -> Bool)
-> (Expr -> Expr -> Expr)
-> (Expr -> Expr -> Expr)
-> Ord Expr
Expr -> Expr -> Bool
Expr -> Expr -> Ordering
Expr -> Expr -> Expr
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Expr -> Expr -> Expr
$cmin :: Expr -> Expr -> Expr
max :: Expr -> Expr -> Expr
$cmax :: Expr -> Expr -> Expr
>= :: Expr -> Expr -> Bool
$c>= :: Expr -> Expr -> Bool
> :: Expr -> Expr -> Bool
$c> :: Expr -> Expr -> Bool
<= :: Expr -> Expr -> Bool
$c<= :: Expr -> Expr -> Bool
< :: Expr -> Expr -> Bool
$c< :: Expr -> Expr -> Bool
compare :: Expr -> Expr -> Ordering
$ccompare :: Expr -> Expr -> Ordering
$cp1Ord :: Eq Expr
Ord, Int -> Expr -> ShowS
[Expr] -> ShowS
Expr -> String
(Int -> Expr -> ShowS)
-> (Expr -> String) -> ([Expr] -> ShowS) -> Show Expr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Expr] -> ShowS
$cshowList :: [Expr] -> ShowS
show :: Expr -> String
$cshow :: Expr -> String
showsPrec :: Int -> Expr -> ShowS
$cshowsPrec :: Int -> Expr -> ShowS
Show)

data Pattern
  = PVar String 
  | PCons Pattern Pattern
  | PTuple Pattern Pattern
  deriving (Pattern -> Pattern -> Bool
(Pattern -> Pattern -> Bool)
-> (Pattern -> Pattern -> Bool) -> Eq Pattern
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Pattern -> Pattern -> Bool
$c/= :: Pattern -> Pattern -> Bool
== :: Pattern -> Pattern -> Bool
$c== :: Pattern -> Pattern -> Bool
Eq, Eq Pattern
Eq Pattern
-> (Pattern -> Pattern -> Ordering)
-> (Pattern -> Pattern -> Bool)
-> (Pattern -> Pattern -> Bool)
-> (Pattern -> Pattern -> Bool)
-> (Pattern -> Pattern -> Bool)
-> (Pattern -> Pattern -> Pattern)
-> (Pattern -> Pattern -> Pattern)
-> Ord Pattern
Pattern -> Pattern -> Bool
Pattern -> Pattern -> Ordering
Pattern -> Pattern -> Pattern
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Pattern -> Pattern -> Pattern
$cmin :: Pattern -> Pattern -> Pattern
max :: Pattern -> Pattern -> Pattern
$cmax :: Pattern -> Pattern -> Pattern
>= :: Pattern -> Pattern -> Bool
$c>= :: Pattern -> Pattern -> Bool
> :: Pattern -> Pattern -> Bool
$c> :: Pattern -> Pattern -> Bool
<= :: Pattern -> Pattern -> Bool
$c<= :: Pattern -> Pattern -> Bool
< :: Pattern -> Pattern -> Bool
$c< :: Pattern -> Pattern -> Bool
compare :: Pattern -> Pattern -> Ordering
$ccompare :: Pattern -> Pattern -> Ordering
$cp1Ord :: Eq Pattern
Ord, Int -> Pattern -> ShowS
[Pattern] -> ShowS
Pattern -> String
(Int -> Pattern -> ShowS)
-> (Pattern -> String) -> ([Pattern] -> ShowS) -> Show Pattern
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Pattern] -> ShowS
$cshowList :: [Pattern] -> ShowS
show :: Pattern -> String
$cshow :: Pattern -> String
showsPrec :: Int -> Pattern -> ShowS
$cshowsPrec :: Int -> Pattern -> ShowS
Show)

data Decl = Define { 
  Decl -> String
declName :: String, 
  Decl -> Expr
declExpr :: Expr
} deriving (Decl -> Decl -> Bool
(Decl -> Decl -> Bool) -> (Decl -> Decl -> Bool) -> Eq Decl
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Decl -> Decl -> Bool
$c/= :: Decl -> Decl -> Bool
== :: Decl -> Decl -> Bool
$c== :: Decl -> Decl -> Bool
Eq, Eq Decl
Eq Decl
-> (Decl -> Decl -> Ordering)
-> (Decl -> Decl -> Bool)
-> (Decl -> Decl -> Bool)
-> (Decl -> Decl -> Bool)
-> (Decl -> Decl -> Bool)
-> (Decl -> Decl -> Decl)
-> (Decl -> Decl -> Decl)
-> Ord Decl
Decl -> Decl -> Bool
Decl -> Decl -> Ordering
Decl -> Decl -> Decl
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Decl -> Decl -> Decl
$cmin :: Decl -> Decl -> Decl
max :: Decl -> Decl -> Decl
$cmax :: Decl -> Decl -> Decl
>= :: Decl -> Decl -> Bool
$c>= :: Decl -> Decl -> Bool
> :: Decl -> Decl -> Bool
$c> :: Decl -> Decl -> Bool
<= :: Decl -> Decl -> Bool
$c<= :: Decl -> Decl -> Bool
< :: Decl -> Decl -> Bool
$c< :: Decl -> Decl -> Bool
compare :: Decl -> Decl -> Ordering
$ccompare :: Decl -> Decl -> Ordering
$cp1Ord :: Eq Decl
Ord, Int -> Decl -> ShowS
[Decl] -> ShowS
Decl -> String
(Int -> Decl -> ShowS)
-> (Decl -> String) -> ([Decl] -> ShowS) -> Show Decl
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Decl] -> ShowS
$cshowList :: [Decl] -> ShowS
show :: Decl -> String
$cshow :: Decl -> String
showsPrec :: Int -> Decl -> ShowS
$cshowsPrec :: Int -> Decl -> ShowS
Show)

data TopLevel = TLD Bool Decl | TLE Expr deriving (TopLevel -> TopLevel -> Bool
(TopLevel -> TopLevel -> Bool)
-> (TopLevel -> TopLevel -> Bool) -> Eq TopLevel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TopLevel -> TopLevel -> Bool
$c/= :: TopLevel -> TopLevel -> Bool
== :: TopLevel -> TopLevel -> Bool
$c== :: TopLevel -> TopLevel -> Bool
Eq, Eq TopLevel
Eq TopLevel
-> (TopLevel -> TopLevel -> Ordering)
-> (TopLevel -> TopLevel -> Bool)
-> (TopLevel -> TopLevel -> Bool)
-> (TopLevel -> TopLevel -> Bool)
-> (TopLevel -> TopLevel -> Bool)
-> (TopLevel -> TopLevel -> TopLevel)
-> (TopLevel -> TopLevel -> TopLevel)
-> Ord TopLevel
TopLevel -> TopLevel -> Bool
TopLevel -> TopLevel -> Ordering
TopLevel -> TopLevel -> TopLevel
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TopLevel -> TopLevel -> TopLevel
$cmin :: TopLevel -> TopLevel -> TopLevel
max :: TopLevel -> TopLevel -> TopLevel
$cmax :: TopLevel -> TopLevel -> TopLevel
>= :: TopLevel -> TopLevel -> Bool
$c>= :: TopLevel -> TopLevel -> Bool
> :: TopLevel -> TopLevel -> Bool
$c> :: TopLevel -> TopLevel -> Bool
<= :: TopLevel -> TopLevel -> Bool
$c<= :: TopLevel -> TopLevel -> Bool
< :: TopLevel -> TopLevel -> Bool
$c< :: TopLevel -> TopLevel -> Bool
compare :: TopLevel -> TopLevel -> Ordering
$ccompare :: TopLevel -> TopLevel -> Ordering
$cp1Ord :: Eq TopLevel
Ord, Int -> TopLevel -> ShowS
[TopLevel] -> ShowS
TopLevel -> String
(Int -> TopLevel -> ShowS)
-> (TopLevel -> String) -> ([TopLevel] -> ShowS) -> Show TopLevel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TopLevel] -> ShowS
$cshowList :: [TopLevel] -> ShowS
show :: TopLevel -> String
$cshow :: TopLevel -> String
showsPrec :: Int -> TopLevel -> ShowS
$cshowsPrec :: Int -> TopLevel -> ShowS
Show)

mapTopLevel :: (Expr -> Expr) -> TopLevel -> TopLevel
mapTopLevel :: (Expr -> Expr) -> TopLevel -> TopLevel
mapTopLevel Expr -> Expr
f TopLevel
tl = case TopLevel -> (Expr, Expr -> TopLevel)
getExpr TopLevel
tl of (Expr
e, Expr -> TopLevel
c) -> Expr -> TopLevel
c (Expr -> TopLevel) -> Expr -> TopLevel
forall a b. (a -> b) -> a -> b
$ Expr -> Expr
f Expr
e

mapTopLevel' :: Functor f => (Expr -> f Expr) -> TopLevel -> f TopLevel
mapTopLevel' :: (Expr -> f Expr) -> TopLevel -> f TopLevel
mapTopLevel' Expr -> f Expr
f TopLevel
tl = case TopLevel -> (Expr, Expr -> TopLevel)
getExpr TopLevel
tl of (Expr
e, Expr -> TopLevel
c) -> (Expr -> TopLevel) -> f Expr -> f TopLevel
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Expr -> TopLevel
c (f Expr -> f TopLevel) -> f Expr -> f TopLevel
forall a b. (a -> b) -> a -> b
$ Expr -> f Expr
f Expr
e

getExpr :: TopLevel -> (Expr, Expr -> TopLevel)
getExpr :: TopLevel -> (Expr, Expr -> TopLevel)
getExpr (TLD Bool
True (Define String
foo Expr
e)) = ([Decl] -> Expr -> Expr
Let [String -> Expr -> Decl
Define String
foo Expr
e] (Fixity -> String -> Expr
Var Fixity
Pref String
foo), 
                                     \Expr
e' -> Bool -> Decl -> TopLevel
TLD Bool
False (Decl -> TopLevel) -> Decl -> TopLevel
forall a b. (a -> b) -> a -> b
$ String -> Expr -> Decl
Define String
foo Expr
e')
getExpr (TLD Bool
False (Define String
foo Expr
e)) = (Expr
e, \Expr
e' -> Bool -> Decl -> TopLevel
TLD Bool
False (Decl -> TopLevel) -> Decl -> TopLevel
forall a b. (a -> b) -> a -> b
$ String -> Expr -> Decl
Define String
foo Expr
e')
getExpr (TLE Expr
e)      = (Expr
e, Expr -> TopLevel
TLE)

sizeExpr :: Expr -> Int
sizeExpr :: Expr -> Int
sizeExpr (Var Fixity
_ String
_) = Int
1
sizeExpr (App Expr
e1 Expr
e2) = Expr -> Int
sizeExpr Expr
e1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Expr -> Int
sizeExpr Expr
e2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
sizeExpr (Lambda Pattern
_ Expr
e) = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Expr -> Int
sizeExpr Expr
e
sizeExpr (Let [Decl]
ds Expr
e) = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((Decl -> Int) -> [Decl] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Decl -> Int
sizeDecl [Decl]
ds) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Expr -> Int
sizeExpr Expr
e where
  sizeDecl :: Decl -> Int
sizeDecl (Define String
_ Expr
e') = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Expr -> Int
sizeExpr Expr
e'

comp, flip', id', const', scomb, cons, nil, fix', if' :: Expr
comp :: Expr
comp   = Fixity -> String -> Expr
Var Fixity
Inf  String
"."
flip' :: Expr
flip'  = Fixity -> String -> Expr
Var Fixity
Pref String
"flip"
id' :: Expr
id'    = Fixity -> String -> Expr
Var Fixity
Pref String
"id"
const' :: Expr
const' = Fixity -> String -> Expr
Var Fixity
Pref String
"const"
scomb :: Expr
scomb  = Fixity -> String -> Expr
Var Fixity
Pref String
"ap"
cons :: Expr
cons   = Fixity -> String -> Expr
Var Fixity
Inf  String
":"
nil :: Expr
nil    = Fixity -> String -> Expr
Var Fixity
Pref String
"[]"
fix' :: Expr
fix'   = Fixity -> String -> Expr
Var Fixity
Pref String
"fix"
if' :: Expr
if'    = Fixity -> String -> Expr
Var Fixity
Pref String
"if'"

makeList :: [Expr] -> Expr
makeList :: [Expr] -> Expr
makeList = (Expr -> Expr -> Expr) -> Expr -> [Expr] -> Expr
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Expr
e1 Expr
e2 -> Expr
cons Expr -> Expr -> Expr
`App` Expr
e1 Expr -> Expr -> Expr
`App` Expr
e2) Expr
nil

-- Modularity is a drag
getList :: Expr -> ([Expr], Expr)
getList :: Expr -> ([Expr], Expr)
getList (Expr
c `App` Expr
x `App` Expr
tl) | Expr
c Expr -> Expr -> Bool
forall a. Eq a => a -> a -> Bool
== Expr
cons = ([Expr] -> [Expr]) -> ([Expr], Expr) -> ([Expr], Expr)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (Expr
xExpr -> [Expr] -> [Expr]
forall a. a -> [a] -> [a]
:) (([Expr], Expr) -> ([Expr], Expr))
-> ([Expr], Expr) -> ([Expr], Expr)
forall a b. (a -> b) -> a -> b
$ Expr -> ([Expr], Expr)
getList Expr
tl
getList Expr
e = ([],Expr
e)

bt :: a
bt :: a
bt = a
forall a. HasCallStack => a
undefined

shift, minPrec, maxPrec :: Int
shift :: Int
shift = Int
0
maxPrec :: Int
maxPrec = Int
shift Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
10
minPrec :: Int
minPrec = Int
0

-- operator precedences are needed both for parsing and prettyprinting
operators :: [[(String, (Assoc (), Int))]]
operators :: [[(String, (Assoc (), Int))]]
operators = (([(String, (Assoc (), Int))] -> [(String, (Assoc (), Int))])
-> [[(String, (Assoc (), Int))]] -> [[(String, (Assoc (), Int))]]
forall a b. (a -> b) -> [a] -> [b]
map (([(String, (Assoc (), Int))] -> [(String, (Assoc (), Int))])
 -> [[(String, (Assoc (), Int))]] -> [[(String, (Assoc (), Int))]])
-> ((Int -> Int)
    -> [(String, (Assoc (), Int))] -> [(String, (Assoc (), Int))])
-> (Int -> Int)
-> [[(String, (Assoc (), Int))]]
-> [[(String, (Assoc (), Int))]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, (Assoc (), Int)) -> (String, (Assoc (), Int)))
-> [(String, (Assoc (), Int))] -> [(String, (Assoc (), Int))]
forall a b. (a -> b) -> [a] -> [b]
map (((String, (Assoc (), Int)) -> (String, (Assoc (), Int)))
 -> [(String, (Assoc (), Int))] -> [(String, (Assoc (), Int))])
-> ((Int -> Int)
    -> (String, (Assoc (), Int)) -> (String, (Assoc (), Int)))
-> (Int -> Int)
-> [(String, (Assoc (), Int))]
-> [(String, (Assoc (), Int))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Assoc (), Int) -> (Assoc (), Int))
-> (String, (Assoc (), Int)) -> (String, (Assoc (), Int))
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (((Assoc (), Int) -> (Assoc (), Int))
 -> (String, (Assoc (), Int)) -> (String, (Assoc (), Int)))
-> ((Int -> Int) -> (Assoc (), Int) -> (Assoc (), Int))
-> (Int -> Int)
-> (String, (Assoc (), Int))
-> (String, (Assoc (), Int))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int) -> (Assoc (), Int) -> (Assoc (), Int)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ((Int -> Int)
 -> [[(String, (Assoc (), Int))]] -> [[(String, (Assoc (), Int))]])
-> (Int -> Int)
-> [[(String, (Assoc (), Int))]]
-> [[(String, (Assoc (), Int))]]
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
shift))
  [[String -> Assoc () -> Int -> (String, (Assoc (), Int))
forall a a b. a -> a -> b -> (a, (a, b))
inf String
"." (() -> Assoc ()
forall l. l -> Assoc l
AssocRight ()) Int
9, String -> Assoc () -> Int -> (String, (Assoc (), Int))
forall a a b. a -> a -> b -> (a, (a, b))
inf String
"!!" (() -> Assoc ()
forall l. l -> Assoc l
AssocLeft ()) Int
9],
   [String -> Assoc () -> Int -> (String, (Assoc (), Int))
forall a a b. a -> a -> b -> (a, (a, b))
inf String
name (() -> Assoc ()
forall l. l -> Assoc l
AssocRight ()) Int
8 | String
name <- [String
"^", String
"^^", String
"**"]],
   [String -> Assoc () -> Int -> (String, (Assoc (), Int))
forall a a b. a -> a -> b -> (a, (a, b))
inf String
name (() -> Assoc ()
forall l. l -> Assoc l
AssocLeft ()) Int
7
     | String
name <- [String
"*", String
"/", String
"`quot`", String
"`rem`", String
"`div`", String
"`mod`", String
":%", String
"%"]],
   [String -> Assoc () -> Int -> (String, (Assoc (), Int))
forall a a b. a -> a -> b -> (a, (a, b))
inf String
name (() -> Assoc ()
forall l. l -> Assoc l
AssocLeft ()) Int
6  | String
name <- [String
"+", String
"-"]],
   [String -> Assoc () -> Int -> (String, (Assoc (), Int))
forall a a b. a -> a -> b -> (a, (a, b))
inf String
name (() -> Assoc ()
forall l. l -> Assoc l
AssocRight ()) Int
5 | String
name <- [String
":", String
"++"]],
   [String -> Assoc () -> Int -> (String, (Assoc (), Int))
forall a a b. a -> a -> b -> (a, (a, b))
inf String
name (() -> Assoc ()
forall l. l -> Assoc l
AssocNone ()) Int
4
     | String
name <- [String
"==", String
"/=", String
"<", String
"<=", String
">=", String
">", String
"`elem`", String
"`notElem`"]],
   [String -> Assoc () -> Int -> (String, (Assoc (), Int))
forall a a b. a -> a -> b -> (a, (a, b))
inf String
"&&" (() -> Assoc ()
forall l. l -> Assoc l
AssocRight ()) Int
3],
   [String -> Assoc () -> Int -> (String, (Assoc (), Int))
forall a a b. a -> a -> b -> (a, (a, b))
inf String
"||" (() -> Assoc ()
forall l. l -> Assoc l
AssocRight ()) Int
2],
   [String -> Assoc () -> Int -> (String, (Assoc (), Int))
forall a a b. a -> a -> b -> (a, (a, b))
inf String
">>" (() -> Assoc ()
forall l. l -> Assoc l
AssocLeft ()) Int
1, String -> Assoc () -> Int -> (String, (Assoc (), Int))
forall a a b. a -> a -> b -> (a, (a, b))
inf String
">>=" (() -> Assoc ()
forall l. l -> Assoc l
AssocLeft ()) Int
1, String -> Assoc () -> Int -> (String, (Assoc (), Int))
forall a a b. a -> a -> b -> (a, (a, b))
inf String
"=<<" (() -> Assoc ()
forall l. l -> Assoc l
AssocRight ()) Int
1],
   [String -> Assoc () -> Int -> (String, (Assoc (), Int))
forall a a b. a -> a -> b -> (a, (a, b))
inf String
name (() -> Assoc ()
forall l. l -> Assoc l
AssocRight ()) Int
0 | String
name <- [String
"$", String
"$!", String
"`seq`"]]
  ] where
  inf :: a -> a -> b -> (a, (a, b))
inf a
name a
assoc b
fx = (a
name, (a
assoc, b
fx))

reservedOps :: [String]
reservedOps :: [String]
reservedOps = [String
"->", String
"..", String
"="]

opFM :: M.Map String (Assoc (), Int)
opFM :: Map String (Assoc (), Int)
opFM = ([(String, (Assoc (), Int))] -> Map String (Assoc (), Int)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(String, (Assoc (), Int))] -> Map String (Assoc (), Int))
-> [(String, (Assoc (), Int))] -> Map String (Assoc (), Int)
forall a b. (a -> b) -> a -> b
$ [[(String, (Assoc (), Int))]] -> [(String, (Assoc (), Int))]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(String, (Assoc (), Int))]]
operators)

lookupOp :: String -> Maybe (Assoc (), Int)
lookupOp :: String -> Maybe (Assoc (), Int)
lookupOp String
k = String -> Map String (Assoc (), Int) -> Maybe (Assoc (), Int)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
k Map String (Assoc (), Int)
opFM

lookupFix :: String -> (Assoc (), Int)
lookupFix :: String -> (Assoc (), Int)
lookupFix String
str = case String -> Maybe (Assoc (), Int)
lookupOp (String -> Maybe (Assoc (), Int))
-> String -> Maybe (Assoc (), Int)
forall a b. (a -> b) -> a -> b
$ String
str of
  Maybe (Assoc (), Int)
Nothing -> ((() -> Assoc ()
forall l. l -> Assoc l
AssocLeft ()), Int
9 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
shift)
  Just (Assoc (), Int)
x  -> (Assoc (), Int)
x

-- This was previously generalized to Monad, but now the right type is MonadFail,
-- but different versions of GHC need different imports / constraints, but we only
-- actually use it with Maybe anyway.
readM :: (Read a) => String -> Maybe a
readM :: String -> Maybe a
readM String
s = case [a
x | (a
x,String
t) <- ReadS a
forall a. Read a => ReadS a
reads String
s, (String
"",String
"")  <- ReadS String
lex String
t] of
            [a
x] -> a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
            []  -> String -> Maybe a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"readM: No parse."
            [a]
_   -> String -> Maybe a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"readM: Ambiguous parse."