{-# LANGUAGE DataKinds, DeriveGeneric, DuplicateRecordFields, FlexibleContexts, FlexibleInstances,
             MultiParamTypeClasses, OverloadedStrings, RankNTypes, ScopedTypeVariables,
             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 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 qualified Transformation.AG.Generics 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 :: forall l.
(Oberon l, Nameable l, Ord (QualIdent l), Show (QualIdent l),
 Atts (Inherited (Auto ConstantFold)) (Block l l Sem Sem) ~ InhCF l,
 Atts (Synthesized (Auto ConstantFold)) (Block l l Sem Sem)
 ~ SynCFMod' l (Block l l),
 Functor (Auto ConstantFold) (Block l l),
 Functor (Auto ConstantFold) (Block l l)) =>
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 =
   forall l (f' :: * -> *) (f :: * -> *).
Modules l f' f -> Map Ident (f (Module l l f' f'))
getModules (forall a. SynCFRoot a -> a
modulesFolded forall a b. (a -> b) -> a -> b
$
               forall t a. Synthesized t a -> Atts (Synthesized t) a
syn (forall t x. At t x => t -> Domain t x -> Codomain t x
Transformation.apply (forall t. t -> Auto t
Auto ConstantFold
ConstantFold)
                                         (forall {b}. b -> ((Int, ParsedLexemes, Int), b)
wrap (forall t. t -> Auto t
Auto ConstantFold
ConstantFold forall t (g :: (* -> *) -> (* -> *) -> *).
Functor t g =>
t -> g (Domain t) (Domain t) -> g (Codomain t) (Codomain t)
Deep.<$> 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))
                    forall {k} (p :: k -> *) (q :: k -> *) (a :: k).
Arrow p q a -> p a -> q a
`Rank2.apply`
                    forall t a. Atts (Inherited t) a -> Inherited t a
Inherited (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 {forall l (f' :: * -> *) (f :: * -> *).
Modules l f' f -> Map Ident (f (Module l l f' f'))
getModules :: Map AST.Ident (f (AST.Module l l f' f'))}

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)

instance AG.Revelation (Auto ConstantFold) where
   reveal :: forall x. Auto ConstantFold -> Domain (Auto ConstantFold) x -> x
reveal (Auto ConstantFold
ConstantFold) = forall a b. (a, b) -> b
snd

data InhCFRoot l = InhCFRoot{forall l. InhCFRoot l -> Environment l
rootEnv :: Environment l} deriving 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{forall l. InhCF l -> Environment l
env           :: Environment l,
                     forall l. InhCF l -> Ident
currentModule :: AST.Ident}
               deriving 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{forall a. SynCF a -> Mapped Placed a
folded :: Mapped Placed a} deriving 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{forall l a. SynCFMod l a -> Environment l
moduleEnv :: Environment l,
                             forall l a. SynCFMod l a -> Mapped Placed a
folded    :: Mapped Placed a}
                    deriving 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{forall λ l.
SynCFExp λ l -> Mapped Placed (Expression λ l Placed Placed)
folded   :: Mapped Placed (Abstract.Expression λ l Placed Placed),
                             forall λ l.
SynCFExp λ l -> Maybe (Placed (Value l l Placed Placed))
foldedValue :: Maybe (Placed (Abstract.Value l l Placed Placed))}

data SynCFDesignator l = SynCFDesignator{forall l.
SynCFDesignator l -> Mapped Placed (Designator l l Placed Placed)
folded :: Mapped Placed (Abstract.Designator l l Placed Placed),
                                         forall l.
SynCFDesignator l -> Maybe (Placed (Value l l Placed Placed))
designatorValue :: Maybe (Placed (Abstract.Value l l Placed Placed))}
                         deriving 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{forall a. 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) = 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 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 forall t x. At t x => t -> Domain t x -> Codomain t x
Transformation.$ ((t
t forall t (g :: (* -> *) -> (* -> *) -> *).
Functor t g =>
t -> g (Domain t) (Domain t) -> g (Codomain t) (Codomain t)
Deep.<$>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Domain t (Module l l (Domain t) (Domain t))
m)

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

instance Rank2.Apply (Modules l f') where
   ~(Modules Map Ident ((~>) p q (Module l l f' f'))
fs) <*> :: forall (p :: * -> *) (q :: * -> *).
Modules l f' (p ~> q) -> Modules l f' p -> Modules l f' q
<*> ~(Modules Map Ident (p (Module l l f' f'))
ms) = forall l (f' :: * -> *) (f :: * -> *).
Map Ident (f (Module l l f' f')) -> Modules l f' f
Modules (forall k a b c.
Ord k =>
(a -> b -> c) -> Map k a -> Map k b -> Map k c
Map.intersectionWith 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) = forall l (f' :: * -> *) (f :: * -> *).
Map Ident (f (Module l l f' f')) -> Modules l f' f
Modules ((t
t forall t x. At t x => t -> Domain t x -> Codomain t x
Transformation.$) 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 ConstantFold) (Modules l _ _) = SynCFRoot (Modules l Placed Placed)
type instance Atts (Synthesized ConstantFold) (AST.Module l l _ _) = SynCFMod' l (AST.Module l l)
type instance Atts (Synthesized ConstantFold) (AST.Declaration l l _ _) = SynCFMod' l (AST.Declaration l l)
type instance Atts (Synthesized ConstantFold) (AST.ProcedureHeading l l _ _) = SynCF' (AST.ProcedureHeading l l)
type instance Atts (Synthesized ConstantFold) (AST.Block l l _ _) = SynCFMod' l (AST.Block l l)
type instance Atts (Synthesized ConstantFold) (AST.FormalParameters l l _ _) = SynCF' (AST.FormalParameters l l)
type instance Atts (Synthesized ConstantFold) (AST.FPSection l l _ _) = SynCF' (AST.FPSection l l)
type instance Atts (Synthesized ConstantFold) (AST.Type l l _ _) = SynCF' (AST.Type l l)
type instance Atts (Synthesized ConstantFold) (AST.FieldList l l _ _) = SynCF' (AST.FieldList l l)
type instance Atts (Synthesized ConstantFold) (AST.StatementSequence l l _ _) =
   SynCF' (AST.StatementSequence l l)
type instance Atts (Synthesized ConstantFold) (AST.Expression λ l _ _) = SynCFExp λ l
type instance Atts (Synthesized ConstantFold) (AST.Element l l _ _) = SynCF' (AST.Element l l)
type instance Atts (Synthesized ConstantFold) (AST.Value l l _ _) = SynCF' (AST.Value l l)
type instance Atts (Synthesized ConstantFold) (AST.Designator l l _ _) = SynCFDesignator l
type instance Atts (Synthesized ConstantFold) (AST.Statement l l _ _) = SynCF' (AST.Statement l l)
type instance Atts (Synthesized ConstantFold) (AST.Case l l _ _) = SynCF' (AST.Case l l)
type instance Atts (Synthesized ConstantFold) (AST.CaseLabels l l _ _) = SynCF' (AST.CaseLabels l l)
type instance Atts (Synthesized ConstantFold) (AST.ConditionalBranch l l _ _) =
   SynCF' (AST.ConditionalBranch l l)
type instance Atts (Synthesized ConstantFold) (AST.WithAlternative l l _ _) = SynCF' (AST.WithAlternative l l)

type instance Atts (Inherited ConstantFold) (Modules l _ _) = InhCFRoot l
type instance Atts (Inherited ConstantFold) (AST.Module λ l _ _) = InhCF l
type instance Atts (Inherited ConstantFold) (AST.Declaration λ l _ _) = InhCF l
type instance Atts (Inherited ConstantFold) (AST.ProcedureHeading λ l _ _) = InhCF l
type instance Atts (Inherited ConstantFold) (AST.Block λ l _ _) = InhCF l
type instance Atts (Inherited ConstantFold) (AST.FormalParameters λ l _ _) = InhCF l
type instance Atts (Inherited ConstantFold) (AST.FPSection λ l _ _) = InhCF l
type instance Atts (Inherited ConstantFold) (AST.Type λ l _ _) = InhCF l
type instance Atts (Inherited ConstantFold) (AST.FieldList λ l _ _) = InhCF l
type instance Atts (Inherited ConstantFold) (AST.StatementSequence λ l _ _) = InhCF l
type instance Atts (Inherited ConstantFold) (AST.Expression λ l _ _) = InhCF l
type instance Atts (Inherited ConstantFold) (AST.Element λ l _ _) = InhCF l
type instance Atts (Inherited ConstantFold) (AST.Value l l _ _) = InhCF l
type instance Atts (Inherited ConstantFold) (AST.Designator λ l _ _) = InhCF l
type instance Atts (Inherited ConstantFold) (AST.Statement λ l _ _) = InhCF l
type instance Atts (Inherited ConstantFold) (AST.Case λ l _ _) = InhCF l
type instance Atts (Inherited ConstantFold) (AST.CaseLabels λ l _ _) = InhCF l
type instance Atts (Inherited ConstantFold) (AST.ConditionalBranch λ l _ _) = InhCF l
type instance Atts (Inherited ConstantFold) (AST.WithAlternative λ 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)
foldedMod :: SynCFMod' l node -> Mapped Placed (node Placed Placed)

folded' :: forall (node :: (* -> *) -> (* -> *) -> *).
SynCF' node -> Mapped Placed (node Placed Placed)
folded' SynCF{$sel:folded:SynCF :: forall a. SynCF a -> Mapped Placed a
folded= Mapped Placed (node Placed Placed)
x} = Mapped Placed (node Placed Placed)
x
foldedExp :: forall λ l.
SynCFExp λ l -> Mapped Placed (Expression λ l Placed Placed)
foldedExp SynCFExp{$sel:folded:SynCFExp :: forall λ l.
SynCFExp λ l -> Mapped Placed (Expression λ l Placed Placed)
folded= Mapped Placed (Expression λ l Placed Placed)
x} = Mapped Placed (Expression λ l Placed Placed)
x
foldedExp' :: forall λ l. SynCFExp λ l -> Placed (Expression λ l Placed Placed)
foldedExp' = forall {k} (f :: k -> *) (a :: k). Mapped f a -> f a
getMapped forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall λ l.
SynCFExp λ l -> Mapped Placed (Expression λ l Placed Placed)
foldedExp
foldedMod :: forall l (node :: (* -> *) -> (* -> *) -> *).
SynCFMod' l node -> Mapped Placed (node Placed Placed)
foldedMod SynCFMod{$sel:folded:SynCFMod :: forall l a. SynCFMod l a -> Mapped Placed a
folded= Mapped Placed (node Placed Placed)
x} = Mapped Placed (node Placed Placed)
x
-- * Rules

instance {-# overlaps #-} Ord (Abstract.QualIdent l) =>
                          Synthesizer (Auto ConstantFold) (Modules l) Sem Placed where
   synthesis :: forall (sem :: * -> *).
(sem ~ Sem) =>
Auto ConstantFold
-> Placed (Modules l Sem Sem)
-> 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 Sem Sem))
self) Atts (Inherited (Auto ConstantFold)) (Modules l sem sem)
inheritance (Modules Map Ident (Synthesized (Auto ConstantFold) (Module l l sem sem))
ms) =
      SynCFRoot{$sel:modulesFolded:SynCFRoot :: Modules l Placed Placed
modulesFolded= (forall l (f' :: * -> *) (f :: * -> *).
Map Ident (f (Module l l f' f')) -> Modules l f' f
Modules (forall {k} (f :: k -> *) (a :: k). Mapped f a -> f a
getMapped forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l (node :: (* -> *) -> (* -> *) -> *).
SynCFMod' l node -> Mapped Placed (node Placed Placed)
foldedMod forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t a. Synthesized t a -> Atts (Synthesized t) a
syn forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Ident (Synthesized (Auto ConstantFold) (Module l l sem sem))
ms))}

instance {-# overlaps #-} Ord (Abstract.QualIdent l) =>
                          Bequether (Auto ConstantFold) (Modules l) Sem Placed where
   bequest :: forall (sem :: * -> *).
(sem ~ Sem) =>
Auto ConstantFold
-> Placed (Modules l Sem Sem)
-> 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 Sem Sem))
self) Atts (Inherited (Auto ConstantFold)) (Modules l sem sem)
inheritance (Modules Map Ident (Synthesized (Auto ConstantFold) (Module l l sem sem))
ms) = forall l (f' :: * -> *) (f :: * -> *).
Map Ident (f (Module l l f' f')) -> Modules l f' f
Modules (forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey Ident
-> Sem (Module l l Sem Sem)
-> Inherited (Auto ConstantFold) (Module l l sem sem)
moduleInheritance Map Ident (Sem (Module l l Sem Sem))
self)
      where moduleInheritance :: Ident
-> Sem (Module l l Sem Sem)
-> Inherited (Auto ConstantFold) (Module l l sem sem)
moduleInheritance Ident
name Sem (Module l l Sem Sem)
mod = forall t a. Atts (Inherited t) a -> Inherited t a
Inherited InhCF{$sel:env:InhCF :: Map (QualIdent l) (Maybe (Value l l Placed Placed))
env= forall l. InhCFRoot l -> Environment l
rootEnv Atts (Inherited (Auto ConstantFold)) (Modules l sem sem)
inheritance forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall l a. SynCFMod l a -> Environment l
moduleEnv forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall (sem :: * -> *).
(sem ~ Sem) =>
Auto ConstantFold
-> Placed (Module l l Sem Sem)
-> 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 Sem Sem)
_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{$sel:moduleEnv:SynCFMod :: Environment l
moduleEnv= Environment l
exportedEnv,
               $sel:folded:SynCFMod :: Mapped Placed (Module l l Placed Placed)
folded= forall {k} (f :: k -> *) (a :: k). f a -> Mapped f a
Mapped ((Int, ParsedLexemes, Int)
pos, forall λ l (f' :: * -> *) (f :: * -> *).
Ident -> [Import l] -> f (Block l l f' f') -> Module λ l f' f
AST.Module Ident
moduleName [Import l]
imports forall a b. (a -> b) -> a -> b
$ forall {k} (f :: k -> *) (a :: k). Mapped f a -> f a
getMapped forall a b. (a -> b) -> a -> b
$ forall l (node :: (* -> *) -> (* -> *) -> *).
SynCFMod' l node -> Mapped Placed (node Placed Placed)
foldedMod (forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto ConstantFold) (Block l l sem sem)
body))}
      where exportedEnv :: Environment l
exportedEnv = 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 = forall l a. SynCFMod l a -> Environment l
moduleEnv (forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto ConstantFold) (Block l l sem sem)
body)
            export :: QualIdent l -> QualIdent l
export QualIdent l
q
               | Just Ident
name <- forall l. Nameable l => QualIdent l -> Maybe Ident
Abstract.getNonQualIdentName QualIdent l
q = 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 :: forall (sem :: * -> *).
(sem ~ Sem) =>
Auto ConstantFold
-> Placed (Block l l Sem Sem)
-> 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 Sem Sem))
_decls Maybe (Sem (StatementSequence l l Sem Sem))
_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) =
      forall λ l (f' :: * -> *) (f :: * -> *).
ZipList (f (Declaration l l f' f'))
-> Maybe (f (StatementSequence l l f' f')) -> Block λ l f' f
AST.Block (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall t a. Atts (Inherited t) a -> Inherited t a
Inherited InhCF l
localEnv) (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall t a. Atts (Inherited t) a -> Inherited t a
Inherited InhCF l
localEnv)
      where newEnv :: Map (QualIdent l) (Maybe (Value l l Placed Placed))
newEnv = forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions (forall l a. SynCFMod l a -> Environment l
moduleEnv forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t a. Synthesized t a -> Atts (Synthesized t) a
syn forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZipList (Synthesized (Auto ConstantFold) (Declaration l l sem sem))
decls)
            localEnv :: InhCF l
localEnv = forall l. Environment l -> Ident -> InhCF l
InhCF (Map (QualIdent l) (Maybe (Value l l Placed Placed))
newEnv forall k a. Ord k => Map k a -> Map k a -> Map k a
`Map.union` forall l. InhCF l -> Environment l
env Atts (Inherited (Auto ConstantFold)) (Block l l sem sem)
inheritance) (forall l. InhCF l -> Ident
currentModule Atts (Inherited (Auto ConstantFold)) (Block l l sem sem)
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 :: forall (sem :: * -> *).
(sem ~ Sem) =>
Proxy "moduleEnv"
-> Auto ConstantFold
-> Placed (Block l l Sem Sem)
-> 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) = forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions (forall l a. SynCFMod l a -> Environment l
moduleEnv forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t a. Synthesized t a -> Atts (Synthesized t) a
syn forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZipList (Synthesized (Auto ConstantFold) (Declaration l l sem sem))
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 :: forall (sem :: * -> *).
(sem ~ Sem) =>
Proxy "moduleEnv"
-> Auto ConstantFold
-> Placed (Declaration l l Sem Sem)
-> 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 Sem Sem)
_) Atts (Inherited (Auto ConstantFold)) (Declaration l l sem sem)
_ (AST.ConstantDeclaration IdentDef l
_ Synthesized (Auto ConstantFold) (ConstExpression l l sem sem)
expression) =
      forall k a. k -> a -> Map k a
Map.singleton (forall l. Wirthy l => Ident -> QualIdent l
Abstract.nonQualIdent forall a b. (a -> b) -> a -> b
$ forall l. Nameable l => IdentDef l -> Ident
Abstract.getIdentDefName IdentDef l
namedef)
                    ((forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall λ l.
SynCFExp λ l -> Maybe (Placed (Value l l Placed Placed))
foldedValue forall a b. (a -> b) -> a -> b
$ forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto ConstantFold) (ConstExpression l l sem sem)
expression)
   synthesizedField Proxy "moduleEnv"
_ Auto ConstantFold
_ Placed (Declaration l l Sem Sem)
_ Atts (Inherited (Auto ConstantFold)) (Declaration l l sem sem)
_ Declaration l l sem (Synthesized (Auto ConstantFold))
_ = forall a. Monoid a => a
mempty

instance {-# overlaps #-}
   (Abstract.Oberon λ, Abstract.Nameable l, Ord (Abstract.QualIdent l),
    Abstract.Value l ~ AST.Value l,
    Pretty (AST.Value l l Identity Identity),
    Atts (Synthesized (Auto ConstantFold)) (Abstract.Expression l l Sem Sem) ~ SynCFExp l l,
    Atts (Synthesized (Auto ConstantFold)) (Abstract.Element l l Sem Sem) ~ SynCF' (Abstract.Element l l),
    Atts (Synthesized (Auto ConstantFold)) (Abstract.Designator l l Sem Sem) ~ SynCFDesignator l) =>
   Synthesizer (Auto ConstantFold) (AST.Expression λ l) Sem Placed where
   synthesis :: forall (sem :: * -> *).
(sem ~ Sem) =>
Auto ConstantFold
-> Placed (Expression λ l Sem Sem)
-> Atts (Inherited (Auto ConstantFold)) (Expression λ l sem sem)
-> Expression λ l sem (Synthesized (Auto ConstantFold))
-> Atts (Synthesized (Auto ConstantFold)) (Expression λ l sem sem)
synthesis Auto ConstantFold
_ (pos :: (Int, ParsedLexemes, Int)
pos@(Int
start, ParsedLexemes
ls, Int
end), AST.Relation RelOp
op Sem (Expression l l Sem Sem)
_ Sem (Expression l l Sem Sem)
_) 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 forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (((Int, ParsedLexemes, Int), Value l l Placed Placed)
-> ((Int, ParsedLexemes, Int), Value l l Placed Placed)
-> Maybe ((Int, ParsedLexemes, Int), Value l l Placed Placed)
compareValues forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall λ l.
SynCFExp λ l -> Maybe (Placed (Value l l Placed Placed))
foldedValue (forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto ConstantFold) (Expression l l sem sem)
left) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall λ l.
SynCFExp λ l -> Maybe (Placed (Value l l Placed Placed))
foldedValue (forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto ConstantFold) (Expression l l sem sem)
right))
      of Just ((Int, ParsedLexemes, Int), Value l l Placed Placed)
value -> 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 l Placed Placed)
value
         Maybe ((Int, ParsedLexemes, Int), Value l l Placed Placed)
Nothing -> SynCFExp{$sel:folded:SynCFExp :: Mapped Placed (Expression λ l Placed Placed)
folded= forall {k} (f :: k -> *) (a :: k). f a -> Mapped f a
Mapped ((Int, ParsedLexemes, Int)
pos,
                                             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 (forall λ l. SynCFExp λ l -> Placed (Expression λ l Placed Placed)
foldedExp' forall a b. (a -> b) -> a -> b
$ forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto ConstantFold) (Expression l l sem sem)
left) (forall λ l. SynCFExp λ l -> Placed (Expression λ l Placed Placed)
foldedExp' forall a b. (a -> b) -> a -> b
$ forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto ConstantFold) (Expression l l sem sem)
right)),
                             $sel:foldedValue:SynCFExp :: Maybe ((Int, ParsedLexemes, Int), Value l l Placed Placed)
foldedValue= forall a. Maybe a
Nothing}
      where compareValues :: ((Int, ParsedLexemes, Int), Value l l Placed Placed)
-> ((Int, ParsedLexemes, Int), Value l l Placed Placed)
-> Maybe ((Int, ParsedLexemes, Int), Value l l Placed Placed)
compareValues ((Int, ParsedLexemes, Int)
_, AST.Boolean Bool
l) ((Int, ParsedLexemes, Int)
ls, AST.Boolean Bool
r)   = (Int, ParsedLexemes, Int)
-> Value l l Placed Placed
-> ((Int, ParsedLexemes, Int), Value l l Placed Placed)
repos (Int, ParsedLexemes, Int)
ls forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {l} {l'} {f' :: * -> *} {f :: * -> *}.
Wirthy l =>
RelOp -> Ordering -> Maybe (Value l l' f' f)
relate RelOp
op (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 l Placed Placed
-> ((Int, ParsedLexemes, Int), Value l l Placed Placed)
repos (Int, ParsedLexemes, Int)
ls forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {l} {l'} {f' :: * -> *} {f :: * -> *}.
Wirthy l =>
RelOp -> Ordering -> Maybe (Value l l' f' f)
relate RelOp
op (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 l Placed Placed
-> ((Int, ParsedLexemes, Int), Value l l Placed Placed)
repos (Int, ParsedLexemes, Int)
ls forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {l} {l'} {f' :: * -> *} {f :: * -> *}.
Wirthy l =>
RelOp -> Ordering -> Maybe (Value l l' f' f)
relate RelOp
op (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 l Placed Placed
-> ((Int, ParsedLexemes, Int), Value l l Placed Placed)
repos (Int, ParsedLexemes, Int)
ls forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {l} {l'} {f' :: * -> *} {f :: * -> *}.
Wirthy l =>
RelOp -> Ordering -> Maybe (Value l l' f' f)
relate RelOp
op (forall a. Ord a => a -> a -> Ordering
compare (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 l Placed Placed
-> ((Int, ParsedLexemes, Int), Value l l Placed Placed)
repos (Int, ParsedLexemes, Int)
ls forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {l} {l'} {f' :: * -> *} {f :: * -> *}.
Wirthy l =>
RelOp -> Ordering -> Maybe (Value l l' f' f)
relate RelOp
op (forall a. Ord a => a -> a -> Ordering
compare Double
l (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 l Placed Placed
-> ((Int, ParsedLexemes, Int), Value l l Placed Placed)
repos (Int, ParsedLexemes, Int)
ls forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {l} {l'} {f' :: * -> *} {f :: * -> *}.
Wirthy l =>
RelOp -> Ordering -> Maybe (Value l l' f' f)
relate RelOp
op (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 l Placed Placed
-> ((Int, ParsedLexemes, Int), Value l l Placed Placed)
repos (Int, ParsedLexemes, Int)
ls forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {l} {l'} {f' :: * -> *} {f :: * -> *}.
Wirthy l =>
RelOp -> Ordering -> Maybe (Value l l' f' f)
relate RelOp
op (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 l Placed Placed
-> ((Int, ParsedLexemes, Int), Value l l Placed Placed)
repos (Int, ParsedLexemes, Int)
ls
                                                                   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {l} {l'} {f' :: * -> *} {f :: * -> *}.
Wirthy l =>
RelOp -> Ordering -> Maybe (Value l l' f' f)
relate RelOp
op (forall a. Ord a => a -> a -> Ordering
compare (Char -> Ident
Text.singleton 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 l Placed Placed
-> ((Int, ParsedLexemes, Int), Value l l Placed Placed)
repos (Int, ParsedLexemes, Int)
ls
                                                                   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {l} {l'} {f' :: * -> *} {f :: * -> *}.
Wirthy l =>
RelOp -> Ordering -> Maybe (Value l l' f' f)
relate RelOp
op (forall a. Ord a => a -> a -> Ordering
compare Ident
l (Char -> Ident
Text.singleton forall a b. (a -> b) -> a -> b
$ Int -> Char
chr Int
r))
            compareValues ((Int, ParsedLexemes, Int), Value l l Placed Placed)
_ ((Int, ParsedLexemes, Int), Value l l Placed Placed)
_                               = forall a. Maybe a
Nothing
            repos :: (Int, ParsedLexemes, Int)
-> Value l l Placed Placed
-> ((Int, ParsedLexemes, Int), Value l l Placed Placed)
repos (Int
_, ParsedLexemes
ls', Int
_) Value l l Placed Placed
v = ((Int
start, ParsedLexemes -> ParsedLexemes -> ParsedLexemes
anyWhitespace ParsedLexemes
ls ParsedLexemes
ls', Int
end), Value l l Placed Placed
v)
            relate :: RelOp -> Ordering -> Maybe (Value l l' f' f)
relate RelOp
Abstract.Equal Ordering
EQ          = forall a. a -> Maybe a
Just forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Value l l' f' f
Abstract.true
            relate RelOp
Abstract.Equal Ordering
_           = forall a. a -> Maybe a
Just forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Value l l' f' f
Abstract.false
            relate RelOp
Abstract.Unequal Ordering
EQ        = forall a. a -> Maybe a
Just forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Value l l' f' f
Abstract.false
            relate RelOp
Abstract.Unequal Ordering
_         = forall a. a -> Maybe a
Just forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Value l l' f' f
Abstract.true
            relate RelOp
Abstract.Less Ordering
LT           = forall a. a -> Maybe a
Just forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Value l l' f' f
Abstract.true
            relate RelOp
Abstract.Less Ordering
_            = forall a. a -> Maybe a
Just forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Value l l' f' f
Abstract.false
            relate RelOp
Abstract.LessOrEqual Ordering
GT    = forall a. a -> Maybe a
Just forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Value l l' f' f
Abstract.false
            relate RelOp
Abstract.LessOrEqual Ordering
_     = forall a. a -> Maybe a
Just forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Value l l' f' f
Abstract.true
            relate RelOp
Abstract.Greater Ordering
GT        = forall a. a -> Maybe a
Just forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Value l l' f' f
Abstract.true
            relate RelOp
Abstract.Greater Ordering
_         = forall a. a -> Maybe a
Just forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Value l l' f' f
Abstract.false
            relate RelOp
Abstract.GreaterOrEqual Ordering
LT = forall a. a -> Maybe a
Just forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Value l l' f' f
Abstract.false
            relate RelOp
Abstract.GreaterOrEqual Ordering
_  = forall a. a -> Maybe a
Just forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Value l l' f' f
Abstract.true
            relate RelOp
Abstract.In Ordering
_              = forall a. Maybe a
Nothing
   synthesis Auto ConstantFold
_ (pos :: (Int, ParsedLexemes, Int)
pos@(Int
start, ParsedLexemes
ls, Int
end), Expression λ l Sem Sem
_) Atts (Inherited (Auto ConstantFold)) (Expression λ l sem sem)
_ (AST.Positive Synthesized (Auto ConstantFold) (Expression l l sem sem)
expr) =
      case forall λ l.
SynCFExp λ l -> Maybe (Placed (Value l l Placed Placed))
foldedValue (forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto ConstantFold) (Expression l l sem sem)
expr)
      of Just ((Int
_, ParsedLexemes
ls', Int
_), AST.Integer Integer
n) -> 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), forall λ l (f' :: * -> *) (f :: * -> *). Integer -> Value λ l f' f
AST.Integer Integer
n)
         Just ((Int
_, ParsedLexemes
ls', Int
_), AST.Real Double
n) -> 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), forall λ l (f' :: * -> *) (f :: * -> *). Double -> Value λ l f' f
AST.Real Double
n)
         Maybe ((Int, ParsedLexemes, Int), Value l l Placed Placed)
_ -> SynCFExp{$sel:folded:SynCFExp :: Mapped Placed (Expression λ l Placed Placed)
folded= forall {k} (f :: k -> *) (a :: k). f a -> Mapped f a
Mapped ((Int, ParsedLexemes, Int)
pos, forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
f (Expression l' l' f' f') -> Expression l l' f' f
Abstract.positive forall a b. (a -> b) -> a -> b
$ forall λ l. SynCFExp λ l -> Placed (Expression λ l Placed Placed)
foldedExp' forall a b. (a -> b) -> a -> b
$ forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto ConstantFold) (Expression l l sem sem)
expr),
                       $sel:foldedValue:SynCFExp :: Maybe ((Int, ParsedLexemes, Int), Value l l Placed Placed)
foldedValue= forall a. Maybe a
Nothing}
   synthesis Auto ConstantFold
_ (pos :: (Int, ParsedLexemes, Int)
pos@(Int
start, ParsedLexemes
ls, Int
end), Expression λ l Sem Sem
_) Atts (Inherited (Auto ConstantFold)) (Expression λ l sem sem)
_ (AST.Negative Synthesized (Auto ConstantFold) (Expression l l sem sem)
expr) =
      case forall λ l.
SynCFExp λ l -> Maybe (Placed (Value l l Placed Placed))
foldedValue (forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto ConstantFold) (Expression l l sem sem)
expr)
      of Just ((Int
_, ParsedLexemes
ls', Int
_), AST.Integer Integer
n) -> 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),
                                                                forall λ l (f' :: * -> *) (f :: * -> *). Integer -> Value λ l f' f
AST.Integer forall a b. (a -> b) -> a -> b
$ forall a. Num a => a -> a
negate Integer
n)
         Just ((Int
_, ParsedLexemes
ls', Int
_), AST.Real Double
n) -> 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), forall λ l (f' :: * -> *) (f :: * -> *). Double -> Value λ l f' f
AST.Real forall a b. (a -> b) -> a -> b
$ forall a. Num a => a -> a
negate Double
n)
         Maybe ((Int, ParsedLexemes, Int), Value l l Placed Placed)
_ -> SynCFExp{$sel:folded:SynCFExp :: Mapped Placed (Expression λ l Placed Placed)
folded= forall {k} (f :: k -> *) (a :: k). f a -> Mapped f a
Mapped ((Int, ParsedLexemes, Int)
pos, forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
f (Expression l' l' f' f') -> Expression l l' f' f
Abstract.negative forall a b. (a -> b) -> a -> b
$ forall λ l. SynCFExp λ l -> Placed (Expression λ l Placed Placed)
foldedExp' forall a b. (a -> b) -> a -> b
$ forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto ConstantFold) (Expression l l sem sem)
expr),
                       $sel:foldedValue:SynCFExp :: Maybe ((Int, ParsedLexemes, Int), Value l l Placed Placed)
foldedValue= forall a. Maybe a
Nothing}
   synthesis Auto ConstantFold
_ ((Int, ParsedLexemes, Int)
pos, Expression λ l Sem Sem
_) Atts (Inherited (Auto ConstantFold)) (Expression λ l sem sem)
_ (AST.Add Synthesized (Auto ConstantFold) (Expression l l sem sem)
left Synthesized (Auto ConstantFold) (Expression l l sem sem)
right) =
      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 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
(+) (forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto ConstantFold) (Expression l l sem sem)
left) (forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto ConstantFold) (Expression l l sem sem)
right)
   synthesis Auto ConstantFold
_ ((Int, ParsedLexemes, Int)
pos, Expression λ l Sem Sem
_) 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) =
      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 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 (-) (forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto ConstantFold) (Expression l l sem sem)
left) (forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto ConstantFold) (Expression l l sem sem)
right)
   synthesis Auto ConstantFold
_ ((Int, ParsedLexemes, Int)
pos, Expression λ l Sem Sem
_) 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) =
      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 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
(||) (forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto ConstantFold) (Expression l l sem sem)
left) (forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto ConstantFold) (Expression l l sem sem)
right)
   synthesis Auto ConstantFold
_ ((Int, ParsedLexemes, Int)
pos, Expression λ l Sem Sem
_) 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) =
      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 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
(*) (forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto ConstantFold) (Expression l l sem sem)
left) (forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto ConstantFold) (Expression l l sem sem)
right)
   synthesis Auto ConstantFold
_ ((Int, ParsedLexemes, Int)
pos, Expression λ l Sem Sem
_) 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) =
      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 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
(/) (forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto ConstantFold) (Expression l l sem sem)
left) (forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto ConstantFold) (Expression l l sem sem)
right)
   synthesis Auto ConstantFold
_ ((Int, ParsedLexemes, Int)
pos, Expression λ l Sem Sem
_) 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) =
      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 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 (forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto ConstantFold) (Expression l l sem sem)
left) (forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto ConstantFold) (Expression l l sem sem)
right)
   synthesis Auto ConstantFold
_ ((Int, ParsedLexemes, Int)
pos, Expression λ l Sem Sem
_) 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) =
      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 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 (forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto ConstantFold) (Expression l l sem sem)
left) (forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto ConstantFold) (Expression l l sem sem)
right)
   synthesis Auto ConstantFold
_ ((Int, ParsedLexemes, Int)
pos, Expression λ l Sem Sem
_) 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) =
      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 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
(&&) (forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto ConstantFold) (Expression l l sem sem)
left) (forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto ConstantFold) (Expression l l sem sem)
right)
   synthesis Auto ConstantFold
_ (pos :: (Int, ParsedLexemes, Int)
pos@(Int
start, ParsedLexemes
ls, Int
end), Expression λ l Sem Sem
_) Atts (Inherited (Auto ConstantFold)) (Expression λ l sem sem)
_ (AST.Not Synthesized (Auto ConstantFold) (Expression l l sem sem)
expr) =
      case forall λ l.
SynCFExp λ l -> Maybe (Placed (Value l l Placed Placed))
foldedValue (forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto ConstantFold) (Expression l l sem sem)
expr)
      of Just ((Int
_, ParsedLexemes
ls', Int
_), AST.Boolean Bool
b) -> 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 forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Value l l' f' f
Abstract.false else forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Value l l' f' f
Abstract.true)
         Maybe ((Int, ParsedLexemes, Int), Value l l Placed Placed)
_ -> SynCFExp{$sel:folded:SynCFExp :: Mapped Placed (Expression λ l Placed Placed)
folded= forall {k} (f :: k -> *) (a :: k). f a -> Mapped f a
Mapped ((Int, ParsedLexemes, Int)
pos, forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
f (Expression l' l' f' f') -> Expression l l' f' f
Abstract.not forall a b. (a -> b) -> a -> b
$ forall λ l. SynCFExp λ l -> Placed (Expression λ l Placed Placed)
foldedExp' forall a b. (a -> b) -> a -> b
$ forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto ConstantFold) (Expression l l sem sem)
expr),
                       $sel:foldedValue:SynCFExp :: Maybe ((Int, ParsedLexemes, Int), Value l l Placed Placed)
foldedValue= forall a. Maybe a
Nothing}
   synthesis Auto ConstantFold
_ ((Int, ParsedLexemes, Int)
pos, AST.IsA Sem (Expression l l Sem Sem)
_ 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{$sel:folded:SynCFExp :: Mapped Placed (Expression λ l Placed Placed)
folded= forall {k} (f :: k -> *) (a :: k). f a -> Mapped f a
Mapped ((Int, ParsedLexemes, Int)
pos, forall l (f :: * -> *) l' (f' :: * -> *).
Oberon l =>
f (Expression l' l' f' f') -> QualIdent l' -> Expression l l' f' f
Abstract.is (forall λ l. SynCFExp λ l -> Placed (Expression λ l Placed Placed)
foldedExp' forall a b. (a -> b) -> a -> b
$ forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto ConstantFold) (Expression l l sem sem)
left) QualIdent l
right),
               $sel:foldedValue:SynCFExp :: Maybe ((Int, ParsedLexemes, Int), Value l l Placed Placed)
foldedValue= forall a. Maybe a
Nothing}
   synthesis Auto ConstantFold
_ ((Int, ParsedLexemes, Int)
pos, Expression λ l Sem Sem
_) Atts (Inherited (Auto ConstantFold)) (Expression λ l sem sem)
_ (AST.Set ZipList (Synthesized (Auto ConstantFold) (Element l l sem sem))
elements) =
      SynCFExp{$sel:folded:SynCFExp :: Mapped Placed (Expression λ l Placed Placed)
folded= forall {k} (f :: k -> *) (a :: k). f a -> Mapped f a
Mapped ((Int, ParsedLexemes, Int)
pos, forall l (f :: * -> *) l' (f' :: * -> *).
Oberon l =>
[f (Element l' l' f' f')] -> Expression l l' f' f
Abstract.set (forall {k} (f :: k -> *) (a :: k). Mapped f a -> f a
getMapped forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (node :: (* -> *) -> (* -> *) -> *).
SynCF' node -> Mapped Placed (node Placed Placed)
folded' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t a. Synthesized t a -> Atts (Synthesized t) a
syn forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ZipList a -> [a]
getZipList ZipList (Synthesized (Auto ConstantFold) (Element l l sem sem))
elements)),
               $sel:foldedValue:SynCFExp :: Maybe ((Int, ParsedLexemes, Int), Value l l Placed Placed)
foldedValue= forall a. Maybe a
Nothing}
   synthesis Auto ConstantFold
_ ((Int, ParsedLexemes, Int)
pos, Expression λ l Sem Sem
_) Atts (Inherited (Auto ConstantFold)) (Expression λ l sem sem)
_ (AST.Read Synthesized (Auto ConstantFold) (Designator l l sem sem)
des) =
      case forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto ConstantFold) (Designator l l sem sem)
des :: SynCFDesignator l
      of SynCFDesignator{$sel:designatorValue:SynCFDesignator :: forall l.
SynCFDesignator l -> Maybe (Placed (Value l l Placed Placed))
designatorValue= Just ((Int, ParsedLexemes, Int), Value l l Placed Placed)
val} -> 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 l 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 ((Int, ParsedLexemes, Int), Value l l Placed Placed)
Nothing} -> SynCFExp{$sel:folded:SynCFExp :: Mapped Placed (Expression λ l Placed Placed)
folded= forall {k} (f :: k -> *) (a :: k). f a -> Mapped f a
Mapped ((Int, ParsedLexemes, Int)
pos, 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
des')),
                                                               $sel:foldedValue:SynCFExp :: Maybe ((Int, ParsedLexemes, Int), Value l l Placed Placed)
foldedValue= forall a. Maybe a
Nothing}
   synthesis Auto ConstantFold
_ ((Int, ParsedLexemes, Int)
pos, Expression λ l Sem Sem
_) Atts (Inherited (Auto ConstantFold)) (Expression λ l sem sem)
_ (AST.FunctionCall Synthesized (Auto ConstantFold) (Designator l l sem sem)
fn ZipList (Synthesized (Auto ConstantFold) (Expression l l sem sem))
args) =
      case (forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall l.
SynCFDesignator l -> Maybe (Placed (Value l l Placed Placed))
designatorValue (forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto ConstantFold) (Designator l l sem sem)
fn :: SynCFDesignator l), (forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall λ l.
SynCFExp λ l -> Maybe (Placed (Value l l Placed Placed))
foldedValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t a. Synthesized t a -> Atts (Synthesized t) a
syn forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ZipList a -> [a]
getZipList ZipList (Synthesized (Auto ConstantFold) (Expression l l sem sem))
args)
      of (Just (AST.Builtin Ident
"CAP"), [Just (AST.String Ident
s)])
            | Ident -> Int
Text.length Ident
s forall a. Eq a => a -> a -> Bool
== Int
1, Ident
capital <- Ident -> Ident
Text.toUpper Ident
s -> Value l l Placed Placed -> SynCFExp λ l
fromValue (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 forall a b. (a -> b) -> a -> b
$ Int -> Char
chr Int
c) -> Value l l Placed Placed -> SynCFExp λ l
fromValue (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 l Placed Placed -> SynCFExp λ l
fromValue (forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Int -> Value l l' f' f
Abstract.charCode forall a b. (a -> b) -> a -> b
$ 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 forall a. Eq a => a -> a -> Bool
== Int
1, Int
code <- Char -> Int
ord (Ident -> Char
Text.head Ident
s) -> Value l l Placed Placed -> SynCFExp λ l
fromValue (forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Integer -> Value l l' f' f
Abstract.integer forall a b. (a -> b) -> a -> b
$ forall a. Integral a => a -> Integer
toInteger Int
code)
         (Just (AST.Builtin Ident
"ORD"), [Just (AST.CharCode Int
code)]) -> Value l l Placed Placed -> SynCFExp λ l
fromValue (forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Integer -> Value l l' f' f
Abstract.integer forall a b. (a -> b) -> a -> b
$ forall a. Integral a => a -> Integer
toInteger Int
code)
         (Just (AST.Builtin Ident
"ABS"), [Just (AST.Integer Integer
i)]) -> Value l l Placed Placed -> SynCFExp λ l
fromValue (forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Integer -> Value l l' f' f
Abstract.integer forall a b. (a -> b) -> a -> b
$ forall a. Num a => a -> a
abs Integer
i)
         (Just (AST.Builtin Ident
"ABS"), [Just (AST.Real Double
r)]) -> Value l l Placed Placed -> SynCFExp λ l
fromValue (forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Double -> Value l l' f' f
Abstract.real forall a b. (a -> b) -> a -> b
$ 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 <- forall a. Bits a => a -> Int -> a
shift Integer
i (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
j) -> Value l l Placed Placed -> SynCFExp λ l
fromValue (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 l Placed Placed -> SynCFExp λ l
fromValue (forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Integer -> Value l l' f' f
Abstract.integer forall a b. (a -> b) -> a -> b
$ forall a b. (RealFrac a, Integral b) => a -> b
ceiling Double
x)
         (Just (AST.Builtin Ident
"LEN"), [Just (AST.String Ident
s)]) -> Value l l Placed Placed -> SynCFExp λ l
fromValue (forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Integer -> Value l l' f' f
Abstract.integer
                                                                            forall a b. (a -> b) -> a -> b
$ forall a. Integral a => a -> Integer
toInteger 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 l Placed Placed -> SynCFExp λ l
fromValue (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 l Placed Placed -> SynCFExp λ l
fromValue (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 l Placed Placed -> SynCFExp λ l
fromValue (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 l Placed Placed -> SynCFExp λ l
fromValue (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 l Placed Placed -> SynCFExp λ l
fromValue (if Integer
x forall n. Integral n => n -> n -> n
`mod` Integer
2 forall a. Eq a => a -> a -> Bool
== Integer
1 then forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Value l l' f' f
Abstract.true else 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 l Placed Placed -> SynCFExp λ l
fromValue (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 l Placed Placed -> SynCFExp λ l
fromValue (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 l Placed Placed -> SynCFExp λ l
fromValue (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 l Placed Placed -> SynCFExp λ l
fromValue (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 l Placed Placed -> SynCFExp λ l
fromValue (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 l Placed Placed -> SynCFExp λ l
fromValue (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 l Placed Placed -> SynCFExp λ l
fromValue (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 l Placed Placed -> SynCFExp λ l
fromValue (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 l Placed Placed -> SynCFExp λ l
fromValue (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 l Placed Placed -> SynCFExp λ l
fromValue (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 l Placed Placed -> SynCFExp λ l
fromValue (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 l Placed Placed -> SynCFExp λ l
fromValue (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 l Placed Placed -> SynCFExp λ l
fromValue (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 l Placed Placed -> SynCFExp λ l
fromValue (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 l Placed Placed -> SynCFExp λ l
fromValue (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 l Placed Placed -> SynCFExp λ l
fromValue (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 l Placed Placed -> SynCFExp λ l
fromValue (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 l Placed Placed -> SynCFExp λ l
fromValue (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 l Placed Placed -> SynCFExp λ l
fromValue (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 l Placed Placed -> SynCFExp λ l
fromValue (forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Double -> Value l l' f' f
Abstract.real Double
minReal)
         (Maybe (Value l l Placed Placed),
 [Maybe (Value l l Placed Placed)])
_ -> SynCFExp{$sel:folded:SynCFExp :: Mapped Placed (Expression λ l Placed Placed)
folded= forall {k} (f :: k -> *) (a :: k). f a -> Mapped f a
Mapped ((Int, ParsedLexemes, Int)
pos,
                                       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 (forall {k} (f :: k -> *) (a :: k). Mapped f a -> f a
getMapped forall a b. (a -> b) -> a -> b
$ forall l.
SynCFDesignator l -> Mapped Placed (Designator l l Placed Placed)
foldedDes forall a b. (a -> b) -> a -> b
$ forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto ConstantFold) (Designator l l sem sem)
fn)
                                                             (forall λ l. SynCFExp λ l -> Placed (Expression λ l Placed Placed)
foldedExp' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t a. Synthesized t a -> Atts (Synthesized t) a
syn forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ZipList a -> [a]
getZipList ZipList (Synthesized (Auto ConstantFold) (Expression l l sem sem))
args)),
                       $sel:foldedValue:SynCFExp :: Maybe ((Int, ParsedLexemes, Int), Value l l Placed Placed)
foldedValue= forall a. Maybe a
Nothing}
      where fromValue :: Value l l Placed Placed -> SynCFExp λ l
fromValue Value l l Placed Placed
v = 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 l Placed Placed
v)
            foldedDes :: SynCFDesignator l -> Mapped Placed (Designator l l Placed Placed)
foldedDes SynCFDesignator{$sel:folded:SynCFDesignator :: forall l.
SynCFDesignator l -> Mapped Placed (Designator l l Placed Placed)
folded= Mapped Placed (Designator l l Placed Placed)
x} = Mapped Placed (Designator l l Placed Placed)
x
   synthesis Auto ConstantFold
_ ((Int, ParsedLexemes, Int)
pos, Expression λ l Sem Sem
_) Atts (Inherited (Auto ConstantFold)) (Expression λ l sem sem)
_ (AST.Literal Synthesized (Auto ConstantFold) (Value l l sem sem)
val) =
      SynCFExp{$sel:folded:SynCFExp :: Mapped Placed (Expression λ l Placed Placed)
folded= forall {k} (f :: k -> *) (a :: k). f a -> Mapped f a
Mapped ((Int, ParsedLexemes, Int)
pos, forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
f (Value l' l' f' f') -> Expression l l' f' f
Abstract.literal forall a b. (a -> b) -> a -> b
$ forall {k} (f :: k -> *) (a :: k). Mapped f a -> f a
getMapped forall a b. (a -> b) -> a -> b
$ forall (node :: (* -> *) -> (* -> *) -> *).
SynCF' node -> Mapped Placed (node Placed Placed)
folded' forall a b. (a -> b) -> a -> b
$ forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto ConstantFold) (Value l l sem sem)
val),
               $sel:foldedValue:SynCFExp :: Maybe ((Int, ParsedLexemes, Int), Value l l Placed Placed)
foldedValue= forall a. a -> Maybe a
Just (forall {k} (f :: k -> *) (a :: k). Mapped f a -> f a
getMapped forall a b. (a -> b) -> a -> b
$ forall (node :: (* -> *) -> (* -> *) -> *).
SynCF' node -> Mapped Placed (node Placed Placed)
folded' forall a b. (a -> b) -> a -> b
$ forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto ConstantFold) (Value l l sem sem)
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 :: 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 v :: Placed (Value l l Placed Placed)
v@((Int
start, Trailing [Lexeme]
l, Int
end), Value l l Placed Placed
value) =
   SynCFExp{$sel:folded:SynCFExp :: Mapped Placed (Expression λ l Placed Placed)
folded= forall {k} (f :: k -> *) (a :: k). f a -> Mapped f a
Mapped ((Int
start, forall a. Monoid a => a
mempty, Int
end),
                            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= forall a. a -> Maybe a
Just Placed (Value l l Placed Placed)
v}
   where lexemes :: ParsedLexemes
lexemes = [Lexeme] -> ParsedLexemes
Trailing ([Token{lexemeType :: TokenType
lexemeType= TokenType
Other,
                                    lexemeText :: Ident
lexemeText= forall ann. SimpleDocStream ann -> Ident
renderStrict forall a b. (a -> b) -> a -> b
$ forall ann1 ann2. Doc ann1 -> SimpleDocStream ann2
layoutCompact forall a b. (a -> b) -> a -> b
$ forall a ann. Pretty a => a -> Doc ann
pretty
                                                forall a b. (a -> b) -> a -> b
$ (forall a. a -> Identity a
Identity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) 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}]
                             forall a. Semigroup a => a -> a -> a
<> 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 = forall a. Integral a => a -> Integer
toInteger (forall a. Bounded a => a
maxBound :: Int)
minInteger :: Integer
minInteger = forall a. Integral a => a -> Integer
toInteger (forall a. Bounded a => a
minBound :: Int)
maxInt32 :: Integer
maxInt32 = forall a. Integral a => a -> Integer
toInteger (forall a. Bounded a => a
maxBound :: Int32)
minInt32 :: Integer
minInt32 = forall a. Integral a => a -> Integer
toInteger (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 = forall a. Integral a => a -> Integer
toInteger (forall a. Storable a => a -> Int
sizeOf (Double
0 :: Double))
floatSize :: Integer
floatSize = forall a. Integral a => a -> Integer
toInteger (forall a. Storable a => a -> Int
sizeOf (Float
0 :: Float))
intSize :: Integer
intSize = forall a. Integral a => a -> Integer
toInteger (forall a. Storable a => a -> Int
sizeOf (Int
0 :: Int))
int32Size :: Integer
int32Size = forall a. Integral a => a -> Integer
toInteger (forall a. Storable a => a -> Int
sizeOf (Int32
0 :: Int32))

maxReal, minReal :: Double
maxReal :: Double
maxReal = forall a. RealFloat a => Integer -> Int -> a
encodeFloat (forall a. RealFloat a => a -> Integer
floatRadix Double
x forall n. Num n => n -> n -> n
- Integer
1) (forall a b. (a, b) -> b
snd (forall a. RealFloat a => a -> (Int, Int)
floatRange Double
x) forall n. Num n => n -> n -> n
- Int
1)
   where x :: Double
x = Double
0 :: Double
minReal :: Double
minReal = forall a. RealFloat a => Integer -> Int -> a
encodeFloat (forall a. RealFloat a => a -> Integer
floatRadix Double
x forall n. Num n => n -> n -> n
- Integer
1) (forall a b. (a, b) -> a
fst (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 :: 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 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 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall λ l.
SynCFExp λ l -> Maybe (Placed (Value l l Placed Placed))
foldedValue SynCFExp l l
l forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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 -> 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 f f)
v
      Maybe (Placed (Value l l f f))
Nothing -> SynCFExp{$sel:folded:SynCFExp :: Mapped Placed (Expression λ l Placed Placed)
folded= 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 (forall λ l. SynCFExp λ l -> Placed (Expression λ l Placed Placed)
foldedExp' SynCFExp l l
l) (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= 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) 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') = forall a. a -> Maybe a
Just (forall λ l (f' :: * -> *) (f :: * -> *). Integer -> Value λ l f' f
AST.Integer forall a b. (a -> b) -> a -> b
$ forall n. Num n => n -> n -> n
op Integer
l' Integer
r')
         foldBareValues (AST.Real Double
l')    (AST.Real Double
r')    = forall a. a -> Maybe a
Just (forall λ l (f' :: * -> *) (f :: * -> *). Double -> Value λ l f' f
AST.Real forall a b. (a -> b) -> a -> b
$ forall n. Num n => n -> n -> n
op Double
l' Double
r')
         foldBareValues (AST.Integer Integer
l') (AST.Real Double
r')    = forall a. a -> Maybe a
Just (forall λ l (f' :: * -> *) (f :: * -> *). Double -> Value λ l f' f
AST.Real forall a b. (a -> b) -> a -> b
$ forall n. Num n => n -> n -> n
op (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
l') Double
r')
         foldBareValues (AST.Real Double
l')    (AST.Integer Integer
r') = forall a. a -> Maybe a
Just (forall λ l (f' :: * -> *) (f :: * -> *). Double -> Value λ l f' f
AST.Real forall a b. (a -> b) -> a -> b
$ forall n. Num n => n -> n -> n
op Double
l' (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
r'))
         foldBareValues Value l l f f
_ 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 :: 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 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 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall λ l.
SynCFExp λ l -> Maybe (Placed (Value l l Placed Placed))
foldedValue SynCFExp l l
l forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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 -> 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 f f)
v
      Maybe (Placed (Value l l f f))
Nothing -> SynCFExp{$sel:folded:SynCFExp :: Mapped Placed (Expression λ l Placed Placed)
folded= 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 (forall λ l. SynCFExp λ l -> Placed (Expression λ l Placed Placed)
foldedExp' SynCFExp l l
l) (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= 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') = forall a. a -> Maybe a
Just ((Int
start, ParsedLexemes -> ParsedLexemes -> ParsedLexemes
anyWhitespace ParsedLexemes
ls ParsedLexemes
ls', Int
end),
                                                                        forall λ l (f' :: * -> *) (f :: * -> *). Double -> Value λ l f' f
AST.Real forall a b. (a -> b) -> a -> b
$ 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)
_ = 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 :: 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 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 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall λ l.
SynCFExp λ l -> Maybe (Placed (Value l l Placed Placed))
foldedValue SynCFExp l l
l forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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 -> 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 f f)
v
      Maybe (Placed (Value l l f f))
Nothing -> SynCFExp{$sel:folded:SynCFExp :: Mapped Placed (Expression λ l Placed Placed)
folded= 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 (forall λ l. SynCFExp λ l -> Placed (Expression λ l Placed Placed)
foldedExp' SynCFExp l l
l) (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= 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') = forall a. a -> Maybe a
Just ((Int
start, ParsedLexemes -> ParsedLexemes -> ParsedLexemes
anyWhitespace ParsedLexemes
ls ParsedLexemes
ls', Int
end),
                                                                              forall λ l (f' :: * -> *) (f :: * -> *). Integer -> Value λ l f' f
AST.Integer forall a b. (a -> b) -> a -> b
$ 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)
_ = 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 :: 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 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 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall λ l.
SynCFExp λ l -> Maybe (Placed (Value l l Placed Placed))
foldedValue SynCFExp l l
l forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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 -> 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 f f)
v
      Maybe (Placed (Value l l f f))
Nothing -> SynCFExp{$sel:folded:SynCFExp :: Mapped Placed (Expression λ l Placed Placed)
folded= 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 (forall λ l. SynCFExp λ l -> Placed (Expression λ l Placed Placed)
foldedExp' SynCFExp l l
l) (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= 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') = forall a. a -> Maybe a
Just ((Int
start, ParsedLexemes -> ParsedLexemes -> ParsedLexemes
anyWhitespace ParsedLexemes
ls ParsedLexemes
ls', Int
end),
                                                                              forall λ l (f' :: * -> *) (f :: * -> *). Bool -> Value λ l f' f
AST.Boolean 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)
_ = 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 :: forall (sem :: * -> *).
(sem ~ Sem) =>
Proxy "designatorValue"
-> Auto ConstantFold
-> Placed (Designator l l Sem Sem)
-> Atts (Inherited (Auto ConstantFold)) (Designator l l sem sem)
-> Designator l l sem (Synthesized (Auto ConstantFold))
-> Maybe (Placed v)
synthesizedField Proxy "designatorValue"
_ Auto ConstantFold
_ ((Int, ParsedLexemes, Int)
pos, AST.Variable QualIdent l
q) Atts (Inherited (Auto ConstantFold)) (Designator l l sem sem)
inheritance Designator l l sem (Synthesized (Auto ConstantFold))
_ = (,) (Int, ParsedLexemes, Int)
pos forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup QualIdent l
q forall a b. (a -> b) -> a -> b
$ forall l. InhCF l -> Environment l
env Atts (Inherited (Auto ConstantFold)) (Designator l l sem sem)
inheritance)
   synthesizedField Proxy "designatorValue"
_ Auto ConstantFold
_ Placed (Designator l l Sem Sem)
_ Atts (Inherited (Auto ConstantFold)) (Designator l l sem sem)
_ Designator l l sem (Synthesized (Auto ConstantFold))
_ = forall a. Maybe a
Nothing

anyWhitespace :: ParsedLexemes -> ParsedLexemes -> ParsedLexemes
anyWhitespace :: ParsedLexemes -> ParsedLexemes -> ParsedLexemes
anyWhitespace ParsedLexemes
outer inner :: ParsedLexemes
inner@(Trailing [Lexeme]
ls)
   | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Lexeme -> Bool
isWhitespace [Lexeme]
ls = ParsedLexemes
inner
   | Bool
otherwise = ParsedLexemes
inner 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
_]) = forall a. Monoid a => a
mempty
lastWhitespace (Trailing (Lexeme
l:[Lexeme]
ls)) = ParsedLexemes -> ParsedLexemes
lastWhitespace ([Lexeme] -> ParsedLexemes
Trailing [Lexeme]
ls)

-- * 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 <*> :: forall (p :: * -> *) (q :: * -> *).
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) =
      forall λ l (f' :: * -> *) (f :: * -> *).
Ident -> [Import l] -> f (Block l l f' f') -> Module λ l f' f
AST.Module Ident
name1 [Import l]
imports1 (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 :: forall l. (Wirthy l, Ord (QualIdent l)) => Environment l
predefined = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first forall l. Wirthy l => Ident -> QualIdent l
Abstract.nonQualIdent) forall a b. (a -> b) -> a -> b
$
   [(Ident
"TRUE", forall a. a -> Maybe a
Just forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Value l l' f' f
Abstract.true),
    (Ident
"FALSE", forall a. a -> Maybe a
Just forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Value l l' f' f
Abstract.false)]
   forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map 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, forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Ident -> Value l l' f' f
Abstract.builtin Ident
name)
predefined2 :: forall l. (Wirthy l, Ord (QualIdent l)) => Environment l
predefined2 = forall l. (Wirthy l, Ord (QualIdent l)) => Environment l
predefined