Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
branch: master
Fetching contributors…

Cannot retrieve contributors at this time

125 lines (106 sloc) 4.17 kB
{
{-# OPTIONS_GHC -fno-warn-unused-binds #-}
module Bar (compile2, Inh_Root(..)) where
import Control.Unification
import Control.Unification.IntVar
import qualified Data.Set as S
import qualified Data.Map as M
import Data.List
import Data.Maybe
import CPP.Intermediate
import CPP.TypeProducer
import CPP.BackendTools
import HN.Intermediate
import qualified HN.MilnerTools as MT
import HN.TypeTools
import SPL.Types
import Utils
}
INCLUDE "AG/Nodes.ag"
INCLUDE "AG/Root.ag"
INCLUDE "AG/ExpressionBuilder.ag"
INCLUDE "AG/Qualifiers.ag"
INCLUDE "AG/TemplateArgs.ag"
INCLUDE "AG/TypeInference.ag"
INCLUDE "AG/DefinitionTypes.ag"
ATTR ASTExpression [ | | freeVars : {S.Set String} ]
ATTR ExpressionList [ | | freeVars USE {:} {[]} : {[S.Set String]} ]
ATTR LetIn
[
|
|
freeVars : {S.Set String}
cppVarDefinition USE {`consMaybe`} {[]} : {[CppLocalVarDef]}
varsFreeInFunctions USE {`S.union`} {S.empty} : {S.Set String}
contextMethods USE {`consMaybe`} {[]} : {[CppDefinition]}
declareSelf USE {||} {False} : Bool
declareParent USE {||} {False} : Bool
sem : CppExpression
]
ATTR Definition LetIn
[
level : Int
parent : String
|
|
]
ATTR Definition
[
|
|
name : String
cppDefinition : CppDefinition
freeVars : {S.Set String}
cppVarDefinition : {Maybe CppLocalVarDef}
varsFreeInFunctions : {S.Set String}
contextMethods : {Maybe CppDefinition}
declareSelf : Bool
declareParent : Bool
]
SEM Definition
| Definition
-- тривиальные атрибуты
where.level = @lhs.level + 1
lhs.name = @name
loc.contextTypeName = @name ++ "_impl"
loc.isFunction = not $ null @params
loc.cppDefType = xtrace "Definition.@loc.cppDefType" $ cppType @loc.definitionType
lhs.contextMethods = constructJust (not @isFunction) $ @loc.cppDefinition
lhs.cppVarDefinition = constructJust (@loc.isFunction) $ CppVar @loc.cppDefType @name @where.sem
-- топ-функция, замкнутые переменные и локальные функции
lhs.cppDefinition = @loc.cppDefinition
loc.cppDefinition = { CppFunctionDef {
functionLevel = @lhs.level
, functionName = @name
, functionRetExpr = @where.sem
, functionIsStatic = @loc.isFunctionStatic
, functionArgs = zipWith CppVarDecl (case @loc.cppDefType of CppTypeFunction _ argTypes -> argTypes ; _ -> []) @params
, functionTemplateArgs = S.toList @loc.templateArgs
, functionReturnType = case @loc.cppDefType of CppTypeFunction returnType _ -> returnType ; _ -> @loc.cppDefType
, functionLocalVars = localVars
, functionContext = constructJust (null @where.contextMethods) $ CppContext {
contextLevel = @lhs.level
, contextTypeName = @loc.contextTypeName
, contextVars = @loc.contextArgs ++ contextVars
, contextTemplateArgs = @loc.contextTemplateArgs
, contextMethods = @where.contextMethods
, contextDeclareSelf = xtrace "contextDeclareSelf" @where.declareSelf
, contextParent = xtrace "contextParent" $ constructJust (not @where.declareParent) $ @lhs.parent ++ "_impl"
}
} where
(contextVars, localVars) = partition (\(CppVar _ name _) -> S.member name @where.varsFreeInFunctions) @where.cppVarDefinition
}
where.parent = @name
(loc.contextArgs, loc.argsTv) = { case @loc.definitionType of
TT funList -> let isArgContext a = S.member a @where.varsFreeInFunctions in
unzip $ map (\(typ, x) -> (CppVar (cppType typ) x $ CppAtom x, typeTu typ)) $ filter (\(_, y) -> isArgContext y) $ zip (init funList) @params
_ -> ([], []) }
loc.freeVars = @where.freeVars S.\\ S.fromList @params
lhs.varsFreeInFunctions = if @loc.isFunction then @loc.freeVars else S.empty
SEM ASTExpression
| Constant lhs.freeVars = S.empty
| Atom lhs.freeVars = S.singleton @name
| Application lhs.freeVars = S.unions (@fn.freeVars : @arg.freeVars)
SEM LetIn
| Let
lhs.freeVars = @tl.freeVars `S.union` @hd.freeVars S.\\ S.singleton @hd.name
Jump to Line
Something went wrong with that request. Please try again.