{-# LANGUAGE DataKinds, DuplicateRecordFields, FlexibleContexts, FlexibleInstances,
             MultiParamTypeClasses, OverloadedStrings, RankNTypes,
             ScopedTypeVariables, TemplateHaskell, TypeApplications, TypeFamilies, UndecidableInstances #-}

-- | The main export of this module is the function 'foldConstants' that folds the constants in an ISO Modula-2 AST
-- using an attribute grammar. Other exports are helper functions and attribute types that can be reused for other
-- languages or attribute grammars.

module Language.Modula2.ISO.ConstantFolder (foldConstants, InhCF,
                                            SynCF(..), SynCFDesignator(..), SynCFExp(..), SynCFMod', Environment) where

import Control.Applicative (liftA2, ZipList(ZipList, getZipList))
import Control.Arrow (first)
import Control.Monad (join)
import Data.Bits (shift)
import Data.Char (chr, ord, toUpper)
import Data.Coerce (Coercible, coerce)
import Data.Functor.Identity (Identity(..))
import Data.Int (Int32)
import Data.Foldable (fold)
import Data.List.NonEmpty (toList)
import Data.Map.Lazy (Map)
import Data.Maybe (fromMaybe)
import qualified Data.Map.Lazy as Map
import Data.Semigroup (Semigroup(..))
import qualified Data.Text as Text
import Foreign.Storable (sizeOf)
import Language.Haskell.TH (appT, conT, varT, varE, newName)
import Data.Text.Prettyprint.Doc (Pretty)

import qualified Rank2
import qualified Transformation
import qualified Transformation.Deep as Deep
import qualified Transformation.Full as Full
import qualified Transformation.Full.TH
import qualified Transformation.AG as AG
import Transformation.AG (Attribution(..), Atts, Inherited(..), Synthesized(..), Semantics)
import Transformation.AG.Generics (Bequether(..), Synthesizer(..), SynthesizedField(..), Auto(Auto), Mapped(..))

import qualified Language.Modula2.Abstract as Abstract hiding (Modula2)
import qualified Language.Modula2.ISO.Abstract as Abstract
import qualified Language.Modula2.AST as Report
import qualified Language.Modula2.AST as AST (Ident, QualIdent, Module(..), Export(..),
                                              ProcedureHeading(..), FieldList(..), Designator(..),
                                              Element(..), Value(..))
import qualified Language.Modula2.ISO.AST as AST
import Language.Modula2.Grammar (ParsedLexemes(Trailing))
import Language.Oberon.Abstract (coExpression, coValue)
import qualified Language.Oberon.Abstract as Oberon.Abstract
import qualified Language.Oberon.AST as Oberon.AST
import qualified Language.Oberon.ConstantFolder as Oberon.ConstantFolder
import Language.Oberon.ConstantFolder (ConstantFold(ConstantFold), Placed, Sem, Environment,
                                       InhCF(..), InhCFRoot(..), SynCF(..), SynCF',
                                       SynCFRoot(..), SynCFMod(..), SynCFMod', SynCFExp(..), SynCFDesignator(..),
                                       folded', foldedExp, foldedExp')
import Language.Modula2.ConstantFolder (foldBinaryArithmetic, foldBinaryBoolean,
                                        foldBinaryFractional, foldBinaryInteger,
                                        maxCardinal, maxInteger, minInteger, maxInt32, minInt32, maxSet, minSet,
                                        doubleSize, floatSize, intSize, int32Size,
                                        maxReal, minReal)

-- | Fold the constants in the given collection of Modula-2 modules (a 'Map' of modules keyed by module name). It uses
-- the constant declarations from the modules as well as the given 'Environment' of predefined constants and
-- functions.
--
-- Note that the ISO Modula-2 'AST.Language' satisfies all constraints in the function's type signature.
foldConstants :: forall l. (Abstract.Modula2 l, Abstract.Nameable l,
                            Ord (Abstract.QualIdent l), Show (Abstract.QualIdent l),
                            Atts (Inherited (Auto ConstantFold)) (Abstract.Block l l Sem Sem) ~ InhCF l,
                            Atts (Inherited (Auto ConstantFold)) (Abstract.Definition l l Sem Sem) ~ InhCF l,
                            Atts (Inherited (Auto ConstantFold)) (Abstract.Expression l l Sem Sem) ~ InhCF l,
                            Atts (Synthesized (Auto ConstantFold)) (Abstract.Block l l Sem Sem)
                            ~ SynCFMod' l (Abstract.Block l l),
                            Atts (Synthesized (Auto ConstantFold)) (Abstract.Block l l Placed Placed)
                            ~ SynCFMod' l (Abstract.Block l l),
                            Atts (Synthesized (Auto ConstantFold)) (Abstract.Definition l l Sem Sem)
                            ~ SynCFMod' l (Abstract.Definition l l),
                            Atts (Synthesized (Auto ConstantFold)) (Abstract.Definition l l Placed Placed)
                            ~ SynCFMod' l (Abstract.Definition l l),
                            Atts (Synthesized (Auto ConstantFold)) (Abstract.Expression l l Sem Sem) ~ SynCFExp l l,
                            Atts (Synthesized (Auto ConstantFold)) (Abstract.Expression l l Placed Placed)
                            ~ SynCFExp l l,
                            Full.Functor (Auto ConstantFold) (Abstract.Block l l),
                            Full.Functor (Auto ConstantFold) (Abstract.Definition l l),
                            Full.Functor (Auto ConstantFold) (Abstract.Expression l l))
              => Environment l -> AST.Module l l Placed Placed -> AST.Module l l Placed Placed
foldConstants :: Environment l
-> Module l l Placed Placed -> Module l l Placed Placed
foldConstants Environment l
predef Module l l Placed Placed
aModule =
   ((Int, ParsedLexemes, Int), Module l l Placed Placed)
-> Module l l Placed Placed
forall a b. (a, b) -> b
snd (((Int, ParsedLexemes, Int), Module l l Placed Placed)
 -> Module l l Placed Placed)
-> ((Int, ParsedLexemes, Int), Module l l Placed Placed)
-> Module l l Placed Placed
forall a b. (a -> b) -> a -> b
$ Mapped Placed (Module l l Placed Placed)
-> ((Int, ParsedLexemes, Int), Module l l Placed Placed)
forall k (f :: k -> *) (a :: k). Mapped f a -> f a
getMapped
   (Mapped Placed (Module l l Placed Placed)
 -> ((Int, ParsedLexemes, Int), Module l l Placed Placed))
-> Mapped Placed (Module l l Placed Placed)
-> ((Int, ParsedLexemes, Int), Module l l Placed Placed)
forall a b. (a -> b) -> a -> b
$ SynCFMod l (Module l l Placed Placed)
-> Mapped Placed (Module l l Placed Placed)
forall l a. SynCFMod l a -> Mapped Placed a
folded (Synthesized
  (Auto ConstantFold)
  (Module
     l
     l
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
-> Atts
     (Synthesized (Auto ConstantFold))
     (Module
        l
        l
        (Semantics (Auto ConstantFold))
        (Semantics (Auto ConstantFold)))
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn (Auto ConstantFold
-> Domain
     (Auto ConstantFold)
     (Module
        l
        l
        (Semantics (Auto ConstantFold))
        (Semantics (Auto ConstantFold)))
-> Codomain
     (Auto ConstantFold)
     (Module
        l
        l
        (Semantics (Auto ConstantFold))
        (Semantics (Auto ConstantFold)))
forall t x. At t x => t -> Domain t x -> Codomain t x
Transformation.apply (ConstantFold -> Auto ConstantFold
forall t. t -> Auto t
Auto ConstantFold
ConstantFold) ((Int
0, [Lexeme] -> ParsedLexemes
Trailing [], Int
0), ConstantFold -> Auto ConstantFold
forall t. t -> Auto t
Auto ConstantFold
ConstantFold Auto ConstantFold
-> Module
     l l (Domain (Auto ConstantFold)) (Domain (Auto ConstantFold))
-> Module
     l l (Codomain (Auto ConstantFold)) (Codomain (Auto ConstantFold))
forall t (g :: (* -> *) -> (* -> *) -> *).
Functor t g =>
t -> g (Domain t) (Domain t) -> g (Codomain t) (Codomain t)
Deep.<$> Module l l Placed Placed
Module
  l l (Domain (Auto ConstantFold)) (Domain (Auto ConstantFold))
aModule)
                  Semantics
  (Auto ConstantFold)
  (Module
     l
     l
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
-> Inherited
     (Auto ConstantFold)
     (Module
        l
        l
        (Semantics (Auto ConstantFold))
        (Semantics (Auto ConstantFold)))
-> Synthesized
     (Auto ConstantFold)
     (Module
        l
        l
        (Semantics (Auto ConstantFold))
        (Semantics (Auto ConstantFold)))
forall k (p :: k -> *) (q :: k -> *) (a :: k).
Arrow p q a -> p a -> q a
`Rank2.apply`
                  Atts
  (Inherited (Auto ConstantFold))
  (Module
     l
     l
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
-> Inherited
     (Auto ConstantFold)
     (Module
        l
        l
        (Semantics (Auto ConstantFold))
        (Semantics (Auto ConstantFold)))
forall t a. Atts (Inherited t) a -> Inherited t a
Inherited (Environment l -> Ident -> InhCF l
forall l. Environment l -> Ident -> InhCF l
InhCF Environment l
predef Ident
forall a. HasCallStack => a
undefined))
             :: SynCFMod' l (AST.Module l l))

newtype Modules l f' f = Modules {Modules l f' f -> Map Ident (f (Module l l f' f'))
getModules :: Map AST.Ident (f (AST.Module l l f' f'))}

-- * Modules instances, TH candidates
instance (Transformation.Transformation t, Functor (Transformation.Domain t), Deep.Functor t (AST.Module l l),
          Transformation.At t (AST.Module l l (Transformation.Codomain t) (Transformation.Codomain t))) =>
         Deep.Functor t (Modules l) where
   t
t <$> :: t
-> Modules l (Domain t) (Domain t)
-> Modules l (Codomain t) (Codomain t)
<$> ~(Modules Map Ident (Domain t (Module l l (Domain t) (Domain t)))
ms) = Map Ident (Codomain t (Module l l (Codomain t) (Codomain t)))
-> Modules l (Codomain t) (Codomain t)
forall l (f' :: * -> *) (f :: * -> *).
Map Ident (f (Module l l f' f')) -> Modules l f' f
Modules (Domain t (Module l l (Domain t) (Domain t))
-> Codomain t (Module l l (Codomain t) (Codomain t))
mapModule (Domain t (Module l l (Domain t) (Domain t))
 -> Codomain t (Module l l (Codomain t) (Codomain t)))
-> Map Ident (Domain t (Module l l (Domain t) (Domain t)))
-> Map Ident (Codomain t (Module l l (Codomain t) (Codomain t)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Ident (Domain t (Module l l (Domain t) (Domain t)))
ms)
      where mapModule :: Domain t (Module l l (Domain t) (Domain t))
-> Codomain t (Module l l (Codomain t) (Codomain t))
mapModule Domain t (Module l l (Domain t) (Domain t))
m = t
t t
-> Domain t (Module l l (Codomain t) (Codomain t))
-> Codomain t (Module l l (Codomain t) (Codomain t))
forall t x. At t x => t -> Domain t x -> Codomain t x
Transformation.$ ((t
t t
-> Module l l (Domain t) (Domain t)
-> Module l l (Codomain t) (Codomain t)
forall t (g :: (* -> *) -> (* -> *) -> *).
Functor t g =>
t -> g (Domain t) (Domain t) -> g (Codomain t) (Codomain t)
Deep.<$>) (Module l l (Domain t) (Domain t)
 -> Module l l (Codomain t) (Codomain t))
-> Domain t (Module l l (Domain t) (Domain t))
-> Domain t (Module l l (Codomain t) (Codomain t))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Domain t (Module l l (Domain t) (Domain t))
m)

instance Rank2.Functor (Modules l f') where
   forall a. p a -> q a
f <$> :: (forall a. p a -> q a) -> Modules l f' p -> Modules l f' q
<$> ~(Modules Map Ident (p (Module l l f' f'))
ms) = Map Ident (q (Module l l f' f')) -> Modules l f' q
forall l (f' :: * -> *) (f :: * -> *).
Map Ident (f (Module l l f' f')) -> Modules l f' f
Modules (p (Module l l f' f') -> q (Module l l f' f')
forall a. p a -> q a
f (p (Module l l f' f') -> q (Module l l f' f'))
-> Map Ident (p (Module l l f' f'))
-> Map Ident (q (Module l l f' f'))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Ident (p (Module l l f' f'))
ms)

instance Rank2.Apply (Modules l f') where
   ~(Modules Map Ident ((~>) p q (Module l l f' f'))
fs) <*> :: Modules l f' (p ~> q) -> Modules l f' p -> Modules l f' q
<*> ~(Modules Map Ident (p (Module l l f' f'))
ms) = Map Ident (q (Module l l f' f')) -> Modules l f' q
forall l (f' :: * -> *) (f :: * -> *).
Map Ident (f (Module l l f' f')) -> Modules l f' f
Modules (((~>) p q (Module l l f' f')
 -> p (Module l l f' f') -> q (Module l l f' f'))
-> Map Ident ((~>) p q (Module l l f' f'))
-> Map Ident (p (Module l l f' f'))
-> Map Ident (q (Module l l f' f'))
forall k a b c.
Ord k =>
(a -> b -> c) -> Map k a -> Map k b -> Map k c
Map.intersectionWith (~>) p q (Module l l f' f')
-> p (Module l l f' f') -> q (Module l l f' f')
forall k (p :: k -> *) (q :: k -> *) (a :: k).
Arrow p q a -> p a -> q a
Rank2.apply Map Ident ((~>) p q (Module l l f' f'))
fs Map Ident (p (Module l l f' f'))
ms)

-- * Boring attribute types
type instance Atts (Synthesized (Auto ConstantFold)) (Modules l _ _) = SynCFRoot (Modules l Placed Identity)
type instance Atts (Synthesized (Auto ConstantFold)) (AST.Block λ l _ _) = SynCFMod' l (AST.Block l l)
type instance Atts (Synthesized (Auto ConstantFold)) (AST.Declaration full λ l _ _) = SynCFMod' l (AST.Declaration full l l)
type instance Atts (Synthesized (Auto ConstantFold)) (AST.AddressedIdent λ l _ _) = SynCF' (AST.AddressedIdent l l)
type instance Atts (Synthesized (Auto ConstantFold)) (AST.Type λ l _ _) = SynCF' (AST.Type l l)
type instance Atts (Synthesized (Auto ConstantFold)) (AST.Expression λ l _ _) = SynCFExp λ l
type instance Atts (Synthesized (Auto ConstantFold)) (AST.Item λ l _ _) = SynCF' (AST.Item l l)
type instance Atts (Synthesized (Auto ConstantFold)) (AST.Statement λ l _ _) = SynCF' (AST.Statement l l)
type instance Atts (Synthesized (Auto ConstantFold)) (AST.Variant λ l _ _) = SynCF' (AST.Variant l l)

type instance Atts (Inherited (Auto ConstantFold)) (Modules l _ _) = InhCFRoot l
type instance Atts (Inherited (Auto ConstantFold)) (AST.Block λ l _ _) = InhCF λ
type instance Atts (Inherited (Auto ConstantFold)) (AST.Declaration full λ l _ _) = InhCF λ
type instance Atts (Inherited (Auto ConstantFold)) (AST.AddressedIdent λ l _ _) = InhCF λ
type instance Atts (Inherited (Auto ConstantFold)) (AST.Type λ l _ _) = InhCF λ
type instance Atts (Inherited (Auto ConstantFold)) (AST.Item λ l _ _) = InhCF λ
type instance Atts (Inherited (Auto ConstantFold)) (AST.Expression λ l _ _) = InhCF λ
type instance Atts (Inherited (Auto ConstantFold)) (AST.Statement λ l _ _) = InhCF λ
type instance Atts (Inherited (Auto ConstantFold)) (AST.Variant λ l _ _) = InhCF λ

wrap :: a -> Mapped Placed a
wrap :: a -> Mapped Placed a
wrap = ((Int, ParsedLexemes, Int), a) -> Mapped Placed a
forall k (f :: k -> *) (a :: k). f a -> Mapped f a
Mapped (((Int, ParsedLexemes, Int), a) -> Mapped Placed a)
-> (a -> ((Int, ParsedLexemes, Int), a)) -> a -> Mapped Placed a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,) (Int
0, [Lexeme] -> ParsedLexemes
Trailing [], Int
0)

-- * Rules

instance Ord (Abstract.QualIdent l) => Attribution (Auto ConstantFold) (Modules l) Sem Placed where
   attribution :: Auto ConstantFold
-> Placed
     (Modules
        l (Semantics (Auto ConstantFold)) (Semantics (Auto ConstantFold)))
-> Rule (Auto ConstantFold) (Modules l)
attribution Auto ConstantFold
_ ((Int, ParsedLexemes, Int)
_, Modules Map
  Ident
  (Sem
     (Module
        l
        l
        (Semantics (Auto ConstantFold))
        (Semantics (Auto ConstantFold))))
self) (Inherited Atts (Inherited (Auto ConstantFold)) (Modules l sem sem)
inheritance, Modules Map Ident (Synthesized (Auto ConstantFold) (Module l l sem sem))
ms) =
     (Atts (Synthesized (Auto ConstantFold)) (Modules l sem sem)
-> Synthesized (Auto ConstantFold) (Modules l sem sem)
forall t a. Atts (Synthesized t) a -> Synthesized t a
Synthesized SynCFRoot :: forall a. a -> SynCFRoot a
SynCFRoot{$sel:modulesFolded:SynCFRoot :: Modules l Placed Identity
modulesFolded= Map Ident (Identity (Module l l Placed Placed))
-> Modules l Placed Identity
forall l (f' :: * -> *) (f :: * -> *).
Map Ident (f (Module l l f' f')) -> Modules l f' f
Modules (Module l l Placed Placed -> Identity (Module l l Placed Placed)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Module l l Placed Placed -> Identity (Module l l Placed Placed))
-> (Synthesized (Auto ConstantFold) (Module l l sem sem)
    -> Module l l Placed Placed)
-> Synthesized (Auto ConstantFold) (Module l l sem sem)
-> Identity (Module l l Placed Placed)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, ParsedLexemes, Int), Module l l Placed Placed)
-> Module l l Placed Placed
forall a b. (a, b) -> b
snd (((Int, ParsedLexemes, Int), Module l l Placed Placed)
 -> Module l l Placed Placed)
-> (Synthesized (Auto ConstantFold) (Module l l sem sem)
    -> ((Int, ParsedLexemes, Int), Module l l Placed Placed))
-> Synthesized (Auto ConstantFold) (Module l l sem sem)
-> Module l l Placed Placed
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mapped Placed (Module l l Placed Placed)
-> ((Int, ParsedLexemes, Int), Module l l Placed Placed)
forall k (f :: k -> *) (a :: k). Mapped f a -> f a
getMapped (Mapped Placed (Module l l Placed Placed)
 -> ((Int, ParsedLexemes, Int), Module l l Placed Placed))
-> (Synthesized (Auto ConstantFold) (Module l l sem sem)
    -> Mapped Placed (Module l l Placed Placed))
-> Synthesized (Auto ConstantFold) (Module l l sem sem)
-> ((Int, ParsedLexemes, Int), Module l l Placed Placed)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SynCFMod' l (Module l l)
-> Mapped Placed (Module l l Placed Placed)
foldedModule (SynCFMod' l (Module l l)
 -> Mapped Placed (Module l l Placed Placed))
-> (Synthesized (Auto ConstantFold) (Module l l sem sem)
    -> SynCFMod' l (Module l l))
-> Synthesized (Auto ConstantFold) (Module l l sem sem)
-> Mapped Placed (Module l l Placed Placed)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Synthesized (Auto ConstantFold) (Module l l sem sem)
-> SynCFMod' l (Module l l)
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn (Synthesized (Auto ConstantFold) (Module l l sem sem)
 -> Identity (Module l l Placed Placed))
-> Map Ident (Synthesized (Auto ConstantFold) (Module l l sem sem))
-> Map Ident (Identity (Module l l Placed Placed))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Ident (Synthesized (Auto ConstantFold) (Module l l sem sem))
ms)},
      Map Ident (Inherited (Auto ConstantFold) (Module l l sem sem))
-> Modules l sem (Inherited (Auto ConstantFold))
forall l (f' :: * -> *) (f :: * -> *).
Map Ident (f (Module l l f' f')) -> Modules l f' f
Modules ((Ident
 -> Sem
      (Module
         l
         l
         (Semantics (Auto ConstantFold))
         (Semantics (Auto ConstantFold)))
 -> Inherited (Auto ConstantFold) (Module l l sem sem))
-> Map
     Ident
     (Sem
        (Module
           l
           l
           (Semantics (Auto ConstantFold))
           (Semantics (Auto ConstantFold))))
-> Map Ident (Inherited (Auto ConstantFold) (Module l l sem sem))
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey Ident
-> Sem
     (Module
        l
        l
        (Semantics (Auto ConstantFold))
        (Semantics (Auto ConstantFold)))
-> Inherited (Auto ConstantFold) (Module l l sem sem)
moduleInheritance Map
  Ident
  (Sem
     (Module
        l
        l
        (Semantics (Auto ConstantFold))
        (Semantics (Auto ConstantFold))))
self))
     where moduleInheritance :: Ident
-> Sem
     (Module
        l
        l
        (Semantics (Auto ConstantFold))
        (Semantics (Auto ConstantFold)))
-> Inherited (Auto ConstantFold) (Module l l sem sem)
moduleInheritance Ident
name Sem
  (Module
     l
     l
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
mod = Atts (Inherited (Auto ConstantFold)) (Module l l sem sem)
-> Inherited (Auto ConstantFold) (Module l l sem sem)
forall t a. Atts (Inherited t) a -> Inherited t a
Inherited InhCF :: forall l. Environment l -> Ident -> InhCF l
InhCF{$sel:env:InhCF :: Environment l
env= InhCFRoot l -> Environment l
forall l. InhCFRoot l -> Environment l
rootEnv Atts (Inherited (Auto ConstantFold)) (Modules l sem sem)
InhCFRoot l
inheritance Environment l -> Environment l -> Environment l
forall a. Semigroup a => a -> a -> a
<> (Synthesized (Auto ConstantFold) (Module l l sem sem)
 -> Environment l)
-> Map Ident (Synthesized (Auto ConstantFold) (Module l l sem sem))
-> Environment l
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (SynCFMod' l (Module l l) -> Environment l
forall l a. SynCFMod l a -> Environment l
moduleEnv (SynCFMod' l (Module l l) -> Environment l)
-> (Synthesized (Auto ConstantFold) (Module l l sem sem)
    -> SynCFMod' l (Module l l))
-> Synthesized (Auto ConstantFold) (Module l l sem sem)
-> Environment l
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Synthesized (Auto ConstantFold) (Module l l sem sem)
-> SynCFMod' l (Module l l)
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn) Map Ident (Synthesized (Auto ConstantFold) (Module l l sem sem))
ms,
                                                        $sel:currentModule:InhCF :: Ident
currentModule= Ident
name}
           foldedModule :: SynCFMod' l (AST.Module l l) -> Mapped Placed (AST.Module l l Placed Placed)
           foldedModule :: SynCFMod' l (Module l l)
-> Mapped Placed (Module l l Placed Placed)
foldedModule = SynCFMod' l (Module l l)
-> Mapped Placed (Module l l Placed Placed)
forall l a. SynCFMod l a -> Mapped Placed a
folded

instance (Abstract.Nameable l, Ord (Abstract.QualIdent l),
          Atts (Synthesized (Auto ConstantFold)) (Abstract.Declaration l l Sem Sem) ~ SynCFMod' l (Abstract.Declaration l l),
          Atts (Inherited (Auto ConstantFold)) (Abstract.StatementSequence l l Sem Sem) ~ InhCF l,
          Atts (Inherited (Auto ConstantFold)) (Abstract.Declaration l l Sem Sem) ~ InhCF l) =>
         Bequether (Auto ConstantFold) (AST.Block l l) Sem Placed where
   bequest :: Auto ConstantFold
-> Placed
     (Block
        l
        l
        (Semantics (Auto ConstantFold))
        (Semantics (Auto ConstantFold)))
-> Atts (Inherited (Auto ConstantFold)) (Block l l sem sem)
-> Block l l sem (Synthesized (Auto ConstantFold))
-> Block l l sem (Inherited (Auto ConstantFold))
bequest Auto ConstantFold
_ ((Int, ParsedLexemes, Int)
pos, AST.Block ZipList
  (Sem
     (Declaration
        l
        l
        (Semantics (Auto ConstantFold))
        (Semantics (Auto ConstantFold))))
_decls Maybe
  (Sem
     (StatementSequence
        l
        l
        (Semantics (Auto ConstantFold))
        (Semantics (Auto ConstantFold))))
_stats) Atts (Inherited (Auto ConstantFold)) (Block l l sem sem)
inheritance (AST.Block ZipList (Synthesized (Auto ConstantFold) (Declaration l l sem sem))
decls Maybe
  (Synthesized (Auto ConstantFold) (StatementSequence l l sem sem))
stats) =
      ZipList (Inherited (Auto ConstantFold) (Declaration l l sem sem))
-> Maybe
     (Inherited (Auto ConstantFold) (StatementSequence l l sem sem))
-> Block l l sem (Inherited (Auto ConstantFold))
forall λ l (f' :: * -> *) (f :: * -> *).
ZipList (f (Declaration l l f' f'))
-> Maybe (f (StatementSequence l l f' f')) -> Block λ l f' f
AST.Block (Inherited
  (Auto ConstantFold)
  (Declaration
     l
     l
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
-> ZipList
     (Inherited
        (Auto ConstantFold)
        (Declaration
           l
           l
           (Semantics (Auto ConstantFold))
           (Semantics (Auto ConstantFold))))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inherited
   (Auto ConstantFold)
   (Declaration
      l
      l
      (Semantics (Auto ConstantFold))
      (Semantics (Auto ConstantFold)))
 -> ZipList
      (Inherited
         (Auto ConstantFold)
         (Declaration
            l
            l
            (Semantics (Auto ConstantFold))
            (Semantics (Auto ConstantFold)))))
-> Inherited
     (Auto ConstantFold)
     (Declaration
        l
        l
        (Semantics (Auto ConstantFold))
        (Semantics (Auto ConstantFold)))
-> ZipList
     (Inherited
        (Auto ConstantFold)
        (Declaration
           l
           l
           (Semantics (Auto ConstantFold))
           (Semantics (Auto ConstantFold))))
forall a b. (a -> b) -> a -> b
$ Atts
  (Inherited (Auto ConstantFold))
  (Declaration
     l
     l
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
-> Inherited
     (Auto ConstantFold)
     (Declaration
        l
        l
        (Semantics (Auto ConstantFold))
        (Semantics (Auto ConstantFold)))
forall t a. Atts (Inherited t) a -> Inherited t a
Inherited Atts
  (Inherited (Auto ConstantFold))
  (Declaration
     l
     l
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
InhCF l
localEnv) (Inherited
  (Auto ConstantFold)
  (StatementSequence
     l
     l
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
-> Maybe
     (Inherited
        (Auto ConstantFold)
        (StatementSequence
           l
           l
           (Semantics (Auto ConstantFold))
           (Semantics (Auto ConstantFold))))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inherited
   (Auto ConstantFold)
   (StatementSequence
      l
      l
      (Semantics (Auto ConstantFold))
      (Semantics (Auto ConstantFold)))
 -> Maybe
      (Inherited
         (Auto ConstantFold)
         (StatementSequence
            l
            l
            (Semantics (Auto ConstantFold))
            (Semantics (Auto ConstantFold)))))
-> Inherited
     (Auto ConstantFold)
     (StatementSequence
        l
        l
        (Semantics (Auto ConstantFold))
        (Semantics (Auto ConstantFold)))
-> Maybe
     (Inherited
        (Auto ConstantFold)
        (StatementSequence
           l
           l
           (Semantics (Auto ConstantFold))
           (Semantics (Auto ConstantFold))))
forall a b. (a -> b) -> a -> b
$ Atts
  (Inherited (Auto ConstantFold))
  (StatementSequence
     l
     l
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
-> Inherited
     (Auto ConstantFold)
     (StatementSequence
        l
        l
        (Semantics (Auto ConstantFold))
        (Semantics (Auto ConstantFold)))
forall t a. Atts (Inherited t) a -> Inherited t a
Inherited Atts
  (Inherited (Auto ConstantFold))
  (StatementSequence
     l
     l
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
InhCF l
localEnv)
      where newEnv :: Map (QualIdent l) (Maybe (Value l l Placed Placed))
newEnv = ZipList (Map (QualIdent l) (Maybe (Value l l Placed Placed)))
-> Map (QualIdent l) (Maybe (Value l l Placed Placed))
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions (SynCFMod' l (Declaration l l)
-> Map (QualIdent l) (Maybe (Value l l Placed Placed))
forall l a. SynCFMod l a -> Environment l
moduleEnv (SynCFMod' l (Declaration l l)
 -> Map (QualIdent l) (Maybe (Value l l Placed Placed)))
-> (Synthesized
      (Auto ConstantFold)
      (Declaration
         l
         l
         (Semantics (Auto ConstantFold))
         (Semantics (Auto ConstantFold)))
    -> SynCFMod' l (Declaration l l))
-> Synthesized
     (Auto ConstantFold)
     (Declaration
        l
        l
        (Semantics (Auto ConstantFold))
        (Semantics (Auto ConstantFold)))
-> Map (QualIdent l) (Maybe (Value l l Placed Placed))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Synthesized
  (Auto ConstantFold)
  (Declaration
     l
     l
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
-> SynCFMod' l (Declaration l l)
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn (Synthesized
   (Auto ConstantFold)
   (Declaration
      l
      l
      (Semantics (Auto ConstantFold))
      (Semantics (Auto ConstantFold)))
 -> Map (QualIdent l) (Maybe (Value l l Placed Placed)))
-> ZipList
     (Synthesized
        (Auto ConstantFold)
        (Declaration
           l
           l
           (Semantics (Auto ConstantFold))
           (Semantics (Auto ConstantFold))))
-> ZipList (Map (QualIdent l) (Maybe (Value l l Placed Placed)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZipList (Synthesized (Auto ConstantFold) (Declaration l l sem sem))
ZipList
  (Synthesized
     (Auto ConstantFold)
     (Declaration
        l
        l
        (Semantics (Auto ConstantFold))
        (Semantics (Auto ConstantFold))))
decls)
            localEnv :: InhCF l
localEnv = Map (QualIdent l) (Maybe (Value l l Placed Placed))
-> Ident -> InhCF l
forall l. Environment l -> Ident -> InhCF l
InhCF (Map (QualIdent l) (Maybe (Value l l Placed Placed))
newEnv Map (QualIdent l) (Maybe (Value l l Placed Placed))
-> Map (QualIdent l) (Maybe (Value l l Placed Placed))
-> Map (QualIdent l) (Maybe (Value l l Placed Placed))
forall k a. Ord k => Map k a -> Map k a -> Map k a
`Map.union` InhCF l -> Map (QualIdent l) (Maybe (Value l l Placed Placed))
forall l. InhCF l -> Environment l
env Atts (Inherited (Auto ConstantFold)) (Block l l sem sem)
InhCF l
inheritance) (InhCF l -> Ident
forall l. InhCF l -> Ident
currentModule Atts (Inherited (Auto ConstantFold)) (Block l l sem sem)
InhCF l
inheritance)
   bequest Auto ConstantFold
_ ((Int, ParsedLexemes, Int)
pos, AST.ExceptionHandlingBlock{}) Atts (Inherited (Auto ConstantFold)) (Block l l sem sem)
inheritance (AST.ExceptionHandlingBlock ZipList (Synthesized (Auto ConstantFold) (Declaration l l sem sem))
decls Maybe
  (Synthesized (Auto ConstantFold) (StatementSequence l l sem sem))
_stats Maybe
  (Synthesized (Auto ConstantFold) (StatementSequence l l sem sem))
_catch Maybe
  (Synthesized (Auto ConstantFold) (StatementSequence l l sem sem))
_always) =
      ZipList (Inherited (Auto ConstantFold) (Declaration l l sem sem))
-> Maybe
     (Inherited (Auto ConstantFold) (StatementSequence l l sem sem))
-> Maybe
     (Inherited (Auto ConstantFold) (StatementSequence l l sem sem))
-> Maybe
     (Inherited (Auto ConstantFold) (StatementSequence l l sem sem))
-> Block l l sem (Inherited (Auto ConstantFold))
forall λ l (f' :: * -> *) (f :: * -> *).
ZipList (f (Declaration l l f' f'))
-> Maybe (f (StatementSequence l l f' f'))
-> Maybe (f (StatementSequence l l f' f'))
-> Maybe (f (StatementSequence l l f' f'))
-> Block λ l f' f
AST.ExceptionHandlingBlock (Inherited
  (Auto ConstantFold)
  (Declaration
     l
     l
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
-> ZipList
     (Inherited
        (Auto ConstantFold)
        (Declaration
           l
           l
           (Semantics (Auto ConstantFold))
           (Semantics (Auto ConstantFold))))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inherited
   (Auto ConstantFold)
   (Declaration
      l
      l
      (Semantics (Auto ConstantFold))
      (Semantics (Auto ConstantFold)))
 -> ZipList
      (Inherited
         (Auto ConstantFold)
         (Declaration
            l
            l
            (Semantics (Auto ConstantFold))
            (Semantics (Auto ConstantFold)))))
-> Inherited
     (Auto ConstantFold)
     (Declaration
        l
        l
        (Semantics (Auto ConstantFold))
        (Semantics (Auto ConstantFold)))
-> ZipList
     (Inherited
        (Auto ConstantFold)
        (Declaration
           l
           l
           (Semantics (Auto ConstantFold))
           (Semantics (Auto ConstantFold))))
forall a b. (a -> b) -> a -> b
$ Atts
  (Inherited (Auto ConstantFold))
  (Declaration
     l
     l
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
-> Inherited
     (Auto ConstantFold)
     (Declaration
        l
        l
        (Semantics (Auto ConstantFold))
        (Semantics (Auto ConstantFold)))
forall t a. Atts (Inherited t) a -> Inherited t a
Inherited Atts
  (Inherited (Auto ConstantFold))
  (Declaration
     l
     l
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
InhCF l
localEnv) (Inherited
  (Auto ConstantFold)
  (StatementSequence
     l
     l
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
-> Maybe
     (Inherited
        (Auto ConstantFold)
        (StatementSequence
           l
           l
           (Semantics (Auto ConstantFold))
           (Semantics (Auto ConstantFold))))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inherited
   (Auto ConstantFold)
   (StatementSequence
      l
      l
      (Semantics (Auto ConstantFold))
      (Semantics (Auto ConstantFold)))
 -> Maybe
      (Inherited
         (Auto ConstantFold)
         (StatementSequence
            l
            l
            (Semantics (Auto ConstantFold))
            (Semantics (Auto ConstantFold)))))
-> Inherited
     (Auto ConstantFold)
     (StatementSequence
        l
        l
        (Semantics (Auto ConstantFold))
        (Semantics (Auto ConstantFold)))
-> Maybe
     (Inherited
        (Auto ConstantFold)
        (StatementSequence
           l
           l
           (Semantics (Auto ConstantFold))
           (Semantics (Auto ConstantFold))))
forall a b. (a -> b) -> a -> b
$ Atts
  (Inherited (Auto ConstantFold))
  (StatementSequence
     l
     l
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
-> Inherited
     (Auto ConstantFold)
     (StatementSequence
        l
        l
        (Semantics (Auto ConstantFold))
        (Semantics (Auto ConstantFold)))
forall t a. Atts (Inherited t) a -> Inherited t a
Inherited Atts
  (Inherited (Auto ConstantFold))
  (StatementSequence
     l
     l
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
InhCF l
localEnv) (Inherited
  (Auto ConstantFold)
  (StatementSequence
     l
     l
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
-> Maybe
     (Inherited
        (Auto ConstantFold)
        (StatementSequence
           l
           l
           (Semantics (Auto ConstantFold))
           (Semantics (Auto ConstantFold))))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inherited
   (Auto ConstantFold)
   (StatementSequence
      l
      l
      (Semantics (Auto ConstantFold))
      (Semantics (Auto ConstantFold)))
 -> Maybe
      (Inherited
         (Auto ConstantFold)
         (StatementSequence
            l
            l
            (Semantics (Auto ConstantFold))
            (Semantics (Auto ConstantFold)))))
-> Inherited
     (Auto ConstantFold)
     (StatementSequence
        l
        l
        (Semantics (Auto ConstantFold))
        (Semantics (Auto ConstantFold)))
-> Maybe
     (Inherited
        (Auto ConstantFold)
        (StatementSequence
           l
           l
           (Semantics (Auto ConstantFold))
           (Semantics (Auto ConstantFold))))
forall a b. (a -> b) -> a -> b
$ Atts
  (Inherited (Auto ConstantFold))
  (StatementSequence
     l
     l
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
-> Inherited
     (Auto ConstantFold)
     (StatementSequence
        l
        l
        (Semantics (Auto ConstantFold))
        (Semantics (Auto ConstantFold)))
forall t a. Atts (Inherited t) a -> Inherited t a
Inherited Atts
  (Inherited (Auto ConstantFold))
  (StatementSequence
     l
     l
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
InhCF l
localEnv) (Inherited
  (Auto ConstantFold)
  (StatementSequence
     l
     l
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
-> Maybe
     (Inherited
        (Auto ConstantFold)
        (StatementSequence
           l
           l
           (Semantics (Auto ConstantFold))
           (Semantics (Auto ConstantFold))))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inherited
   (Auto ConstantFold)
   (StatementSequence
      l
      l
      (Semantics (Auto ConstantFold))
      (Semantics (Auto ConstantFold)))
 -> Maybe
      (Inherited
         (Auto ConstantFold)
         (StatementSequence
            l
            l
            (Semantics (Auto ConstantFold))
            (Semantics (Auto ConstantFold)))))
-> Inherited
     (Auto ConstantFold)
     (StatementSequence
        l
        l
        (Semantics (Auto ConstantFold))
        (Semantics (Auto ConstantFold)))
-> Maybe
     (Inherited
        (Auto ConstantFold)
        (StatementSequence
           l
           l
           (Semantics (Auto ConstantFold))
           (Semantics (Auto ConstantFold))))
forall a b. (a -> b) -> a -> b
$ Atts
  (Inherited (Auto ConstantFold))
  (StatementSequence
     l
     l
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
-> Inherited
     (Auto ConstantFold)
     (StatementSequence
        l
        l
        (Semantics (Auto ConstantFold))
        (Semantics (Auto ConstantFold)))
forall t a. Atts (Inherited t) a -> Inherited t a
Inherited Atts
  (Inherited (Auto ConstantFold))
  (StatementSequence
     l
     l
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
InhCF l
localEnv)
      where newEnv :: Map (QualIdent l) (Maybe (Value l l Placed Placed))
newEnv = ZipList (Map (QualIdent l) (Maybe (Value l l Placed Placed)))
-> Map (QualIdent l) (Maybe (Value l l Placed Placed))
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions (SynCFMod' l (Declaration l l)
-> Map (QualIdent l) (Maybe (Value l l Placed Placed))
forall l a. SynCFMod l a -> Environment l
moduleEnv (SynCFMod' l (Declaration l l)
 -> Map (QualIdent l) (Maybe (Value l l Placed Placed)))
-> (Synthesized
      (Auto ConstantFold)
      (Declaration
         l
         l
         (Semantics (Auto ConstantFold))
         (Semantics (Auto ConstantFold)))
    -> SynCFMod' l (Declaration l l))
-> Synthesized
     (Auto ConstantFold)
     (Declaration
        l
        l
        (Semantics (Auto ConstantFold))
        (Semantics (Auto ConstantFold)))
-> Map (QualIdent l) (Maybe (Value l l Placed Placed))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Synthesized
  (Auto ConstantFold)
  (Declaration
     l
     l
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
-> SynCFMod' l (Declaration l l)
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn (Synthesized
   (Auto ConstantFold)
   (Declaration
      l
      l
      (Semantics (Auto ConstantFold))
      (Semantics (Auto ConstantFold)))
 -> Map (QualIdent l) (Maybe (Value l l Placed Placed)))
-> ZipList
     (Synthesized
        (Auto ConstantFold)
        (Declaration
           l
           l
           (Semantics (Auto ConstantFold))
           (Semantics (Auto ConstantFold))))
-> ZipList (Map (QualIdent l) (Maybe (Value l l Placed Placed)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZipList (Synthesized (Auto ConstantFold) (Declaration l l sem sem))
ZipList
  (Synthesized
     (Auto ConstantFold)
     (Declaration
        l
        l
        (Semantics (Auto ConstantFold))
        (Semantics (Auto ConstantFold))))
decls)
            localEnv :: InhCF l
localEnv = Map (QualIdent l) (Maybe (Value l l Placed Placed))
-> Ident -> InhCF l
forall l. Environment l -> Ident -> InhCF l
InhCF (Map (QualIdent l) (Maybe (Value l l Placed Placed))
newEnv Map (QualIdent l) (Maybe (Value l l Placed Placed))
-> Map (QualIdent l) (Maybe (Value l l Placed Placed))
-> Map (QualIdent l) (Maybe (Value l l Placed Placed))
forall k a. Ord k => Map k a -> Map k a -> Map k a
`Map.union` InhCF l -> Map (QualIdent l) (Maybe (Value l l Placed Placed))
forall l. InhCF l -> Environment l
env Atts (Inherited (Auto ConstantFold)) (Block l l sem sem)
InhCF l
inheritance) (InhCF l -> Ident
forall l. InhCF l -> Ident
currentModule Atts (Inherited (Auto ConstantFold)) (Block l l sem sem)
InhCF l
inheritance)

instance (Abstract.Nameable l, k ~ Abstract.QualIdent l, v ~ Abstract.Value l l Placed Placed, Ord k,
          Atts (Synthesized (Auto ConstantFold)) (Abstract.Declaration l l Sem Sem)
          ~ SynCFMod' l (Abstract.Declaration l l)) =>
         SynthesizedField "moduleEnv" (Map k (Maybe v)) (Auto ConstantFold) (AST.Block l l) Sem Placed where
   synthesizedField :: Proxy "moduleEnv"
-> Auto ConstantFold
-> Placed
     (Block
        l
        l
        (Semantics (Auto ConstantFold))
        (Semantics (Auto ConstantFold)))
-> Atts (Inherited (Auto ConstantFold)) (Block l l sem sem)
-> Block l l sem (Synthesized (Auto ConstantFold))
-> Map k (Maybe v)
synthesizedField Proxy "moduleEnv"
_ Auto ConstantFold
_ ((Int, ParsedLexemes, Int)
pos, AST.Block{}) Atts (Inherited (Auto ConstantFold)) (Block l l sem sem)
_ (AST.Block ZipList (Synthesized (Auto ConstantFold) (Declaration l l sem sem))
decls Maybe
  (Synthesized (Auto ConstantFold) (StatementSequence l l sem sem))
_stats) = ZipList (Map k (Maybe v)) -> Map k (Maybe v)
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions (SynCFMod' l (Declaration l l) -> Map k (Maybe v)
forall l a. SynCFMod l a -> Environment l
moduleEnv (SynCFMod' l (Declaration l l) -> Map k (Maybe v))
-> (Synthesized
      (Auto ConstantFold)
      (Declaration
         l
         l
         (Semantics (Auto ConstantFold))
         (Semantics (Auto ConstantFold)))
    -> SynCFMod' l (Declaration l l))
-> Synthesized
     (Auto ConstantFold)
     (Declaration
        l
        l
        (Semantics (Auto ConstantFold))
        (Semantics (Auto ConstantFold)))
-> Map k (Maybe v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Synthesized
  (Auto ConstantFold)
  (Declaration
     l
     l
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
-> SynCFMod' l (Declaration l l)
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn (Synthesized
   (Auto ConstantFold)
   (Declaration
      l
      l
      (Semantics (Auto ConstantFold))
      (Semantics (Auto ConstantFold)))
 -> Map k (Maybe v))
-> ZipList
     (Synthesized
        (Auto ConstantFold)
        (Declaration
           l
           l
           (Semantics (Auto ConstantFold))
           (Semantics (Auto ConstantFold))))
-> ZipList (Map k (Maybe v))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZipList (Synthesized (Auto ConstantFold) (Declaration l l sem sem))
ZipList
  (Synthesized
     (Auto ConstantFold)
     (Declaration
        l
        l
        (Semantics (Auto ConstantFold))
        (Semantics (Auto ConstantFold))))
decls)
   synthesizedField Proxy "moduleEnv"
_ Auto ConstantFold
_ ((Int, ParsedLexemes, Int)
pos, AST.ExceptionHandlingBlock{}) Atts (Inherited (Auto ConstantFold)) (Block l l sem sem)
_ (AST.ExceptionHandlingBlock ZipList (Synthesized (Auto ConstantFold) (Declaration l l sem sem))
decls Maybe
  (Synthesized (Auto ConstantFold) (StatementSequence l l sem sem))
_stats Maybe
  (Synthesized (Auto ConstantFold) (StatementSequence l l sem sem))
_catch Maybe
  (Synthesized (Auto ConstantFold) (StatementSequence l l sem sem))
_always) =
      ZipList (Map k (Maybe v)) -> Map k (Maybe v)
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions (SynCFMod' l (Declaration l l) -> Map k (Maybe v)
forall l a. SynCFMod l a -> Environment l
moduleEnv (SynCFMod' l (Declaration l l) -> Map k (Maybe v))
-> (Synthesized
      (Auto ConstantFold)
      (Declaration
         l
         l
         (Semantics (Auto ConstantFold))
         (Semantics (Auto ConstantFold)))
    -> SynCFMod' l (Declaration l l))
-> Synthesized
     (Auto ConstantFold)
     (Declaration
        l
        l
        (Semantics (Auto ConstantFold))
        (Semantics (Auto ConstantFold)))
-> Map k (Maybe v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Synthesized
  (Auto ConstantFold)
  (Declaration
     l
     l
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
-> SynCFMod' l (Declaration l l)
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn (Synthesized
   (Auto ConstantFold)
   (Declaration
      l
      l
      (Semantics (Auto ConstantFold))
      (Semantics (Auto ConstantFold)))
 -> Map k (Maybe v))
-> ZipList
     (Synthesized
        (Auto ConstantFold)
        (Declaration
           l
           l
           (Semantics (Auto ConstantFold))
           (Semantics (Auto ConstantFold))))
-> ZipList (Map k (Maybe v))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZipList (Synthesized (Auto ConstantFold) (Declaration l l sem sem))
ZipList
  (Synthesized
     (Auto ConstantFold)
     (Declaration
        l
        l
        (Semantics (Auto ConstantFold))
        (Semantics (Auto ConstantFold))))
decls)

instance (Abstract.Modula2 l, Abstract.Nameable l, k ~ Abstract.QualIdent l, Ord k, v ~ Abstract.Value l l Placed Placed,
          Abstract.Export l ~ AST.Export l, Abstract.Value l ~ AST.Value l,
          Atts (Synthesized (Auto ConstantFold)) (Abstract.Declaration l l Sem Sem)
          ~ SynCFMod' l (Abstract.Declaration l l),
          Atts (Synthesized (Auto ConstantFold)) (Abstract.Type l l Sem Sem) ~ SynCF' (Abstract.Type l l),
          Atts (Synthesized (Auto ConstantFold)) (Abstract.ProcedureHeading l l Sem Sem)
          ~ SynCF' (Abstract.ProcedureHeading l l),
          Atts (Synthesized (Auto ConstantFold)) (Abstract.FormalParameters l l Sem Sem)
          ~ SynCF' (Abstract.FormalParameters l l),
          Atts (Synthesized (Auto ConstantFold)) (Abstract.Block l l Sem Sem) ~ SynCFMod' l (Abstract.Block l l),
          Atts (Synthesized (Auto ConstantFold)) (Abstract.ConstExpression l l Sem Sem) ~ SynCFExp l l) =>
         SynthesizedField "moduleEnv" (Map k (Maybe v)) (Auto ConstantFold) (AST.Declaration full l l) Sem Placed where
   synthesizedField :: Proxy "moduleEnv"
-> Auto ConstantFold
-> Placed
     (Declaration
        full
        l
        l
        (Semantics (Auto ConstantFold))
        (Semantics (Auto ConstantFold)))
-> Atts
     (Inherited (Auto ConstantFold)) (Declaration full l l sem sem)
-> Declaration full l l sem (Synthesized (Auto ConstantFold))
-> Map k (Maybe v)
synthesizedField Proxy "moduleEnv"
_ Auto ConstantFold
_ ((Int, ParsedLexemes, Int)
pos, AST.ConstantDeclaration IdentDef l
namedef Sem
  (ConstExpression
     l
     l
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
_) Atts (Inherited (Auto ConstantFold)) (Declaration full l l sem sem)
_ (AST.ConstantDeclaration IdentDef l
_ Synthesized (Auto ConstantFold) (ConstExpression l l sem sem)
expression) =
      k -> Maybe v -> Map k (Maybe v)
forall k a. k -> a -> Map k a
Map.singleton (Ident -> QualIdent l
forall l. Wirthy l => Ident -> QualIdent l
Abstract.nonQualIdent (Ident -> QualIdent l) -> Ident -> QualIdent l
forall a b. (a -> b) -> a -> b
$ IdentDef l -> Ident
forall l. Nameable l => IdentDef l -> Ident
Abstract.getIdentDefName IdentDef l
namedef)
                    ((((Int, ParsedLexemes, Int), v) -> v
forall a b. (a, b) -> b
snd (((Int, ParsedLexemes, Int), v) -> v)
-> Maybe ((Int, ParsedLexemes, Int), v) -> Maybe v
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Maybe ((Int, ParsedLexemes, Int), v) -> Maybe v)
-> (SynCFExp l l -> Maybe ((Int, ParsedLexemes, Int), v))
-> SynCFExp l l
-> Maybe v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SynCFExp l l -> Maybe ((Int, ParsedLexemes, Int), v)
forall λ l.
SynCFExp λ l -> Maybe (Placed (Value l l Placed Placed))
foldedValue (SynCFExp l l -> Maybe v) -> SynCFExp l l -> Maybe v
forall a b. (a -> b) -> a -> b
$ Synthesized
  (Auto ConstantFold)
  (ConstExpression
     l
     l
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
-> Atts
     (Synthesized (Auto ConstantFold))
     (ConstExpression
        l
        l
        (Semantics (Auto ConstantFold))
        (Semantics (Auto ConstantFold)))
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto ConstantFold) (ConstExpression l l sem sem)
Synthesized
  (Auto ConstantFold)
  (ConstExpression
     l
     l
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
expression)
   synthesizedField Proxy "moduleEnv"
_ Auto ConstantFold
_ ((Int, ParsedLexemes, Int)
pos, AST.ModuleDeclaration Ident
moduleName Maybe
  (Sem
     (ConstExpression
        l
        l
        (Semantics (Auto ConstantFold))
        (Semantics (Auto ConstantFold))))
_priority [Import l]
imports Maybe (Export l)
exports Sem
  (Block
     l
     l
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
_body)
                    Atts (Inherited (Auto ConstantFold)) (Declaration full l l sem sem)
_ (AST.ModuleDeclaration Ident
_name Maybe
  (Synthesized (Auto ConstantFold) (ConstExpression l l sem sem))
priority [Import l]
_imports Maybe (Export l)
_exports Synthesized (Auto ConstantFold) (Block l l sem sem)
body) =
      (Export l -> Map k (Maybe v))
-> Maybe (Export l) -> Map k (Maybe v)
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Export l -> Map k (Maybe v)
exportedEnv Maybe (Export l)
Maybe (Export l)
exports
      where exportedEnv :: Export l -> Map k (Maybe v)
exportedEnv (AST.Export Bool
qualified NonEmpty Ident
names) =
               (k -> k) -> Map k (Maybe v) -> Map k (Maybe v)
forall k1 k2 a. (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeysMonotonic k -> k
qualify ((k -> Maybe v -> Bool) -> Map k (Maybe v) -> Map k (Maybe v)
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey (Bool -> Maybe v -> Bool
forall a b. a -> b -> a
const (Bool -> Maybe v -> Bool) -> (k -> Bool) -> k -> Maybe v -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (k -> [k] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [k]
exportList)) (SynCFMod' l (Block l l) -> Environment l
forall l a. SynCFMod l a -> Environment l
moduleEnv (SynCFMod' l (Block l l) -> Environment l)
-> SynCFMod' l (Block l l) -> Environment l
forall a b. (a -> b) -> a -> b
$ Synthesized
  (Auto ConstantFold)
  (Block
     l
     l
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
-> Atts
     (Synthesized (Auto ConstantFold))
     (Block
        l
        l
        (Semantics (Auto ConstantFold))
        (Semantics (Auto ConstantFold)))
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto ConstantFold) (Block l l sem sem)
Synthesized
  (Auto ConstantFold)
  (Block
     l
     l
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
body))
               where exportList :: [k]
exportList = [Ident] -> Ident -> QualIdent l
forall l. Modula2 l => [Ident] -> Ident -> QualIdent l
Abstract.qualIdent [] (Ident -> k) -> [Ident] -> [k]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty Ident -> [Ident]
forall a. NonEmpty a -> [a]
toList NonEmpty Ident
names
                     qualify :: k -> k
qualify k
qname
                        | Bool
qualified,
                          Just Ident
name <- QualIdent l -> Maybe Ident
forall l. Nameable l => QualIdent l -> Maybe Ident
Abstract.getNonQualIdentName k
QualIdent l
qname = [Ident] -> Ident -> QualIdent l
forall l. Modula2 l => [Ident] -> Ident -> QualIdent l
Abstract.qualIdent [Ident
moduleName] Ident
name
                        | Bool
otherwise = k
qname
   synthesizedField Proxy "moduleEnv"
_ Auto ConstantFold
_ Placed
  (Declaration
     full
     l
     l
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
_ Atts (Inherited (Auto ConstantFold)) (Declaration full l l sem sem)
_ Declaration full l l sem (Synthesized (Auto ConstantFold))
_ = Map k (Maybe v)
forall a. Monoid a => a
mempty

instance (Abstract.Nameable l, Ord (Abstract.QualIdent l),
          Abstract.QualIdent l ~ AST.QualIdent l, Abstract.Value l ~ AST.Value l,
          λ ~ AST.Language,
--          Abstract.QualIdent Report.Language ~ AST.QualIdent l,
          Coercible (Abstract.QualIdent Report.Language) (AST.QualIdent l),
          Coercible (Abstract.Value Report.Language Report.Language) (AST.Value l l),
          InhCF l ~ InhCF λ,
          Pretty (AST.Value l l Identity Identity),
          Atts (Synthesized (Auto ConstantFold)) (Abstract.Expression l l Sem Sem) ~ SynCFExp l l,
          Atts (Synthesized (Auto ConstantFold)) (Abstract.Element l l Sem Sem) ~ SynCF' (Abstract.Element l l),
          Atts (Synthesized (Auto ConstantFold)) (Abstract.Item l l Sem Sem) ~ SynCF' (Abstract.Item l l),
          Atts (Synthesized (Auto ConstantFold)) (Abstract.Designator l l Sem Sem) ~ SynCFDesignator l) =>
         Synthesizer (Auto ConstantFold) (AST.Expression λ l) Sem Placed where
   synthesis :: Auto ConstantFold
-> Placed
     (Expression
        λ
        l
        (Semantics (Auto ConstantFold))
        (Semantics (Auto ConstantFold)))
-> Atts (Inherited (Auto ConstantFold)) (Expression λ l sem sem)
-> Expression λ l sem (Synthesized (Auto ConstantFold))
-> Atts (Synthesized (Auto ConstantFold)) (Expression λ l sem sem)
synthesis Auto ConstantFold
_ ((Int, ParsedLexemes, Int)
pos, Expression
  λ l (Semantics (Auto ConstantFold)) (Semantics (Auto ConstantFold))
_) Atts (Inherited (Auto ConstantFold)) (Expression λ l sem sem)
_ (AST.Remainder Synthesized (Auto ConstantFold) (Expression l l sem sem)
left Synthesized (Auto ConstantFold) (Expression l l sem sem)
right) = 
      (Int, ParsedLexemes, Int)
-> (Placed (Expression Language Language Placed Placed)
    -> Placed (Expression Language Language Placed Placed)
    -> Expression Language Language Placed Placed)
-> (forall n. Integral n => n -> n -> n)
-> SynCFExp Language Language
-> SynCFExp Language Language
-> SynCFExp Language Language
forall λ l (f :: * -> *).
(f ~ Placed, Value l ~ Value l, Wirthy λ,
 Pretty (Value l l Identity Identity)) =>
(Int, ParsedLexemes, Int)
-> (f (Expression l l f f)
    -> f (Expression l l f f) -> Expression λ l f f)
-> (forall n. Integral n => n -> n -> n)
-> SynCFExp l l
-> SynCFExp l l
-> SynCFExp λ l
foldBinaryInteger (Int, ParsedLexemes, Int)
pos Placed (Expression Language Language Placed Placed)
-> Placed (Expression Language Language Placed Placed)
-> Expression Language Language Placed Placed
forall l (f :: * -> *) l' (f' :: * -> *).
Modula2 l =>
f (Expression l' l' f' f')
-> f (Expression l' l' f' f') -> Expression l l' f' f
Abstract.remainder forall n. Integral n => n -> n -> n
div (Synthesized
  (Auto ConstantFold)
  (Expression
     Language
     Language
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
-> Atts
     (Synthesized (Auto ConstantFold))
     (Expression
        Language
        Language
        (Semantics (Auto ConstantFold))
        (Semantics (Auto ConstantFold)))
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto ConstantFold) (Expression l l sem sem)
Synthesized
  (Auto ConstantFold)
  (Expression
     Language
     Language
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
left) (Synthesized
  (Auto ConstantFold)
  (Expression
     Language
     Language
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
-> Atts
     (Synthesized (Auto ConstantFold))
     (Expression
        Language
        Language
        (Semantics (Auto ConstantFold))
        (Semantics (Auto ConstantFold)))
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto ConstantFold) (Expression l l sem sem)
Synthesized
  (Auto ConstantFold)
  (Expression
     Language
     Language
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
right)
   synthesis Auto ConstantFold
_ ((Int, ParsedLexemes, Int)
pos, Expression
  λ l (Semantics (Auto ConstantFold)) (Semantics (Auto ConstantFold))
_) Atts (Inherited (Auto ConstantFold)) (Expression λ l sem sem)
_ (AST.Array Maybe (QualIdent l)
itemType [Synthesized (Auto ConstantFold) (Item l l sem sem)]
dimensions) =
      SynCFExp :: forall λ l.
Mapped Placed (Expression λ l Placed Placed)
-> Maybe (Placed (Value l l Placed Placed)) -> SynCFExp λ l
SynCFExp{$sel:folded:SynCFExp :: Mapped Placed (Expression Language Language Placed Placed)
folded= ((Int, ParsedLexemes, Int),
 Expression Language Language Placed Placed)
-> Mapped Placed (Expression Language Language Placed Placed)
forall k (f :: k -> *) (a :: k). f a -> Mapped f a
Mapped ((Int, ParsedLexemes, Int)
pos, Maybe (QualIdent Language)
-> [((Int, ParsedLexemes, Int),
     Item Language Language Placed Placed)]
-> Expression Language Language Placed Placed
forall l l' (f :: * -> *) (f' :: * -> *).
Modula2 l =>
Maybe (QualIdent l')
-> [f (Item l' l' f' f')] -> Expression l l' f' f
Abstract.array Maybe (QualIdent l)
Maybe (QualIdent Language)
itemType (Mapped Placed (Item Language Language Placed Placed)
-> Placed (Item Language Language Placed Placed)
forall k (f :: k -> *) (a :: k). Mapped f a -> f a
getMapped (Mapped Placed (Item Language Language Placed Placed)
 -> Placed (Item Language Language Placed Placed))
-> (Synthesized
      (Auto ConstantFold)
      (Item
         Language
         Language
         (Semantics (Auto ConstantFold))
         (Semantics (Auto ConstantFold)))
    -> Mapped Placed (Item Language Language Placed Placed))
-> Synthesized
     (Auto ConstantFold)
     (Item
        Language
        Language
        (Semantics (Auto ConstantFold))
        (Semantics (Auto ConstantFold)))
-> Placed (Item Language Language Placed Placed)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SynCF' (Item Language Language)
-> Mapped Placed (Item Language Language Placed Placed)
forall (node :: (* -> *) -> (* -> *) -> *).
SynCF' node -> Mapped Placed (node Placed Placed)
folded' (SynCF' (Item Language Language)
 -> Mapped Placed (Item Language Language Placed Placed))
-> (Synthesized
      (Auto ConstantFold)
      (Item
         Language
         Language
         (Semantics (Auto ConstantFold))
         (Semantics (Auto ConstantFold)))
    -> SynCF' (Item Language Language))
-> Synthesized
     (Auto ConstantFold)
     (Item
        Language
        Language
        (Semantics (Auto ConstantFold))
        (Semantics (Auto ConstantFold)))
-> Mapped Placed (Item Language Language Placed Placed)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Synthesized
  (Auto ConstantFold)
  (Item
     Language
     Language
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
-> SynCF' (Item Language Language)
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn (Synthesized
   (Auto ConstantFold)
   (Item
      Language
      Language
      (Semantics (Auto ConstantFold))
      (Semantics (Auto ConstantFold)))
 -> Placed (Item Language Language Placed Placed))
-> [Synthesized
      (Auto ConstantFold)
      (Item
         Language
         Language
         (Semantics (Auto ConstantFold))
         (Semantics (Auto ConstantFold)))]
-> [Placed (Item Language Language Placed Placed)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Synthesized (Auto ConstantFold) (Item l l sem sem)]
[Synthesized
   (Auto ConstantFold)
   (Item
      Language
      Language
      (Semantics (Auto ConstantFold))
      (Semantics (Auto ConstantFold)))]
dimensions)),
               $sel:foldedValue:SynCFExp :: Maybe (Placed (Value Language Language Placed Placed))
foldedValue= Maybe (Placed (Value Language Language Placed Placed))
forall a. Maybe a
Nothing}
   synthesis Auto ConstantFold
_ ((Int, ParsedLexemes, Int)
pos, Expression
  λ l (Semantics (Auto ConstantFold)) (Semantics (Auto ConstantFold))
_) Atts (Inherited (Auto ConstantFold)) (Expression λ l sem sem)
_ (AST.Record Maybe (QualIdent l)
recordType [Synthesized (Auto ConstantFold) (Expression l l sem sem)]
fields) =
      SynCFExp :: forall λ l.
Mapped Placed (Expression λ l Placed Placed)
-> Maybe (Placed (Value l l Placed Placed)) -> SynCFExp λ l
SynCFExp{$sel:folded:SynCFExp :: Mapped Placed (Expression Language Language Placed Placed)
folded= ((Int, ParsedLexemes, Int),
 Expression Language Language Placed Placed)
-> Mapped Placed (Expression Language Language Placed Placed)
forall k (f :: k -> *) (a :: k). f a -> Mapped f a
Mapped ((Int, ParsedLexemes, Int)
pos, Maybe (QualIdent Language)
-> [Placed (Expression Language Language Placed Placed)]
-> Expression Language Language Placed Placed
forall l l' (f :: * -> *) (f' :: * -> *).
Modula2 l =>
Maybe (QualIdent l')
-> [f (Expression l' l' f' f')] -> Expression l l' f' f
Abstract.record Maybe (QualIdent l)
Maybe (QualIdent Language)
recordType (SynCFExp Language Language
-> ((Int, ParsedLexemes, Int),
    Expression Language Language Placed Placed)
forall λ l. SynCFExp λ l -> Placed (Expression λ l Placed Placed)
foldedExp' (SynCFExp Language Language
 -> ((Int, ParsedLexemes, Int),
     Expression Language Language Placed Placed))
-> (Synthesized
      (Auto ConstantFold)
      (Expression
         Language
         Language
         (Semantics (Auto ConstantFold))
         (Semantics (Auto ConstantFold)))
    -> SynCFExp Language Language)
-> Synthesized
     (Auto ConstantFold)
     (Expression
        Language
        Language
        (Semantics (Auto ConstantFold))
        (Semantics (Auto ConstantFold)))
-> ((Int, ParsedLexemes, Int),
    Expression Language Language Placed Placed)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Synthesized
  (Auto ConstantFold)
  (Expression
     Language
     Language
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
-> SynCFExp Language Language
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn (Synthesized
   (Auto ConstantFold)
   (Expression
      Language
      Language
      (Semantics (Auto ConstantFold))
      (Semantics (Auto ConstantFold)))
 -> ((Int, ParsedLexemes, Int),
     Expression Language Language Placed Placed))
-> [Synthesized
      (Auto ConstantFold)
      (Expression
         Language
         Language
         (Semantics (Auto ConstantFold))
         (Semantics (Auto ConstantFold)))]
-> [((Int, ParsedLexemes, Int),
     Expression Language Language Placed Placed)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Synthesized (Auto ConstantFold) (Expression l l sem sem)]
[Synthesized
   (Auto ConstantFold)
   (Expression
      Language
      Language
      (Semantics (Auto ConstantFold))
      (Semantics (Auto ConstantFold)))]
fields)),
               $sel:foldedValue:SynCFExp :: Maybe (Placed (Value Language Language Placed Placed))
foldedValue= Maybe (Placed (Value Language Language Placed Placed))
forall a. Maybe a
Nothing}
   synthesis Auto ConstantFold
_ ((Int, ParsedLexemes, Int)
pos, AST.Set Maybe (QualIdent l)
t ZipList
  (Sem
     (Element
        l
        l
        (Semantics (Auto ConstantFold))
        (Semantics (Auto ConstantFold))))
_elements) Atts (Inherited (Auto ConstantFold)) (Expression λ l sem sem)
_ (AST.Set Maybe (QualIdent l)
_t ZipList (Synthesized (Auto ConstantFold) (Element l l sem sem))
elements) =
      SynCFExp :: forall λ l.
Mapped Placed (Expression λ l Placed Placed)
-> Maybe (Placed (Value l l Placed Placed)) -> SynCFExp λ l
SynCFExp{$sel:folded:SynCFExp :: Mapped Placed (Expression Language Language Placed Placed)
folded= ((Int, ParsedLexemes, Int),
 Expression Language Language Placed Placed)
-> Mapped Placed (Expression Language Language Placed Placed)
forall k (f :: k -> *) (a :: k). f a -> Mapped f a
Mapped ((Int, ParsedLexemes, Int)
pos, Maybe (QualIdent Language)
-> [((Int, ParsedLexemes, Int),
     Element Language Language Placed Placed)]
-> Expression Language Language Placed Placed
forall l l' (f :: * -> *) (f' :: * -> *).
Modula2 l =>
Maybe (QualIdent l')
-> [f (Element l' l' f' f')] -> Expression l l' f' f
Abstract.set Maybe (QualIdent l)
Maybe (QualIdent Language)
t (Mapped Placed (Element Language Language Placed Placed)
-> Placed (Element Language Language Placed Placed)
forall k (f :: k -> *) (a :: k). Mapped f a -> f a
getMapped (Mapped Placed (Element Language Language Placed Placed)
 -> Placed (Element Language Language Placed Placed))
-> (Synthesized
      (Auto ConstantFold)
      (Element
         Language
         Language
         (Semantics (Auto ConstantFold))
         (Semantics (Auto ConstantFold)))
    -> Mapped Placed (Element Language Language Placed Placed))
-> Synthesized
     (Auto ConstantFold)
     (Element
        Language
        Language
        (Semantics (Auto ConstantFold))
        (Semantics (Auto ConstantFold)))
-> Placed (Element Language Language Placed Placed)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SynCF' (Element Language Language)
-> Mapped Placed (Element Language Language Placed Placed)
forall (node :: (* -> *) -> (* -> *) -> *).
SynCF' node -> Mapped Placed (node Placed Placed)
folded' (SynCF' (Element Language Language)
 -> Mapped Placed (Element Language Language Placed Placed))
-> (Synthesized
      (Auto ConstantFold)
      (Element
         Language
         Language
         (Semantics (Auto ConstantFold))
         (Semantics (Auto ConstantFold)))
    -> SynCF' (Element Language Language))
-> Synthesized
     (Auto ConstantFold)
     (Element
        Language
        Language
        (Semantics (Auto ConstantFold))
        (Semantics (Auto ConstantFold)))
-> Mapped Placed (Element Language Language Placed Placed)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Synthesized
  (Auto ConstantFold)
  (Element
     Language
     Language
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
-> SynCF' (Element Language Language)
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn (Synthesized
   (Auto ConstantFold)
   (Element
      Language
      Language
      (Semantics (Auto ConstantFold))
      (Semantics (Auto ConstantFold)))
 -> Placed (Element Language Language Placed Placed))
-> [Synthesized
      (Auto ConstantFold)
      (Element
         Language
         Language
         (Semantics (Auto ConstantFold))
         (Semantics (Auto ConstantFold)))]
-> [Placed (Element Language Language Placed Placed)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZipList
  (Synthesized
     (Auto ConstantFold)
     (Element
        Language
        Language
        (Semantics (Auto ConstantFold))
        (Semantics (Auto ConstantFold))))
-> [Synthesized
      (Auto ConstantFold)
      (Element
         Language
         Language
         (Semantics (Auto ConstantFold))
         (Semantics (Auto ConstantFold)))]
forall a. ZipList a -> [a]
getZipList ZipList
  (Synthesized
     (Auto ConstantFold)
     (Element
        Language
        Language
        (Semantics (Auto ConstantFold))
        (Semantics (Auto ConstantFold))))
ZipList (Synthesized (Auto ConstantFold) (Element l l sem sem))
elements)),
               $sel:foldedValue:SynCFExp :: Maybe (Placed (Value Language Language Placed Placed))
foldedValue= Maybe (Placed (Value Language Language Placed Placed))
forall a. Maybe a
Nothing}
   synthesis Auto ConstantFold
t ((Int, ParsedLexemes, Int)
pos, Expression
  λ l (Semantics (Auto ConstantFold)) (Semantics (Auto ConstantFold))
self) (InhCF environment currMod) Expression λ l sem (Synthesized (Auto ConstantFold))
synthesized =
      SynCFExp Language l -> SynCFExp Language l
fromReport (Auto ConstantFold
-> ((Int, ParsedLexemes, Int),
    Expression
      Language
      l
      (Semantics (Auto ConstantFold))
      (Semantics (Auto ConstantFold)))
-> Atts
     (Inherited (Auto ConstantFold))
     (Expression
        Language
        l
        (Semantics (Auto ConstantFold))
        (Semantics (Auto ConstantFold)))
-> Expression
     Language
     l
     (Semantics (Auto ConstantFold))
     (Synthesized (Auto ConstantFold))
-> Atts
     (Synthesized (Auto ConstantFold))
     (Expression
        Language
        l
        (Semantics (Auto ConstantFold))
        (Semantics (Auto ConstantFold)))
forall t (g :: (* -> *) -> (* -> *) -> *) (deep :: * -> *)
       (shallow :: * -> *) (sem :: * -> *).
(Synthesizer t g deep shallow, sem ~ Semantics t) =>
t
-> shallow (g deep deep)
-> Atts (Inherited t) (g sem sem)
-> g sem (Synthesized t)
-> Atts (Synthesized t) (g sem sem)
synthesis Auto ConstantFold
t ((Int, ParsedLexemes, Int)
pos, Expression
  Language
  l
  (Semantics (Auto ConstantFold))
  (Semantics (Auto ConstantFold))
-> Expression
     Language
     l
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold))
forall (f1 :: * -> *) (f2 :: * -> *).
Expression Language l f1 f2 -> Expression Language l f1 f2
toReport Expression
  Language
  l
  (Semantics (Auto ConstantFold))
  (Semantics (Auto ConstantFold))
Expression
  λ l (Semantics (Auto ConstantFold)) (Semantics (Auto ConstantFold))
self) (Environment Language -> Ident -> InhCF Language
forall l. Environment l -> Ident -> InhCF l
InhCF (Maybe (Value Language Language Placed Placed)
-> Maybe (Value Language Language Placed Placed)
coerce (Maybe (Value Language Language Placed Placed)
 -> Maybe (Value Language Language Placed Placed))
-> Map
     (QualIdent Language)
     (Maybe (Value Language Language Placed Placed))
-> Map
     (QualIdent Language)
     (Maybe (Value Language Language Placed Placed))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QualIdent Language -> QualIdent Language)
-> Map
     (QualIdent Language)
     (Maybe (Value Language Language Placed Placed))
-> Map
     (QualIdent Language)
     (Maybe (Value Language Language Placed Placed))
forall k1 k2 a. (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeysMonotonic QualIdent Language -> QualIdent Language
coerce Environment Language
Map
  (QualIdent Language)
  (Maybe (Value Language Language Placed Placed))
environment) Ident
currMod)
                  (Expression
   Language
   l
   (Semantics (Auto ConstantFold))
   (Synthesized (Auto ConstantFold))
 -> Atts
      (Synthesized (Auto ConstantFold))
      (Expression
         Language
         l
         (Semantics (Auto ConstantFold))
         (Semantics (Auto ConstantFold))))
-> Expression
     Language
     l
     (Semantics (Auto ConstantFold))
     (Synthesized (Auto ConstantFold))
-> Atts
     (Synthesized (Auto ConstantFold))
     (Expression
        Language
        l
        (Semantics (Auto ConstantFold))
        (Semantics (Auto ConstantFold)))
forall a b. (a -> b) -> a -> b
$ Expression
  Language
  l
  (Semantics (Auto ConstantFold))
  (Synthesized (Auto ConstantFold))
-> Expression
     Language
     l
     (Semantics (Auto ConstantFold))
     (Synthesized (Auto ConstantFold))
forall (f1 :: * -> *) (f2 :: * -> *).
Expression Language l f1 f2 -> Expression Language l f1 f2
toReport Expression
  Language
  l
  (Semantics (Auto ConstantFold))
  (Synthesized (Auto ConstantFold))
Expression λ l sem (Synthesized (Auto ConstantFold))
synthesized)
      where fromJust :: forall f a (b :: * -> *) (c :: * -> *). Oberon.Abstract.Maybe3 f a b c -> f a b c
            fromJust :: Maybe3 f a b c -> f a b c
fromJust (Oberon.Abstract.Maybe3 Maybe (f a b c)
Nothing) =
               [Char] -> f a b c
forall a. HasCallStack => [Char] -> a
error ([Char]
"Modula-2 expression cannot be converted from ISO to Report at " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ (Int, ParsedLexemes, Int) -> [Char]
forall a. Show a => a -> [Char]
show (Int, ParsedLexemes, Int)
pos)
            fromJust (Oberon.Abstract.Maybe3 (Just f a b c
e)) = f a b c
e
            fromReport :: SynCFExp Report.Language l -> SynCFExp AST.Language l
            fromReport :: SynCFExp Language l -> SynCFExp Language l
fromReport SynCFExp{$sel:folded:SynCFExp :: forall λ l.
SynCFExp λ l -> Mapped Placed (Expression λ l Placed Placed)
folded= Mapped ((Int, ParsedLexemes, Int)
pos', Expression Language l Placed Placed
reportExpression),
                                $sel:foldedValue:SynCFExp :: forall λ l.
SynCFExp λ l -> Maybe (Placed (Value l l Placed Placed))
foldedValue= Maybe (Placed (Value l l Placed Placed))
reportValue} =
               SynCFExp :: forall λ l.
Mapped Placed (Expression λ l Placed Placed)
-> Maybe (Placed (Value l l Placed Placed)) -> SynCFExp λ l
SynCFExp{$sel:folded:SynCFExp :: Mapped Placed (Expression Language l Placed Placed)
folded= ((Int, ParsedLexemes, Int),
 Expression Language Language Placed Placed)
-> Mapped Placed (Expression Language Language Placed Placed)
forall k (f :: k -> *) (a :: k). f a -> Mapped f a
Mapped ((Int, ParsedLexemes, Int)
pos', Maybe3 (Expression Language) Language Placed Placed
-> Expression Language Language Placed Placed
forall (f :: * -> (* -> *) -> (* -> *) -> *) a (b :: * -> *)
       (c :: * -> *).
Maybe3 f a b c -> f a b c
fromJust (Expression Language Language Placed Placed
-> Expression (WirthySubsetOf Language) Language Placed Placed
forall l l' l'' (f' :: * -> *) (f :: * -> *).
(CoWirthy l, TargetClass l l') =>
Expression l l'' f' f -> Expression l' l'' f' f
coExpression @Report.Language
                                                        @(Abstract.WirthySubsetOf AST.Language) Expression Language l Placed Placed
Expression Language Language Placed Placed
reportExpression)),
                        $sel:foldedValue:SynCFExp :: Maybe (Placed (Value l l Placed Placed))
foldedValue= Maybe (Placed (Value l l Placed Placed))
reportValue}
            toReport :: Abstract.Expression AST.Language l f1 f2 -> Report.Expression Report.Language l f1 f2
            toReport :: Expression Language l f1 f2 -> Expression Language l f1 f2
toReport Expression Language l f1 f2
s = Maybe3 (Expression Language) l f1 f2 -> Expression Language l f1 f2
forall (f :: * -> (* -> *) -> (* -> *) -> *) a (b :: * -> *)
       (c :: * -> *).
Maybe3 f a b c -> f a b c
fromJust (Expression Language Language f1 f2
-> Expression (WirthySubsetOf Language) Language f1 f2
forall l l' l'' (f' :: * -> *) (f :: * -> *).
(CoWirthy l, TargetClass l l') =>
Expression l l'' f' f -> Expression l' l'' f' f
coExpression @AST.Language @(Abstract.WirthySubsetOf Report.Language) Expression Language l f1 f2
Expression Language Language f1 f2
s)

-- * More boring Transformation.Functor instances, TH candidates
instance Ord (Abstract.QualIdent l) => Transformation.At (Auto ConstantFold) (Modules l Sem Sem) where
   $ :: Auto ConstantFold
-> Domain
     (Auto ConstantFold)
     (Modules
        l (Semantics (Auto ConstantFold)) (Semantics (Auto ConstantFold)))
-> Codomain
     (Auto ConstantFold)
     (Modules
        l (Semantics (Auto ConstantFold)) (Semantics (Auto ConstantFold)))
($) = (forall a. ((Int, ParsedLexemes, Int), a) -> a)
-> Auto ConstantFold
-> ((Int, ParsedLexemes, Int),
    Modules
      l (Semantics (Auto ConstantFold)) (Semantics (Auto ConstantFold)))
-> Semantics
     (Auto ConstantFold)
     (Modules
        l (Semantics (Auto ConstantFold)) (Semantics (Auto ConstantFold)))
forall (q :: * -> *) t x (g :: (* -> *) -> (* -> *) -> *)
       (p :: * -> *).
(q ~ Semantics t, x ~ g q q, Apply (g q), Attribution t g q p) =>
(forall a. p a -> a) -> t -> p x -> q x
AG.applyDefault forall a. ((Int, ParsedLexemes, Int), a) -> a
forall a b. (a, b) -> b
snd

-- * Unsafe Rank2 AST instances

$(do l <- varT  <$> newName "l"
     mconcat <$> mapM (\g-> Transformation.Full.TH.deriveUpFunctor (conT ''Auto `appT` conT ''ConstantFold) $ conT g `appT` l `appT` l)
        [''AST.Block, ''AST.AddressedIdent, ''AST.Type, ''AST.Expression, ''AST.Statement, ''AST.Item, ''AST.Variant])

$(do let sem = [t|Semantics (Auto ConstantFold)|]
     let inst g = [d| instance Attribution (Auto ConstantFold) ($g l l) Sem Placed =>
                               Transformation.At (Auto ConstantFold) ($g l l $sem $sem)
                         where ($) = AG.applyDefault snd |]
     mconcat <$> mapM (inst . conT)
        [''AST.Block, ''AST.AddressedIdent, ''AST.Type, ''AST.Statement, ''AST.Expression, ''AST.Item, ''AST.Variant])

$(do full <- varT  <$> newName "full"
     l <- varT  <$> newName "l"
     Transformation.Full.TH.deriveUpFunctor [t| (Auto ConstantFold) |] [t| AST.Declaration $full $l $l |])

instance Attribution (Auto ConstantFold) (AST.Declaration full l l) Sem Placed
      => Transformation.At (Auto ConstantFold) (AST.Declaration full l l Sem Sem) where
   $ :: Auto ConstantFold
-> Domain
     (Auto ConstantFold)
     (Declaration
        full
        l
        l
        (Semantics (Auto ConstantFold))
        (Semantics (Auto ConstantFold)))
-> Codomain
     (Auto ConstantFold)
     (Declaration
        full
        l
        l
        (Semantics (Auto ConstantFold))
        (Semantics (Auto ConstantFold)))
($) = (forall a. ((Int, ParsedLexemes, Int), a) -> a)
-> Auto ConstantFold
-> ((Int, ParsedLexemes, Int),
    Declaration
      full
      l
      l
      (Semantics (Auto ConstantFold))
      (Semantics (Auto ConstantFold)))
-> Semantics
     (Auto ConstantFold)
     (Declaration
        full
        l
        l
        (Semantics (Auto ConstantFold))
        (Semantics (Auto ConstantFold)))
forall (q :: * -> *) t x (g :: (* -> *) -> (* -> *) -> *)
       (p :: * -> *).
(q ~ Semantics t, x ~ g q q, Apply (g q), Attribution t g q p) =>
(forall a. p a -> a) -> t -> p x -> q x
AG.applyDefault forall a. ((Int, ParsedLexemes, Int), a) -> a
forall a b. (a, b) -> b
snd