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

-- | The main export of this module is the function 'foldConstants' that folds the constants in Oberon AST using a
-- attribute grammar. Other exports are helper functions and attribute types that can be reused for other languages or
-- attribute grammars.
-- 
-- This module expects the ambiguities in the AST to be already resolved by the "Language.Oberon.Resolver" module.

module Language.Oberon.ConstantFolder 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.Functor.Identity (Identity(..))
import Data.Int (Int32)
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 Language.Haskell.TH (appT, conT, varT, varE, newName)
import Data.Text.Prettyprint.Doc (layoutCompact, Pretty(pretty))
import Data.Text.Prettyprint.Doc.Render.Text (renderStrict)

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

import qualified Language.Oberon.Abstract as Abstract
import qualified Language.Oberon.AST as AST
import qualified Language.Oberon.Pretty ()
import Language.Oberon.Grammar (ParsedLexemes(Trailing), Lexeme(Token, WhiteSpace, lexemeType, lexemeText),
                                TokenType(Other))

-- | Fold the constants in the given collection of Oberon 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. The value of the latter argument is typically 'predefined' or 'predefined2'.
foldConstants :: (Abstract.Oberon 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 (Synthesized (Auto ConstantFold)) (Abstract.Block l l Sem Sem)
                  ~ SynCFMod' l (Abstract.Block l l),
                  Full.Functor (Auto ConstantFold) (Abstract.Block l l),
                  Deep.Functor (Auto ConstantFold) (Abstract.Block l l))
              => Environment l -> Map AST.Ident (Placed (AST.Module l l Placed Placed))
              -> Map AST.Ident (Placed (AST.Module l l Placed Placed))
foldConstants :: Environment l
-> Map Ident (Placed (Module l l Placed Placed))
-> Map Ident (Placed (Module l l Placed Placed))
foldConstants Environment l
predef Map Ident (Placed (Module l l Placed Placed))
modules =
   Modules l Placed Placed
-> Map Ident (Placed (Module l l Placed Placed))
forall l (f' :: * -> *) (f :: * -> *).
Modules l f' f -> Map Ident (f (Module l l f' f'))
getModules (SynCFRoot (Modules l Placed Placed) -> Modules l Placed Placed
forall a. SynCFRoot a -> a
modulesFolded (SynCFRoot (Modules l Placed Placed) -> Modules l Placed Placed)
-> SynCFRoot (Modules l Placed Placed) -> Modules l Placed Placed
forall a b. (a -> b) -> a -> b
$
               Synthesized
  (Auto ConstantFold)
  (Modules
     l (Semantics (Auto ConstantFold)) (Semantics (Auto ConstantFold)))
-> Atts
     (Synthesized (Auto ConstantFold))
     (Modules
        l (Semantics (Auto ConstantFold)) (Semantics (Auto ConstantFold)))
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn (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 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)
                                         (Modules
  l (Semantics (Auto ConstantFold)) (Semantics (Auto ConstantFold))
-> ((Int, ParsedLexemes, Int),
    Modules
      l (Semantics (Auto ConstantFold)) (Semantics (Auto ConstantFold)))
forall b. b -> ((Int, ParsedLexemes, Int), b)
wrap (ConstantFold -> Auto ConstantFold
forall t. t -> Auto t
Auto ConstantFold
ConstantFold Auto ConstantFold
-> Modules
     l (Domain (Auto ConstantFold)) (Domain (Auto ConstantFold))
-> Modules
     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.<$> Map Ident (Placed (Module l l Placed Placed))
-> Modules l Placed Placed
forall l (f' :: * -> *) (f :: * -> *).
Map Ident (f (Module l l f' f')) -> Modules l f' f
Modules Map Ident (Placed (Module l l Placed Placed))
modules))
                    Semantics
  (Auto ConstantFold)
  (Modules
     l (Semantics (Auto ConstantFold)) (Semantics (Auto ConstantFold)))
-> Inherited
     (Auto ConstantFold)
     (Modules
        l (Semantics (Auto ConstantFold)) (Semantics (Auto ConstantFold)))
-> Synthesized
     (Auto ConstantFold)
     (Modules
        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))
  (Modules
     l (Semantics (Auto ConstantFold)) (Semantics (Auto ConstantFold)))
-> Inherited
     (Auto ConstantFold)
     (Modules
        l (Semantics (Auto ConstantFold)) (Semantics (Auto ConstantFold)))
forall t a. Atts (Inherited t) a -> Inherited t a
Inherited (Environment l -> InhCFRoot l
forall l. Environment l -> InhCFRoot l
InhCFRoot Environment l
predef)))
   where wrap :: b -> ((Int, ParsedLexemes, Int), b)
wrap = (,) (Int
0, [Lexeme] -> ParsedLexemes
Trailing [], Int
0)

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

type Environment l = Map (Abstract.QualIdent l) (Maybe (Abstract.Value l l Placed Placed))

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'))}

data ConstantFold = ConstantFold

type Sem = Semantics (Auto ConstantFold)

instance Transformation.Transformation (Auto ConstantFold) where
   type Domain (Auto ConstantFold) = Placed
   type Codomain (Auto ConstantFold) = Semantics (Auto ConstantFold)

data InhCFRoot l = InhCFRoot{InhCFRoot l -> Environment l
rootEnv :: Environment l} deriving (forall x. InhCFRoot l -> Rep (InhCFRoot l) x)
-> (forall x. Rep (InhCFRoot l) x -> InhCFRoot l)
-> Generic (InhCFRoot l)
forall x. Rep (InhCFRoot l) x -> InhCFRoot l
forall x. InhCFRoot l -> Rep (InhCFRoot l) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall l x. Rep (InhCFRoot l) x -> InhCFRoot l
forall l x. InhCFRoot l -> Rep (InhCFRoot l) x
$cto :: forall l x. Rep (InhCFRoot l) x -> InhCFRoot l
$cfrom :: forall l x. InhCFRoot l -> Rep (InhCFRoot l) x
Generic

data InhCF l = InhCF{InhCF l -> Environment l
env           :: Environment l,
                     InhCF l -> Ident
currentModule :: AST.Ident}
               deriving (forall x. InhCF l -> Rep (InhCF l) x)
-> (forall x. Rep (InhCF l) x -> InhCF l) -> Generic (InhCF l)
forall x. Rep (InhCF l) x -> InhCF l
forall x. InhCF l -> Rep (InhCF l) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall l x. Rep (InhCF l) x -> InhCF l
forall l x. InhCF l -> Rep (InhCF l) x
$cto :: forall l x. Rep (InhCF l) x -> InhCF l
$cfrom :: forall l x. InhCF l -> Rep (InhCF l) x
Generic

data SynCF a = SynCF{SynCF a -> Mapped Placed a
folded :: Mapped Placed a} deriving (forall x. SynCF a -> Rep (SynCF a) x)
-> (forall x. Rep (SynCF a) x -> SynCF a) -> Generic (SynCF a)
forall x. Rep (SynCF a) x -> SynCF a
forall x. SynCF a -> Rep (SynCF a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (SynCF a) x -> SynCF a
forall a x. SynCF a -> Rep (SynCF a) x
$cto :: forall a x. Rep (SynCF a) x -> SynCF a
$cfrom :: forall a x. SynCF a -> Rep (SynCF a) x
Generic

data SynCFMod l a = SynCFMod{SynCFMod l a -> Environment l
moduleEnv :: Environment l,
                             SynCFMod l a -> Mapped Placed a
folded    :: Mapped Placed a}
                    deriving (forall x. SynCFMod l a -> Rep (SynCFMod l a) x)
-> (forall x. Rep (SynCFMod l a) x -> SynCFMod l a)
-> Generic (SynCFMod l a)
forall x. Rep (SynCFMod l a) x -> SynCFMod l a
forall x. SynCFMod l a -> Rep (SynCFMod l a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall l a x. Rep (SynCFMod l a) x -> SynCFMod l a
forall l a x. SynCFMod l a -> Rep (SynCFMod l a) x
$cto :: forall l a x. Rep (SynCFMod l a) x -> SynCFMod l a
$cfrom :: forall l a x. SynCFMod l a -> Rep (SynCFMod l a) x
Generic

data SynCFExp λ l = SynCFExp{SynCFExp λ l -> Mapped Placed (Expression λ l Placed Placed)
folded   :: Mapped Placed (Abstract.Expression λ l Placed Placed),
                             SynCFExp λ l -> Maybe (Placed (Value l l Placed Placed))
foldedValue :: Maybe (Placed (Abstract.Value l l Placed Placed))}

data SynCFDesignator l = SynCFDesignator{SynCFDesignator l -> Mapped Placed (Designator l l Placed Placed)
folded :: Mapped Placed (Abstract.Designator l l Placed Placed),
                                         SynCFDesignator l -> Maybe (Placed (Value l l Placed Placed))
designatorValue :: Maybe (Placed (Abstract.Value l l Placed Placed))}
                         deriving (forall x. SynCFDesignator l -> Rep (SynCFDesignator l) x)
-> (forall x. Rep (SynCFDesignator l) x -> SynCFDesignator l)
-> Generic (SynCFDesignator l)
forall x. Rep (SynCFDesignator l) x -> SynCFDesignator l
forall x. SynCFDesignator l -> Rep (SynCFDesignator l) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall l x. Rep (SynCFDesignator l) x -> SynCFDesignator l
forall l x. SynCFDesignator l -> Rep (SynCFDesignator l) x
$cto :: forall l x. Rep (SynCFDesignator l) x -> SynCFDesignator l
$cfrom :: forall l x. SynCFDesignator l -> Rep (SynCFDesignator l) x
Generic

data SynCFRoot a = SynCFRoot{SynCFRoot a -> a
modulesFolded :: a}

-- * 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)

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

-- * Boring attribute types
type instance Atts (Synthesized (Auto ConstantFold)) (Modules l _ _) = SynCFRoot (Modules l Placed Placed)
type instance Atts (Synthesized (Auto ConstantFold)) (AST.Module l l _ _) = SynCFMod' l (AST.Module l l)
type instance Atts (Synthesized (Auto ConstantFold)) (AST.Declaration l l _ _) = SynCFMod' l (AST.Declaration l l)
type instance Atts (Synthesized (Auto ConstantFold)) (AST.ProcedureHeading l l _ _) = SynCF' (AST.ProcedureHeading l l)
type instance Atts (Synthesized (Auto ConstantFold)) (AST.Block l l _ _) = SynCFMod' l (AST.Block l l)
type instance Atts (Synthesized (Auto ConstantFold)) (AST.FormalParameters l l _ _) = SynCF' (AST.FormalParameters l l)
type instance Atts (Synthesized (Auto ConstantFold)) (AST.FPSection l l _ _) = SynCF' (AST.FPSection l l)
type instance Atts (Synthesized (Auto ConstantFold)) (AST.Type l l _ _) = SynCF' (AST.Type l l)
type instance Atts (Synthesized (Auto ConstantFold)) (AST.FieldList l l _ _) = SynCF' (AST.FieldList l l)
type instance Atts (Synthesized (Auto ConstantFold)) (AST.StatementSequence l l _ _) =
   SynCF' (AST.StatementSequence l l)
type instance Atts (Synthesized (Auto ConstantFold)) (AST.Expression λ l _ _) = SynCFExp λ l
type instance Atts (Synthesized (Auto ConstantFold)) (AST.Element l l _ _) = SynCF' (AST.Element l l)
type instance Atts (Synthesized (Auto ConstantFold)) (AST.Value l l _ _) = SynCF' (AST.Value l l)
type instance Atts (Synthesized (Auto ConstantFold)) (AST.Designator l l _ _) = SynCFDesignator l
type instance Atts (Synthesized (Auto ConstantFold)) (AST.Statement l l _ _) = SynCF' (AST.Statement l l)
type instance Atts (Synthesized (Auto ConstantFold)) (AST.Case l l _ _) = SynCF' (AST.Case l l)
type instance Atts (Synthesized (Auto ConstantFold)) (AST.CaseLabels l l _ _) = SynCF' (AST.CaseLabels l l)
type instance Atts (Synthesized (Auto ConstantFold)) (AST.ConditionalBranch l l _ _) =
   SynCF' (AST.ConditionalBranch l l)
type instance Atts (Synthesized (Auto ConstantFold)) (AST.WithAlternative l l _ _) = SynCF' (AST.WithAlternative l l)

type instance Atts (Inherited (Auto ConstantFold)) (Modules l _ _) = InhCFRoot l
type instance Atts (Inherited (Auto ConstantFold)) (AST.Module l l _ _) = InhCF l
type instance Atts (Inherited (Auto ConstantFold)) (AST.Declaration l l _ _) = InhCF l
type instance Atts (Inherited (Auto ConstantFold)) (AST.ProcedureHeading l l _ _) = InhCF l
type instance Atts (Inherited (Auto ConstantFold)) (AST.Block l l _ _) = InhCF l
type instance Atts (Inherited (Auto ConstantFold)) (AST.FormalParameters l l _ _) = InhCF l
type instance Atts (Inherited (Auto ConstantFold)) (AST.FPSection l l _ _) = InhCF l
type instance Atts (Inherited (Auto ConstantFold)) (AST.Type l l _ _) = InhCF l
type instance Atts (Inherited (Auto ConstantFold)) (AST.FieldList l l _ _) = InhCF l
type instance Atts (Inherited (Auto ConstantFold)) (AST.StatementSequence l l _ _) = InhCF l
type instance Atts (Inherited (Auto ConstantFold)) (AST.Expression l l _ _) = InhCF l
type instance Atts (Inherited (Auto ConstantFold)) (AST.Element l l _ _) = InhCF l
type instance Atts (Inherited (Auto ConstantFold)) (AST.Value l l _ _) = InhCF l
type instance Atts (Inherited (Auto ConstantFold)) (AST.Designator l l _ _) = InhCF l
type instance Atts (Inherited (Auto ConstantFold)) (AST.Statement l l _ _) = InhCF l
type instance Atts (Inherited (Auto ConstantFold)) (AST.Case l l _ _) = InhCF l
type instance Atts (Inherited (Auto ConstantFold)) (AST.CaseLabels l l _ _) = InhCF l
type instance Atts (Inherited (Auto ConstantFold)) (AST.ConditionalBranch l l _ _) = InhCF l
type instance Atts (Inherited (Auto ConstantFold)) (AST.WithAlternative l l _ _) = InhCF l

type SynCF' node = SynCF (node Placed Placed)
type SynCFMod' l node = SynCFMod l (node Placed Placed)


-- * Disambiguation

folded' :: SynCF' node -> Mapped Placed (node Placed Placed)
foldedExp  :: SynCFExp λ l -> Mapped Placed (Abstract.Expression λ l Placed Placed)
foldedExp' :: SynCFExp λ l -> Placed (Abstract.Expression λ l Placed Placed)

folded' :: SynCF' node -> Mapped Placed (node Placed Placed)
folded' = SynCF' node -> Mapped Placed (node Placed Placed)
forall a. SynCF a -> Mapped Placed a
folded
foldedExp :: SynCFExp λ l -> Mapped Placed (Expression λ l Placed Placed)
foldedExp = SynCFExp λ l -> Mapped Placed (Expression λ l Placed Placed)
forall λ l.
SynCFExp λ l -> Mapped Placed (Expression λ l Placed Placed)
folded
foldedExp' :: SynCFExp λ l -> Placed (Expression λ l Placed Placed)
foldedExp' = Mapped Placed (Expression λ l Placed Placed)
-> Placed (Expression λ l Placed Placed)
forall k (f :: k -> *) (a :: k). Mapped f a -> f a
getMapped (Mapped Placed (Expression λ l Placed Placed)
 -> Placed (Expression λ l Placed Placed))
-> (SynCFExp λ l -> Mapped Placed (Expression λ l Placed Placed))
-> SynCFExp λ l
-> Placed (Expression λ l Placed Placed)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SynCFExp λ l -> Mapped Placed (Expression λ l Placed Placed)
forall λ l.
SynCFExp λ l -> Mapped Placed (Expression λ l Placed Placed)
foldedExp

-- * Rules

instance {-# overlaps #-} Ord (Abstract.QualIdent l) =>
                          Synthesizer (Auto ConstantFold) (Modules l) Sem Placed where
   synthesis :: Auto ConstantFold
-> Placed
     (Modules
        l (Semantics (Auto ConstantFold)) (Semantics (Auto ConstantFold)))
-> Atts (Inherited (Auto ConstantFold)) (Modules l sem sem)
-> Modules l sem (Synthesized (Auto ConstantFold))
-> Atts (Synthesized (Auto ConstantFold)) (Modules l sem sem)
synthesis Auto ConstantFold
_ ((Int, ParsedLexemes, Int)
_, Modules Map
  Ident
  (Sem
     (Module
        l
        l
        (Semantics (Auto ConstantFold))
        (Semantics (Auto ConstantFold))))
self) Atts (Inherited (Auto ConstantFold)) (Modules l sem sem)
inheritance (Modules Map Ident (Synthesized (Auto ConstantFold) (Module l l sem sem))
ms) =
      SynCFRoot :: forall a. a -> SynCFRoot a
SynCFRoot{$sel:modulesFolded:SynCFRoot :: Modules l Placed Placed
modulesFolded= (Map Ident ((Int, ParsedLexemes, Int), Module l l Placed Placed)
-> Modules l Placed Placed
forall l (f' :: * -> *) (f :: * -> *).
Map Ident (f (Module l l f' f')) -> Modules l f' f
Modules (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)
 -> ((Int, ParsedLexemes, Int), Module l l Placed Placed))
-> Map Ident (Synthesized (Auto ConstantFold) (Module l l sem sem))
-> Map Ident ((Int, ParsedLexemes, Int), 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))}
      where 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 {-# overlaps #-} Ord (Abstract.QualIdent l) =>
                          Bequether (Auto ConstantFold) (Modules l) Sem Placed where
   bequest :: Auto ConstantFold
-> Placed
     (Modules
        l (Semantics (Auto ConstantFold)) (Semantics (Auto ConstantFold)))
-> Atts (Inherited (Auto ConstantFold)) (Modules l sem sem)
-> Modules l sem (Synthesized (Auto ConstantFold))
-> Modules l sem (Inherited (Auto ConstantFold))
bequest Auto ConstantFold
_ ((Int, ParsedLexemes, Int)
_, Modules Map
  Ident
  (Sem
     (Module
        l
        l
        (Semantics (Auto ConstantFold))
        (Semantics (Auto ConstantFold))))
self) Atts (Inherited (Auto ConstantFold)) (Modules l sem sem)
inheritance (Modules 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 Placed Placed) -> Environment l
forall l a. SynCFMod l a -> Environment l
moduleEnv (SynCFMod l (Module l l Placed Placed) -> Environment l)
-> (Synthesized (Auto ConstantFold) (Module l l sem sem)
    -> SynCFMod l (Module l l Placed Placed))
-> 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 Placed Placed)
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 {-# overlaps #-} (Abstract.Oberon l, Abstract.Nameable l, Ord (Abstract.QualIdent l), Show (Abstract.QualIdent l),
                           Atts (Synthesized (Auto ConstantFold)) (Abstract.Block l l Sem Sem) ~ SynCFMod' l (Abstract.Block l l)) =>
                          Synthesizer (Auto ConstantFold) (AST.Module l l) Sem Placed where
   synthesis :: Auto ConstantFold
-> Placed
     (Module
        l
        l
        (Semantics (Auto ConstantFold))
        (Semantics (Auto ConstantFold)))
-> Atts (Inherited (Auto ConstantFold)) (Module l l sem sem)
-> Module l l sem (Synthesized (Auto ConstantFold))
-> Atts (Synthesized (Auto ConstantFold)) (Module l l sem sem)
synthesis Auto ConstantFold
_ ((Int, ParsedLexemes, Int)
pos, AST.Module Ident
moduleName [Import l]
imports Sem
  (Block
     l
     l
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
_body) Atts (Inherited (Auto ConstantFold)) (Module l l sem sem)
inheritance (AST.Module Ident
_ [Import l]
_ Synthesized (Auto ConstantFold) (Block l l sem sem)
body) =
      SynCFMod :: forall l a. Environment l -> Mapped Placed a -> SynCFMod l a
SynCFMod{$sel:moduleEnv:SynCFMod :: Environment l
moduleEnv= Environment l
exportedEnv,
               $sel:folded:SynCFMod :: Mapped Placed (Module l l Placed Placed)
folded= ((Int, ParsedLexemes, Int), Module l l Placed Placed)
-> Mapped Placed (Module l l Placed Placed)
forall k (f :: k -> *) (a :: k). f a -> Mapped f a
Mapped ((Int, ParsedLexemes, Int)
pos,
                               Ident
-> [Import l]
-> Placed (Block l l Placed Placed)
-> Module l l Placed Placed
forall λ l (f' :: * -> *) (f :: * -> *).
Ident -> [Import l] -> f (Block l l f' f') -> Module λ l f' f
AST.Module Ident
moduleName [Import l]
imports (Placed (Block l l Placed Placed) -> Module l l Placed Placed)
-> Placed (Block l l Placed Placed) -> Module l l Placed Placed
forall a b. (a -> b) -> a -> b
$ Mapped Placed (Block l l Placed Placed)
-> Placed (Block l l Placed Placed)
forall k (f :: k -> *) (a :: k). Mapped f a -> f a
getMapped
                               (Mapped Placed (Block l l Placed Placed)
 -> Placed (Block l l Placed Placed))
-> Mapped Placed (Block l l Placed Placed)
-> Placed (Block l l Placed Placed)
forall a b. (a -> b) -> a -> b
$ SynCFMod' l (Block l l) -> Mapped Placed (Block l l Placed Placed)
forall l a. SynCFMod l a -> Mapped Placed a
folded (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 :: SynCFMod' l (Abstract.Block l l)))}
      where exportedEnv :: Environment l
exportedEnv = (QualIdent l -> QualIdent l) -> Environment l -> Environment l
forall k1 k2 a. (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeysMonotonic QualIdent l -> QualIdent l
export Environment l
newEnv
            newEnv :: Environment l
newEnv = SynCFMod' l (Block l l) -> Environment l
forall l a. SynCFMod l a -> Environment l
moduleEnv (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)
            export :: QualIdent l -> QualIdent l
export QualIdent l
q
               | Just Ident
name <- QualIdent l -> Maybe Ident
forall l. Nameable l => QualIdent l -> Maybe Ident
Abstract.getNonQualIdentName QualIdent l
q = Ident -> Ident -> QualIdent l
forall l. Oberon l => Ident -> Ident -> QualIdent l
Abstract.qualIdent Ident
moduleName Ident
name
               | Bool
otherwise = QualIdent l
q

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)

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)
_, 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)

instance (Abstract.Nameable l, k ~ Abstract.QualIdent l, v ~ Abstract.Value l l Placed Placed, Ord k,
          Atts (Synthesized (Auto ConstantFold)) (Abstract.ConstExpression l l Sem Sem) ~ SynCFExp l l) =>
         SynthesizedField "moduleEnv" (Map k (Maybe v)) (Auto ConstantFold) (AST.Declaration l l) Sem Placed where
   synthesizedField :: Proxy "moduleEnv"
-> Auto ConstantFold
-> Placed
     (Declaration
        l
        l
        (Semantics (Auto ConstantFold))
        (Semantics (Auto ConstantFold)))
-> Atts (Inherited (Auto ConstantFold)) (Declaration l l sem sem)
-> Declaration 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
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
_) Atts (Inherited (Auto ConstantFold)) (Declaration 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
_ Placed
  (Declaration
     l
     l
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
_ Atts (Inherited (Auto ConstantFold)) (Declaration l l sem sem)
_ Declaration l l sem (Synthesized (Auto ConstantFold))
_ = Map k (Maybe v)
forall a. Monoid a => a
mempty

instance {-# overlaps #-}
   (Abstract.Oberon l, Abstract.Nameable l, Ord (Abstract.QualIdent l),
    Abstract.Value l ~ AST.Value l, InhCF l ~ InhCF λ,
    Pretty (AST.Value λ λ 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.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
_ (pos :: (Int, ParsedLexemes, Int)
pos@(Int
start, ParsedLexemes
ls, Int
end), AST.Relation RelOp
op Sem
  (Expression
     l
     l
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
_ Sem
  (Expression
     l
     l
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
_) Atts (Inherited (Auto ConstantFold)) (Expression λ l sem sem)
_ (AST.Relation RelOp
_op Synthesized (Auto ConstantFold) (Expression l l sem sem)
left Synthesized (Auto ConstantFold) (Expression l l sem sem)
right) =
      case Maybe (Maybe ((Int, ParsedLexemes, Int), Value l λ Placed Placed))
-> Maybe ((Int, ParsedLexemes, Int), Value l λ Placed Placed)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (((Int, ParsedLexemes, Int), Value λ λ Placed Placed)
-> ((Int, ParsedLexemes, Int), Value λ λ Placed Placed)
-> Maybe ((Int, ParsedLexemes, Int), Value l λ Placed Placed)
compareValues (((Int, ParsedLexemes, Int), Value λ λ Placed Placed)
 -> ((Int, ParsedLexemes, Int), Value λ λ Placed Placed)
 -> Maybe ((Int, ParsedLexemes, Int), Value l λ Placed Placed))
-> Maybe ((Int, ParsedLexemes, Int), Value λ λ Placed Placed)
-> Maybe
     (((Int, ParsedLexemes, Int), Value λ λ Placed Placed)
      -> Maybe ((Int, ParsedLexemes, Int), Value l λ Placed Placed))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SynCFExp λ λ -> Maybe (Placed (Value λ λ Placed Placed))
forall λ l.
SynCFExp λ l -> Maybe (Placed (Value l l Placed Placed))
foldedValue (Synthesized
  (Auto ConstantFold)
  (Expression
     λ
     λ
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
-> Atts
     (Synthesized (Auto ConstantFold))
     (Expression
        λ
        λ
        (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
     λ
     λ
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
left) Maybe
  (((Int, ParsedLexemes, Int), Value λ λ Placed Placed)
   -> Maybe ((Int, ParsedLexemes, Int), Value l λ Placed Placed))
-> Maybe ((Int, ParsedLexemes, Int), Value λ λ Placed Placed)
-> Maybe
     (Maybe ((Int, ParsedLexemes, Int), Value l λ Placed Placed))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SynCFExp λ λ -> Maybe (Placed (Value λ λ Placed Placed))
forall λ l.
SynCFExp λ l -> Maybe (Placed (Value l l Placed Placed))
foldedValue (Synthesized
  (Auto ConstantFold)
  (Expression
     λ
     λ
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
-> Atts
     (Synthesized (Auto ConstantFold))
     (Expression
        λ
        λ
        (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
     λ
     λ
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
right))
      of Just ((Int, ParsedLexemes, Int), Value l λ Placed Placed)
value -> Placed (Value λ λ Placed Placed) -> SynCFExp λ λ
forall λ l.
(Wirthy λ, Functor (Map Placed Identity) (Value l l),
 Pretty (Value l l Identity Identity)) =>
Placed (Value l l Placed Placed) -> SynCFExp λ l
literalSynthesis ((Int, ParsedLexemes, Int), Value l λ Placed Placed)
Placed (Value λ λ Placed Placed)
value
         Maybe ((Int, ParsedLexemes, Int), Value l λ Placed Placed)
Nothing -> 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 λ λ Placed Placed)
folded= ((Int, ParsedLexemes, Int), Expression λ λ Placed Placed)
-> Mapped Placed (Expression λ λ Placed Placed)
forall k (f :: k -> *) (a :: k). f a -> Mapped f a
Mapped ((Int, ParsedLexemes, Int)
pos,
                                             RelOp
-> ((Int, ParsedLexemes, Int), Expression λ λ Placed Placed)
-> ((Int, ParsedLexemes, Int), Expression λ λ Placed Placed)
-> Expression λ λ Placed Placed
forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
RelOp
-> f (Expression l' l' f' f')
-> f (Expression l' l' f' f')
-> Expression l l' f' f
Abstract.relation RelOp
op (SynCFExp λ λ
-> ((Int, ParsedLexemes, Int), Expression λ λ Placed Placed)
forall λ l. SynCFExp λ l -> Placed (Expression λ l Placed Placed)
foldedExp' (SynCFExp λ λ
 -> ((Int, ParsedLexemes, Int), Expression λ λ Placed Placed))
-> SynCFExp λ λ
-> ((Int, ParsedLexemes, Int), Expression λ λ Placed Placed)
forall a b. (a -> b) -> a -> b
$ Synthesized
  (Auto ConstantFold)
  (Expression
     λ
     λ
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
-> Atts
     (Synthesized (Auto ConstantFold))
     (Expression
        λ
        λ
        (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
     λ
     λ
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
left) (SynCFExp λ λ
-> ((Int, ParsedLexemes, Int), Expression λ λ Placed Placed)
forall λ l. SynCFExp λ l -> Placed (Expression λ l Placed Placed)
foldedExp' (SynCFExp λ λ
 -> ((Int, ParsedLexemes, Int), Expression λ λ Placed Placed))
-> SynCFExp λ λ
-> ((Int, ParsedLexemes, Int), Expression λ λ Placed Placed)
forall a b. (a -> b) -> a -> b
$ Synthesized
  (Auto ConstantFold)
  (Expression
     λ
     λ
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
-> Atts
     (Synthesized (Auto ConstantFold))
     (Expression
        λ
        λ
        (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
     λ
     λ
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
right)),
                             $sel:foldedValue:SynCFExp :: Maybe (Placed (Value λ λ Placed Placed))
foldedValue= Maybe (Placed (Value λ λ Placed Placed))
forall a. Maybe a
Nothing}
      where compareValues :: ((Int, ParsedLexemes, Int), Value λ λ Placed Placed)
-> ((Int, ParsedLexemes, Int), Value λ λ Placed Placed)
-> Maybe ((Int, ParsedLexemes, Int), Value l λ Placed Placed)
compareValues ((Int, ParsedLexemes, Int)
_, AST.Boolean Bool
l) ((Int, ParsedLexemes, Int)
ls, AST.Boolean Bool
r)   = (Int, ParsedLexemes, Int)
-> Value l λ Placed Placed
-> ((Int, ParsedLexemes, Int), Value l λ Placed Placed)
repos (Int, ParsedLexemes, Int)
ls (Value l λ Placed Placed
 -> ((Int, ParsedLexemes, Int), Value l λ Placed Placed))
-> Maybe (Value l λ Placed Placed)
-> Maybe ((Int, ParsedLexemes, Int), Value l λ Placed Placed)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RelOp -> Ordering -> Maybe (Value λ λ Placed Placed)
forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
RelOp -> Ordering -> Maybe (Value l l' f' f)
relate RelOp
op (Bool -> Bool -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Bool
l Bool
r)
            compareValues ((Int, ParsedLexemes, Int)
_, AST.Integer Integer
l) ((Int, ParsedLexemes, Int)
ls, AST.Integer Integer
r)   = (Int, ParsedLexemes, Int)
-> Value l λ Placed Placed
-> ((Int, ParsedLexemes, Int), Value l λ Placed Placed)
repos (Int, ParsedLexemes, Int)
ls (Value l λ Placed Placed
 -> ((Int, ParsedLexemes, Int), Value l λ Placed Placed))
-> Maybe (Value l λ Placed Placed)
-> Maybe ((Int, ParsedLexemes, Int), Value l λ Placed Placed)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RelOp -> Ordering -> Maybe (Value λ λ Placed Placed)
forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
RelOp -> Ordering -> Maybe (Value l l' f' f)
relate RelOp
op (Integer -> Integer -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Integer
l Integer
r)
            compareValues ((Int, ParsedLexemes, Int)
_, AST.Real Double
l) ((Int, ParsedLexemes, Int)
ls, AST.Real Double
r)         = (Int, ParsedLexemes, Int)
-> Value l λ Placed Placed
-> ((Int, ParsedLexemes, Int), Value l λ Placed Placed)
repos (Int, ParsedLexemes, Int)
ls (Value l λ Placed Placed
 -> ((Int, ParsedLexemes, Int), Value l λ Placed Placed))
-> Maybe (Value l λ Placed Placed)
-> Maybe ((Int, ParsedLexemes, Int), Value l λ Placed Placed)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RelOp -> Ordering -> Maybe (Value λ λ Placed Placed)
forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
RelOp -> Ordering -> Maybe (Value l l' f' f)
relate RelOp
op (Double -> Double -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Double
l Double
r)
            compareValues ((Int, ParsedLexemes, Int)
_, AST.Integer Integer
l) ((Int, ParsedLexemes, Int)
ls, AST.Real Double
r)      = (Int, ParsedLexemes, Int)
-> Value l λ Placed Placed
-> ((Int, ParsedLexemes, Int), Value l λ Placed Placed)
repos (Int, ParsedLexemes, Int)
ls (Value l λ Placed Placed
 -> ((Int, ParsedLexemes, Int), Value l λ Placed Placed))
-> Maybe (Value l λ Placed Placed)
-> Maybe ((Int, ParsedLexemes, Int), Value l λ Placed Placed)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RelOp -> Ordering -> Maybe (Value λ λ Placed Placed)
forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
RelOp -> Ordering -> Maybe (Value l l' f' f)
relate RelOp
op (Double -> Double -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
l) Double
r)
            compareValues ((Int, ParsedLexemes, Int)
_, AST.Real Double
l) ((Int, ParsedLexemes, Int)
ls, AST.Integer Integer
r)      = (Int, ParsedLexemes, Int)
-> Value l λ Placed Placed
-> ((Int, ParsedLexemes, Int), Value l λ Placed Placed)
repos (Int, ParsedLexemes, Int)
ls (Value l λ Placed Placed
 -> ((Int, ParsedLexemes, Int), Value l λ Placed Placed))
-> Maybe (Value l λ Placed Placed)
-> Maybe ((Int, ParsedLexemes, Int), Value l λ Placed Placed)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RelOp -> Ordering -> Maybe (Value λ λ Placed Placed)
forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
RelOp -> Ordering -> Maybe (Value l l' f' f)
relate RelOp
op (Double -> Double -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Double
l (Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
r))
            compareValues ((Int, ParsedLexemes, Int)
_, AST.CharCode Int
l) ((Int, ParsedLexemes, Int)
ls, AST.CharCode Int
r) = (Int, ParsedLexemes, Int)
-> Value l λ Placed Placed
-> ((Int, ParsedLexemes, Int), Value l λ Placed Placed)
repos (Int, ParsedLexemes, Int)
ls (Value l λ Placed Placed
 -> ((Int, ParsedLexemes, Int), Value l λ Placed Placed))
-> Maybe (Value l λ Placed Placed)
-> Maybe ((Int, ParsedLexemes, Int), Value l λ Placed Placed)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RelOp -> Ordering -> Maybe (Value λ λ Placed Placed)
forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
RelOp -> Ordering -> Maybe (Value l l' f' f)
relate RelOp
op (Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
l Int
r)
            compareValues ((Int, ParsedLexemes, Int)
_, AST.String Ident
l) ((Int, ParsedLexemes, Int)
ls, AST.String Ident
r)     = (Int, ParsedLexemes, Int)
-> Value l λ Placed Placed
-> ((Int, ParsedLexemes, Int), Value l λ Placed Placed)
repos (Int, ParsedLexemes, Int)
ls (Value l λ Placed Placed
 -> ((Int, ParsedLexemes, Int), Value l λ Placed Placed))
-> Maybe (Value l λ Placed Placed)
-> Maybe ((Int, ParsedLexemes, Int), Value l λ Placed Placed)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RelOp -> Ordering -> Maybe (Value λ λ Placed Placed)
forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
RelOp -> Ordering -> Maybe (Value l l' f' f)
relate RelOp
op (Ident -> Ident -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Ident
l Ident
r)
            compareValues ((Int, ParsedLexemes, Int)
_, AST.CharCode Int
l) ((Int, ParsedLexemes, Int)
ls, AST.String Ident
r) = (Int, ParsedLexemes, Int)
-> Value l λ Placed Placed
-> ((Int, ParsedLexemes, Int), Value l λ Placed Placed)
repos (Int, ParsedLexemes, Int)
ls
                                                                   (Value l λ Placed Placed
 -> ((Int, ParsedLexemes, Int), Value l λ Placed Placed))
-> Maybe (Value l λ Placed Placed)
-> Maybe ((Int, ParsedLexemes, Int), Value l λ Placed Placed)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RelOp -> Ordering -> Maybe (Value λ λ Placed Placed)
forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
RelOp -> Ordering -> Maybe (Value l l' f' f)
relate RelOp
op (Ident -> Ident -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Char -> Ident
Text.singleton (Char -> Ident) -> Char -> Ident
forall a b. (a -> b) -> a -> b
$ Int -> Char
chr Int
l) Ident
r)
            compareValues ((Int, ParsedLexemes, Int)
_, AST.String Ident
l) ((Int, ParsedLexemes, Int)
ls, AST.CharCode Int
r) = (Int, ParsedLexemes, Int)
-> Value l λ Placed Placed
-> ((Int, ParsedLexemes, Int), Value l λ Placed Placed)
repos (Int, ParsedLexemes, Int)
ls
                                                                   (Value l λ Placed Placed
 -> ((Int, ParsedLexemes, Int), Value l λ Placed Placed))
-> Maybe (Value l λ Placed Placed)
-> Maybe ((Int, ParsedLexemes, Int), Value l λ Placed Placed)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RelOp -> Ordering -> Maybe (Value λ λ Placed Placed)
forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
RelOp -> Ordering -> Maybe (Value l l' f' f)
relate RelOp
op (Ident -> Ident -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Ident
l (Char -> Ident
Text.singleton (Char -> Ident) -> Char -> Ident
forall a b. (a -> b) -> a -> b
$ Int -> Char
chr Int
r))
            compareValues ((Int, ParsedLexemes, Int), Value λ λ Placed Placed)
_ ((Int, ParsedLexemes, Int), Value λ λ Placed Placed)
_                               = Maybe ((Int, ParsedLexemes, Int), Value l λ Placed Placed)
forall a. Maybe a
Nothing
            repos :: (Int, ParsedLexemes, Int)
-> Value l λ Placed Placed
-> ((Int, ParsedLexemes, Int), Value l λ Placed Placed)
repos (Int
_, ParsedLexemes
ls', Int
_) Value l λ Placed Placed
v = ((Int
start, ParsedLexemes -> ParsedLexemes -> ParsedLexemes
anyWhitespace ParsedLexemes
ls ParsedLexemes
ls', Int
end), Value l λ Placed Placed
v)
            relate :: RelOp -> Ordering -> Maybe (Value l l' f' f)
relate RelOp
Abstract.Equal Ordering
EQ          = Value l l' f' f -> Maybe (Value l l' f' f)
forall a. a -> Maybe a
Just Value l l' f' f
forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Value l l' f' f
Abstract.true
            relate RelOp
Abstract.Equal Ordering
_           = Value l l' f' f -> Maybe (Value l l' f' f)
forall a. a -> Maybe a
Just Value l l' f' f
forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Value l l' f' f
Abstract.false
            relate RelOp
Abstract.Unequal Ordering
EQ        = Value l l' f' f -> Maybe (Value l l' f' f)
forall a. a -> Maybe a
Just Value l l' f' f
forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Value l l' f' f
Abstract.false
            relate RelOp
Abstract.Unequal Ordering
_         = Value l l' f' f -> Maybe (Value l l' f' f)
forall a. a -> Maybe a
Just Value l l' f' f
forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Value l l' f' f
Abstract.true
            relate RelOp
Abstract.Less Ordering
LT           = Value l l' f' f -> Maybe (Value l l' f' f)
forall a. a -> Maybe a
Just Value l l' f' f
forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Value l l' f' f
Abstract.true
            relate RelOp
Abstract.Less Ordering
_            = Value l l' f' f -> Maybe (Value l l' f' f)
forall a. a -> Maybe a
Just Value l l' f' f
forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Value l l' f' f
Abstract.false
            relate RelOp
Abstract.LessOrEqual Ordering
GT    = Value l l' f' f -> Maybe (Value l l' f' f)
forall a. a -> Maybe a
Just Value l l' f' f
forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Value l l' f' f
Abstract.false
            relate RelOp
Abstract.LessOrEqual Ordering
_     = Value l l' f' f -> Maybe (Value l l' f' f)
forall a. a -> Maybe a
Just Value l l' f' f
forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Value l l' f' f
Abstract.true
            relate RelOp
Abstract.Greater Ordering
GT        = Value l l' f' f -> Maybe (Value l l' f' f)
forall a. a -> Maybe a
Just Value l l' f' f
forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Value l l' f' f
Abstract.true
            relate RelOp
Abstract.Greater Ordering
_         = Value l l' f' f -> Maybe (Value l l' f' f)
forall a. a -> Maybe a
Just Value l l' f' f
forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Value l l' f' f
Abstract.false
            relate RelOp
Abstract.GreaterOrEqual Ordering
LT = Value l l' f' f -> Maybe (Value l l' f' f)
forall a. a -> Maybe a
Just Value l l' f' f
forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Value l l' f' f
Abstract.false
            relate RelOp
Abstract.GreaterOrEqual Ordering
_  = Value l l' f' f -> Maybe (Value l l' f' f)
forall a. a -> Maybe a
Just Value l l' f' f
forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Value l l' f' f
Abstract.true
            relate RelOp
Abstract.In Ordering
_              = Maybe (Value l l' f' f)
forall a. Maybe a
Nothing
   synthesis Auto ConstantFold
_ (pos :: (Int, ParsedLexemes, Int)
pos@(Int
start, ParsedLexemes
ls, Int
end), Expression
  λ l (Semantics (Auto ConstantFold)) (Semantics (Auto ConstantFold))
_) Atts (Inherited (Auto ConstantFold)) (Expression λ l sem sem)
_ (AST.Positive Synthesized (Auto ConstantFold) (Expression l l sem sem)
expr) =
      case SynCFExp λ λ -> Maybe (Placed (Value λ λ Placed Placed))
forall λ l.
SynCFExp λ l -> Maybe (Placed (Value l l Placed Placed))
foldedValue (Synthesized
  (Auto ConstantFold)
  (Expression
     λ
     λ
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
-> Atts
     (Synthesized (Auto ConstantFold))
     (Expression
        λ
        λ
        (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
     λ
     λ
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
expr)
      of Just ((Int
_, ParsedLexemes
ls', Int
_), AST.Integer n) -> Placed (Value λ λ Placed Placed) -> SynCFExp λ λ
forall λ l.
(Wirthy λ, Functor (Map Placed Identity) (Value l l),
 Pretty (Value l l Identity Identity)) =>
Placed (Value l l Placed Placed) -> SynCFExp λ l
literalSynthesis ((Int
start, ParsedLexemes -> ParsedLexemes -> ParsedLexemes
anyWhitespace ParsedLexemes
ls ParsedLexemes
ls', Int
end), Integer -> Value λ λ Placed Placed
forall λ l (f' :: * -> *) (f :: * -> *). Integer -> Value λ l f' f
AST.Integer Integer
n)
         Just ((Int
_, ParsedLexemes
ls', Int
_), AST.Real n) -> Placed (Value λ λ Placed Placed) -> SynCFExp λ λ
forall λ l.
(Wirthy λ, Functor (Map Placed Identity) (Value l l),
 Pretty (Value l l Identity Identity)) =>
Placed (Value l l Placed Placed) -> SynCFExp λ l
literalSynthesis ((Int
start, ParsedLexemes -> ParsedLexemes -> ParsedLexemes
anyWhitespace ParsedLexemes
ls ParsedLexemes
ls', Int
end), Double -> Value λ λ Placed Placed
forall λ l (f' :: * -> *) (f :: * -> *). Double -> Value λ l f' f
AST.Real Double
n)
         Maybe (Placed (Value λ λ Placed Placed))
_ -> 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 λ λ Placed Placed)
folded= ((Int, ParsedLexemes, Int), Expression λ λ Placed Placed)
-> Mapped Placed (Expression λ λ Placed Placed)
forall k (f :: k -> *) (a :: k). f a -> Mapped f a
Mapped ((Int, ParsedLexemes, Int)
pos, ((Int, ParsedLexemes, Int), Expression λ λ Placed Placed)
-> Expression λ λ Placed Placed
forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
f (Expression l' l' f' f') -> Expression l l' f' f
Abstract.positive (((Int, ParsedLexemes, Int), Expression λ λ Placed Placed)
 -> Expression λ λ Placed Placed)
-> ((Int, ParsedLexemes, Int), Expression λ λ Placed Placed)
-> Expression λ λ Placed Placed
forall a b. (a -> b) -> a -> b
$ SynCFExp λ λ
-> ((Int, ParsedLexemes, Int), Expression λ λ Placed Placed)
forall λ l. SynCFExp λ l -> Placed (Expression λ l Placed Placed)
foldedExp' (SynCFExp λ λ
 -> ((Int, ParsedLexemes, Int), Expression λ λ Placed Placed))
-> SynCFExp λ λ
-> ((Int, ParsedLexemes, Int), Expression λ λ Placed Placed)
forall a b. (a -> b) -> a -> b
$ Synthesized
  (Auto ConstantFold)
  (Expression
     λ
     λ
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
-> Atts
     (Synthesized (Auto ConstantFold))
     (Expression
        λ
        λ
        (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
     λ
     λ
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
expr),
                       $sel:foldedValue:SynCFExp :: Maybe (Placed (Value λ λ Placed Placed))
foldedValue= Maybe (Placed (Value λ λ Placed Placed))
forall a. Maybe a
Nothing}
   synthesis Auto ConstantFold
_ (pos :: (Int, ParsedLexemes, Int)
pos@(Int
start, ParsedLexemes
ls, Int
end), Expression
  λ l (Semantics (Auto ConstantFold)) (Semantics (Auto ConstantFold))
_) Atts (Inherited (Auto ConstantFold)) (Expression λ l sem sem)
_ (AST.Negative Synthesized (Auto ConstantFold) (Expression l l sem sem)
expr) =
      case SynCFExp λ λ -> Maybe (Placed (Value λ λ Placed Placed))
forall λ l.
SynCFExp λ l -> Maybe (Placed (Value l l Placed Placed))
foldedValue (Synthesized
  (Auto ConstantFold)
  (Expression
     λ
     λ
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
-> Atts
     (Synthesized (Auto ConstantFold))
     (Expression
        λ
        λ
        (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
     λ
     λ
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
expr)
      of Just ((Int
_, ParsedLexemes
ls', Int
_), AST.Integer n) -> Placed (Value λ λ Placed Placed) -> SynCFExp λ λ
forall λ l.
(Wirthy λ, Functor (Map Placed Identity) (Value l l),
 Pretty (Value l l Identity Identity)) =>
Placed (Value l l Placed Placed) -> SynCFExp λ l
literalSynthesis ((Int
start, ParsedLexemes -> ParsedLexemes -> ParsedLexemes
anyWhitespace ParsedLexemes
ls ParsedLexemes
ls', Int
end),
                                                                Integer -> Value λ λ Placed Placed
forall λ l (f' :: * -> *) (f :: * -> *). Integer -> Value λ l f' f
AST.Integer (Integer -> Value λ λ Placed Placed)
-> Integer -> Value λ λ Placed Placed
forall a b. (a -> b) -> a -> b
$ Integer -> Integer
forall a. Num a => a -> a
negate Integer
n)
         Just ((Int
_, ParsedLexemes
ls', Int
_), AST.Real n) -> Placed (Value λ λ Placed Placed) -> SynCFExp λ λ
forall λ l.
(Wirthy λ, Functor (Map Placed Identity) (Value l l),
 Pretty (Value l l Identity Identity)) =>
Placed (Value l l Placed Placed) -> SynCFExp λ l
literalSynthesis ((Int
start, ParsedLexemes -> ParsedLexemes -> ParsedLexemes
anyWhitespace ParsedLexemes
ls ParsedLexemes
ls', Int
end), Double -> Value λ λ Placed Placed
forall λ l (f' :: * -> *) (f :: * -> *). Double -> Value λ l f' f
AST.Real (Double -> Value λ λ Placed Placed)
-> Double -> Value λ λ Placed Placed
forall a b. (a -> b) -> a -> b
$ Double -> Double
forall a. Num a => a -> a
negate Double
n)
         Maybe (Placed (Value λ λ Placed Placed))
_ -> 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 λ λ Placed Placed)
folded= ((Int, ParsedLexemes, Int), Expression λ λ Placed Placed)
-> Mapped Placed (Expression λ λ Placed Placed)
forall k (f :: k -> *) (a :: k). f a -> Mapped f a
Mapped ((Int, ParsedLexemes, Int)
pos, ((Int, ParsedLexemes, Int), Expression λ λ Placed Placed)
-> Expression λ λ Placed Placed
forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
f (Expression l' l' f' f') -> Expression l l' f' f
Abstract.negative (((Int, ParsedLexemes, Int), Expression λ λ Placed Placed)
 -> Expression λ λ Placed Placed)
-> ((Int, ParsedLexemes, Int), Expression λ λ Placed Placed)
-> Expression λ λ Placed Placed
forall a b. (a -> b) -> a -> b
$ SynCFExp λ λ
-> ((Int, ParsedLexemes, Int), Expression λ λ Placed Placed)
forall λ l. SynCFExp λ l -> Placed (Expression λ l Placed Placed)
foldedExp' (SynCFExp λ λ
 -> ((Int, ParsedLexemes, Int), Expression λ λ Placed Placed))
-> SynCFExp λ λ
-> ((Int, ParsedLexemes, Int), Expression λ λ Placed Placed)
forall a b. (a -> b) -> a -> b
$ Synthesized
  (Auto ConstantFold)
  (Expression
     λ
     λ
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
-> Atts
     (Synthesized (Auto ConstantFold))
     (Expression
        λ
        λ
        (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
     λ
     λ
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
expr),
                       $sel:foldedValue:SynCFExp :: Maybe (Placed (Value λ λ Placed Placed))
foldedValue= Maybe (Placed (Value λ λ 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.Add Synthesized (Auto ConstantFold) (Expression l l sem sem)
left Synthesized (Auto ConstantFold) (Expression l l sem sem)
right) =
      (Int, ParsedLexemes, Int)
-> (((Int, ParsedLexemes, Int), Expression λ λ Placed Placed)
    -> ((Int, ParsedLexemes, Int), Expression λ λ Placed Placed)
    -> Expression λ λ Placed Placed)
-> (forall n. Num n => n -> n -> n)
-> SynCFExp λ λ
-> SynCFExp λ λ
-> SynCFExp λ λ
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. Num n => n -> n -> n)
-> SynCFExp l l
-> SynCFExp l l
-> SynCFExp λ l
foldBinaryArithmetic (Int, ParsedLexemes, Int)
pos ((Int, ParsedLexemes, Int), Expression λ λ Placed Placed)
-> ((Int, ParsedLexemes, Int), Expression λ λ Placed Placed)
-> Expression λ λ Placed Placed
forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
f (Expression l' l' f' f')
-> f (Expression l' l' f' f') -> Expression l l' f' f
Abstract.add forall n. Num n => n -> n -> n
(+) (Synthesized
  (Auto ConstantFold)
  (Expression
     λ
     λ
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
-> Atts
     (Synthesized (Auto ConstantFold))
     (Expression
        λ
        λ
        (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
     λ
     λ
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
left) (Synthesized
  (Auto ConstantFold)
  (Expression
     λ
     λ
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
-> Atts
     (Synthesized (Auto ConstantFold))
     (Expression
        λ
        λ
        (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
     λ
     λ
     (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.Subtract Synthesized (Auto ConstantFold) (Expression l l sem sem)
left Synthesized (Auto ConstantFold) (Expression l l sem sem)
right) =
      (Int, ParsedLexemes, Int)
-> (((Int, ParsedLexemes, Int), Expression λ λ Placed Placed)
    -> ((Int, ParsedLexemes, Int), Expression λ λ Placed Placed)
    -> Expression λ λ Placed Placed)
-> (forall n. Num n => n -> n -> n)
-> SynCFExp λ λ
-> SynCFExp λ λ
-> SynCFExp λ λ
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. Num n => n -> n -> n)
-> SynCFExp l l
-> SynCFExp l l
-> SynCFExp λ l
foldBinaryArithmetic (Int, ParsedLexemes, Int)
pos ((Int, ParsedLexemes, Int), Expression λ λ Placed Placed)
-> ((Int, ParsedLexemes, Int), Expression λ λ Placed Placed)
-> Expression λ λ Placed Placed
forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
f (Expression l' l' f' f')
-> f (Expression l' l' f' f') -> Expression l l' f' f
Abstract.subtract (-) (Synthesized
  (Auto ConstantFold)
  (Expression
     λ
     λ
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
-> Atts
     (Synthesized (Auto ConstantFold))
     (Expression
        λ
        λ
        (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
     λ
     λ
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
left) (Synthesized
  (Auto ConstantFold)
  (Expression
     λ
     λ
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
-> Atts
     (Synthesized (Auto ConstantFold))
     (Expression
        λ
        λ
        (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
     λ
     λ
     (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.Or Synthesized (Auto ConstantFold) (Expression l l sem sem)
left Synthesized (Auto ConstantFold) (Expression l l sem sem)
right) =
      (Int, ParsedLexemes, Int)
-> (((Int, ParsedLexemes, Int), Expression λ λ Placed Placed)
    -> ((Int, ParsedLexemes, Int), Expression λ λ Placed Placed)
    -> Expression λ λ Placed Placed)
-> (Bool -> Bool -> Bool)
-> SynCFExp λ λ
-> SynCFExp λ λ
-> SynCFExp λ λ
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)
-> (Bool -> Bool -> Bool)
-> SynCFExp l l
-> SynCFExp l l
-> SynCFExp λ l
foldBinaryBoolean (Int, ParsedLexemes, Int)
pos ((Int, ParsedLexemes, Int), Expression λ λ Placed Placed)
-> ((Int, ParsedLexemes, Int), Expression λ λ Placed Placed)
-> Expression λ λ Placed Placed
forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
f (Expression l' l' f' f')
-> f (Expression l' l' f' f') -> Expression l l' f' f
Abstract.or Bool -> Bool -> Bool
(||) (Synthesized
  (Auto ConstantFold)
  (Expression
     λ
     λ
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
-> Atts
     (Synthesized (Auto ConstantFold))
     (Expression
        λ
        λ
        (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
     λ
     λ
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
left) (Synthesized
  (Auto ConstantFold)
  (Expression
     λ
     λ
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
-> Atts
     (Synthesized (Auto ConstantFold))
     (Expression
        λ
        λ
        (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
     λ
     λ
     (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.Multiply Synthesized (Auto ConstantFold) (Expression l l sem sem)
left Synthesized (Auto ConstantFold) (Expression l l sem sem)
right) =
      (Int, ParsedLexemes, Int)
-> (((Int, ParsedLexemes, Int), Expression λ λ Placed Placed)
    -> ((Int, ParsedLexemes, Int), Expression λ λ Placed Placed)
    -> Expression λ λ Placed Placed)
-> (forall n. Num n => n -> n -> n)
-> SynCFExp λ λ
-> SynCFExp λ λ
-> SynCFExp λ λ
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. Num n => n -> n -> n)
-> SynCFExp l l
-> SynCFExp l l
-> SynCFExp λ l
foldBinaryArithmetic (Int, ParsedLexemes, Int)
pos ((Int, ParsedLexemes, Int), Expression λ λ Placed Placed)
-> ((Int, ParsedLexemes, Int), Expression λ λ Placed Placed)
-> Expression λ λ Placed Placed
forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
f (Expression l' l' f' f')
-> f (Expression l' l' f' f') -> Expression l l' f' f
Abstract.multiply forall n. Num n => n -> n -> n
(*) (Synthesized
  (Auto ConstantFold)
  (Expression
     λ
     λ
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
-> Atts
     (Synthesized (Auto ConstantFold))
     (Expression
        λ
        λ
        (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
     λ
     λ
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
left) (Synthesized
  (Auto ConstantFold)
  (Expression
     λ
     λ
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
-> Atts
     (Synthesized (Auto ConstantFold))
     (Expression
        λ
        λ
        (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
     λ
     λ
     (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.Divide Synthesized (Auto ConstantFold) (Expression l l sem sem)
left Synthesized (Auto ConstantFold) (Expression l l sem sem)
right) =
      (Int, ParsedLexemes, Int)
-> (((Int, ParsedLexemes, Int), Expression λ λ Placed Placed)
    -> ((Int, ParsedLexemes, Int), Expression λ λ Placed Placed)
    -> Expression λ λ Placed Placed)
-> (forall n. Fractional n => n -> n -> n)
-> SynCFExp λ λ
-> SynCFExp λ λ
-> SynCFExp λ λ
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. Fractional n => n -> n -> n)
-> SynCFExp l l
-> SynCFExp l l
-> SynCFExp λ l
foldBinaryFractional (Int, ParsedLexemes, Int)
pos ((Int, ParsedLexemes, Int), Expression λ λ Placed Placed)
-> ((Int, ParsedLexemes, Int), Expression λ λ Placed Placed)
-> Expression λ λ Placed Placed
forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
f (Expression l' l' f' f')
-> f (Expression l' l' f' f') -> Expression l l' f' f
Abstract.divide forall n. Fractional n => n -> n -> n
(/) (Synthesized
  (Auto ConstantFold)
  (Expression
     λ
     λ
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
-> Atts
     (Synthesized (Auto ConstantFold))
     (Expression
        λ
        λ
        (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
     λ
     λ
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
left) (Synthesized
  (Auto ConstantFold)
  (Expression
     λ
     λ
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
-> Atts
     (Synthesized (Auto ConstantFold))
     (Expression
        λ
        λ
        (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
     λ
     λ
     (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.IntegerDivide Synthesized (Auto ConstantFold) (Expression l l sem sem)
left Synthesized (Auto ConstantFold) (Expression l l sem sem)
right) =
      (Int, ParsedLexemes, Int)
-> (((Int, ParsedLexemes, Int), Expression λ λ Placed Placed)
    -> ((Int, ParsedLexemes, Int), Expression λ λ Placed Placed)
    -> Expression λ λ Placed Placed)
-> (forall n. Integral n => n -> n -> n)
-> SynCFExp λ λ
-> SynCFExp λ λ
-> SynCFExp λ λ
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 ((Int, ParsedLexemes, Int), Expression λ λ Placed Placed)
-> ((Int, ParsedLexemes, Int), Expression λ λ Placed Placed)
-> Expression λ λ Placed Placed
forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
f (Expression l' l' f' f')
-> f (Expression l' l' f' f') -> Expression l l' f' f
Abstract.integerDivide forall n. Integral n => n -> n -> n
div (Synthesized
  (Auto ConstantFold)
  (Expression
     λ
     λ
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
-> Atts
     (Synthesized (Auto ConstantFold))
     (Expression
        λ
        λ
        (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
     λ
     λ
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
left) (Synthesized
  (Auto ConstantFold)
  (Expression
     λ
     λ
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
-> Atts
     (Synthesized (Auto ConstantFold))
     (Expression
        λ
        λ
        (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
     λ
     λ
     (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.Modulo Synthesized (Auto ConstantFold) (Expression l l sem sem)
left Synthesized (Auto ConstantFold) (Expression l l sem sem)
right) =
      (Int, ParsedLexemes, Int)
-> (((Int, ParsedLexemes, Int), Expression λ λ Placed Placed)
    -> ((Int, ParsedLexemes, Int), Expression λ λ Placed Placed)
    -> Expression λ λ Placed Placed)
-> (forall n. Integral n => n -> n -> n)
-> SynCFExp λ λ
-> SynCFExp λ λ
-> SynCFExp λ λ
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 ((Int, ParsedLexemes, Int), Expression λ λ Placed Placed)
-> ((Int, ParsedLexemes, Int), Expression λ λ Placed Placed)
-> Expression λ λ Placed Placed
forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
f (Expression l' l' f' f')
-> f (Expression l' l' f' f') -> Expression l l' f' f
Abstract.modulo forall n. Integral n => n -> n -> n
mod (Synthesized
  (Auto ConstantFold)
  (Expression
     λ
     λ
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
-> Atts
     (Synthesized (Auto ConstantFold))
     (Expression
        λ
        λ
        (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
     λ
     λ
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
left) (Synthesized
  (Auto ConstantFold)
  (Expression
     λ
     λ
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
-> Atts
     (Synthesized (Auto ConstantFold))
     (Expression
        λ
        λ
        (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
     λ
     λ
     (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.And Synthesized (Auto ConstantFold) (Expression l l sem sem)
left Synthesized (Auto ConstantFold) (Expression l l sem sem)
right) =
      (Int, ParsedLexemes, Int)
-> (((Int, ParsedLexemes, Int), Expression λ λ Placed Placed)
    -> ((Int, ParsedLexemes, Int), Expression λ λ Placed Placed)
    -> Expression λ λ Placed Placed)
-> (Bool -> Bool -> Bool)
-> SynCFExp λ λ
-> SynCFExp λ λ
-> SynCFExp λ λ
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)
-> (Bool -> Bool -> Bool)
-> SynCFExp l l
-> SynCFExp l l
-> SynCFExp λ l
foldBinaryBoolean (Int, ParsedLexemes, Int)
pos ((Int, ParsedLexemes, Int), Expression λ λ Placed Placed)
-> ((Int, ParsedLexemes, Int), Expression λ λ Placed Placed)
-> Expression λ λ Placed Placed
forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
f (Expression l' l' f' f')
-> f (Expression l' l' f' f') -> Expression l l' f' f
Abstract.and Bool -> Bool -> Bool
(&&) (Synthesized
  (Auto ConstantFold)
  (Expression
     λ
     λ
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
-> Atts
     (Synthesized (Auto ConstantFold))
     (Expression
        λ
        λ
        (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
     λ
     λ
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
left) (Synthesized
  (Auto ConstantFold)
  (Expression
     λ
     λ
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
-> Atts
     (Synthesized (Auto ConstantFold))
     (Expression
        λ
        λ
        (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
     λ
     λ
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
right)
   synthesis Auto ConstantFold
_ (pos :: (Int, ParsedLexemes, Int)
pos@(Int
start, ParsedLexemes
ls, Int
end), Expression
  λ l (Semantics (Auto ConstantFold)) (Semantics (Auto ConstantFold))
_) Atts (Inherited (Auto ConstantFold)) (Expression λ l sem sem)
_ (AST.Not Synthesized (Auto ConstantFold) (Expression l l sem sem)
expr) =
      case SynCFExp λ λ -> Maybe (Placed (Value λ λ Placed Placed))
forall λ l.
SynCFExp λ l -> Maybe (Placed (Value l l Placed Placed))
foldedValue (Synthesized
  (Auto ConstantFold)
  (Expression
     λ
     λ
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
-> Atts
     (Synthesized (Auto ConstantFold))
     (Expression
        λ
        λ
        (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
     λ
     λ
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
expr)
      of Just ((Int
_, ParsedLexemes
ls', Int
_), AST.Boolean b) -> Placed (Value λ λ Placed Placed) -> SynCFExp λ λ
forall λ l.
(Wirthy λ, Functor (Map Placed Identity) (Value l l),
 Pretty (Value l l Identity Identity)) =>
Placed (Value l l Placed Placed) -> SynCFExp λ l
literalSynthesis ((Int
start, ParsedLexemes -> ParsedLexemes -> ParsedLexemes
anyWhitespace ParsedLexemes
ls ParsedLexemes
ls', Int
end),
                                                                if Bool
b then Value λ λ Placed Placed
forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Value l l' f' f
Abstract.false else Value λ λ Placed Placed
forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Value l l' f' f
Abstract.true)
         Maybe (Placed (Value λ λ Placed Placed))
_ -> 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 λ λ Placed Placed)
folded= ((Int, ParsedLexemes, Int), Expression λ λ Placed Placed)
-> Mapped Placed (Expression λ λ Placed Placed)
forall k (f :: k -> *) (a :: k). f a -> Mapped f a
Mapped ((Int, ParsedLexemes, Int)
pos, ((Int, ParsedLexemes, Int), Expression λ λ Placed Placed)
-> Expression λ λ Placed Placed
forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
f (Expression l' l' f' f') -> Expression l l' f' f
Abstract.not (((Int, ParsedLexemes, Int), Expression λ λ Placed Placed)
 -> Expression λ λ Placed Placed)
-> ((Int, ParsedLexemes, Int), Expression λ λ Placed Placed)
-> Expression λ λ Placed Placed
forall a b. (a -> b) -> a -> b
$ SynCFExp λ λ
-> ((Int, ParsedLexemes, Int), Expression λ λ Placed Placed)
forall λ l. SynCFExp λ l -> Placed (Expression λ l Placed Placed)
foldedExp' (SynCFExp λ λ
 -> ((Int, ParsedLexemes, Int), Expression λ λ Placed Placed))
-> SynCFExp λ λ
-> ((Int, ParsedLexemes, Int), Expression λ λ Placed Placed)
forall a b. (a -> b) -> a -> b
$ Synthesized
  (Auto ConstantFold)
  (Expression
     λ
     λ
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
-> Atts
     (Synthesized (Auto ConstantFold))
     (Expression
        λ
        λ
        (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
     λ
     λ
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
expr),
                       $sel:foldedValue:SynCFExp :: Maybe (Placed (Value λ λ Placed Placed))
foldedValue= Maybe (Placed (Value λ λ Placed Placed))
forall a. Maybe a
Nothing}
   synthesis Auto ConstantFold
_ ((Int, ParsedLexemes, Int)
pos, AST.IsA Sem
  (Expression
     l
     l
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
_ QualIdent l
right) Atts (Inherited (Auto ConstantFold)) (Expression λ l sem sem)
_ (AST.IsA Synthesized (Auto ConstantFold) (Expression l l sem sem)
left QualIdent l
_) =
      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 λ λ Placed Placed)
folded= ((Int, ParsedLexemes, Int), Expression λ λ Placed Placed)
-> Mapped Placed (Expression λ λ Placed Placed)
forall k (f :: k -> *) (a :: k). f a -> Mapped f a
Mapped ((Int, ParsedLexemes, Int)
pos, ((Int, ParsedLexemes, Int), Expression λ λ Placed Placed)
-> QualIdent λ -> Expression λ λ Placed Placed
forall l (f :: * -> *) l' (f' :: * -> *).
Oberon l =>
f (Expression l' l' f' f') -> QualIdent l' -> Expression l l' f' f
Abstract.is (SynCFExp λ λ
-> ((Int, ParsedLexemes, Int), Expression λ λ Placed Placed)
forall λ l. SynCFExp λ l -> Placed (Expression λ l Placed Placed)
foldedExp' (SynCFExp λ λ
 -> ((Int, ParsedLexemes, Int), Expression λ λ Placed Placed))
-> SynCFExp λ λ
-> ((Int, ParsedLexemes, Int), Expression λ λ Placed Placed)
forall a b. (a -> b) -> a -> b
$ Synthesized
  (Auto ConstantFold)
  (Expression
     λ
     λ
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
-> Atts
     (Synthesized (Auto ConstantFold))
     (Expression
        λ
        λ
        (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
     λ
     λ
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
left) QualIdent l
QualIdent λ
right),
               $sel:foldedValue:SynCFExp :: Maybe (Placed (Value λ λ Placed Placed))
foldedValue= Maybe (Placed (Value λ λ 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.Set 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 λ λ Placed Placed)
folded= ((Int, ParsedLexemes, Int), Expression λ λ Placed Placed)
-> Mapped Placed (Expression λ λ Placed Placed)
forall k (f :: k -> *) (a :: k). f a -> Mapped f a
Mapped ((Int, ParsedLexemes, Int)
pos, [((Int, ParsedLexemes, Int), Element λ λ Placed Placed)]
-> Expression λ λ Placed Placed
forall l (f :: * -> *) l' (f' :: * -> *).
Oberon l =>
[f (Element l' l' f' f')] -> Expression l l' f' f
Abstract.set (Mapped Placed (Element λ λ Placed Placed)
-> ((Int, ParsedLexemes, Int), Element λ λ Placed Placed)
forall k (f :: k -> *) (a :: k). Mapped f a -> f a
getMapped (Mapped Placed (Element λ λ Placed Placed)
 -> ((Int, ParsedLexemes, Int), Element λ λ Placed Placed))
-> (Synthesized
      (Auto ConstantFold)
      (Element
         λ
         λ
         (Semantics (Auto ConstantFold))
         (Semantics (Auto ConstantFold)))
    -> Mapped Placed (Element λ λ Placed Placed))
-> Synthesized
     (Auto ConstantFold)
     (Element
        λ
        λ
        (Semantics (Auto ConstantFold))
        (Semantics (Auto ConstantFold)))
-> ((Int, ParsedLexemes, Int), Element λ λ Placed Placed)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SynCF' (Element λ λ) -> Mapped Placed (Element λ λ Placed Placed)
forall (node :: (* -> *) -> (* -> *) -> *).
SynCF' node -> Mapped Placed (node Placed Placed)
folded' (SynCF' (Element λ λ) -> Mapped Placed (Element λ λ Placed Placed))
-> (Synthesized
      (Auto ConstantFold)
      (Element
         λ
         λ
         (Semantics (Auto ConstantFold))
         (Semantics (Auto ConstantFold)))
    -> SynCF' (Element λ λ))
-> Synthesized
     (Auto ConstantFold)
     (Element
        λ
        λ
        (Semantics (Auto ConstantFold))
        (Semantics (Auto ConstantFold)))
-> Mapped Placed (Element λ λ Placed Placed)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Synthesized
  (Auto ConstantFold)
  (Element
     λ
     λ
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
-> SynCF' (Element λ λ)
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn (Synthesized
   (Auto ConstantFold)
   (Element
      λ
      λ
      (Semantics (Auto ConstantFold))
      (Semantics (Auto ConstantFold)))
 -> ((Int, ParsedLexemes, Int), Element λ λ Placed Placed))
-> [Synthesized
      (Auto ConstantFold)
      (Element
         λ
         λ
         (Semantics (Auto ConstantFold))
         (Semantics (Auto ConstantFold)))]
-> [((Int, ParsedLexemes, Int), Element λ λ Placed Placed)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZipList
  (Synthesized
     (Auto ConstantFold)
     (Element
        λ
        λ
        (Semantics (Auto ConstantFold))
        (Semantics (Auto ConstantFold))))
-> [Synthesized
      (Auto ConstantFold)
      (Element
         λ
         λ
         (Semantics (Auto ConstantFold))
         (Semantics (Auto ConstantFold)))]
forall a. ZipList a -> [a]
getZipList ZipList (Synthesized (Auto ConstantFold) (Element l l sem sem))
ZipList
  (Synthesized
     (Auto ConstantFold)
     (Element
        λ
        λ
        (Semantics (Auto ConstantFold))
        (Semantics (Auto ConstantFold))))
elements)),
               $sel:foldedValue:SynCFExp :: Maybe (Placed (Value λ λ Placed Placed))
foldedValue= Maybe (Placed (Value λ λ 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.Read Synthesized (Auto ConstantFold) (Designator l l sem sem)
des) =
      case Synthesized
  (Auto ConstantFold)
  (Designator
     λ
     λ
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
-> Atts
     (Synthesized (Auto ConstantFold))
     (Designator
        λ
        λ
        (Semantics (Auto ConstantFold))
        (Semantics (Auto ConstantFold)))
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto ConstantFold) (Designator l l sem sem)
Synthesized
  (Auto ConstantFold)
  (Designator
     λ
     λ
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
des :: SynCFDesignator l
      of SynCFDesignator{$sel:designatorValue:SynCFDesignator :: forall l.
SynCFDesignator l -> Maybe (Placed (Value l l Placed Placed))
designatorValue= Just Placed (Value l l Placed Placed)
val} -> Placed (Value λ λ Placed Placed) -> SynCFExp λ λ
forall λ l.
(Wirthy λ, Functor (Map Placed Identity) (Value l l),
 Pretty (Value l l Identity Identity)) =>
Placed (Value l l Placed Placed) -> SynCFExp λ l
literalSynthesis Placed (Value l l Placed Placed)
Placed (Value λ λ Placed Placed)
val
         SynCFDesignator{$sel:folded:SynCFDesignator :: forall l.
SynCFDesignator l -> Mapped Placed (Designator l l Placed Placed)
folded= Mapped ((Int, ParsedLexemes, Int)
pos', Designator l l Placed Placed
des'),
                         $sel:designatorValue:SynCFDesignator :: forall l.
SynCFDesignator l -> Maybe (Placed (Value l l Placed Placed))
designatorValue= Maybe (Placed (Value l l Placed Placed))
Nothing} -> 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 λ λ Placed Placed)
folded= ((Int, ParsedLexemes, Int), Expression λ λ Placed Placed)
-> Mapped Placed (Expression λ λ Placed Placed)
forall k (f :: k -> *) (a :: k). f a -> Mapped f a
Mapped ((Int, ParsedLexemes, Int)
pos, ((Int, ParsedLexemes, Int), Designator λ λ Placed Placed)
-> Expression λ λ Placed Placed
forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
f (Designator l' l' f' f') -> Expression l l' f' f
Abstract.read ((Int, ParsedLexemes, Int)
pos', Designator l l Placed Placed
Designator λ λ Placed Placed
des')),
                                                               $sel:foldedValue:SynCFExp :: Maybe (Placed (Value λ λ Placed Placed))
foldedValue= Maybe (Placed (Value λ λ 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.FunctionCall Synthesized (Auto ConstantFold) (Designator l l sem sem)
fn ZipList (Synthesized (Auto ConstantFold) (Expression l l sem sem))
args) =
      case (((Int, ParsedLexemes, Int), Value λ λ Placed Placed)
-> Value λ λ Placed Placed
forall a b. (a, b) -> b
snd (((Int, ParsedLexemes, Int), Value λ λ Placed Placed)
 -> Value λ λ Placed Placed)
-> Maybe ((Int, ParsedLexemes, Int), Value λ λ Placed Placed)
-> Maybe (Value λ λ 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
     λ
     λ
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
-> Atts
     (Synthesized (Auto ConstantFold))
     (Designator
        λ
        λ
        (Semantics (Auto ConstantFold))
        (Semantics (Auto ConstantFold)))
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto ConstantFold) (Designator l l sem sem)
Synthesized
  (Auto ConstantFold)
  (Designator
     λ
     λ
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
fn :: SynCFDesignator l), (((Int, ParsedLexemes, Int), Value λ λ Placed Placed)
-> Value λ λ Placed Placed
forall a b. (a, b) -> b
snd (((Int, ParsedLexemes, Int), Value λ λ Placed Placed)
 -> Value λ λ Placed Placed)
-> Maybe ((Int, ParsedLexemes, Int), Value λ λ Placed Placed)
-> Maybe (Value λ λ Placed Placed)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Maybe ((Int, ParsedLexemes, Int), Value λ λ Placed Placed)
 -> Maybe (Value λ λ Placed Placed))
-> (Synthesized
      (Auto ConstantFold)
      (Expression
         λ
         λ
         (Semantics (Auto ConstantFold))
         (Semantics (Auto ConstantFold)))
    -> Maybe ((Int, ParsedLexemes, Int), Value λ λ Placed Placed))
-> Synthesized
     (Auto ConstantFold)
     (Expression
        λ
        λ
        (Semantics (Auto ConstantFold))
        (Semantics (Auto ConstantFold)))
-> Maybe (Value λ λ Placed Placed)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SynCFExp λ λ
-> Maybe ((Int, ParsedLexemes, Int), Value λ λ Placed Placed)
forall λ l.
SynCFExp λ l -> Maybe (Placed (Value l l Placed Placed))
foldedValue (SynCFExp λ λ
 -> Maybe ((Int, ParsedLexemes, Int), Value λ λ Placed Placed))
-> (Synthesized
      (Auto ConstantFold)
      (Expression
         λ
         λ
         (Semantics (Auto ConstantFold))
         (Semantics (Auto ConstantFold)))
    -> SynCFExp λ λ)
-> Synthesized
     (Auto ConstantFold)
     (Expression
        λ
        λ
        (Semantics (Auto ConstantFold))
        (Semantics (Auto ConstantFold)))
-> Maybe ((Int, ParsedLexemes, Int), Value λ λ Placed Placed)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Synthesized
  (Auto ConstantFold)
  (Expression
     λ
     λ
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
-> SynCFExp λ λ
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn (Synthesized
   (Auto ConstantFold)
   (Expression
      λ
      λ
      (Semantics (Auto ConstantFold))
      (Semantics (Auto ConstantFold)))
 -> Maybe (Value λ λ Placed Placed))
-> [Synthesized
      (Auto ConstantFold)
      (Expression
         λ
         λ
         (Semantics (Auto ConstantFold))
         (Semantics (Auto ConstantFold)))]
-> [Maybe (Value λ λ Placed Placed)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZipList
  (Synthesized
     (Auto ConstantFold)
     (Expression
        λ
        λ
        (Semantics (Auto ConstantFold))
        (Semantics (Auto ConstantFold))))
-> [Synthesized
      (Auto ConstantFold)
      (Expression
         λ
         λ
         (Semantics (Auto ConstantFold))
         (Semantics (Auto ConstantFold)))]
forall a. ZipList a -> [a]
getZipList ZipList (Synthesized (Auto ConstantFold) (Expression l l sem sem))
ZipList
  (Synthesized
     (Auto ConstantFold)
     (Expression
        λ
        λ
        (Semantics (Auto ConstantFold))
        (Semantics (Auto ConstantFold))))
args)
      of (Just (AST.Builtin Ident
"CAP"), [Just (AST.String Ident
s)])
            | Ident -> Int
Text.length Ident
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1, Ident
capital <- Ident -> Ident
Text.toUpper Ident
s -> Value l λ Placed Placed -> SynCFExp λ λ
fromValue (Ident -> Value λ λ Placed Placed
forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Ident -> Value l l' f' f
Abstract.string Ident
capital)
         (Just (AST.Builtin Ident
"CAP"), [Just (AST.CharCode Int
c)])
            | Int
capital <- Char -> Int
ord (Char -> Char
toUpper (Char -> Char) -> Char -> Char
forall a b. (a -> b) -> a -> b
$ Int -> Char
chr Int
c) -> Value l λ Placed Placed -> SynCFExp λ λ
fromValue (Int -> Value λ λ Placed Placed
forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Int -> Value l l' f' f
Abstract.charCode Int
capital)
         (Just (AST.Builtin Ident
"CHR"), [Just (AST.Integer Integer
code)]) -> Value l λ Placed Placed -> SynCFExp λ λ
fromValue (Int -> Value λ λ Placed Placed
forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Int -> Value l l' f' f
Abstract.charCode (Int -> Value λ λ Placed Placed) -> Int -> Value λ λ Placed Placed
forall a b. (a -> b) -> a -> b
$ Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
code)
         (Just (AST.Builtin Ident
"ORD"), [Just (AST.String Ident
s)])
            | Ident -> Int
Text.length Ident
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1, Int
code <- Char -> Int
ord (Ident -> Char
Text.head Ident
s) -> Value l λ Placed Placed -> SynCFExp λ λ
fromValue (Integer -> Value λ λ Placed Placed
forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Integer -> Value l l' f' f
Abstract.integer (Integer -> Value λ λ Placed Placed)
-> Integer -> Value λ λ Placed Placed
forall a b. (a -> b) -> a -> b
$ Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
code)
         (Just (AST.Builtin Ident
"ORD"), [Just (AST.CharCode Int
code)]) -> Value l λ Placed Placed -> SynCFExp λ λ
fromValue (Integer -> Value λ λ Placed Placed
forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Integer -> Value l l' f' f
Abstract.integer (Integer -> Value λ λ Placed Placed)
-> Integer -> Value λ λ Placed Placed
forall a b. (a -> b) -> a -> b
$ Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
code)
         (Just (AST.Builtin Ident
"ABS"), [Just (AST.Integer Integer
i)]) -> Value l λ Placed Placed -> SynCFExp λ λ
fromValue (Integer -> Value λ λ Placed Placed
forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Integer -> Value l l' f' f
Abstract.integer (Integer -> Value λ λ Placed Placed)
-> Integer -> Value λ λ Placed Placed
forall a b. (a -> b) -> a -> b
$ Integer -> Integer
forall a. Num a => a -> a
abs Integer
i)
         (Just (AST.Builtin Ident
"ABS"), [Just (AST.Real Double
r)]) -> Value l λ Placed Placed -> SynCFExp λ λ
fromValue (Double -> Value λ λ Placed Placed
forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Double -> Value l l' f' f
Abstract.real (Double -> Value λ λ Placed Placed)
-> Double -> Value λ λ Placed Placed
forall a b. (a -> b) -> a -> b
$ Double -> Double
forall a. Num a => a -> a
abs Double
r)
         (Just (AST.Builtin Ident
"ASH"), [Just (AST.Integer Integer
i), Just (AST.Integer Integer
j)])
            | Integer
shifted <- Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
shift Integer
i (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
j) -> Value l λ Placed Placed -> SynCFExp λ λ
fromValue (Integer -> Value λ λ Placed Placed
forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Integer -> Value l l' f' f
Abstract.integer Integer
shifted)
         (Just (AST.Builtin Ident
"ENTIER"), [Just (AST.Real Double
x)]) -> Value l λ Placed Placed -> SynCFExp λ λ
fromValue (Integer -> Value λ λ Placed Placed
forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Integer -> Value l l' f' f
Abstract.integer (Integer -> Value λ λ Placed Placed)
-> Integer -> Value λ λ Placed Placed
forall a b. (a -> b) -> a -> b
$ Double -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
ceiling Double
x)
         (Just (AST.Builtin Ident
"LEN"), [Just (AST.String Ident
s)]) -> Value l λ Placed Placed -> SynCFExp λ λ
fromValue (Integer -> Value λ λ Placed Placed
forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Integer -> Value l l' f' f
Abstract.integer
                                                                            (Integer -> Value λ λ Placed Placed)
-> Integer -> Value λ λ 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
$ Ident -> Int
Text.length Ident
s)
         (Just (AST.Builtin Ident
"LONG"), [Just (AST.Integer Integer
x)]) -> Value l λ Placed Placed -> SynCFExp λ λ
fromValue (Integer -> Value λ λ Placed Placed
forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Integer -> Value l l' f' f
Abstract.integer Integer
x)
         (Just (AST.Builtin Ident
"LONG"), [Just (AST.Real Double
x)]) -> Value l λ Placed Placed -> SynCFExp λ λ
fromValue (Double -> Value λ λ Placed Placed
forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Double -> Value l l' f' f
Abstract.real Double
x)
         (Just (AST.Builtin Ident
"SHORT"), [Just (AST.Integer Integer
x)]) -> Value l λ Placed Placed -> SynCFExp λ λ
fromValue (Integer -> Value λ λ Placed Placed
forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Integer -> Value l l' f' f
Abstract.integer Integer
x)
         (Just (AST.Builtin Ident
"SHORT"), [Just (AST.Real Double
x)]) -> Value l λ Placed Placed -> SynCFExp λ λ
fromValue (Double -> Value λ λ Placed Placed
forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Double -> Value l l' f' f
Abstract.real Double
x)
         (Just (AST.Builtin Ident
"ODD"), [Just (AST.Integer Integer
x)]) ->
            Value l λ Placed Placed -> SynCFExp λ λ
fromValue (if Integer
x Integer -> Integer -> Integer
forall n. Integral n => n -> n -> n
`mod` Integer
2 Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1 then Value l λ Placed Placed
forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Value l l' f' f
Abstract.true else Value l λ Placed Placed
forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Value l l' f' f
Abstract.false)
         (Just (AST.Builtin Ident
"SIZE"), [Just (AST.Builtin Ident
"INTEGER")]) -> Value l λ Placed Placed -> SynCFExp λ λ
fromValue (Integer -> Value λ λ Placed Placed
forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Integer -> Value l l' f' f
Abstract.integer Integer
intSize)
         (Just (AST.Builtin Ident
"SIZE"), [Just (AST.Builtin Ident
"LONGINT")]) -> Value l λ Placed Placed -> SynCFExp λ λ
fromValue (Integer -> Value λ λ Placed Placed
forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Integer -> Value l l' f' f
Abstract.integer Integer
intSize)
         (Just (AST.Builtin Ident
"SIZE"), [Just (AST.Builtin Ident
"SHORTINT")]) -> Value l λ Placed Placed -> SynCFExp λ λ
fromValue (Integer -> Value λ λ Placed Placed
forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Integer -> Value l l' f' f
Abstract.integer Integer
int32Size)
         (Just (AST.Builtin Ident
"SIZE"), [Just (AST.Builtin Ident
"REAL")]) -> Value l λ Placed Placed -> SynCFExp λ λ
fromValue (Integer -> Value λ λ Placed Placed
forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Integer -> Value l l' f' f
Abstract.integer Integer
doubleSize)
         (Just (AST.Builtin Ident
"SIZE"), [Just (AST.Builtin Ident
"LONGREAL")]) -> Value l λ Placed Placed -> SynCFExp λ λ
fromValue (Integer -> Value λ λ Placed Placed
forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Integer -> Value l l' f' f
Abstract.integer Integer
doubleSize)
         (Just (AST.Builtin Ident
"SIZE"), [Just (AST.Builtin Ident
"SHORTREAL")]) -> Value l λ Placed Placed -> SynCFExp λ λ
fromValue (Integer -> Value λ λ Placed Placed
forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Integer -> Value l l' f' f
Abstract.integer Integer
floatSize)
         (Just (AST.Builtin Ident
"MAX"), [Just (AST.Builtin Ident
"CHAR")]) -> Value l λ Placed Placed -> SynCFExp λ λ
fromValue (Int -> Value λ λ Placed Placed
forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Int -> Value l l' f' f
Abstract.charCode Int
0xff)
         (Just (AST.Builtin Ident
"MAX"), [Just (AST.Builtin Ident
"INTEGER")]) -> Value l λ Placed Placed -> SynCFExp λ λ
fromValue (Integer -> Value λ λ Placed Placed
forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Integer -> Value l l' f' f
Abstract.integer Integer
maxInteger)
         (Just (AST.Builtin Ident
"MAX"), [Just (AST.Builtin Ident
"LONGINT")]) -> Value l λ Placed Placed -> SynCFExp λ λ
fromValue (Integer -> Value λ λ Placed Placed
forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Integer -> Value l l' f' f
Abstract.integer Integer
maxInteger)
         (Just (AST.Builtin Ident
"MAX"), [Just (AST.Builtin Ident
"SHORTINT")]) -> Value l λ Placed Placed -> SynCFExp λ λ
fromValue (Integer -> Value λ λ Placed Placed
forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Integer -> Value l l' f' f
Abstract.integer Integer
maxInt32)
         (Just (AST.Builtin Ident
"MAX"), [Just (AST.Builtin Ident
"SET")]) -> Value l λ Placed Placed -> SynCFExp λ λ
fromValue (Integer -> Value λ λ Placed Placed
forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Integer -> Value l l' f' f
Abstract.integer Integer
maxSet)
         (Just (AST.Builtin Ident
"MAX"), [Just (AST.Builtin Ident
"REAL")]) -> Value l λ Placed Placed -> SynCFExp λ λ
fromValue (Double -> Value λ λ Placed Placed
forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Double -> Value l l' f' f
Abstract.real Double
maxReal)
         (Just (AST.Builtin Ident
"MAX"), [Just (AST.Builtin Ident
"LONGREAL")]) -> Value l λ Placed Placed -> SynCFExp λ λ
fromValue (Double -> Value λ λ Placed Placed
forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Double -> Value l l' f' f
Abstract.real Double
maxReal)
         (Just (AST.Builtin Ident
"MIN"), [Just (AST.Builtin Ident
"CHAR")]) -> Value l λ Placed Placed -> SynCFExp λ λ
fromValue (Int -> Value λ λ Placed Placed
forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Int -> Value l l' f' f
Abstract.charCode Int
0)
         (Just (AST.Builtin Ident
"MIN"), [Just (AST.Builtin Ident
"INTEGER")]) -> Value l λ Placed Placed -> SynCFExp λ λ
fromValue (Integer -> Value λ λ Placed Placed
forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Integer -> Value l l' f' f
Abstract.integer Integer
minInteger)
         (Just (AST.Builtin Ident
"MIN"), [Just (AST.Builtin Ident
"LONGINT")]) -> Value l λ Placed Placed -> SynCFExp λ λ
fromValue (Integer -> Value λ λ Placed Placed
forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Integer -> Value l l' f' f
Abstract.integer Integer
minInteger)
         (Just (AST.Builtin Ident
"MIN"), [Just (AST.Builtin Ident
"SHORTINT")]) -> Value l λ Placed Placed -> SynCFExp λ λ
fromValue (Integer -> Value λ λ Placed Placed
forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Integer -> Value l l' f' f
Abstract.integer Integer
minInt32)
         (Just (AST.Builtin Ident
"MIN"), [Just (AST.Builtin Ident
"SET")]) -> Value l λ Placed Placed -> SynCFExp λ λ
fromValue (Integer -> Value λ λ Placed Placed
forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Integer -> Value l l' f' f
Abstract.integer Integer
minSet)
         (Just (AST.Builtin Ident
"MIN"), [Just (AST.Builtin Ident
"REAL")]) -> Value l λ Placed Placed -> SynCFExp λ λ
fromValue (Double -> Value λ λ Placed Placed
forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Double -> Value l l' f' f
Abstract.real Double
minReal)
         (Just (AST.Builtin Ident
"MIN"), [Just (AST.Builtin Ident
"LONGREAL")]) -> Value l λ Placed Placed -> SynCFExp λ λ
fromValue (Double -> Value λ λ Placed Placed
forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Double -> Value l l' f' f
Abstract.real Double
minReal)
         (Maybe (Value λ λ Placed Placed),
 [Maybe (Value λ λ Placed Placed)])
_ -> 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 λ λ Placed Placed)
folded= ((Int, ParsedLexemes, Int), Expression λ λ Placed Placed)
-> Mapped Placed (Expression λ λ Placed Placed)
forall k (f :: k -> *) (a :: k). f a -> Mapped f a
Mapped ((Int, ParsedLexemes, Int)
pos,
                                       ((Int, ParsedLexemes, Int), Designator λ λ Placed Placed)
-> [((Int, ParsedLexemes, Int), Expression λ λ Placed Placed)]
-> Expression λ λ Placed Placed
forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
f (Designator l' l' f' f')
-> [f (Expression l' l' f' f')] -> Expression l l' f' f
Abstract.functionCall (Mapped Placed (Designator λ λ Placed Placed)
-> ((Int, ParsedLexemes, Int), Designator λ λ Placed Placed)
forall k (f :: k -> *) (a :: k). Mapped f a -> f a
getMapped (Mapped Placed (Designator λ λ Placed Placed)
 -> ((Int, ParsedLexemes, Int), Designator λ λ Placed Placed))
-> Mapped Placed (Designator λ λ Placed Placed)
-> ((Int, ParsedLexemes, Int), Designator λ λ Placed Placed)
forall a b. (a -> b) -> a -> b
$ SynCFDesignator l -> Mapped Placed (Designator l l Placed Placed)
forall l.
SynCFDesignator l -> Mapped Placed (Designator l l Placed Placed)
folded (Synthesized
  (Auto ConstantFold)
  (Designator
     λ
     λ
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
-> Atts
     (Synthesized (Auto ConstantFold))
     (Designator
        λ
        λ
        (Semantics (Auto ConstantFold))
        (Semantics (Auto ConstantFold)))
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto ConstantFold) (Designator l l sem sem)
Synthesized
  (Auto ConstantFold)
  (Designator
     λ
     λ
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
fn :: SynCFDesignator l))
                                                             (SynCFExp λ λ
-> ((Int, ParsedLexemes, Int), Expression λ λ Placed Placed)
forall λ l. SynCFExp λ l -> Placed (Expression λ l Placed Placed)
foldedExp' (SynCFExp λ λ
 -> ((Int, ParsedLexemes, Int), Expression λ λ Placed Placed))
-> (Synthesized
      (Auto ConstantFold)
      (Expression
         λ
         λ
         (Semantics (Auto ConstantFold))
         (Semantics (Auto ConstantFold)))
    -> SynCFExp λ λ)
-> Synthesized
     (Auto ConstantFold)
     (Expression
        λ
        λ
        (Semantics (Auto ConstantFold))
        (Semantics (Auto ConstantFold)))
-> ((Int, ParsedLexemes, Int), Expression λ λ Placed Placed)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Synthesized
  (Auto ConstantFold)
  (Expression
     λ
     λ
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
-> SynCFExp λ λ
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn (Synthesized
   (Auto ConstantFold)
   (Expression
      λ
      λ
      (Semantics (Auto ConstantFold))
      (Semantics (Auto ConstantFold)))
 -> ((Int, ParsedLexemes, Int), Expression λ λ Placed Placed))
-> [Synthesized
      (Auto ConstantFold)
      (Expression
         λ
         λ
         (Semantics (Auto ConstantFold))
         (Semantics (Auto ConstantFold)))]
-> [((Int, ParsedLexemes, Int), Expression λ λ Placed Placed)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZipList
  (Synthesized
     (Auto ConstantFold)
     (Expression
        λ
        λ
        (Semantics (Auto ConstantFold))
        (Semantics (Auto ConstantFold))))
-> [Synthesized
      (Auto ConstantFold)
      (Expression
         λ
         λ
         (Semantics (Auto ConstantFold))
         (Semantics (Auto ConstantFold)))]
forall a. ZipList a -> [a]
getZipList ZipList (Synthesized (Auto ConstantFold) (Expression l l sem sem))
ZipList
  (Synthesized
     (Auto ConstantFold)
     (Expression
        λ
        λ
        (Semantics (Auto ConstantFold))
        (Semantics (Auto ConstantFold))))
args)),
                       $sel:foldedValue:SynCFExp :: Maybe (Placed (Value λ λ Placed Placed))
foldedValue= Maybe (Placed (Value λ λ Placed Placed))
forall a. Maybe a
Nothing}
      where fromValue :: Value l λ Placed Placed -> SynCFExp λ λ
fromValue Value l λ Placed Placed
v = Placed (Value λ λ Placed Placed) -> SynCFExp λ λ
forall λ l.
(Wirthy λ, Functor (Map Placed Identity) (Value l l),
 Pretty (Value l l Identity Identity)) =>
Placed (Value l l Placed Placed) -> SynCFExp λ l
literalSynthesis ((Int, ParsedLexemes, Int)
pos, Value l λ Placed Placed
Value λ λ Placed Placed
v)
   synthesis Auto ConstantFold
_ ((Int, ParsedLexemes, Int)
pos, Expression
  λ l (Semantics (Auto ConstantFold)) (Semantics (Auto ConstantFold))
_) Atts (Inherited (Auto ConstantFold)) (Expression λ l sem sem)
_ (AST.Literal Synthesized (Auto ConstantFold) (Value l l sem sem)
val) =
      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 λ λ Placed Placed)
folded= ((Int, ParsedLexemes, Int), Expression λ λ Placed Placed)
-> Mapped Placed (Expression λ λ Placed Placed)
forall k (f :: k -> *) (a :: k). f a -> Mapped f a
Mapped ((Int, ParsedLexemes, Int)
pos, Placed (Value λ λ Placed Placed) -> Expression λ λ Placed Placed
forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
f (Value l' l' f' f') -> Expression l l' f' f
Abstract.literal (Placed (Value λ λ Placed Placed) -> Expression λ λ Placed Placed)
-> Placed (Value λ λ Placed Placed) -> Expression λ λ Placed Placed
forall a b. (a -> b) -> a -> b
$ Mapped Placed (Value l λ Placed Placed)
-> ((Int, ParsedLexemes, Int), Value l λ Placed Placed)
forall k (f :: k -> *) (a :: k). Mapped f a -> f a
getMapped (Mapped Placed (Value l λ Placed Placed)
 -> ((Int, ParsedLexemes, Int), Value l λ Placed Placed))
-> Mapped Placed (Value l λ Placed Placed)
-> ((Int, ParsedLexemes, Int), Value l λ Placed Placed)
forall a b. (a -> b) -> a -> b
$ SynCF' (Value l λ) -> Mapped Placed (Value l λ Placed Placed)
forall (node :: (* -> *) -> (* -> *) -> *).
SynCF' node -> Mapped Placed (node Placed Placed)
folded' (SynCF' (Value l λ) -> Mapped Placed (Value l λ Placed Placed))
-> SynCF' (Value l λ) -> Mapped Placed (Value l λ Placed Placed)
forall a b. (a -> b) -> a -> b
$ Synthesized
  (Auto ConstantFold)
  (Value
     λ
     λ
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
-> Atts
     (Synthesized (Auto ConstantFold))
     (Value
        λ
        λ
        (Semantics (Auto ConstantFold))
        (Semantics (Auto ConstantFold)))
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto ConstantFold) (Value l l sem sem)
Synthesized
  (Auto ConstantFold)
  (Value
     λ
     λ
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
val),
               $sel:foldedValue:SynCFExp :: Maybe (Placed (Value λ λ Placed Placed))
foldedValue= ((Int, ParsedLexemes, Int), Value λ λ Placed Placed)
-> Maybe ((Int, ParsedLexemes, Int), Value λ λ Placed Placed)
forall a. a -> Maybe a
Just ((Int, ParsedLexemes, Int)
pos, ((Int, ParsedLexemes, Int), Value λ λ Placed Placed)
-> Value λ λ Placed Placed
forall a b. (a, b) -> b
snd (((Int, ParsedLexemes, Int), Value λ λ Placed Placed)
 -> Value λ λ Placed Placed)
-> ((Int, ParsedLexemes, Int), Value λ λ Placed Placed)
-> Value λ λ Placed Placed
forall a b. (a -> b) -> a -> b
$ Mapped Placed (Value λ λ Placed Placed)
-> ((Int, ParsedLexemes, Int), Value λ λ Placed Placed)
forall k (f :: k -> *) (a :: k). Mapped f a -> f a
getMapped (Mapped Placed (Value λ λ Placed Placed)
 -> ((Int, ParsedLexemes, Int), Value λ λ Placed Placed))
-> Mapped Placed (Value λ λ Placed Placed)
-> ((Int, ParsedLexemes, Int), Value λ λ Placed Placed)
forall a b. (a -> b) -> a -> b
$ SynCF' (Value λ λ) -> Mapped Placed (Value λ λ Placed Placed)
forall (node :: (* -> *) -> (* -> *) -> *).
SynCF' node -> Mapped Placed (node Placed Placed)
folded' (SynCF' (Value λ λ) -> Mapped Placed (Value λ λ Placed Placed))
-> SynCF' (Value λ λ) -> Mapped Placed (Value λ λ Placed Placed)
forall a b. (a -> b) -> a -> b
$ Synthesized
  (Auto ConstantFold)
  (Value
     λ
     λ
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
-> Atts
     (Synthesized (Auto ConstantFold))
     (Value
        λ
        λ
        (Semantics (Auto ConstantFold))
        (Semantics (Auto ConstantFold)))
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto ConstantFold) (Value l l sem sem)
Synthesized
  (Auto ConstantFold)
  (Value
     λ
     λ
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
val)}

literalSynthesis :: (Abstract.Wirthy λ, Deep.Functor (Transformation.Rank2.Map Placed Identity) (Abstract.Value l l),
                     Pretty (Abstract.Value l l Identity Identity)) =>
                    Placed (Abstract.Value l l Placed Placed) -> SynCFExp λ l
literalSynthesis :: Placed (Value l l Placed Placed) -> SynCFExp λ l
literalSynthesis v :: Placed (Value l l Placed Placed)
v@((Int
start, Trailing [Lexeme]
l, Int
end), Value l l Placed Placed
value) =
   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 λ l Placed Placed)
folded= ((Int, ParsedLexemes, Int), Expression λ l Placed Placed)
-> Mapped Placed (Expression λ l Placed Placed)
forall k (f :: k -> *) (a :: k). f a -> Mapped f a
Mapped ((Int
start, ParsedLexemes
forall a. Monoid a => a
mempty, Int
end),
                            Placed (Value l l Placed Placed) -> Expression λ l Placed Placed
forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
f (Value l' l' f' f') -> Expression l l' f' f
Abstract.literal ((Int
start, ParsedLexemes
lexemes, Int
end), Value l l Placed Placed
value)),
            $sel:foldedValue:SynCFExp :: Maybe (Placed (Value l l Placed Placed))
foldedValue= Placed (Value l l Placed Placed)
-> Maybe (Placed (Value l l Placed Placed))
forall a. a -> Maybe a
Just Placed (Value l l Placed Placed)
v}
   where lexemes :: ParsedLexemes
lexemes = [Lexeme] -> ParsedLexemes
Trailing ([Token :: TokenType -> Ident -> Lexeme
Token{lexemeType :: TokenType
lexemeType= TokenType
Other,
                                    lexemeText :: Ident
lexemeText= SimpleDocStream Any -> Ident
forall ann. SimpleDocStream ann -> Ident
renderStrict (SimpleDocStream Any -> Ident) -> SimpleDocStream Any -> Ident
forall a b. (a -> b) -> a -> b
$ Doc Any -> SimpleDocStream Any
forall ann1 ann2. Doc ann1 -> SimpleDocStream ann2
layoutCompact (Doc Any -> SimpleDocStream Any) -> Doc Any -> SimpleDocStream Any
forall a b. (a -> b) -> a -> b
$ Value l l Identity Identity -> Doc Any
forall a ann. Pretty a => a -> Doc ann
pretty
                                                (Value l l Identity Identity -> Doc Any)
-> Value l l Identity Identity -> Doc Any
forall a b. (a -> b) -> a -> b
$ (a -> Identity a
forall a. a -> Identity a
Identity (a -> Identity a)
-> (((Int, ParsedLexemes, Int), a) -> a)
-> ((Int, ParsedLexemes, Int), a)
-> Identity a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, ParsedLexemes, Int), a) -> a
forall a b. (a, b) -> b
snd) (forall a. ((Int, ParsedLexemes, Int), a) -> Identity a)
-> Value l l Placed Placed -> Value l l Identity Identity
forall (p :: * -> *) (q :: * -> *)
       (g :: (* -> *) -> (* -> *) -> *).
Functor (Map p q) g =>
(forall a. p a -> q a) -> g p p -> g q q
Transformation.Rank2.<$> Value l l Placed Placed
value}]
                             [Lexeme] -> [Lexeme] -> [Lexeme]
forall a. Semigroup a => a -> a -> a
<> (Lexeme -> Bool) -> [Lexeme] -> [Lexeme]
forall a. (a -> Bool) -> [a] -> [a]
filter Lexeme -> Bool
isWhiteSpace [Lexeme]
l)
         isWhiteSpace :: Lexeme -> Bool
isWhiteSpace WhiteSpace{} = Bool
True
         isWhiteSpace Lexeme
_ = Bool
False

maxInteger, minInteger, maxInt32, minInt32, maxSet, minSet :: Integer
maxInteger :: Integer
maxInteger = Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int
forall a. Bounded a => a
maxBound :: Int)
minInteger :: Integer
minInteger = Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int
forall a. Bounded a => a
minBound :: Int)
maxInt32 :: Integer
maxInt32 = Int32 -> Integer
forall a. Integral a => a -> Integer
toInteger (Int32
forall a. Bounded a => a
maxBound :: Int32)
minInt32 :: Integer
minInt32 = Int32 -> Integer
forall a. Integral a => a -> Integer
toInteger (Int32
forall a. Bounded a => a
minBound :: Int32)
maxSet :: Integer
maxSet = Integer
63
minSet :: Integer
minSet = Integer
0

doubleSize, floatSize, intSize, int32Size :: Integer
doubleSize :: Integer
doubleSize = Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Double -> Int
forall a. Storable a => a -> Int
sizeOf (Double
0 :: Double))
floatSize :: Integer
floatSize = Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Float -> Int
forall a. Storable a => a -> Int
sizeOf (Float
0 :: Float))
intSize :: Integer
intSize = Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Int
forall a. Storable a => a -> Int
sizeOf (Int
0 :: Int))
int32Size :: Integer
int32Size = Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int32 -> Int
forall a. Storable a => a -> Int
sizeOf (Int32
0 :: Int32))

maxReal, minReal :: Double
maxReal :: Double
maxReal = Integer -> Int -> Double
forall a. RealFloat a => Integer -> Int -> a
encodeFloat (Double -> Integer
forall a. RealFloat a => a -> Integer
floatRadix Double
x Integer -> Integer -> Integer
forall n. Num n => n -> n -> n
- Integer
1) ((Int, Int) -> Int
forall a b. (a, b) -> b
snd (Double -> (Int, Int)
forall a. RealFloat a => a -> (Int, Int)
floatRange Double
x) Int -> Int -> Int
forall n. Num n => n -> n -> n
- Int
1)
   where x :: Double
x = Double
0 :: Double
minReal :: Double
minReal = Integer -> Int -> Double
forall a. RealFloat a => Integer -> Int -> a
encodeFloat (Double -> Integer
forall a. RealFloat a => a -> Integer
floatRadix Double
x Integer -> Integer -> Integer
forall n. Num n => n -> n -> n
- Integer
1) ((Int, Int) -> Int
forall a b. (a, b) -> a
fst (Double -> (Int, Int)
forall a. RealFloat a => a -> (Int, Int)
floatRange Double
x))
   where x :: Double
x = Double
0 :: Double

foldBinaryArithmetic :: forall λ l f. (f ~ Placed, Abstract.Value l ~ AST.Value l, Abstract.Wirthy λ,
                                  Pretty (Abstract.Value l l Identity Identity)) =>
                        (Int, ParsedLexemes, Int)
                     -> (f (Abstract.Expression l l f f) -> f (Abstract.Expression l l f f) -> Abstract.Expression λ l f f)
                     -> (forall n. Num n => n -> n -> n)
                     -> SynCFExp l l -> SynCFExp l l -> SynCFExp λ l
foldBinaryArithmetic :: (Int, ParsedLexemes, Int)
-> (f (Expression l l f f)
    -> f (Expression l l f f) -> Expression λ l f f)
-> (forall n. Num n => n -> n -> n)
-> SynCFExp l l
-> SynCFExp l l
-> SynCFExp λ l
foldBinaryArithmetic pos :: (Int, ParsedLexemes, Int)
pos@(Int
start, ParsedLexemes
ls, Int
end) f (Expression l l f f)
-> f (Expression l l f f) -> Expression λ l f f
node forall n. Num n => n -> n -> n
op SynCFExp l l
l SynCFExp l l
r =
   case Maybe (Maybe (Placed (Value l l f f)))
-> Maybe (Placed (Value l l f f))
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Placed (Value l l f f)
-> Placed (Value l l f f) -> Maybe (Placed (Value l l f f))
foldValues (Placed (Value l l f f)
 -> Placed (Value l l f f) -> Maybe (Placed (Value l l f f)))
-> Maybe (Placed (Value l l f f))
-> Maybe (Placed (Value l l f f) -> Maybe (Placed (Value l l f f)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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
l Maybe (Placed (Value l l f f) -> Maybe (Placed (Value l l f f)))
-> Maybe (Placed (Value l l f f))
-> Maybe (Maybe (Placed (Value l l f f)))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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
r)
   of Just Placed (Value l l f f)
v -> Placed (Value l l Placed Placed) -> SynCFExp λ 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
literalSynthesis Placed (Value l l Placed Placed)
Placed (Value l l f f)
v
      Maybe (Placed (Value l l f f))
Nothing -> 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 λ l Placed Placed)
folded= ((Int, ParsedLexemes, Int), Expression λ l Placed Placed)
-> Mapped Placed (Expression λ l Placed Placed)
forall k (f :: k -> *) (a :: k). f a -> Mapped f a
Mapped ((Int, ParsedLexemes, Int)
pos, f (Expression l l f f)
-> f (Expression l l f f) -> Expression λ l f f
node (SynCFExp l l -> Placed (Expression l l Placed Placed)
forall λ l. SynCFExp λ l -> Placed (Expression λ l Placed Placed)
foldedExp' SynCFExp l l
l) (SynCFExp l l -> Placed (Expression l l Placed Placed)
forall λ l. SynCFExp λ l -> Placed (Expression λ l Placed Placed)
foldedExp' SynCFExp l l
r)),
                          $sel:foldedValue:SynCFExp :: Maybe (Placed (Value l l Placed Placed))
foldedValue= Maybe (Placed (Value l l Placed Placed))
forall a. Maybe a
Nothing}
   where foldValues :: Placed (AST.Value l l f f) -> Placed (AST.Value l l f f) -> Maybe (Placed (AST.Value l l f f))
         foldBareValues :: AST.Value l l f f -> AST.Value l l f f -> Maybe (AST.Value l l f f)
         foldValues :: Placed (Value l l f f)
-> Placed (Value l l f f) -> Maybe (Placed (Value l l f f))
foldValues ((Int, ParsedLexemes, Int)
_, Value l l f f
l') ((Int
_, ParsedLexemes
ls', Int
_), Value l l f f
r') = (,) (Int
start, ParsedLexemes -> ParsedLexemes -> ParsedLexemes
anyWhitespace ParsedLexemes
ls ParsedLexemes
ls', Int
end) (Value l l f f -> Placed (Value l l f f))
-> Maybe (Value l l f f) -> Maybe (Placed (Value l l f f))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value l l f f -> Value l l f f -> Maybe (Value l l f f)
foldBareValues Value l l f f
l' Value l l f f
r'
         foldBareValues :: Value l l f f -> Value l l f f -> Maybe (Value l l f f)
foldBareValues (AST.Integer Integer
l') (AST.Integer Integer
r') = Value l l f f -> Maybe (Value l l f f)
forall a. a -> Maybe a
Just (Integer -> Value l l f f
forall λ l (f' :: * -> *) (f :: * -> *). Integer -> Value λ l f' f
AST.Integer (Integer -> Value l l f f) -> Integer -> Value l l f f
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Integer
forall n. Num n => n -> n -> n
op Integer
l' Integer
r')
         foldBareValues (AST.Real Double
l')    (AST.Real Double
r')    = Value l l f f -> Maybe (Value l l f f)
forall a. a -> Maybe a
Just (Double -> Value l l f f
forall λ l (f' :: * -> *) (f :: * -> *). Double -> Value λ l f' f
AST.Real (Double -> Value l l f f) -> Double -> Value l l f f
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Double
forall n. Num n => n -> n -> n
op Double
l' Double
r')
         foldBareValues (AST.Integer Integer
l') (AST.Real Double
r')    = Value l l f f -> Maybe (Value l l f f)
forall a. a -> Maybe a
Just (Double -> Value l l f f
forall λ l (f' :: * -> *) (f :: * -> *). Double -> Value λ l f' f
AST.Real (Double -> Value l l f f) -> Double -> Value l l f f
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Double
forall n. Num n => n -> n -> n
op (Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
l') Double
r')
         foldBareValues (AST.Real Double
l')    (AST.Integer Integer
r') = Value l l f f -> Maybe (Value l l f f)
forall a. a -> Maybe a
Just (Double -> Value l l f f
forall λ l (f' :: * -> *) (f :: * -> *). Double -> Value λ l f' f
AST.Real (Double -> Value l l f f) -> Double -> Value l l f f
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Double
forall n. Num n => n -> n -> n
op Double
l' (Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
r'))
         foldBareValues Value l l f f
_ Value l l f f
_ = Maybe (Value l l f f)
forall a. Maybe a
Nothing

foldBinaryFractional :: forall λ l f. (f ~ Placed, Abstract.Value l ~ AST.Value l, Abstract.Wirthy λ,
                                  Pretty (Abstract.Value l l Identity Identity)) =>
                        (Int, ParsedLexemes, Int)
                     -> (f (Abstract.Expression l l f f) -> f (Abstract.Expression l l f f) -> Abstract.Expression λ l f f)
                     -> (forall n. Fractional n => n -> n -> n)
                     -> SynCFExp l l -> SynCFExp l l -> SynCFExp λ l
foldBinaryFractional :: (Int, ParsedLexemes, Int)
-> (f (Expression l l f f)
    -> f (Expression l l f f) -> Expression λ l f f)
-> (forall n. Fractional n => n -> n -> n)
-> SynCFExp l l
-> SynCFExp l l
-> SynCFExp λ l
foldBinaryFractional pos :: (Int, ParsedLexemes, Int)
pos@(Int
start, ParsedLexemes
ls, Int
end) f (Expression l l f f)
-> f (Expression l l f f) -> Expression λ l f f
node forall n. Fractional n => n -> n -> n
op SynCFExp l l
l SynCFExp l l
r =
   case Maybe (Maybe (Placed (Value l l f f)))
-> Maybe (Placed (Value l l f f))
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Placed (Value l l f f)
-> Placed (Value l l f f) -> Maybe (Placed (Value l l f f))
foldValues (Placed (Value l l f f)
 -> Placed (Value l l f f) -> Maybe (Placed (Value l l f f)))
-> Maybe (Placed (Value l l f f))
-> Maybe (Placed (Value l l f f) -> Maybe (Placed (Value l l f f)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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
l Maybe (Placed (Value l l f f) -> Maybe (Placed (Value l l f f)))
-> Maybe (Placed (Value l l f f))
-> Maybe (Maybe (Placed (Value l l f f)))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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
r)
   of Just Placed (Value l l f f)
v -> Placed (Value l l Placed Placed) -> SynCFExp λ 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
literalSynthesis Placed (Value l l Placed Placed)
Placed (Value l l f f)
v
      Maybe (Placed (Value l l f f))
Nothing -> 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 λ l Placed Placed)
folded= ((Int, ParsedLexemes, Int), Expression λ l Placed Placed)
-> Mapped Placed (Expression λ l Placed Placed)
forall k (f :: k -> *) (a :: k). f a -> Mapped f a
Mapped ((Int, ParsedLexemes, Int)
pos, f (Expression l l f f)
-> f (Expression l l f f) -> Expression λ l f f
node (SynCFExp l l -> Placed (Expression l l Placed Placed)
forall λ l. SynCFExp λ l -> Placed (Expression λ l Placed Placed)
foldedExp' SynCFExp l l
l) (SynCFExp l l -> Placed (Expression l l Placed Placed)
forall λ l. SynCFExp λ l -> Placed (Expression λ l Placed Placed)
foldedExp' SynCFExp l l
r)),
                          $sel:foldedValue:SynCFExp :: Maybe (Placed (Value l l Placed Placed))
foldedValue= Maybe (Placed (Value l l Placed Placed))
forall a. Maybe a
Nothing}
   where foldValues :: Placed (AST.Value l l f f) -> Placed (AST.Value l l f f) -> Maybe (Placed (AST.Value l l f f))
         foldValues :: Placed (Value l l f f)
-> Placed (Value l l f f) -> Maybe (Placed (Value l l f f))
foldValues ((Int, ParsedLexemes, Int)
_, AST.Real Double
l') ((Int
_, ParsedLexemes
ls', Int
_), AST.Real Double
r') = Placed (Value l l f f) -> Maybe (Placed (Value l l f f))
forall a. a -> Maybe a
Just ((Int
start, ParsedLexemes -> ParsedLexemes -> ParsedLexemes
anyWhitespace ParsedLexemes
ls ParsedLexemes
ls', Int
end),
                                                                        Double -> Value l l f f
forall λ l (f' :: * -> *) (f :: * -> *). Double -> Value λ l f' f
AST.Real (Double -> Value l l f f) -> Double -> Value l l f f
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Double
forall n. Fractional n => n -> n -> n
op Double
l' Double
r')
         foldValues Placed (Value l l f f)
_ Placed (Value l l f f)
_ = Maybe (Placed (Value l l f f))
forall a. Maybe a
Nothing

foldBinaryInteger :: forall λ l f. (f ~ Placed, Abstract.Value l ~ AST.Value l, Abstract.Wirthy λ,
                               Pretty (Abstract.Value l l Identity Identity)) =>
                        (Int, ParsedLexemes, Int)
                     -> (f (Abstract.Expression l l f f) -> f (Abstract.Expression l l f f) -> Abstract.Expression λ l f f)
                     -> (forall n. Integral n => n -> n -> n)
                     -> SynCFExp l l -> SynCFExp l l -> SynCFExp λ l
foldBinaryInteger :: (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 pos :: (Int, ParsedLexemes, Int)
pos@(Int
start, ParsedLexemes
ls, Int
end) f (Expression l l f f)
-> f (Expression l l f f) -> Expression λ l f f
node forall n. Integral n => n -> n -> n
op SynCFExp l l
l SynCFExp l l
r =
   case Maybe (Maybe (Placed (Value l l f f)))
-> Maybe (Placed (Value l l f f))
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Placed (Value l l f f)
-> Placed (Value l l f f) -> Maybe (Placed (Value l l f f))
foldValues (Placed (Value l l f f)
 -> Placed (Value l l f f) -> Maybe (Placed (Value l l f f)))
-> Maybe (Placed (Value l l f f))
-> Maybe (Placed (Value l l f f) -> Maybe (Placed (Value l l f f)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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
l Maybe (Placed (Value l l f f) -> Maybe (Placed (Value l l f f)))
-> Maybe (Placed (Value l l f f))
-> Maybe (Maybe (Placed (Value l l f f)))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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
r)
   of Just Placed (Value l l f f)
v -> Placed (Value l l Placed Placed) -> SynCFExp λ 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
literalSynthesis Placed (Value l l Placed Placed)
Placed (Value l l f f)
v
      Maybe (Placed (Value l l f f))
Nothing -> 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 λ l Placed Placed)
folded= ((Int, ParsedLexemes, Int), Expression λ l Placed Placed)
-> Mapped Placed (Expression λ l Placed Placed)
forall k (f :: k -> *) (a :: k). f a -> Mapped f a
Mapped ((Int, ParsedLexemes, Int)
pos, f (Expression l l f f)
-> f (Expression l l f f) -> Expression λ l f f
node (SynCFExp l l -> Placed (Expression l l Placed Placed)
forall λ l. SynCFExp λ l -> Placed (Expression λ l Placed Placed)
foldedExp' SynCFExp l l
l) (SynCFExp l l -> Placed (Expression l l Placed Placed)
forall λ l. SynCFExp λ l -> Placed (Expression λ l Placed Placed)
foldedExp' SynCFExp l l
r)),
                          $sel:foldedValue:SynCFExp :: Maybe (Placed (Value l l Placed Placed))
foldedValue= Maybe (Placed (Value l l Placed Placed))
forall a. Maybe a
Nothing}
   where foldValues :: Placed (AST.Value l l f f) -> Placed (AST.Value l l f f) -> Maybe (Placed (AST.Value l l f f))
         foldValues :: Placed (Value l l f f)
-> Placed (Value l l f f) -> Maybe (Placed (Value l l f f))
foldValues ((Int, ParsedLexemes, Int)
_, AST.Integer Integer
l') ((Int
_, ParsedLexemes
ls', Int
_), AST.Integer Integer
r') = Placed (Value l l f f) -> Maybe (Placed (Value l l f f))
forall a. a -> Maybe a
Just ((Int
start, ParsedLexemes -> ParsedLexemes -> ParsedLexemes
anyWhitespace ParsedLexemes
ls ParsedLexemes
ls', Int
end),
                                                                              Integer -> Value l l f f
forall λ l (f' :: * -> *) (f :: * -> *). Integer -> Value λ l f' f
AST.Integer (Integer -> Value l l f f) -> Integer -> Value l l f f
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Integer
forall n. Integral n => n -> n -> n
op Integer
l' Integer
r')
         foldValues Placed (Value l l f f)
_ Placed (Value l l f f)
_ = Maybe (Placed (Value l l f f))
forall a. Maybe a
Nothing

foldBinaryBoolean :: forall λ l f. (f ~ Placed, Abstract.Value l ~ AST.Value l, Abstract.Wirthy λ,
                               Pretty (Abstract.Value l l Identity Identity)) =>
                     (Int, ParsedLexemes, Int)
                  -> (f (Abstract.Expression l l f f) -> f (Abstract.Expression l l f f) -> Abstract.Expression λ l f f)
                  -> (Bool -> Bool -> Bool)
                  -> SynCFExp l l -> SynCFExp l l -> SynCFExp λ l
foldBinaryBoolean :: (Int, ParsedLexemes, Int)
-> (f (Expression l l f f)
    -> f (Expression l l f f) -> Expression λ l f f)
-> (Bool -> Bool -> Bool)
-> SynCFExp l l
-> SynCFExp l l
-> SynCFExp λ l
foldBinaryBoolean pos :: (Int, ParsedLexemes, Int)
pos@(Int
start, ParsedLexemes
ls, Int
end) f (Expression l l f f)
-> f (Expression l l f f) -> Expression λ l f f
node Bool -> Bool -> Bool
op SynCFExp l l
l SynCFExp l l
r =
   case Maybe (Maybe (Placed (Value l l f f)))
-> Maybe (Placed (Value l l f f))
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Placed (Value l l f f)
-> Placed (Value l l f f) -> Maybe (Placed (Value l l f f))
foldValues (Placed (Value l l f f)
 -> Placed (Value l l f f) -> Maybe (Placed (Value l l f f)))
-> Maybe (Placed (Value l l f f))
-> Maybe (Placed (Value l l f f) -> Maybe (Placed (Value l l f f)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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
l Maybe (Placed (Value l l f f) -> Maybe (Placed (Value l l f f)))
-> Maybe (Placed (Value l l f f))
-> Maybe (Maybe (Placed (Value l l f f)))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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
r)
   of Just Placed (Value l l f f)
v -> Placed (Value l l Placed Placed) -> SynCFExp λ 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
literalSynthesis Placed (Value l l Placed Placed)
Placed (Value l l f f)
v
      Maybe (Placed (Value l l f f))
Nothing -> 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 λ l Placed Placed)
folded= ((Int, ParsedLexemes, Int), Expression λ l Placed Placed)
-> Mapped Placed (Expression λ l Placed Placed)
forall k (f :: k -> *) (a :: k). f a -> Mapped f a
Mapped ((Int, ParsedLexemes, Int)
pos, f (Expression l l f f)
-> f (Expression l l f f) -> Expression λ l f f
node (SynCFExp l l -> Placed (Expression l l Placed Placed)
forall λ l. SynCFExp λ l -> Placed (Expression λ l Placed Placed)
foldedExp' SynCFExp l l
l) (SynCFExp l l -> Placed (Expression l l Placed Placed)
forall λ l. SynCFExp λ l -> Placed (Expression λ l Placed Placed)
foldedExp' SynCFExp l l
r)),
                          $sel:foldedValue:SynCFExp :: Maybe (Placed (Value l l Placed Placed))
foldedValue= Maybe (Placed (Value l l Placed Placed))
forall a. Maybe a
Nothing}
   where foldValues :: Placed (AST.Value l l f f) -> Placed (AST.Value l l f f) -> Maybe (Placed (AST.Value l l f f))
         foldValues :: Placed (Value l l f f)
-> Placed (Value l l f f) -> Maybe (Placed (Value l l f f))
foldValues ((Int, ParsedLexemes, Int)
_, AST.Boolean Bool
l') ((Int
_, ParsedLexemes
ls', Int
_), AST.Boolean Bool
r') = Placed (Value l l f f) -> Maybe (Placed (Value l l f f))
forall a. a -> Maybe a
Just ((Int
start, ParsedLexemes -> ParsedLexemes -> ParsedLexemes
anyWhitespace ParsedLexemes
ls ParsedLexemes
ls', Int
end),
                                                                              Bool -> Value l l f f
forall λ l (f' :: * -> *) (f :: * -> *). Bool -> Value λ l f' f
AST.Boolean (Bool -> Value l l f f) -> Bool -> Value l l f f
forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> Bool
op Bool
l' Bool
r')
         foldValues Placed (Value l l f f)
_ Placed (Value l l f f)
_ = Maybe (Placed (Value l l f f))
forall a. Maybe a
Nothing

instance (Ord (Abstract.QualIdent l), v ~ Abstract.Value l l Placed Placed) =>
         SynthesizedField "designatorValue" (Maybe (Placed v)) (Auto ConstantFold) (AST.Designator l l) Sem Placed where
   synthesizedField :: Proxy "designatorValue"
-> Auto ConstantFold
-> Placed
     (Designator
        l
        l
        (Semantics (Auto ConstantFold))
        (Semantics (Auto ConstantFold)))
-> 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
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
_ Atts (Inherited (Auto ConstantFold)) (Designator l l sem sem)
_ Designator l l sem (Synthesized (Auto ConstantFold))
_ = Maybe (Placed v)
forall a. Maybe a
Nothing

instance {-# overlaps #-} 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

anyWhitespace :: ParsedLexemes -> ParsedLexemes -> ParsedLexemes
anyWhitespace :: ParsedLexemes -> ParsedLexemes -> ParsedLexemes
anyWhitespace ParsedLexemes
outer inner :: ParsedLexemes
inner@(Trailing [Lexeme]
ls)
   | (Lexeme -> Bool) -> [Lexeme] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Lexeme -> Bool
isWhitespace [Lexeme]
ls = ParsedLexemes
inner
   | Bool
otherwise = ParsedLexemes
inner ParsedLexemes -> ParsedLexemes -> ParsedLexemes
forall a. Semigroup a => a -> a -> a
<> ParsedLexemes -> ParsedLexemes
lastWhitespace ParsedLexemes
outer
   where isWhitespace :: Lexeme -> Bool
isWhitespace WhiteSpace{} = Bool
True
         isWhitespace Lexeme
_ = Bool
False

lastWhitespace :: ParsedLexemes -> ParsedLexemes
lastWhitespace :: ParsedLexemes -> ParsedLexemes
lastWhitespace ls :: ParsedLexemes
ls@(Trailing []) = ParsedLexemes
ls
lastWhitespace ls :: ParsedLexemes
ls@(Trailing [WhiteSpace{}]) = ParsedLexemes
ls
lastWhitespace (Trailing [Lexeme
_]) = ParsedLexemes
forall a. Monoid a => a
mempty
lastWhitespace (Trailing (Lexeme
l:[Lexeme]
ls)) = ParsedLexemes -> ParsedLexemes
lastWhitespace ([Lexeme] -> ParsedLexemes
Trailing [Lexeme]
ls)

--- * Shortcut

instance Full.Functor (Auto ConstantFold) (AST.Value l l) where
   Auto ConstantFold
ConstantFold <$> :: Auto ConstantFold
-> Domain
     (Auto ConstantFold)
     (Value
        l l (Domain (Auto ConstantFold)) (Domain (Auto ConstantFold)))
-> Codomain
     (Auto ConstantFold)
     (Value
        l l (Codomain (Auto ConstantFold)) (Codomain (Auto ConstantFold)))
<$> (pos, val) = (Inherited
   (Auto ConstantFold)
   (Value
      l
      l
      (Semantics (Auto ConstantFold))
      (Semantics (Auto ConstantFold)))
 -> Synthesized
      (Auto ConstantFold)
      (Value
         l
         l
         (Semantics (Auto ConstantFold))
         (Semantics (Auto ConstantFold))))
-> Arrow
     (Inherited (Auto ConstantFold))
     (Synthesized (Auto ConstantFold))
     (Value
        l
        l
        (Semantics (Auto ConstantFold))
        (Semantics (Auto ConstantFold)))
forall k (p :: k -> *) (q :: k -> *) (a :: k).
(p a -> q a) -> Arrow p q a
Rank2.Arrow Inherited
  (Auto ConstantFold)
  (Value
     l
     l
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
-> Synthesized
     (Auto ConstantFold)
     (Value
        l
        l
        (Semantics (Auto ConstantFold))
        (Semantics (Auto ConstantFold)))
sem
      where sem :: Inherited
  (Auto ConstantFold)
  (Value
     l
     l
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
-> Synthesized
     (Auto ConstantFold)
     (Value
        l
        l
        (Semantics (Auto ConstantFold))
        (Semantics (Auto ConstantFold)))
sem Inherited
  (Auto ConstantFold)
  (Value
     l
     l
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
_inherited = Atts
  (Synthesized (Auto ConstantFold))
  (Value
     l
     l
     (Semantics (Auto ConstantFold))
     (Semantics (Auto ConstantFold)))
-> Synthesized
     (Auto ConstantFold)
     (Value
        l
        l
        (Semantics (Auto ConstantFold))
        (Semantics (Auto ConstantFold)))
forall t a. Atts (Synthesized t) a -> Synthesized t a
Synthesized (Mapped Placed (Value l l Placed Placed)
-> SynCF (Value l l Placed Placed)
forall a. Mapped Placed a -> SynCF a
SynCF (Mapped Placed (Value l l Placed Placed)
 -> SynCF (Value l l Placed Placed))
-> Mapped Placed (Value l l Placed Placed)
-> SynCF (Value l l Placed Placed)
forall a b. (a -> b) -> a -> b
$ ((Int, ParsedLexemes, Int), Value l l Placed Placed)
-> Mapped Placed (Value l l Placed Placed)
forall k (f :: k -> *) (a :: k). f a -> Mapped f a
Mapped ((Int, ParsedLexemes, Int)
pos, Value l l Placed Placed
val))

-- * Unsafe Rank2 AST instances

instance Rank2.Apply (AST.Module l l f') where
   AST.Module Ident
name1 [Import l]
imports1 (~>) p q (Block l l f' f')
body1 <*> :: Module l l f' (p ~> q) -> Module l l f' p -> Module l l f' q
<*> ~(AST.Module Ident
_name [Import l]
_imports p (Block l l f' f')
body2) =
      Ident -> [Import l] -> q (Block l l f' f') -> Module l l f' q
forall λ l (f' :: * -> *) (f :: * -> *).
Ident -> [Import l] -> f (Block l l f' f') -> Module λ l f' f
AST.Module Ident
name1 [Import l]
imports1 ((~>) p q (Block l l f' f')
-> p (Block l l f' f') -> q (Block l l f' f')
forall k (p :: k -> *) (q :: k -> *) (a :: k).
Arrow p q a -> p a -> q a
Rank2.apply (~>) p q (Block l l f' f')
body1 p (Block l l f' f')
body2)

predefined, predefined2 :: (Abstract.Wirthy l, Ord (Abstract.QualIdent l)) => Environment l
-- | The set of predefined types and procedures defined in the Oberon Language Report.
predefined :: Environment l
predefined = [(QualIdent l, Maybe (Value l l Placed Placed))] -> Environment l
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(QualIdent l, Maybe (Value l l Placed Placed))] -> Environment l)
-> [(QualIdent l, Maybe (Value l l Placed Placed))]
-> Environment l
forall a b. (a -> b) -> a -> b
$ ((Ident, Maybe (Value l l Placed Placed))
 -> (QualIdent l, Maybe (Value l l Placed Placed)))
-> [(Ident, Maybe (Value l l Placed Placed))]
-> [(QualIdent l, Maybe (Value l l Placed Placed))]
forall a b. (a -> b) -> [a] -> [b]
map ((Ident -> QualIdent l)
-> (Ident, Maybe (Value l l Placed Placed))
-> (QualIdent l, Maybe (Value l l Placed Placed))
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Ident -> QualIdent l
forall l. Wirthy l => Ident -> QualIdent l
Abstract.nonQualIdent) ([(Ident, Maybe (Value l l Placed Placed))]
 -> [(QualIdent l, Maybe (Value l l Placed Placed))])
-> [(Ident, Maybe (Value l l Placed Placed))]
-> [(QualIdent l, Maybe (Value l l Placed Placed))]
forall a b. (a -> b) -> a -> b
$
   [(Ident
"TRUE", Value l l Placed Placed -> Maybe (Value l l Placed Placed)
forall a. a -> Maybe a
Just Value l l Placed Placed
forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Value l l' f' f
Abstract.true),
    (Ident
"FALSE", Value l l Placed Placed -> Maybe (Value l l Placed Placed)
forall a. a -> Maybe a
Just Value l l Placed Placed
forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Value l l' f' f
Abstract.false)]
   [(Ident, Maybe (Value l l Placed Placed))]
-> [(Ident, Maybe (Value l l Placed Placed))]
-> [(Ident, Maybe (Value l l Placed Placed))]
forall a. [a] -> [a] -> [a]
++ (Ident -> (Ident, Maybe (Value l l Placed Placed)))
-> [Ident] -> [(Ident, Maybe (Value l l Placed Placed))]
forall a b. (a -> b) -> [a] -> [b]
map Ident -> (Ident, Maybe (Value l l Placed Placed))
forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Ident -> (Ident, Maybe (Value l l' f' f))
builtin [Ident
"BOOLEAN", Ident
"CHAR", Ident
"SHORTINT", Ident
"INTEGER", Ident
"LONGINT", Ident
"REAL", Ident
"LONGREAL", Ident
"SET",
                   Ident
"ABS", Ident
"ASH", Ident
"CAP", Ident
"LEN", Ident
"MAX", Ident
"MIN",
                   Ident
"ODD", Ident
"SIZE", Ident
"ORD", Ident
"CHR", Ident
"SHORT", Ident
"LONG", Ident
"ENTIER"]
   where builtin :: Ident -> (Ident, Maybe (Value l l' f' f))
builtin Ident
name = (Ident
name, Value l l' f' f -> Maybe (Value l l' f' f)
forall a. a -> Maybe a
Just (Value l l' f' f -> Maybe (Value l l' f' f))
-> Value l l' f' f -> Maybe (Value l l' f' f)
forall a b. (a -> b) -> a -> b
$ Ident -> Value l l' f' f
forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Ident -> Value l l' f' f
Abstract.builtin Ident
name)
predefined2 :: Environment l
predefined2 = Environment l
forall l. (Wirthy l, Ord (QualIdent l)) => Environment l
predefined

$(do l <- varT  <$> newName "l"
     mconcat <$> mapM (\g-> Transformation.Full.TH.deriveUpFunctor (conT ''Auto `appT` conT ''ConstantFold)
                            $ conT g `appT` l `appT` l)
        [''AST.Declaration, ''AST.Type, ''AST.FieldList,
         ''AST.ProcedureHeading, ''AST.FormalParameters, ''AST.FPSection,
         ''AST.Expression, ''AST.Element, ''AST.Designator,
         ''AST.Block, ''AST.StatementSequence, ''AST.Statement,
         ''AST.Case, ''AST.CaseLabels, ''AST.ConditionalBranch, ''AST.WithAlternative])

$(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.Module, ''AST.Block, ''AST.Declaration, ''AST.Type, ''AST.FieldList,
         ''AST.ProcedureHeading, ''AST.FormalParameters, ''AST.FPSection,
         ''AST.StatementSequence, ''AST.Statement,
         ''AST.Case, ''AST.CaseLabels, ''AST.ConditionalBranch, ''AST.WithAlternative,
         ''AST.Element, ''AST.Expression, ''AST.Designator])