{-# LANGUAGE DataKinds, DeriveGeneric, DuplicateRecordFields, FlexibleContexts, FlexibleInstances,
             InstanceSigs,
             MultiParamTypeClasses, OverloadedRecordDot, OverloadedStrings, RankNTypes,
             ScopedTypeVariables, TypeApplications, TypeFamilies, TypeOperators, UndecidableInstances #-}

-- | The main export of this module is the function 'foldConstants' that folds the constants in a 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.ConstantFolder (foldConstants,
                                        ConstantFold, Sem, Environment, InhCF,
                                        SynCF(..), SynCFDesignator(..), SynCFExp(..), SynCFMod(..), SynCFMod') 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.Kind (Type)
import Data.List.NonEmpty (NonEmpty((:|)), toList)
import Data.Map.Lazy (Map)
import qualified Data.Map.Lazy as Map
import Data.Semigroup (Semigroup(..))
import qualified Data.Text as Text
import Foreign.Storable (sizeOf)
import GHC.Generics (Generic)
import Prettyprinter (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
import qualified Language.Modula2.AST as AST
import Language.Modula2.Grammar (ParsedLexemes(Trailing), Lexeme(WhiteSpace))
import qualified Language.Oberon.Abstract as Oberon.Abstract
import qualified Language.Oberon.AST as Oberon.AST
import qualified Language.Oberon.ConstantFolder as Oberon
import Language.Oberon.ConstantFolder (ConstantFold(ConstantFold), Sem, Environment,
                                       InhCF(..), InhCFRoot(..), SynCF(..), SynCF',
                                       SynCFRoot(..), SynCFMod(..), SynCFDesignator(..), SynCFMod', SynCFExp(..),
                                       anyWhitespace, folded', foldedExp, foldedExp')

-- | 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 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 :: forall l.
(Modula2 l, Nameable l, Ord (QualIdent l), Show (QualIdent l),
 Atts (Inherited (Auto ConstantFold)) (Block l l Sem Sem) ~ InhCF l,
 Atts (Inherited (Auto ConstantFold)) (Definition l l Sem Sem)
 ~ InhCF l,
 Atts (Inherited (Auto ConstantFold)) (Expression l l Sem Sem)
 ~ InhCF l,
 Atts (Synthesized (Auto ConstantFold)) (Block l l Sem Sem)
 ~ SynCFMod' l (Block l l),
 Atts (Synthesized (Auto ConstantFold)) (Block l l Placed Placed)
 ~ SynCFMod' l (Block l l),
 Atts (Synthesized (Auto ConstantFold)) (Definition l l Sem Sem)
 ~ SynCFMod' l (Definition l l),
 Atts
   (Synthesized (Auto ConstantFold)) (Definition l l Placed Placed)
 ~ SynCFMod' l (Definition l l),
 Atts (Synthesized (Auto ConstantFold)) (Expression l l Sem Sem)
 ~ SynCFExp l l,
 Atts
   (Synthesized (Auto ConstantFold)) (Expression l l Placed Placed)
 ~ SynCFExp l l,
 Functor (Auto ConstantFold) (Block l l),
 Functor (Auto ConstantFold) (Definition l l),
 Functor (Auto ConstantFold) (Expression l l)) =>
Environment l
-> Module l l Placed Placed -> Module l l Placed Placed
foldConstants Map (QualIdent l) (Maybe (Value l l Placed Placed))
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
$ (Synthesized (Auto ConstantFold) (Module l l Sem Sem)
-> Atts (Synthesized (Auto ConstantFold)) (Module l l Sem Sem)
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn (Auto ConstantFold
-> Domain (Auto ConstantFold) (Module l l Sem Sem)
-> Codomain (Auto ConstantFold) (Module l l Sem Sem)
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 Sem Sem)
-> Inherited (Auto ConstantFold) (Module l l Sem Sem)
-> Synthesized (Auto ConstantFold) (Module l l Sem Sem)
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 Sem Sem)
-> Inherited (Auto ConstantFold) (Module l l Sem Sem)
forall t a. Atts (Inherited t) a -> Inherited t a
Inherited (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))
predef Ident
forall a. HasCallStack => a
undefined))).folded

newtype Modules l f' f = Modules {forall l (f' :: * -> *) (f :: * -> *).
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 (p :: * -> *) (q :: * -> *).
(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) <*> :: forall (p :: * -> *) (q :: * -> *).
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 ConstantFold) (Modules l _ _) = SynCFRoot (Modules l Placed Identity)
type instance Atts (Synthesized ConstantFold) (AST.Module λ l _ _) = SynCFMod' l (AST.Module λ l)
type instance Atts (Synthesized ConstantFold) (AST.Declaration full λ l _ _) = SynCFMod' l (AST.Declaration full λ l)
type instance Atts (Synthesized ConstantFold) (AST.ProcedureHeading λ l _ _) = SynCF' (AST.ProcedureHeading λ l)
type instance Atts (Synthesized ConstantFold) (AST.Type λ l _ _) = SynCF' (AST.Type λ l)
type instance Atts (Synthesized ConstantFold) (AST.FieldList λ l _ _) = SynCF' (AST.FieldList λ l)
type instance Atts (Synthesized ConstantFold) (AST.Expression λ l _ _) = SynCFExp λ l
type instance Atts (Synthesized ConstantFold) (AST.Designator λ l _ _) = SynCFDesignator l
type instance Atts (Synthesized ConstantFold) (AST.Statement λ l _ _) = SynCF' (AST.Statement λ l)
type instance Atts (Synthesized ConstantFold) (AST.Variant λ l _ _) = SynCF' (AST.Variant λ l)

type instance Atts (Inherited ConstantFold) (Modules l _ _) = InhCFRoot l
type instance Atts (Inherited ConstantFold) (AST.Module λ l _ _) = InhCF l
type instance Atts (Inherited ConstantFold) (AST.Declaration full λ l _ _) = InhCF l
type instance Atts (Inherited ConstantFold) (AST.ProcedureHeading λ l _ _) = InhCF l
type instance Atts (Inherited ConstantFold) (AST.Type λ l _ _) = InhCF l
type instance Atts (Inherited ConstantFold) (AST.FieldList λ l _ _) = InhCF l
type instance Atts (Inherited ConstantFold) (AST.Expression λ l _ _) = InhCF l
type instance Atts (Inherited ConstantFold) (AST.Designator λ l _ _) = InhCF l
type instance Atts (Inherited ConstantFold) (AST.Statement λ l _ _) = InhCF l
type instance Atts (Inherited ConstantFold) (AST.Variant λ l _ _) = InhCF l

type Placed = (,) (Int, ParsedLexemes, Int)

-- * Rules

instance Ord (Abstract.QualIdent l) => Attribution (Auto ConstantFold) (Modules l) Sem Placed where
   attribution :: Auto ConstantFold
-> Placed (Modules l Sem Sem)
-> Rule (Auto ConstantFold) (Modules l)
attribution Auto ConstantFold
_ ((Int, ParsedLexemes, Int)
_, Modules Map Ident (Sem (Module l l Sem Sem))
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{$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 a. a -> Identity a
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
. (.folded) (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)
-> Atts (Synthesized (Auto ConstantFold)) (Module l l sem sem)
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 Sem Sem)
 -> Inherited (Auto ConstantFold) (Module l l sem sem))
-> Map Ident (Sem (Module l l Sem Sem))
-> 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 Sem Sem)
-> Inherited (Auto ConstantFold) (Module l l sem sem)
moduleInheritance Map Ident (Sem (Module l l Sem Sem))
self))
     where moduleInheritance :: Ident
-> Sem (Module l l Sem Sem)
-> Inherited (Auto ConstantFold) (Module l l sem sem)
moduleInheritance Ident
name Sem (Module l l Sem Sem)
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{$sel:env:InhCF :: Map (QualIdent l) (Maybe (Value l l Placed Placed))
env= InhCFRoot l -> Map (QualIdent l) (Maybe (Value l l Placed Placed))
forall l. InhCFRoot l -> Environment l
rootEnv Atts (Inherited (Auto ConstantFold)) (Modules l sem Sem)
InhCFRoot l
inheritance 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 a. Semigroup a => a -> a -> a
<> (Synthesized (Auto ConstantFold) (Module l l sem sem)
 -> Map (QualIdent l) (Maybe (Value l l Placed Placed)))
-> Map Ident (Synthesized (Auto ConstantFold) (Module l l sem sem))
-> Map (QualIdent l) (Maybe (Value l l Placed Placed))
forall m a. Monoid m => (a -> m) -> Map Ident a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (SynCFMod' l (Module l l)
-> Map (QualIdent l) (Maybe (Value l l Placed Placed))
forall l a. SynCFMod l a -> Environment l
moduleEnv (SynCFMod' l (Module l l)
 -> Map (QualIdent l) (Maybe (Value 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)
-> Map (QualIdent l) (Maybe (Value l l Placed Placed))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Synthesized (Auto ConstantFold) (Module l l sem sem)
-> Atts (Synthesized (Auto ConstantFold)) (Module l l sem sem)
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}

instance (Abstract.Modula2 l, Abstract.Nameable l, k ~ Abstract.QualIdent l, Ord k, Show k,
          v ~ Abstract.Value l l Placed Placed,
          Atts (Synthesized (Auto ConstantFold)) (Abstract.Block l l Sem Sem) ~ 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) =>
         SynthesizedField "moduleEnv" (Map k (Maybe v)) (Auto ConstantFold) (AST.Module l l) Sem Placed where
   synthesizedField :: forall (sem :: * -> *).
(sem ~ Sem) =>
Proxy "moduleEnv"
-> Auto ConstantFold
-> Placed (Module l l Sem Sem)
-> Atts (Inherited (Auto ConstantFold)) (Module l l sem sem)
-> Module l l sem (Synthesized (Auto ConstantFold))
-> Map k (Maybe v)
synthesizedField Proxy "moduleEnv"
_ Auto ConstantFold
_ ((Int, ParsedLexemes, Int)
_, Module l l Sem Sem
mod) Atts (Inherited (Auto ConstantFold)) (Module l l sem sem)
inheritance Module l l sem (Synthesized (Auto ConstantFold))
mod' =
      case (Module l l Sem Sem
mod, Module l l sem (Synthesized (Auto ConstantFold))
mod') of
        (AST.DefinitionModule{}, AST.DefinitionModule Ident
_ [Import l]
_ Maybe (Export l)
_ ZipList (Synthesized (Auto ConstantFold) (Definition l l sem sem))
definitions) -> (Synthesized (Auto ConstantFold) (Definition l l Sem Sem)
 -> Map k (Maybe v))
-> ZipList
     (Synthesized (Auto ConstantFold) (Definition l l Sem Sem))
-> Map k (Maybe v)
forall m a. Monoid m => (a -> m) -> ZipList a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (SynCFMod' l (Definition l l) -> Map k (Maybe v)
SynCFMod' l (Definition l l) -> Environment l
forall l a. SynCFMod l a -> Environment l
moduleEnv (SynCFMod' l (Definition l l) -> Map k (Maybe v))
-> (Synthesized (Auto ConstantFold) (Definition l l Sem Sem)
    -> SynCFMod' l (Definition l l))
-> Synthesized (Auto ConstantFold) (Definition l l Sem Sem)
-> Map k (Maybe v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Synthesized (Auto ConstantFold) (Definition l l Sem Sem)
-> Atts (Synthesized (Auto ConstantFold)) (Definition l l Sem Sem)
Synthesized (Auto ConstantFold) (Definition l l Sem Sem)
-> SynCFMod' l (Definition l l)
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn) ZipList (Synthesized (Auto ConstantFold) (Definition l l sem sem))
ZipList (Synthesized (Auto ConstantFold) (Definition l l Sem Sem))
definitions
        (Module l l Sem Sem,
 Module l l sem (Synthesized (Auto ConstantFold)))
_ -> Map k (Maybe v)
forall a. Monoid a => a
mempty

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 :: forall (sem :: * -> *).
(sem ~ Sem) =>
Proxy "moduleEnv"
-> Auto ConstantFold
-> Placed (Declaration full l l Sem Sem)
-> 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)
_, AST.ConstantDeclaration IdentDef l
namedef Sem (ConstExpression l l Sem Sem)
_) 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)
SynCFExp l l -> Maybe (Placed (Value l l Placed Placed))
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 Sem Sem)
-> Atts
     (Synthesized (Auto ConstantFold)) (ConstExpression l l Sem Sem)
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 Sem Sem)
expression)
   synthesizedField Proxy "moduleEnv"
_ Auto ConstantFold
_ ((Int, ParsedLexemes, Int)
pos, AST.ModuleDeclaration Ident
moduleName Maybe (Sem (ConstExpression l l Sem Sem))
_priority [Import l]
imports Maybe (Export l)
exports Sem (Block l l Sem Sem)
_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 m a. Monoid m => (a -> m) -> Maybe a -> m
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) =
               (QualIdent l -> k)
-> Map (QualIdent l) (Maybe v) -> Map k (Maybe v)
forall k1 k2 a. (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeysMonotonic QualIdent l -> k
QualIdent l -> QualIdent l
qualify ((QualIdent l -> Maybe v -> Bool)
-> Map (QualIdent l) (Maybe v) -> Map (QualIdent l) (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)
-> (QualIdent l -> Bool) -> QualIdent l -> Maybe v -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (QualIdent l -> [QualIdent l] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [QualIdent l]
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 Sem Sem)
-> Atts (Synthesized (Auto ConstantFold)) (Block l l Sem Sem)
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 Sem Sem)
body))
               where exportList :: [QualIdent l]
exportList = [Ident] -> Ident -> QualIdent l
forall l. Modula2 l => [Ident] -> Ident -> QualIdent l
Abstract.qualIdent [] (Ident -> QualIdent l) -> [Ident] -> [QualIdent l]
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 :: QualIdent l -> QualIdent l
qualify QualIdent l
qname
                        | Bool
qualified,
                          Just Ident
name <- QualIdent l -> Maybe Ident
forall l. Nameable l => QualIdent l -> Maybe Ident
Abstract.getNonQualIdentName QualIdent l
qname = [Ident] -> Ident -> QualIdent l
forall l. Modula2 l => [Ident] -> Ident -> QualIdent l
Abstract.qualIdent [Ident
moduleName] Ident
name
                        | Bool
otherwise = QualIdent l
qname
   synthesizedField Proxy "moduleEnv"
_ Auto ConstantFold
_ Placed (Declaration full l l Sem Sem)
_ 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.Expression λ ~ AST.Expression AST.Language, Abstract.QualIdent λ ~ AST.QualIdent AST.Language,
          Abstract.QualIdent l ~ AST.QualIdent l,
          Abstract.Element l l ~ AST.Element l l,
          Abstract.Value l l ~ AST.Value l l,
          λ ~ AST.Language,
          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' (AST.Element l l),
          Atts (Synthesized (Auto ConstantFold)) (Abstract.Designator l l Sem Sem) ~ SynCFDesignator l) =>
         Synthesizer (Auto ConstantFold) (AST.Expression λ l) Sem Placed where
   synthesis :: forall (sem :: * -> *).
(sem ~ Sem) =>
Auto ConstantFold
-> Placed (Expression λ l Sem Sem)
-> 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, AST.Set Maybe (QualIdent l)
t ZipList (Sem (Element l l Sem Sem))
_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{$sel:folded:SynCFExp :: Mapped Placed (Expression Language l Placed Placed)
folded= Placed (Expression Language l Placed Placed)
-> Mapped Placed (Expression Language l Placed Placed)
forall {k} (f :: k -> *) (a :: k). f a -> Mapped f a
Mapped ((Int, ParsedLexemes, Int)
pos, Maybe (QualIdent l)
-> [Placed (Element l l Placed Placed)]
-> Expression Language l Placed Placed
forall l l' (f :: * -> *) (f' :: * -> *).
Modula2 l =>
Maybe (QualIdent l')
-> [f (Element l' l' f' f')] -> Expression l l' f' f
forall l' (f :: * -> *) (f' :: * -> *).
Maybe (QualIdent l')
-> [f (Element l' l' f' f')] -> Expression Language l' f' f
Abstract.set Maybe (QualIdent l)
t (Mapped Placed (Element l l Placed Placed)
-> Placed (Element l l Placed Placed)
forall {k} (f :: k -> *) (a :: k). Mapped f a -> f a
getMapped (Mapped Placed (Element l l Placed Placed)
 -> Placed (Element l l Placed Placed))
-> (Synthesized (Auto ConstantFold) (Element l l Sem Sem)
    -> Mapped Placed (Element l l Placed Placed))
-> Synthesized (Auto ConstantFold) (Element l l Sem Sem)
-> Placed (Element l l Placed Placed)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SynCF' (Element l l) -> Mapped Placed (Element l l Placed Placed)
forall (node :: (* -> *) -> (* -> *) -> *).
SynCF' node -> Mapped Placed (node Placed Placed)
folded' (SynCF' (Element l l) -> Mapped Placed (Element l l Placed Placed))
-> (Synthesized (Auto ConstantFold) (Element l l Sem Sem)
    -> SynCF' (Element l l))
-> Synthesized (Auto ConstantFold) (Element l l Sem Sem)
-> Mapped Placed (Element l l Placed Placed)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Synthesized (Auto ConstantFold) (Element l l Sem Sem)
-> Atts (Synthesized (Auto ConstantFold)) (Element l l Sem Sem)
Synthesized (Auto ConstantFold) (Element l l Sem Sem)
-> SynCF' (Element l l)
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn (Synthesized (Auto ConstantFold) (Element l l Sem Sem)
 -> Placed (Element l l Placed Placed))
-> [Synthesized (Auto ConstantFold) (Element l l Sem Sem)]
-> [Placed (Element l l Placed Placed)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZipList (Synthesized (Auto ConstantFold) (Element l l Sem Sem))
-> [Synthesized (Auto ConstantFold) (Element l l Sem Sem)]
forall a. ZipList a -> [a]
getZipList ZipList (Synthesized (Auto ConstantFold) (Element l l sem sem))
ZipList (Synthesized (Auto ConstantFold) (Element l l Sem Sem))
elements)),
               $sel:foldedValue:SynCFExp :: Maybe (Placed (Value l l Placed Placed))
foldedValue= Maybe (Placed (Value l l Placed Placed))
Maybe (Placed (Value l l Placed Placed))
forall a. Maybe a
Nothing}
   synthesis Auto ConstantFold
_ ((Int, ParsedLexemes, Int)
pos, Expression λ l Sem Sem
_) Atts (Inherited (Auto ConstantFold)) (Expression λ l sem sem)
_ (AST.Read Synthesized (Auto ConstantFold) (Designator l l sem sem)
des) =
      case (SynCFDesignator l -> Maybe (Placed (Value l l Placed Placed))
forall l.
SynCFDesignator l -> Maybe (Placed (Value l l Placed Placed))
designatorValue (Synthesized (Auto ConstantFold) (Designator l l Sem Sem)
-> Atts (Synthesized (Auto ConstantFold)) (Designator l l Sem Sem)
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto ConstantFold) (Designator l l sem sem)
Synthesized (Auto ConstantFold) (Designator l l Sem Sem)
des), Mapped Placed (Designator l l Placed Placed)
-> ((Int, ParsedLexemes, Int), Designator l l Placed Placed)
forall {k} (f :: k -> *) (a :: k). Mapped f a -> f a
getMapped (Mapped Placed (Designator l l Placed Placed)
 -> ((Int, ParsedLexemes, Int), Designator l l Placed Placed))
-> Mapped Placed (Designator l l Placed Placed)
-> ((Int, ParsedLexemes, Int), Designator l l Placed Placed)
forall a b. (a -> b) -> a -> b
$ (Synthesized (Auto ConstantFold) (Designator l l Sem Sem)
-> Atts (Synthesized (Auto ConstantFold)) (Designator l l Sem Sem)
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto ConstantFold) (Designator l l sem sem)
Synthesized (Auto ConstantFold) (Designator l l Sem Sem)
des).folded)
      of (Just Placed (Value l l Placed Placed)
val, ((Int, ParsedLexemes, Int), Designator l l Placed Placed)
_) -> Placed (Value l l Placed Placed) -> SynCFExp Language l
forall λ l.
(Wirthy λ, Functor (Map Placed Identity) (Value l l),
 Pretty (Value l l Identity Identity)) =>
Placed (Value l l Placed Placed) -> SynCFExp λ l
Oberon.literalSynthesis Placed (Value l l Placed Placed)
val
         (Maybe (Placed (Value l l Placed Placed))
Nothing, ((Int, ParsedLexemes, Int)
pos', Designator l l Placed Placed
des')) -> SynCFExp{$sel:folded:SynCFExp :: Mapped Placed (Expression Language l Placed Placed)
folded= Placed (Expression Language l Placed Placed)
-> Mapped Placed (Expression Language l Placed Placed)
forall {k} (f :: k -> *) (a :: k). f a -> Mapped f a
Mapped ((Int, ParsedLexemes, Int)
pos, ((Int, ParsedLexemes, Int), Designator l l Placed Placed)
-> Expression Language l Placed Placed
forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
f (Designator l' l' f' f') -> Expression l l' f' f
forall (f :: * -> *) l' (f' :: * -> *).
f (Designator l' l' f' f') -> Expression Language l' f' f
Abstract.read ((Int, ParsedLexemes, Int)
pos', Designator l l Placed Placed
des')),
                                             $sel:foldedValue:SynCFExp :: Maybe (Placed (Value l l Placed Placed))
foldedValue= Maybe (Placed (Value l l Placed Placed))
forall a. Maybe a
Nothing}
   synthesis Auto ConstantFold
_ ((Int, ParsedLexemes, Int)
pos, Expression λ l Sem Sem
_) Atts (Inherited (Auto ConstantFold)) (Expression λ l sem sem)
_ (AST.FunctionCall Synthesized (Auto ConstantFold) (Designator l l sem sem)
fn ZipList (Synthesized (Auto ConstantFold) (Expression l l sem sem))
args)
      | Just (AST.Builtin Ident
"TRUNC") <- Maybe (Value l l Placed Placed)
functionValue,
        [Just (AST.Real Double
x)] <- [Maybe (Value l l Placed Placed)]
argValues = Value l l Placed Placed -> SynCFExp Language l
fromValue (Integer -> Value l l Placed Placed
forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Integer -> Value l l' f' f
forall l' (f' :: * -> *) (f :: * -> *). Integer -> Value l l' f' f
Abstract.integer (Integer -> Value l l Placed Placed)
-> Integer -> Value l l Placed Placed
forall a b. (a -> b) -> a -> b
$ Double -> Integer
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor Double
x)
      | Just (AST.Builtin Ident
"FLOAT") <- Maybe (Value l l Placed Placed)
functionValue,
        [Just (AST.Integer Integer
x)] <- [Maybe (Value l l Placed Placed)]
argValues = Value l l Placed Placed -> SynCFExp Language l
fromValue (Double -> Value l l Placed Placed
forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Double -> Value l l' f' f
forall l' (f' :: * -> *) (f :: * -> *). Double -> Value l l' f' f
Abstract.real (Double -> Value l l Placed Placed)
-> Double -> Value l l Placed Placed
forall a b. (a -> b) -> a -> b
$ Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
x)
      | Just (AST.Builtin Ident
"SIZE") <- Maybe (Value l l Placed Placed)
functionValue,
        [Just (AST.Builtin Ident
"CARDINAL")] <- [Maybe (Value l l Placed Placed)]
argValues = Value l l Placed Placed -> SynCFExp Language l
fromValue (Integer -> Value l l Placed Placed
forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Integer -> Value l l' f' f
forall l' (f' :: * -> *) (f :: * -> *). Integer -> Value l l' f' f
Abstract.integer (Integer -> Value l l Placed Placed)
-> Integer -> Value l l Placed Placed
forall a b. (a -> b) -> a -> b
$ Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ Int -> Int
forall a. Storable a => a -> Int
sizeOf (Int
0 :: Int))
      | Just (AST.Builtin Ident
"MAX") <- Maybe (Value l l Placed Placed)
functionValue,
        [Just (AST.Builtin Ident
"CARDINAL")] <- [Maybe (Value l l Placed Placed)]
argValues = Value l l Placed Placed -> SynCFExp Language l
fromValue (Integer -> Value l l Placed Placed
forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Integer -> Value l l' f' f
forall l' (f' :: * -> *) (f :: * -> *). Integer -> Value l l' f' f
Abstract.integer Integer
maxCardinal)
      | Just (AST.Builtin Ident
"MAX") <- Maybe (Value l l Placed Placed)
functionValue,
        [Just (AST.Builtin Ident
"BISET")] <- [Maybe (Value l l Placed Placed)]
argValues = Value l l Placed Placed -> SynCFExp Language l
fromValue (Integer -> Value l l Placed Placed
forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Integer -> Value l l' f' f
forall l' (f' :: * -> *) (f :: * -> *). Integer -> Value l l' f' f
Abstract.integer Integer
maxSet)
      | Just (AST.Builtin Ident
"MIN") <- Maybe (Value l l Placed Placed)
functionValue,
        [Just (AST.Builtin Ident
"CARDINAL")] <- [Maybe (Value l l Placed Placed)]
argValues = Value l l Placed Placed -> SynCFExp Language l
fromValue (Integer -> Value l l Placed Placed
forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Integer -> Value l l' f' f
forall l' (f' :: * -> *) (f :: * -> *). Integer -> Value l l' f' f
Abstract.integer Integer
0)
      | Just (AST.Builtin Ident
"MIN") <- Maybe (Value l l Placed Placed)
functionValue,
        [Just (AST.Builtin Ident
"BISET")] <- [Maybe (Value l l Placed Placed)]
argValues = Value l l Placed Placed -> SynCFExp Language l
fromValue (Integer -> Value l l Placed Placed
forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Integer -> Value l l' f' f
forall l' (f' :: * -> *) (f :: * -> *). Integer -> Value l l' f' f
Abstract.integer Integer
minSet)
      where fromValue :: Value l l Placed Placed -> SynCFExp Language l
fromValue Value l l Placed Placed
v = Placed (Value l l Placed Placed) -> SynCFExp Language l
forall λ l.
(Wirthy λ, Functor (Map Placed Identity) (Value l l),
 Pretty (Value l l Identity Identity)) =>
Placed (Value l l Placed Placed) -> SynCFExp λ l
Oberon.literalSynthesis ((Int, ParsedLexemes, Int)
pos, Value l l Placed Placed
v)
            functionValue :: Maybe (Value l l Placed Placed)
functionValue = Placed (Value l l Placed Placed) -> Value l l Placed Placed
forall a b. (a, b) -> b
snd (Placed (Value l l Placed Placed) -> Value l l Placed Placed)
-> Maybe (Placed (Value l l Placed Placed))
-> Maybe (Value l l Placed Placed)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SynCFDesignator l -> Maybe (Placed (Value l l Placed Placed))
forall l.
SynCFDesignator l -> Maybe (Placed (Value l l Placed Placed))
designatorValue (Synthesized (Auto ConstantFold) (Designator l l Sem Sem)
-> Atts (Synthesized (Auto ConstantFold)) (Designator l l Sem Sem)
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto ConstantFold) (Designator l l sem sem)
Synthesized (Auto ConstantFold) (Designator l l Sem Sem)
fn :: SynCFDesignator l)
            argValues :: [Maybe (Value l l Placed Placed)]
argValues = (Placed (Value l l Placed Placed) -> Value l l Placed Placed
forall a b. (a, b) -> b
snd (Placed (Value l l Placed Placed) -> Value l l Placed Placed)
-> Maybe (Placed (Value l l Placed Placed))
-> Maybe (Value l l Placed Placed)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Maybe (Placed (Value l l Placed Placed))
 -> Maybe (Value l l Placed Placed))
-> (Synthesized (Auto ConstantFold) (Expression l l Sem Sem)
    -> Maybe (Placed (Value l l Placed Placed)))
-> Synthesized (Auto ConstantFold) (Expression l l Sem Sem)
-> Maybe (Value l l Placed Placed)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SynCFExp l l -> Maybe (Placed (Value l l Placed Placed))
SynCFExp l l -> Maybe (Placed (Value l l Placed Placed))
forall λ l.
SynCFExp λ l -> Maybe (Placed (Value l l Placed Placed))
foldedValue (SynCFExp l l -> Maybe (Placed (Value l l Placed Placed)))
-> (Synthesized (Auto ConstantFold) (Expression l l Sem Sem)
    -> SynCFExp l l)
-> Synthesized (Auto ConstantFold) (Expression l l Sem Sem)
-> Maybe (Placed (Value l l Placed Placed))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Synthesized (Auto ConstantFold) (Expression l l Sem Sem)
-> Atts (Synthesized (Auto ConstantFold)) (Expression l l Sem Sem)
Synthesized (Auto ConstantFold) (Expression l l Sem Sem)
-> SynCFExp l l
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn (Synthesized (Auto ConstantFold) (Expression l l Sem Sem)
 -> Maybe (Value l l Placed Placed))
-> [Synthesized (Auto ConstantFold) (Expression l l Sem Sem)]
-> [Maybe (Value l l Placed Placed)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZipList (Synthesized (Auto ConstantFold) (Expression l l Sem Sem))
-> [Synthesized (Auto ConstantFold) (Expression l l Sem Sem)]
forall a. ZipList a -> [a]
getZipList ZipList (Synthesized (Auto ConstantFold) (Expression l l sem sem))
ZipList (Synthesized (Auto ConstantFold) (Expression l l Sem Sem))
args
   synthesis Auto ConstantFold
t ((Int, ParsedLexemes, Int)
pos, Expression λ l Sem Sem
self) (InhCF Environment l
environment Ident
currMod) Expression λ l sem (Synthesized (Auto ConstantFold))
synthesized =
      SynCFExp Language l -> SynCFExp Language l
fromOberon (Auto ConstantFold
-> ((Int, ParsedLexemes, Int), Expression Language l Sem Sem)
-> Atts
     (Inherited (Auto ConstantFold)) (Expression Language l Sem Sem)
-> Expression Language l Sem (Synthesized (Auto ConstantFold))
-> Atts
     (Synthesized (Auto ConstantFold)) (Expression Language l Sem Sem)
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)
forall (sem :: * -> *).
(sem ~ Sem) =>
Auto ConstantFold
-> ((Int, ParsedLexemes, Int), Expression Language l Sem Sem)
-> Atts
     (Inherited (Auto ConstantFold)) (Expression Language l sem sem)
-> Expression Language l sem (Synthesized (Auto ConstantFold))
-> Atts
     (Synthesized (Auto ConstantFold)) (Expression Language l sem sem)
synthesis Auto ConstantFold
t ((Int, ParsedLexemes, Int)
pos, Expression Language l Sem Sem -> Expression Language l Sem Sem
forall (f1 :: * -> *) (f2 :: * -> *).
Expression Language l f1 f2 -> Expression Language l f1 f2
toOberon Expression Language l Sem Sem
Expression λ l Sem Sem
self) (Environment l -> Ident -> InhCF l
forall l. Environment l -> Ident -> InhCF l
InhCF Environment l
environment Ident
currMod) (Expression Language l Sem (Synthesized (Auto ConstantFold))
 -> Atts
      (Synthesized (Auto ConstantFold)) (Expression Language l Sem Sem))
-> Expression Language l Sem (Synthesized (Auto ConstantFold))
-> Atts
     (Synthesized (Auto ConstantFold)) (Expression Language l Sem Sem)
forall a b. (a -> b) -> a -> b
$ Expression Language l Sem (Synthesized (Auto ConstantFold))
-> Expression Language l Sem (Synthesized (Auto ConstantFold))
forall (f1 :: * -> *) (f2 :: * -> *).
Expression Language l f1 f2 -> Expression Language l f1 f2
toOberon Expression Language l Sem (Synthesized (Auto ConstantFold))
Expression λ l sem (Synthesized (Auto ConstantFold))
synthesized)
      where fromJust3 :: forall f a (b :: Type -> Type) (c :: Type -> Type). Oberon.Abstract.Maybe3 f a b c -> f a b c
            fromJust3 :: forall (f :: * -> (* -> *) -> (* -> *) -> *) a (b :: * -> *)
       (c :: * -> *).
Maybe3 f a b c -> f a b c
fromJust3 (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 to Oberon at " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ (Int, ParsedLexemes, Int) -> [Char]
forall a. Show a => a -> [Char]
show (Int, ParsedLexemes, Int)
pos)
            fromJust3 (Oberon.Abstract.Maybe3 (Just f a b c
e)) = f a b c
e
            fromOberon :: SynCFExp Oberon.AST.Language l -> SynCFExp AST.Language l
            fromOberon :: SynCFExp Language l -> SynCFExp Language l
fromOberon 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{$sel:folded:SynCFExp :: Mapped Placed (Expression Language l Placed Placed)
folded= Placed (Expression Language l Placed Placed)
-> Mapped Placed (Expression Language l Placed Placed)
forall {k} (f :: k -> *) (a :: k). f a -> Mapped f a
Mapped ((Int, ParsedLexemes, Int)
pos', Maybe3 (Expression Language) l Placed Placed
-> Expression Language l Placed Placed
forall (f :: * -> (* -> *) -> (* -> *) -> *) a (b :: * -> *)
       (c :: * -> *).
Maybe3 f a b c -> f a b c
fromJust3
                                              (Maybe3 (Expression Language) l Placed Placed
 -> Expression Language l Placed Placed)
-> Maybe3 (Expression Language) l Placed Placed
-> Expression Language l Placed Placed
forall a b. (a -> b) -> a -> b
$ forall l l' l'' (f' :: * -> *) (f :: * -> *).
(CoWirthy l, TargetClass l l') =>
Expression l l'' f' f -> Expression l' l'' f' f
Abstract.coExpression @Oberon.AST.Language
                                                @(Abstract.WirthySubsetOf AST.Language) Expression Language l Placed Placed
reportExpression),
                        $sel:foldedValue:SynCFExp :: Maybe (Placed (Value l l Placed Placed))
foldedValue= Maybe (Placed (Value l l Placed Placed))
reportValue}
            toOberon :: Abstract.Expression AST.Language l f1 f2 -> Oberon.AST.Expression Oberon.AST.Language l f1 f2
            toOberon :: forall (f1 :: * -> *) (f2 :: * -> *).
Expression Language l f1 f2 -> Expression Language l f1 f2
toOberon = 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
fromJust3 (Maybe3 (Expression Language) l f1 f2
 -> Expression Language l f1 f2)
-> (Expression Language l f1 f2
    -> Maybe3 (Expression Language) l f1 f2)
-> Expression Language l f1 f2
-> Expression Language l f1 f2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l l' l'' (f' :: * -> *) (f :: * -> *).
(CoWirthy l, TargetClass l l') =>
Expression l l'' f' f -> Expression l' l'' f' f
Abstract.coExpression @AST.Language @(Abstract.WirthySubsetOf Oberon.AST.Language)

maxCardinal, maxInteger, maxSet, minSet :: Integer
maxCardinal :: Integer
maxCardinal = Integer
2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
maxInteger Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1
maxInteger :: Integer
maxInteger = Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int
forall a. Bounded a => a
maxBound :: Int)
maxSet :: Integer
maxSet = Integer
63
minSet :: Integer
minSet = Integer
0

instance (Abstract.Modula2 l, Ord (Abstract.QualIdent l), v ~ Abstract.Value l l Placed Placed,
          Atts (Inherited (Auto ConstantFold)) (Abstract.Expression l l Sem Sem) ~ InhCF l,
          Atts (Inherited (Auto ConstantFold)) (Abstract.Designator l l Sem Sem) ~ InhCF l,
          Atts (Synthesized (Auto ConstantFold)) (Abstract.Expression l l Sem Sem) ~ SynCFExp λ l,
          Atts (Synthesized (Auto ConstantFold)) (Abstract.Designator l l Sem Sem) ~ SynCFDesignator l) =>
         SynthesizedField "designatorValue" (Maybe (Placed v)) (Auto ConstantFold) (AST.Designator l l) Sem Placed where
   synthesizedField :: forall (sem :: * -> *).
(sem ~ Sem) =>
Proxy "designatorValue"
-> Auto ConstantFold
-> Placed (Designator l l Sem Sem)
-> Atts (Inherited (Auto ConstantFold)) (Designator l l sem sem)
-> Designator l l sem (Synthesized (Auto ConstantFold))
-> Maybe (Placed v)
synthesizedField Proxy "designatorValue"
_ Auto ConstantFold
_ ((Int, ParsedLexemes, Int)
pos, AST.Variable QualIdent l
q) Atts (Inherited (Auto ConstantFold)) (Designator l l sem sem)
inheritance Designator l l sem (Synthesized (Auto ConstantFold))
_ = (,) (Int, ParsedLexemes, Int)
pos (v -> Placed v) -> Maybe v -> Maybe (Placed v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Maybe v) -> Maybe v
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (QualIdent l -> Map (QualIdent l) (Maybe v) -> Maybe (Maybe v)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup QualIdent l
q (Map (QualIdent l) (Maybe v) -> Maybe (Maybe v))
-> Map (QualIdent l) (Maybe v) -> Maybe (Maybe v)
forall a b. (a -> b) -> a -> b
$ InhCF l -> Environment l
forall l. InhCF l -> Environment l
env Atts (Inherited (Auto ConstantFold)) (Designator l l sem sem)
InhCF l
inheritance)
   synthesizedField Proxy "designatorValue"
_ Auto ConstantFold
_ Placed (Designator l l Sem Sem)
_ Atts (Inherited (Auto ConstantFold)) (Designator l l sem sem)
_ Designator l l sem (Synthesized (Auto ConstantFold))
_ = Maybe (Placed v)
forall a. Maybe a
Nothing