module DDC.Build.Language.Eval
( language
, bundle
, fragment
, profile)
where
import DDC.Build.Language.Base
import DDC.Core.Simplifier
import DDC.Core.Transform.Namify
import DDC.Core.Eval.Profile
import DDC.Core.Eval.Name
import DDC.Core.Fragment
import DDC.Core.Eval.Check as Eval
import DDC.Type.Exp
import DDC.Type.Env (Env)
import qualified DDC.Type.Env as Env
import qualified Data.Map as Map
import Control.Monad.State.Strict
language :: Language
language = Language bundle
bundle :: Bundle Int Name Eval.Error
bundle = Bundle
{ bundleFragment = fragment
, bundleModules = Map.empty
, bundleStateInit = 0 :: Int
, bundleSimplifier = Trans Id
, bundleMakeNamifierT = makeNamifier freshT
, bundleMakeNamifierX = makeNamifier freshX
, bundleRewriteRules = Map.empty }
fragment :: Fragment Name Eval.Error
fragment
= Fragment
{ fragmentProfile = evalProfile
, fragmentExtension = "dcv"
, fragmentReadName = readName
, fragmentLexModule = lexModuleString
, fragmentLexExp = lexExpString
, fragmentCheckModule = checkCapsModule
, fragmentCheckExp = checkCapsX }
profile = evalProfile
freshT :: Env Name -> Bind Name -> State Int Name
freshT env bb
= do i <- get
put (i + 1)
let n = NameVar ("t" ++ show i)
case Env.lookupName n env of
Nothing -> return n
_ -> freshT env bb
freshX :: Env Name -> Bind Name -> State Int Name
freshX env bb
= do i <- get
put (i + 1)
let n = NameVar ("v" ++ show i)
case Env.lookupName n env of
Nothing -> return n
_ -> freshX env bb