{-# OPTIONS_GHC -Wwarn -fmax-pmcheck-models=100 #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Strict            #-}
{-# LANGUAGE TupleSections     #-}
{-# LANGUAGE ViewPatterns      #-}
module Apigen.Parser.InferProperties (simplify) where

import           Apigen.Parser.Query        (declName)
import           Apigen.Parser.SymbolTable  (M, Name, SId, SIdToName, Sym,
                                             display, mustLookupM, resolve)
import qualified Apigen.Parser.SymbolTable  as SymbolTable
import           Apigen.Types               (BuiltinType (..), Constness (..),
                                             Decl (..))
import           Control.Arrow              (Arrow (first, second))
import           Control.Monad              ((>=>))
import           Control.Monad.Extra        (mapMaybeM)
import qualified Control.Monad.State.Strict as State
import qualified Data.Foldable              as Foldable
import           Data.HashMap.Strict.InsOrd (InsOrdHashMap)
import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
import           Data.List                  (isSuffixOf)
import           Data.Maybe                 (maybeToList)
import           Data.Text                  (Text)
import           Data.Tuple                 (swap)
import           GHC.Stack                  (HasCallStack)
import           Language.Cimple            (Lexeme (..), lexemeText)

type Prop = Decl (Lexeme SId)
type PropTable = InsOrdHashMap Name Prop

data Kind
    = KindGet
    | KindSet
    | KindSize
    deriving (Int -> Kind -> ShowS
[Kind] -> ShowS
Kind -> String
(Int -> Kind -> ShowS)
-> (Kind -> String) -> ([Kind] -> ShowS) -> Show Kind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Kind] -> ShowS
$cshowList :: [Kind] -> ShowS
show :: Kind -> String
$cshow :: Kind -> String
showsPrec :: Int -> Kind -> ShowS
$cshowsPrec :: Int -> Kind -> ShowS
Show)

addSymbols :: M PropTable (InsOrdHashMap SId Prop)
addSymbols :: M PropTable (InsOrdHashMap Int Prop)
addSymbols = do
    PropTable
props <- (SIdToName, PropTable) -> PropTable
forall a b. (a, b) -> b
snd ((SIdToName, PropTable) -> PropTable)
-> StateT (SIdToName, PropTable) Identity (SIdToName, PropTable)
-> StateT (SIdToName, PropTable) Identity PropTable
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT (SIdToName, PropTable) Identity (SIdToName, PropTable)
forall s (m :: * -> *). MonadState s m => m s
State.get
    ([(Int, Prop)] -> InsOrdHashMap Int Prop)
-> StateT (SIdToName, PropTable) Identity [(Int, Prop)]
-> M PropTable (InsOrdHashMap Int Prop)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(Int, Prop)] -> InsOrdHashMap Int Prop
forall k v. (Eq k, Hashable k) => [(k, v)] -> InsOrdHashMap k v
InsOrdHashMap.fromList (StateT (SIdToName, PropTable) Identity [(Int, Prop)]
 -> M PropTable (InsOrdHashMap Int Prop))
-> (PropTable
    -> StateT (SIdToName, PropTable) Identity [(Int, Prop)])
-> PropTable
-> M PropTable (InsOrdHashMap Int Prop)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Name, Prop)
 -> StateT (SIdToName, PropTable) Identity (Int, Prop))
-> [(Name, Prop)]
-> StateT (SIdToName, PropTable) Identity [(Int, Prop)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Name, Prop) -> StateT (SIdToName, PropTable) Identity (Int, Prop)
insert ([(Name, Prop)]
 -> StateT (SIdToName, PropTable) Identity [(Int, Prop)])
-> (PropTable -> [(Name, Prop)])
-> PropTable
-> StateT (SIdToName, PropTable) Identity [(Int, Prop)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PropTable -> [(Name, Prop)]
forall k v. InsOrdHashMap k v -> [(k, v)]
InsOrdHashMap.toList (PropTable -> M PropTable (InsOrdHashMap Int Prop))
-> PropTable -> M PropTable (InsOrdHashMap Int Prop)
forall a b. (a -> b) -> a -> b
$ PropTable
props
  where
    insert :: (Name, Prop) -> M PropTable (SId, Prop)
    insert :: (Name, Prop) -> StateT (SIdToName, PropTable) Identity (Int, Prop)
insert (Name
name, Prop
prop) =
        (,Prop
prop) (Int -> (Int, Prop))
-> StateT (SIdToName, PropTable) Identity Int
-> StateT (SIdToName, PropTable) Identity (Int, Prop)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> StateT (SIdToName, PropTable) Identity Int
forall s. Name -> M s Int
SymbolTable.insert Name
name


propSloc :: Show lexeme => Decl lexeme -> [lexeme]
propSloc :: Decl lexeme -> [lexeme]
propSloc Decl lexeme
prop = case Decl lexeme
prop of
    ValueProp Decl lexeme
t Maybe (Decl lexeme)
g Maybe (Decl lexeme)
s   -> [Maybe (Decl lexeme)] -> [lexeme]
forall b. [Maybe (Decl b)] -> [b]
go [Decl lexeme -> Maybe (Decl lexeme)
forall a. a -> Maybe a
Just Decl lexeme
t, Maybe (Decl lexeme)
g, Maybe (Decl lexeme)
s   ]
    ArrayProp Decl lexeme
t Maybe (Decl lexeme)
g Maybe (Decl lexeme)
s Maybe (Decl lexeme)
l -> [Maybe (Decl lexeme)] -> [lexeme]
forall b. [Maybe (Decl b)] -> [b]
go [Decl lexeme -> Maybe (Decl lexeme)
forall a. a -> Maybe a
Just Decl lexeme
t, Maybe (Decl lexeme)
g, Maybe (Decl lexeme)
s, Maybe (Decl lexeme)
l]
    Decl lexeme
_                 -> String -> [lexeme]
forall a. HasCallStack => String -> a
error (String -> [lexeme]) -> String -> [lexeme]
forall a b. (a -> b) -> a -> b
$ Decl lexeme -> String
forall a. Show a => a -> String
show Decl lexeme
prop
  where go :: [Maybe (Decl b)] -> [b]
go = (Maybe (Decl b) -> [b]) -> [Maybe (Decl b)] -> [b]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([[b]] -> [b]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[b]] -> [b])
-> (Maybe (Decl b) -> [[b]]) -> Maybe (Decl b) -> [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe [b] -> [[b]]
forall a. Maybe a -> [a]
maybeToList (Maybe [b] -> [[b]])
-> (Maybe (Decl b) -> Maybe [b]) -> Maybe (Decl b) -> [[b]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Decl b -> [b]) -> Maybe (Decl b) -> Maybe [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Decl b -> [b]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList)


simplify :: SIdToName -> [Sym] -> (SIdToName, [Sym])
simplify :: SIdToName -> [Prop] -> (SIdToName, [Prop])
simplify SIdToName
st = ((SIdToName, PropTable) -> SIdToName)
-> ((SIdToName, PropTable), [Prop]) -> (SIdToName, [Prop])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (SIdToName, PropTable) -> SIdToName
forall a b. (a, b) -> a
fst (((SIdToName, PropTable), [Prop]) -> (SIdToName, [Prop]))
-> ([Prop] -> ((SIdToName, PropTable), [Prop]))
-> [Prop]
-> (SIdToName, [Prop])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Prop], (SIdToName, PropTable))
-> ((SIdToName, PropTable), [Prop])
forall a b. (a, b) -> (b, a)
swap (([Prop], (SIdToName, PropTable))
 -> ((SIdToName, PropTable), [Prop]))
-> ([Prop] -> ([Prop], (SIdToName, PropTable)))
-> [Prop]
-> ((SIdToName, PropTable), [Prop])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (State (SIdToName, PropTable) [Prop]
 -> (SIdToName, PropTable) -> ([Prop], (SIdToName, PropTable)))
-> (SIdToName, PropTable)
-> State (SIdToName, PropTable) [Prop]
-> ([Prop], (SIdToName, PropTable))
forall a b c. (a -> b -> c) -> b -> a -> c
flip State (SIdToName, PropTable) [Prop]
-> (SIdToName, PropTable) -> ([Prop], (SIdToName, PropTable))
forall s a. State s a -> s -> (a, s)
State.runState (SIdToName
st, PropTable
forall k v. InsOrdHashMap k v
InsOrdHashMap.empty) (State (SIdToName, PropTable) [Prop]
 -> ([Prop], (SIdToName, PropTable)))
-> ([Prop] -> State (SIdToName, PropTable) [Prop])
-> [Prop]
-> ([Prop], (SIdToName, PropTable))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Prop -> StateT (SIdToName, PropTable) Identity (Maybe Prop))
-> [Prop] -> State (SIdToName, PropTable) [Prop]
forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> [a] -> m [b]
mapMaybeM Prop -> StateT (SIdToName, PropTable) Identity (Maybe Prop)
go
  where
    go :: Sym -> M PropTable (Maybe Sym)
    go :: Prop -> StateT (SIdToName, PropTable) Identity (Maybe Prop)
go (Namespace [Text]
name [Prop]
mems) = Prop -> Maybe Prop
forall a. a -> Maybe a
Just (Prop -> Maybe Prop) -> ([Prop] -> Prop) -> [Prop] -> Maybe Prop
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Prop] -> Prop
forall lexeme. [Text] -> [Decl lexeme] -> Decl lexeme
Namespace [Text]
name ([Prop] -> Maybe Prop)
-> State (SIdToName, PropTable) [Prop]
-> StateT (SIdToName, PropTable) Identity (Maybe Prop)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Prop] -> State (SIdToName, PropTable) [Prop]
descend [Prop]
mems
    go (ClassDecl Lexeme Int
name [Prop]
mems) = Prop -> Maybe Prop
forall a. a -> Maybe a
Just (Prop -> Maybe Prop) -> ([Prop] -> Prop) -> [Prop] -> Maybe Prop
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lexeme Int -> [Prop] -> Prop
forall lexeme. lexeme -> [Decl lexeme] -> Decl lexeme
ClassDecl Lexeme Int
name ([Prop] -> Maybe Prop)
-> State (SIdToName, PropTable) [Prop]
-> StateT (SIdToName, PropTable) Identity (Maybe Prop)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Prop] -> State (SIdToName, PropTable) [Prop]
descend [Prop]
mems

    go m :: Prop
m@(Method Constness
_ Prop
_ (L AlexPosn
_ LexemeClass
_ Int
sid) [Prop]
_) = do
        Name
name <- Int -> M PropTable Name
forall s. Int -> M s Name
mustLookupM Int
sid
        HasCallStack =>
Name -> Prop -> StateT (SIdToName, PropTable) Identity (Maybe Prop)
Name -> Prop -> StateT (SIdToName, PropTable) Identity (Maybe Prop)
mth Name
name Prop
m

    go Prop
x = Maybe Prop -> StateT (SIdToName, PropTable) Identity (Maybe Prop)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Prop -> StateT (SIdToName, PropTable) Identity (Maybe Prop))
-> Maybe Prop
-> StateT (SIdToName, PropTable) Identity (Maybe Prop)
forall a b. (a -> b) -> a -> b
$ Prop -> Maybe Prop
forall a. a -> Maybe a
Just Prop
x

    descend :: [Prop] -> State (SIdToName, PropTable) [Prop]
descend [Prop]
mems = do
        PropTable
old <- (SIdToName, PropTable) -> PropTable
forall a b. (a, b) -> b
snd ((SIdToName, PropTable) -> PropTable)
-> StateT (SIdToName, PropTable) Identity (SIdToName, PropTable)
-> StateT (SIdToName, PropTable) Identity PropTable
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT (SIdToName, PropTable) Identity (SIdToName, PropTable)
forall s (m :: * -> *). MonadState s m => m s
State.get
        ((SIdToName, PropTable) -> (SIdToName, PropTable))
-> StateT (SIdToName, PropTable) Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify (((SIdToName, PropTable) -> (SIdToName, PropTable))
 -> StateT (SIdToName, PropTable) Identity ())
-> ((SIdToName, PropTable) -> (SIdToName, PropTable))
-> StateT (SIdToName, PropTable) Identity ()
forall a b. (a -> b) -> a -> b
$ (PropTable -> PropTable)
-> (SIdToName, PropTable) -> (SIdToName, PropTable)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ((PropTable -> PropTable)
 -> (SIdToName, PropTable) -> (SIdToName, PropTable))
-> (PropTable -> PropTable)
-> (SIdToName, PropTable)
-> (SIdToName, PropTable)
forall a b. (a -> b) -> a -> b
$ PropTable -> PropTable -> PropTable
forall a b. a -> b -> a
const PropTable
forall k v. InsOrdHashMap k v
InsOrdHashMap.empty
        [Prop]
newMems <- (Prop -> StateT (SIdToName, PropTable) Identity (Maybe Prop))
-> [Prop] -> State (SIdToName, PropTable) [Prop]
forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> [a] -> m [b]
mapMaybeM Prop -> StateT (SIdToName, PropTable) Identity (Maybe Prop)
go [Prop]
mems
        [Prop]
props <- ((Int, Prop) -> Prop) -> [(Int, Prop)] -> [Prop]
forall a b. (a -> b) -> [a] -> [b]
map ((Lexeme Int -> Prop -> Prop) -> (Lexeme Int, Prop) -> Prop
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Lexeme Int -> Prop -> Prop
forall lexeme. lexeme -> Decl lexeme -> Decl lexeme
Property ((Lexeme Int, Prop) -> Prop)
-> ((Int, Prop) -> (Lexeme Int, Prop)) -> (Int, Prop) -> Prop
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Prop) -> (Lexeme Int, Prop)
near) ([(Int, Prop)] -> [Prop])
-> (InsOrdHashMap Int Prop -> [(Int, Prop)])
-> InsOrdHashMap Int Prop
-> [Prop]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InsOrdHashMap Int Prop -> [(Int, Prop)]
forall k v. InsOrdHashMap k v -> [(k, v)]
InsOrdHashMap.toList (InsOrdHashMap Int Prop -> [Prop])
-> M PropTable (InsOrdHashMap Int Prop)
-> State (SIdToName, PropTable) [Prop]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> M PropTable (InsOrdHashMap Int Prop)
addSymbols
        ((SIdToName, PropTable) -> (SIdToName, PropTable))
-> StateT (SIdToName, PropTable) Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify (((SIdToName, PropTable) -> (SIdToName, PropTable))
 -> StateT (SIdToName, PropTable) Identity ())
-> ((SIdToName, PropTable) -> (SIdToName, PropTable))
-> StateT (SIdToName, PropTable) Identity ()
forall a b. (a -> b) -> a -> b
$ (PropTable -> PropTable)
-> (SIdToName, PropTable) -> (SIdToName, PropTable)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ((PropTable -> PropTable)
 -> (SIdToName, PropTable) -> (SIdToName, PropTable))
-> (PropTable -> PropTable)
-> (SIdToName, PropTable)
-> (SIdToName, PropTable)
forall a b. (a -> b) -> a -> b
$ PropTable -> PropTable -> PropTable
forall a b. a -> b -> a
const PropTable
old
        [Prop] -> State (SIdToName, PropTable) [Prop]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Prop] -> State (SIdToName, PropTable) [Prop])
-> [Prop] -> State (SIdToName, PropTable) [Prop]
forall a b. (a -> b) -> a -> b
$ [Prop]
props [Prop] -> [Prop] -> [Prop]
forall a. [a] -> [a] -> [a]
++ [Prop]
newMems

    near :: (SId, Prop) -> (Lexeme SId, Prop)
    near :: (Int, Prop) -> (Lexeme Int, Prop)
near (Int
t, x :: Prop
x@([Lexeme Int] -> Lexeme Int
forall a. [a] -> a
head ([Lexeme Int] -> Lexeme Int)
-> (Prop -> [Lexeme Int]) -> Prop -> Lexeme Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Prop -> [Lexeme Int]
forall lexeme. Show lexeme => Decl lexeme -> [lexeme]
propSloc -> L AlexPosn
c LexemeClass
p Int
_)) = (AlexPosn -> LexemeClass -> Int -> Lexeme Int
forall text. AlexPosn -> LexemeClass -> text -> Lexeme text
L AlexPosn
c LexemeClass
p Int
t, Prop
x)

    -- Ignore these non-compliant functions.
    mth :: HasCallStack => Name -> Sym -> M PropTable (Maybe Sym)
    mth :: Name -> Prop -> StateT (SIdToName, PropTable) Identity (Maybe Prop)
mth ([Text]
_, [Text
"get",Text
"savedata",Text
"data"]) (Method Constness
ConstThis Prop
_ Lexeme Int
_ [Prop]
_) = Maybe Prop -> StateT (SIdToName, PropTable) Identity (Maybe Prop)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Prop
forall a. Maybe a
Nothing
    mth ([Text]
_, [Text
"get",Text
"savedata",Text
"length"]) (Method Constness
ConstThis Prop
_ Lexeme Int
_ [Prop]
_) = Maybe Prop -> StateT (SIdToName, PropTable) Identity (Maybe Prop)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Prop
forall a. Maybe a
Nothing
    mth ([Text]
_, [Text
"set",Text
"savedata",Text
"length"]) (Method Constness
MutableThis Prop
_ Lexeme Int
_ [Prop]
_) = Maybe Prop -> StateT (SIdToName, PropTable) Identity (Maybe Prop)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Prop
forall a. Maybe a
Nothing

    -- Ignore log callback for now. We'll use Tox_Log later.
    mth ([Text]
_, [Text
"get",Text
"log",Text
"callback"]) (Method Constness
ConstThis Prop
_ Lexeme Int
_ [Prop]
_) = Maybe Prop -> StateT (SIdToName, PropTable) Identity (Maybe Prop)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Prop
forall a. Maybe a
Nothing
    mth ([Text]
_, [Text
"set",Text
"log",Text
"callback"]) (Method Constness
MutableThis Prop
_ Lexeme Int
_ [Prop]
_) = Maybe Prop -> StateT (SIdToName, PropTable) Identity (Maybe Prop)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Prop
forall a. Maybe a
Nothing
    mth ([Text]
_, [Text
"get",Text
"log",Text
"user",Text
"data"]) (Method Constness
ConstThis Prop
_ Lexeme Int
_ [Prop]
_) = Maybe Prop -> StateT (SIdToName, PropTable) Identity (Maybe Prop)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Prop
forall a. Maybe a
Nothing
    mth ([Text]
_, [Text
"set",Text
"log",Text
"user",Text
"data"]) (Method Constness
MutableThis Prop
_ Lexeme Int
_ [Prop]
_) = Maybe Prop -> StateT (SIdToName, PropTable) Identity (Maybe Prop)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Prop
forall a. Maybe a
Nothing

    -- Ignore Tox_System for now.
    mth ([Text]
_, [Text
"get",Text
"operating",Text
"system"]) (Method Constness
ConstThis Prop
_ Lexeme Int
_ [Prop]
_) = Maybe Prop -> StateT (SIdToName, PropTable) Identity (Maybe Prop)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Prop
forall a. Maybe a
Nothing
    mth ([Text]
_, [Text
"set",Text
"operating",Text
"system"]) (Method Constness
MutableThis Prop
_ Lexeme Int
_ [Prop]
_) = Maybe Prop -> StateT (SIdToName, PropTable) Identity (Maybe Prop)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Prop
forall a. Maybe a
Nothing
    mth ([Text]
_, [Text
"get",Text
"system"]) (Method Constness
MutableThis Prop
_ Lexeme Int
_ [Prop]
_) = Maybe Prop -> StateT (SIdToName, PropTable) Identity (Maybe Prop)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Prop
forall a. Maybe a
Nothing

    -- Ignore toxav_get_tox for now.
    mth ([Text]
_, [Text
"get",Text
"tox"]) (Method Constness
ConstThis Prop
_ Lexeme Int
_ [Prop]
_) = Maybe Prop -> StateT (SIdToName, PropTable) Identity (Maybe Prop)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Prop
forall a. Maybe a
Nothing

    mth ([Text]
ns, Text
"get":[Text]
name) m :: Prop
m@(Method Constness
ConstThis (BuiltinType BuiltinType
SizeT) Lexeme Int
_ [Prop]
_) | [Text
"size"] [Text] -> [Text] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` [Text]
name = do
        -- We might not know the type, yet.
        ((SIdToName, PropTable) -> (SIdToName, PropTable))
-> StateT (SIdToName, PropTable) Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify (((SIdToName, PropTable) -> (SIdToName, PropTable))
 -> StateT (SIdToName, PropTable) Identity ())
-> ((SIdToName, PropTable) -> (SIdToName, PropTable))
-> StateT (SIdToName, PropTable) Identity ()
forall a b. (a -> b) -> a -> b
$ (PropTable -> PropTable)
-> (SIdToName, PropTable) -> (SIdToName, PropTable)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ((PropTable -> PropTable)
 -> (SIdToName, PropTable) -> (SIdToName, PropTable))
-> (PropTable -> PropTable)
-> (SIdToName, PropTable)
-> (SIdToName, PropTable)
forall a b. (a -> b) -> a -> b
$ HasCallStack =>
Kind -> Prop -> Name -> Prop -> PropTable -> PropTable
Kind -> Prop -> Name -> Prop -> PropTable -> PropTable
addArrayProp Kind
KindSize (BuiltinType -> Prop
forall lexeme. BuiltinType -> Decl lexeme
BuiltinType BuiltinType
Void) ([Text]
ns, Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
take ([Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
name Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [Text]
name) Prop
m
        Maybe Prop -> StateT (SIdToName, PropTable) Identity (Maybe Prop)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Prop
forall a. Maybe a
Nothing
    mth ([Text]
ns, Text
"get":[Text]
name) m :: Prop
m@(Method Constness
ConstThis Prop
ret Lexeme Int
_ [Prop]
params) = do
        case SIdToName -> [Text] -> [Prop] -> Maybe Prop
findPropertyParam SIdToName
st [Text]
name [Prop]
params of
            Just ty :: Prop
ty@(SizedArrayType BuiltinType{} Prop
_) ->
                ((SIdToName, PropTable) -> (SIdToName, PropTable))
-> StateT (SIdToName, PropTable) Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify (((SIdToName, PropTable) -> (SIdToName, PropTable))
 -> StateT (SIdToName, PropTable) Identity ())
-> ((SIdToName, PropTable) -> (SIdToName, PropTable))
-> StateT (SIdToName, PropTable) Identity ()
forall a b. (a -> b) -> a -> b
$ (PropTable -> PropTable)
-> (SIdToName, PropTable) -> (SIdToName, PropTable)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ((PropTable -> PropTable)
 -> (SIdToName, PropTable) -> (SIdToName, PropTable))
-> (PropTable -> PropTable)
-> (SIdToName, PropTable)
-> (SIdToName, PropTable)
forall a b. (a -> b) -> a -> b
$ HasCallStack =>
Kind -> Prop -> Name -> Prop -> PropTable -> PropTable
Kind -> Prop -> Name -> Prop -> PropTable -> PropTable
addArrayProp Kind
KindGet Prop
ty ([Text]
ns,[Text]
name) Prop
m
            Just Prop
ty | Prop -> Bool
forall lexeme. Decl lexeme -> Bool
isArrayType Prop
ty ->
                ((SIdToName, PropTable) -> (SIdToName, PropTable))
-> StateT (SIdToName, PropTable) Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify (((SIdToName, PropTable) -> (SIdToName, PropTable))
 -> StateT (SIdToName, PropTable) Identity ())
-> ((SIdToName, PropTable) -> (SIdToName, PropTable))
-> StateT (SIdToName, PropTable) Identity ()
forall a b. (a -> b) -> a -> b
$ (PropTable -> PropTable)
-> (SIdToName, PropTable) -> (SIdToName, PropTable)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ((PropTable -> PropTable)
 -> (SIdToName, PropTable) -> (SIdToName, PropTable))
-> (PropTable -> PropTable)
-> (SIdToName, PropTable)
-> (SIdToName, PropTable)
forall a b. (a -> b) -> a -> b
$ HasCallStack =>
Kind -> Prop -> Name -> Prop -> PropTable -> PropTable
Kind -> Prop -> Name -> Prop -> PropTable -> PropTable
addArrayProp Kind
KindGet Prop
ty ([Text]
ns,[Text]
name) Prop
m
            Maybe Prop
Nothing | Prop -> Bool
forall lexeme. Decl lexeme -> Bool
isValueType Prop
ret ->
                ((SIdToName, PropTable) -> (SIdToName, PropTable))
-> StateT (SIdToName, PropTable) Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify (((SIdToName, PropTable) -> (SIdToName, PropTable))
 -> StateT (SIdToName, PropTable) Identity ())
-> ((SIdToName, PropTable) -> (SIdToName, PropTable))
-> StateT (SIdToName, PropTable) Identity ()
forall a b. (a -> b) -> a -> b
$ (PropTable -> PropTable)
-> (SIdToName, PropTable) -> (SIdToName, PropTable)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ((PropTable -> PropTable)
 -> (SIdToName, PropTable) -> (SIdToName, PropTable))
-> (PropTable -> PropTable)
-> (SIdToName, PropTable)
-> (SIdToName, PropTable)
forall a b. (a -> b) -> a -> b
$ HasCallStack =>
SIdToName -> Kind -> Prop -> Name -> Prop -> PropTable -> PropTable
SIdToName -> Kind -> Prop -> Name -> Prop -> PropTable -> PropTable
addValueProp SIdToName
st Kind
KindGet Prop
ret ([Text]
ns,[Text]
name) Prop
m
            Just Prop
ty -> String -> StateT (SIdToName, PropTable) Identity ()
forall a. HasCallStack => String -> a
error (String -> StateT (SIdToName, PropTable) Identity ())
-> String -> StateT (SIdToName, PropTable) Identity ()
forall a b. (a -> b) -> a -> b
$ String
"found a property getter for unsupported type: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Decl (Lexeme Name) -> String
forall a. Show a => a -> String
show (SIdToName -> Prop -> Decl (Lexeme Name)
forall (t :: * -> *).
Traversable t =>
SIdToName -> t (Lexeme Int) -> t (Lexeme Name)
resolve SIdToName
st Prop
ty)
            Maybe Prop
Nothing -> String -> StateT (SIdToName, PropTable) Identity ()
forall a. HasCallStack => String -> a
error (String -> StateT (SIdToName, PropTable) Identity ())
-> String -> StateT (SIdToName, PropTable) Identity ()
forall a b. (a -> b) -> a -> b
$ String
"did not find property parameter for " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Name -> String
display ([Text]
ns,[Text]
name) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
": " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Decl (Lexeme Name) -> String
forall a. Show a => a -> String
show (SIdToName -> Prop -> Decl (Lexeme Name)
forall (t :: * -> *).
Traversable t =>
SIdToName -> t (Lexeme Int) -> t (Lexeme Name)
resolve SIdToName
st Prop
m)
        Maybe Prop -> StateT (SIdToName, PropTable) Identity (Maybe Prop)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Prop
forall a. Maybe a
Nothing
    mth ([Text]
ns, Text
"set":[Text]
name) m :: Prop
m@(Method Constness
MutableThis Prop
_ Lexeme Int
_ [Prop]
params) = do
        case SIdToName -> [Text] -> [Prop] -> Maybe Prop
findPropertyParam SIdToName
st [Text]
name [Prop]
params of
            Just (SizedArrayType (ConstType ty :: Prop
ty@BuiltinType{}) Prop
size) ->
                ((SIdToName, PropTable) -> (SIdToName, PropTable))
-> StateT (SIdToName, PropTable) Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify (((SIdToName, PropTable) -> (SIdToName, PropTable))
 -> StateT (SIdToName, PropTable) Identity ())
-> ((SIdToName, PropTable) -> (SIdToName, PropTable))
-> StateT (SIdToName, PropTable) Identity ()
forall a b. (a -> b) -> a -> b
$ (PropTable -> PropTable)
-> (SIdToName, PropTable) -> (SIdToName, PropTable)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ((PropTable -> PropTable)
 -> (SIdToName, PropTable) -> (SIdToName, PropTable))
-> (PropTable -> PropTable)
-> (SIdToName, PropTable)
-> (SIdToName, PropTable)
forall a b. (a -> b) -> a -> b
$ HasCallStack =>
Kind -> Prop -> Name -> Prop -> PropTable -> PropTable
Kind -> Prop -> Name -> Prop -> PropTable -> PropTable
addArrayProp Kind
KindSet (Prop -> Prop -> Prop
forall lexeme. Decl lexeme -> Decl lexeme -> Decl lexeme
SizedArrayType Prop
ty Prop
size) ([Text]
ns,[Text]
name) Prop
m
            Just (ConstArrayType BuiltinType
ty) ->
                ((SIdToName, PropTable) -> (SIdToName, PropTable))
-> StateT (SIdToName, PropTable) Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify (((SIdToName, PropTable) -> (SIdToName, PropTable))
 -> StateT (SIdToName, PropTable) Identity ())
-> ((SIdToName, PropTable) -> (SIdToName, PropTable))
-> StateT (SIdToName, PropTable) Identity ()
forall a b. (a -> b) -> a -> b
$ (PropTable -> PropTable)
-> (SIdToName, PropTable) -> (SIdToName, PropTable)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ((PropTable -> PropTable)
 -> (SIdToName, PropTable) -> (SIdToName, PropTable))
-> (PropTable -> PropTable)
-> (SIdToName, PropTable)
-> (SIdToName, PropTable)
forall a b. (a -> b) -> a -> b
$ HasCallStack =>
Kind -> Prop -> Name -> Prop -> PropTable -> PropTable
Kind -> Prop -> Name -> Prop -> PropTable -> PropTable
addArrayProp Kind
KindSet (BuiltinType -> Prop
forall lexeme. BuiltinType -> Decl lexeme
ArrayType BuiltinType
ty) ([Text]
ns,[Text]
name) Prop
m
            Just Prop
ty | Prop -> Bool
forall lexeme. Decl lexeme -> Bool
isValueType Prop
ty ->
                ((SIdToName, PropTable) -> (SIdToName, PropTable))
-> StateT (SIdToName, PropTable) Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify (((SIdToName, PropTable) -> (SIdToName, PropTable))
 -> StateT (SIdToName, PropTable) Identity ())
-> ((SIdToName, PropTable) -> (SIdToName, PropTable))
-> StateT (SIdToName, PropTable) Identity ()
forall a b. (a -> b) -> a -> b
$ (PropTable -> PropTable)
-> (SIdToName, PropTable) -> (SIdToName, PropTable)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ((PropTable -> PropTable)
 -> (SIdToName, PropTable) -> (SIdToName, PropTable))
-> (PropTable -> PropTable)
-> (SIdToName, PropTable)
-> (SIdToName, PropTable)
forall a b. (a -> b) -> a -> b
$ HasCallStack =>
SIdToName -> Kind -> Prop -> Name -> Prop -> PropTable -> PropTable
SIdToName -> Kind -> Prop -> Name -> Prop -> PropTable -> PropTable
addValueProp SIdToName
st Kind
KindSet Prop
ty ([Text]
ns,[Text]
name) Prop
m
            Just Prop
ty -> String -> StateT (SIdToName, PropTable) Identity ()
forall a. HasCallStack => String -> a
error (String -> StateT (SIdToName, PropTable) Identity ())
-> String -> StateT (SIdToName, PropTable) Identity ()
forall a b. (a -> b) -> a -> b
$ String
"found a property setter for unsupported type: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Decl (Lexeme Name) -> String
forall a. Show a => a -> String
show (SIdToName -> Prop -> Decl (Lexeme Name)
forall (t :: * -> *).
Traversable t =>
SIdToName -> t (Lexeme Int) -> t (Lexeme Name)
resolve SIdToName
st Prop
ty)
            Maybe Prop
Nothing -> String -> StateT (SIdToName, PropTable) Identity ()
forall a. HasCallStack => String -> a
error (String -> StateT (SIdToName, PropTable) Identity ())
-> String -> StateT (SIdToName, PropTable) Identity ()
forall a b. (a -> b) -> a -> b
$ String
"did not find property parameter for " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Name -> String
display ([Text]
ns,[Text]
name) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
": " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Decl (Lexeme Name) -> String
forall a. Show a => a -> String
show (SIdToName -> Prop -> Decl (Lexeme Name)
forall (t :: * -> *).
Traversable t =>
SIdToName -> t (Lexeme Int) -> t (Lexeme Name)
resolve SIdToName
st Prop
m)
        Maybe Prop -> StateT (SIdToName, PropTable) Identity (Maybe Prop)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Prop
forall a. Maybe a
Nothing

    mth ([Text]
ns, Text
"set":[Text]
name) (Method Constness
ConstThis Prop
_ Lexeme Int
_ [Prop]
_) =
        String -> StateT (SIdToName, PropTable) Identity (Maybe Prop)
forall a. HasCallStack => String -> a
error (String -> StateT (SIdToName, PropTable) Identity (Maybe Prop))
-> String -> StateT (SIdToName, PropTable) Identity (Maybe Prop)
forall a b. (a -> b) -> a -> b
$ String
"setter for " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Name -> String
display ([Text]
ns,[Text]
name) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" has a const `this`"

    mth ([Text]
_, Text
"get":[Text]
_) m :: Prop
m@Method{} = String -> StateT (SIdToName, PropTable) Identity (Maybe Prop)
forall a. HasCallStack => String -> a
error (String -> StateT (SIdToName, PropTable) Identity (Maybe Prop))
-> String -> StateT (SIdToName, PropTable) Identity (Maybe Prop)
forall a b. (a -> b) -> a -> b
$ String
"invalid getter format: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Decl (Lexeme Name) -> String
forall a. Show a => a -> String
show (SIdToName -> Prop -> Decl (Lexeme Name)
forall (t :: * -> *).
Traversable t =>
SIdToName -> t (Lexeme Int) -> t (Lexeme Name)
resolve SIdToName
st Prop
m)
    mth ([Text]
_, Text
"set":[Text]
_) m :: Prop
m@Method{} = String -> StateT (SIdToName, PropTable) Identity (Maybe Prop)
forall a. HasCallStack => String -> a
error (String -> StateT (SIdToName, PropTable) Identity (Maybe Prop))
-> String -> StateT (SIdToName, PropTable) Identity (Maybe Prop)
forall a b. (a -> b) -> a -> b
$ String
"invalid setter format: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Decl (Lexeme Name) -> String
forall a. Show a => a -> String
show (SIdToName -> Prop -> Decl (Lexeme Name)
forall (t :: * -> *).
Traversable t =>
SIdToName -> t (Lexeme Int) -> t (Lexeme Name)
resolve SIdToName
st Prop
m)

    mth Name
_ Prop
m = Maybe Prop -> StateT (SIdToName, PropTable) Identity (Maybe Prop)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Prop -> StateT (SIdToName, PropTable) Identity (Maybe Prop))
-> Maybe Prop
-> StateT (SIdToName, PropTable) Identity (Maybe Prop)
forall a b. (a -> b) -> a -> b
$ Prop -> Maybe Prop
forall a. a -> Maybe a
Just Prop
m

findPropertyParam :: SIdToName -> [Text] -> [Sym] -> Maybe Sym
findPropertyParam :: SIdToName -> [Text] -> [Prop] -> Maybe Prop
findPropertyParam SIdToName
st [Text]
name =
    (Prop -> Bool) -> [Prop] -> Maybe Prop
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
Foldable.find Prop -> Bool
isProperty ([Prop] -> Maybe Prop)
-> (Prop -> Maybe Prop) -> [Prop] -> Maybe Prop
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Prop -> Maybe Prop
forall lexeme. Decl lexeme -> Maybe (Decl lexeme)
getVarType
  where
    isProperty :: Prop -> Bool
isProperty = ([Text] -> Maybe [Text]
forall a. a -> Maybe a
Just [Text]
name Maybe [Text] -> Maybe [Text] -> Bool
forall a. Eq a => a -> a -> Bool
==) (Maybe [Text] -> Bool) -> (Prop -> Maybe [Text]) -> Prop -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Lexeme Int -> [Text]) -> Maybe (Lexeme Int) -> Maybe [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Name -> [Text]
forall a b. (a, b) -> b
snd (Name -> [Text]) -> (Lexeme Int -> Name) -> Lexeme Int -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SIdToName -> Int -> Name
SymbolTable.mustLookup SIdToName
st (Int -> Name) -> (Lexeme Int -> Int) -> Lexeme Int -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lexeme Int -> Int
forall text. Lexeme text -> text
lexemeText) (Maybe (Lexeme Int) -> Maybe [Text])
-> (Prop -> Maybe (Lexeme Int)) -> Prop -> Maybe [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Prop -> Maybe (Lexeme Int)
declName

    getVarType :: Decl lexeme -> Maybe (Decl lexeme)
getVarType (Var Decl lexeme
ty lexeme
_) = Decl lexeme -> Maybe (Decl lexeme)
forall a. a -> Maybe a
Just Decl lexeme
ty
    getVarType Decl lexeme
_          = Maybe (Decl lexeme)
forall a. Maybe a
Nothing

isValueType :: Decl lexeme -> Bool
isValueType :: Decl lexeme -> Bool
isValueType (BuiltinType SInt{}) = Bool
True
isValueType (BuiltinType UInt{}) = Bool
True
isValueType (BuiltinType BuiltinType
Bool)   = Bool
True
isValueType (BuiltinType BuiltinType
String) = Bool
True
isValueType Typename{}           = Bool
True
isValueType Decl lexeme
_                    = Bool
False

isArrayType :: Decl lexeme -> Bool
isArrayType :: Decl lexeme -> Bool
isArrayType ArrayType{}      = Bool
True
isArrayType UserArrayType{}  = Bool
True
isArrayType SizedArrayType{} = Bool
True
isArrayType Decl lexeme
_                = Bool
False

addValueProp :: HasCallStack => SIdToName -> Kind -> Sym -> Name -> Sym -> PropTable -> PropTable
addValueProp :: SIdToName -> Kind -> Prop -> Name -> Prop -> PropTable -> PropTable
addValueProp SIdToName
st Kind
kind Prop
ty Name
name Prop
mth PropTable
syms =
    Name -> Prop -> PropTable -> PropTable
forall k v.
(Eq k, Hashable k) =>
k -> v -> InsOrdHashMap k v -> InsOrdHashMap k v
InsOrdHashMap.insert Name
name Prop
prop' PropTable
syms
  where
    prop' :: Prop
prop' =
        case (Kind
kind, Prop
prop) of
            (Kind
KindGet, ValueProp Prop
valTy Maybe Prop
Nothing Maybe Prop
set) -> Prop -> Maybe Prop -> Maybe Prop -> Prop
forall lexeme.
Decl lexeme
-> Maybe (Decl lexeme) -> Maybe (Decl lexeme) -> Decl lexeme
ValueProp Prop
valTy (Prop -> Maybe Prop
forall a. a -> Maybe a
Just Prop
mth) Maybe Prop
set
            (Kind
KindSet, ValueProp Prop
valTy Maybe Prop
get Maybe Prop
Nothing) -> Prop -> Maybe Prop -> Maybe Prop -> Prop
forall lexeme.
Decl lexeme
-> Maybe (Decl lexeme) -> Maybe (Decl lexeme) -> Decl lexeme
ValueProp Prop
valTy Maybe Prop
get (Prop -> Maybe Prop
forall a. a -> Maybe a
Just Prop
mth)
            (Kind, Prop)
_ -> String -> Prop
forall a. HasCallStack => String -> a
error (String -> Prop) -> String -> Prop
forall a b. (a -> b) -> a -> b
$ String
"accessor of type " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Kind -> String
forall a. Show a => a -> String
show Kind
kind String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" already present for value property " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Name -> String
forall a. Show a => a -> String
show Name
name String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
": " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (Prop, Decl (Lexeme Name)) -> String
forall a. Show a => a -> String
show (Prop
mth, SIdToName -> Prop -> Decl (Lexeme Name)
forall (t :: * -> *).
Traversable t =>
SIdToName -> t (Lexeme Int) -> t (Lexeme Name)
resolve SIdToName
st Prop
prop)
    prop :: Prop
prop =
        case Name -> PropTable -> Maybe Prop
forall k v. (Eq k, Hashable k) => k -> InsOrdHashMap k v -> Maybe v
InsOrdHashMap.lookup Name
name PropTable
syms of
            Maybe Prop
Nothing  -> Prop -> Maybe Prop -> Maybe Prop -> Prop
forall lexeme.
Decl lexeme
-> Maybe (Decl lexeme) -> Maybe (Decl lexeme) -> Decl lexeme
ValueProp Prop
ty Maybe Prop
forall a. Maybe a
Nothing Maybe Prop
forall a. Maybe a
Nothing
            Just Prop
acc -> Prop
acc


addArrayProp :: HasCallStack => Kind -> Sym -> Name -> Sym -> PropTable -> PropTable
addArrayProp :: Kind -> Prop -> Name -> Prop -> PropTable -> PropTable
addArrayProp Kind
kind Prop
ty Name
name Prop
mth PropTable
syms =
    Name -> Prop -> PropTable -> PropTable
forall k v.
(Eq k, Hashable k) =>
k -> v -> InsOrdHashMap k v -> InsOrdHashMap k v
InsOrdHashMap.insert Name
name Prop
prop' PropTable
syms
  where
    prop' :: Prop
prop' =
        case (Kind
kind, Prop
prop) of
            (Kind
KindGet, ArrayProp Prop
arrTy Maybe Prop
Nothing Maybe Prop
set Maybe Prop
size) -> Prop -> Maybe Prop -> Maybe Prop -> Maybe Prop -> Prop
forall lexeme.
Decl lexeme
-> Maybe (Decl lexeme)
-> Maybe (Decl lexeme)
-> Maybe (Decl lexeme)
-> Decl lexeme
ArrayProp Prop
arrTy (Prop -> Maybe Prop
forall a. a -> Maybe a
Just Prop
mth) Maybe Prop
set Maybe Prop
size
            (Kind
KindSet, ArrayProp Prop
arrTy Maybe Prop
get Maybe Prop
Nothing Maybe Prop
size) -> Prop -> Maybe Prop -> Maybe Prop -> Maybe Prop -> Prop
forall lexeme.
Decl lexeme
-> Maybe (Decl lexeme)
-> Maybe (Decl lexeme)
-> Maybe (Decl lexeme)
-> Decl lexeme
ArrayProp Prop
arrTy Maybe Prop
get (Prop -> Maybe Prop
forall a. a -> Maybe a
Just Prop
mth) Maybe Prop
size
            (Kind
KindSize, ArrayProp Prop
arrTy Maybe Prop
get Maybe Prop
set Maybe Prop
Nothing) -> Prop -> Maybe Prop -> Maybe Prop -> Maybe Prop -> Prop
forall lexeme.
Decl lexeme
-> Maybe (Decl lexeme)
-> Maybe (Decl lexeme)
-> Maybe (Decl lexeme)
-> Decl lexeme
ArrayProp Prop
arrTy Maybe Prop
get Maybe Prop
set (Prop -> Maybe Prop
forall a. a -> Maybe a
Just Prop
mth)
            (Kind, Prop)
_ -> String -> Prop
forall a. HasCallStack => String -> a
error (String -> Prop) -> String -> Prop
forall a b. (a -> b) -> a -> b
$ String
"accessor of type " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Kind -> String
forall a. Show a => a -> String
show Kind
kind String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" already present for array property " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Name -> String
forall a. Show a => a -> String
show Name
name String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
": " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (Prop, Prop) -> String
forall a. Show a => a -> String
show (Prop
mth, Prop
prop)
    prop :: Prop
prop =
        case Name -> PropTable -> Maybe Prop
forall k v. (Eq k, Hashable k) => k -> InsOrdHashMap k v -> Maybe v
InsOrdHashMap.lookup Name
name PropTable
syms of
            Maybe Prop
Nothing  -> Prop -> Maybe Prop -> Maybe Prop -> Maybe Prop -> Prop
forall lexeme.
Decl lexeme
-> Maybe (Decl lexeme)
-> Maybe (Decl lexeme)
-> Maybe (Decl lexeme)
-> Decl lexeme
ArrayProp Prop
ty Maybe Prop
forall a. Maybe a
Nothing Maybe Prop
forall a. Maybe a
Nothing Maybe Prop
forall a. Maybe a
Nothing
            -- If we didn't know it yet, maybe we do now.
            Just (ArrayProp (BuiltinType BuiltinType
Void) Maybe Prop
get Maybe Prop
set Maybe Prop
size) -> Prop -> Maybe Prop -> Maybe Prop -> Maybe Prop -> Prop
forall lexeme.
Decl lexeme
-> Maybe (Decl lexeme)
-> Maybe (Decl lexeme)
-> Maybe (Decl lexeme)
-> Decl lexeme
ArrayProp Prop
ty Maybe Prop
get Maybe Prop
set Maybe Prop
size
            Just Prop
acc -> Prop
acc