Commit f77b65b4 authored by Martin Wierich's avatar Martin Wierich
Browse files

solving the problem of strict aliases. Now a strict alias

  #! x = y

will be transformed into

  #! x = _dummyForStrictAlias y

while checking. The new predefined symbol _dummyForStrictAlias has
the type of the identity function. This application will be removed
in the backend conversion phase. In this case x and y will simply get
the same sequence number (see module backendpreprocess). Then the
binding can be ignored.
parent ec7340ad
......@@ -305,7 +305,10 @@ backEndConvertModules predefs {fe_icl = fe_icl =: {icl_name, icl_functions, icl_
#! backEnd
= adjustArrayFunctions predefs fe_arrayInstances icl_functions fe_dcls varHeap (backEnd -*-> "adjustArrayFunctions")
#! (rules, backEnd)
= convertRules [(index, icl_functions.[index]) \\ (_, index) <- functionIndices] varHeap (backEnd -*-> "convertRules")
// MW was: = convertRules [(index, icl_functions.[index]) \\ (_, index) <- functionIndices] varHeap (backEnd -*-> "convertRules")
= convertRules predefs.[PD_DummyForStrictAliasFun].pds_ident
[(index, icl_functions.[index]) \\ (_, index) <- functionIndices]
varHeap (backEnd -*-> "convertRules")
#! backEnd
= BEDefineRules rules (backEnd -*-> "BEDefineRules")
#! backEnd
......@@ -407,7 +410,11 @@ reshuffleTypes nIclTypes dclIclConversions be
#! to` = if (to` >= nDclTypes) frm` to`
= (swap frm` to` p, swap frm to p`, swapTypes frm to be)
/* MW changed into
class declareVars a :: a !(!Ident, !VarHeap) -> Backender
before it was:
class declareVars a :: a !VarHeap -> Backender
non trivial changes are indicated with a comment
instance declareVars [a] | declareVars a where
declareVars :: [a] VarHeap -> Backender | declareVars a
......@@ -476,6 +483,88 @@ instance declareVars BackendBody where
declareVars {bb_args, bb_rhs} varHeap
= declareVars bb_args varHeap
o` declareVars bb_rhs varHeap
*/
:: DeclVarsInput :== (!Ident, !VarHeap)
class declareVars a :: a !DeclVarsInput -> Backender
instance declareVars [a] | declareVars a where
declareVars :: [a] !DeclVarsInput -> Backender | declareVars a
declareVars list dvInput
= foldState (flip declareVars dvInput) list
instance declareVars (Ptr VarInfo) where
declareVars varInfoPtr (_, varHeap)
= declareVariable BELhsNodeId varInfoPtr "_var???" varHeap // +++ name
instance declareVars FreeVar where
declareVars :: FreeVar !DeclVarsInput -> Backender
declareVars freeVar (_, varHeap)
= declareVariable BELhsNodeId freeVar.fv_info_ptr freeVar.fv_name.id_name varHeap
// MW this rule was changed non trivially
instance declareVars (Bind Expression FreeVar) where
declareVars :: (Bind Expression FreeVar) !DeclVarsInput -> Backender
declareVars {bind_src=App {app_symb, app_args=[Var _:_]}, bind_dst=freeVar} (aliasDummyId, varHeap)
| app_symb.symb_name==aliasDummyId
= identity // we have an alias. Don't declare the same variable twice
= declareVariable BERhsNodeId freeVar.fv_info_ptr freeVar.fv_name.id_name varHeap
declareVars {bind_dst=freeVar} (_, varHeap)
= declareVariable BERhsNodeId freeVar.fv_info_ptr freeVar.fv_name.id_name varHeap
declareVariable :: Int (Ptr VarInfo) {#Char} !VarHeap -> Backender
declareVariable lhsOrRhs varInfoPtr name varHeap
= beDeclareNodeId (getVariableSequenceNumber varInfoPtr varHeap) lhsOrRhs name
instance declareVars (Optional a) | declareVars a where
declareVars :: (Optional a) !DeclVarsInput -> Backender | declareVars a
declareVars (Yes x) dvInput
= declareVars x dvInput
declareVars No _
= identity
instance declareVars FunctionPattern where
declareVars :: FunctionPattern !DeclVarsInput -> Backender
declareVars (FP_Algebraic _ freeVars optionalVar) dvInput
= declareVars freeVars dvInput
o` declareVars optionalVar dvInput
declareVars (FP_Variable freeVar) dvInput
= declareVars freeVar dvInput
declareVars (FP_Basic _ optionalVar) dvInput
= declareVars optionalVar dvInput
declareVars FP_Empty dvInput
= identity
instance declareVars Expression where
declareVars :: Expression !DeclVarsInput -> Backender
declareVars (Let {let_strict_binds, let_lazy_binds, let_expr}) dvInput
= declareVars let_strict_binds dvInput
o` declareVars let_lazy_binds dvInput
o` declareVars let_expr dvInput
declareVars (Conditional {if_then, if_else}) dvInput
= declareVars if_then dvInput
o` declareVars if_else dvInput
// MW here was a non trivial change
declareVars (AnyCodeExpr _ outParams _) (_, varHeap)
= foldState (declVar varHeap) outParams
where
declVar varHeap {bind_dst=freeVar}
= declareVariable BERhsNodeId freeVar.fv_info_ptr freeVar.fv_name.id_name varHeap
declareVars _ _
= identity
instance declareVars TransformedBody where
declareVars :: TransformedBody !DeclVarsInput -> Backender
declareVars {tb_args, tb_rhs} dvInput
= declareVars tb_args dvInput
o` declareVars tb_rhs dvInput
instance declareVars BackendBody where
declareVars :: BackendBody !DeclVarsInput -> Backender
declareVars {bb_args, bb_rhs} dvInput
= declareVars bb_args dvInput
o` declareVars bb_rhs dvInput
:: ModuleIndex :== Index
......@@ -830,8 +919,12 @@ convertRules rules varHeap
= foldl (flip beRules) beNoRules (map (flip convertRule varHeap) rules)
*/
/* MW was
convertRules :: [(Int, FunDef)] VarHeap *BackEnd -> (BEImpRuleP, *BackEnd)
convertRules rules varHeap be
*/
convertRules :: Ident [(Int, FunDef)] VarHeap *BackEnd -> (BEImpRuleP, *BackEnd)
convertRules aliasDummyId rules varHeap be
# (null, be)
= BENoRules be
= convert rules varHeap null be
......@@ -842,14 +935,22 @@ convertRules rules varHeap be
= (rulesP, be)
convert [h:t] varHeap rulesP be
# (ruleP, be)
= convertRule h varHeap be
// MW was = convertRule h varHeap be
= convertRule aliasDummyId h varHeap be
# (rulesP, be)
= BERules ruleP rulesP be
= convert t varHeap rulesP be
/* MW was
convertRule :: (Int,FunDef) VarHeap -> BEMonad BEImpRuleP
convertRule (index, {fun_type=Yes type, fun_body=body, fun_pos, fun_kind, fun_symb}) varHeap
= beRule index (cafness fun_kind) (convertTypeAlt index cIclModIndex (type /* ->> ("convertRule", fun_symb.id_name, index, type) */)) (convertFunctionBody index (positionToLineNumber fun_pos) body varHeap)
*/
convertRule :: Ident (Int,FunDef) VarHeap -> BEMonad BEImpRuleP
convertRule aliasDummyId (index, {fun_type=Yes type, fun_body=body, fun_pos, fun_kind, fun_symb}) varHeap
// MW was: = beRule index (cafness fun_kind) (convertTypeAlt index cIclModIndex (type /* ->> ("convertRule", fun_symb.id_name, index, type) */)) (convertFunctionBody index (positionToLineNumber fun_pos) body varHeap)
= beRule index (cafness fun_kind)
(convertTypeAlt index cIclModIndex (type /* ->> ("convertRule", fun_symb.id_name, index, type) */))
(convertFunctionBody index (positionToLineNumber fun_pos) aliasDummyId body varHeap)
where
cafness :: FunKind -> Int
cafness (FK_Function _)
......@@ -869,9 +970,14 @@ convertRule (index, {fun_type=Yes type, fun_body=body, fun_pos, fun_kind, fun_sy
positionToLineNumber _
= -1
/* MW was
convertFunctionBody :: Int Int FunctionBody VarHeap -> BEMonad BERuleAltP
convertFunctionBody functionIndex lineNumber (BackendBody bodies) varHeap
= convertBackendBodies functionIndex lineNumber bodies varHeap
*/
convertFunctionBody :: Int Int Ident FunctionBody VarHeap -> BEMonad BERuleAltP
convertFunctionBody functionIndex lineNumber aliasDummyId (BackendBody bodies) varHeap
= convertBackendBodies functionIndex lineNumber aliasDummyId bodies varHeap
convertTypeAlt :: Int ModuleIndex SymbolType -> BEMonad BETypeAltP
convertTypeAlt functionIndex moduleIndex symbol=:{st_result}
......@@ -951,37 +1057,54 @@ convertTypeArgs :: [AType] -> BEMonad BETypeArgP
convertTypeArgs args
= foldr (beTypeArgs o convertAnnotTypeNode) beNoTypeArgs args
/* MW was
convertBackendBodies :: Int Int [BackendBody] VarHeap -> BEMonad BERuleAltP
convertBackendBodies functionIndex lineNumber bodies varHeap
= foldr (beRuleAlts o (flip (convertBackendBody functionIndex lineNumber)) varHeap) beNoRuleAlts bodies
*/
convertBackendBodies :: Int Int Ident [BackendBody] VarHeap -> BEMonad BERuleAltP
convertBackendBodies functionIndex lineNumber aliasDummyId bodies varHeap
= foldr (beRuleAlts o (flip (convertBackendBody functionIndex lineNumber aliasDummyId)) varHeap)
beNoRuleAlts bodies
/* MW was
convertBackendBody :: Int Int BackendBody VarHeap -> BEMonad BERuleAltP
convertBackendBody functionIndex lineNumber body=:{bb_args, bb_rhs=ABCCodeExpr instructions inline} varHeap
*/
convertBackendBody :: Int Int Ident BackendBody VarHeap -> BEMonad BERuleAltP
convertBackendBody functionIndex lineNumber aliasDummyId body=:{bb_args, bb_rhs=ABCCodeExpr instructions inline} varHeap
= beNoNodeDefs ==> \noNodeDefs
-> declareVars body varHeap
// MW was -> declareVars body varHeap
-> declareVars body (aliasDummyId, varHeap)
o` beCodeAlt
lineNumber
(convertLhsNodeDefs bb_args noNodeDefs varHeap)
(convertBackendLhs functionIndex bb_args varHeap)
(beAbcCodeBlock inline (convertStrings instructions))
convertBackendBody functionIndex lineNumber body=:{bb_args, bb_rhs=AnyCodeExpr inParams outParams instructions} varHeap
// MW was:convertBackendBody functionIndex lineNumber body=:{bb_args, bb_rhs=AnyCodeExpr inParams outParams instructions} varHeap
convertBackendBody functionIndex lineNumber aliasDummyId body=:{bb_args, bb_rhs=AnyCodeExpr inParams outParams instructions} varHeap
= beNoNodeDefs ==> \noNodeDefs
-> declareVars body varHeap
// MW was -> declareVars body varHeap
-> declareVars body (aliasDummyId, varHeap)
o` beCodeAlt
lineNumber
(convertLhsNodeDefs bb_args noNodeDefs varHeap)
(convertBackendLhs functionIndex bb_args varHeap)
(beAnyCodeBlock (convertCodeParameters inParams varHeap) (convertCodeParameters outParams varHeap) (convertStrings instructions))
convertBackendBody functionIndex lineNumber body=:{bb_args, bb_rhs} varHeap
// MW was:convertBackendBody functionIndex lineNumber body=:{bb_args, bb_rhs} varHeap
convertBackendBody functionIndex lineNumber aliasDummyId body=:{bb_args, bb_rhs} varHeap
= beNoNodeDefs ==> \noNodeDefs
-> declareVars body varHeap
// MW was -> declareVars body varHeap
-> declareVars body (aliasDummyId, varHeap)
o` beRuleAlt
lineNumber
(convertLhsNodeDefs bb_args noNodeDefs varHeap)
(convertBackendLhs functionIndex bb_args varHeap)
(convertRhsNodeDefs bb_rhs varHeap)
// MW was: (convertRhsNodeDefs bb_rhs varHeap)
(convertRhsNodeDefs aliasDummyId bb_rhs varHeap)
(convertRhsStrictNodeIds bb_rhs varHeap)
(convertRootExpr bb_rhs varHeap)
// MW was: (convertRootExpr bb_rhs varHeap)
(convertRootExpr aliasDummyId bb_rhs varHeap)
convertStrings :: [{#Char}] -> BEMonad BEStringListP
convertStrings strings
......@@ -1049,6 +1172,7 @@ convertVars :: [VarInfoPtr] VarHeap -> BEMonad BEArgP
convertVars vars varHeap
= foldr (beArgs o flip convertVarPtr varHeap) beNoArgs vars
/* MW was
convertRootExpr :: Expression VarHeap -> BEMonad BENodeP
convertRootExpr (Let {let_expr}) varHeap
= convertRootExpr let_expr varHeap
......@@ -1057,24 +1181,41 @@ convertRootExpr (Conditional {if_cond=cond, if_then=then, if_else=Yes else}) var
where
convertConditional :: Expression Expression Expression VarHeap -> BEMonad BENodeP
convertConditional cond then else varHeap
*/
convertRootExpr :: Ident Expression VarHeap -> BEMonad BENodeP
convertRootExpr aliasDummyId (Let {let_expr}) varHeap
= convertRootExpr aliasDummyId let_expr varHeap
convertRootExpr aliasDummyId (Conditional {if_cond=cond, if_then=then, if_else=Yes else}) varHeap
= convertConditional aliasDummyId cond then else varHeap
where
convertConditional :: Ident Expression Expression Expression VarHeap -> BEMonad BENodeP
convertConditional aliasDummyId cond then else varHeap
= beGuardNode
(convertExpr cond varHeap)
(convertRhsNodeDefs then varHeap)
// MW was: (convertRhsNodeDefs then varHeap)
(convertRhsNodeDefs aliasDummyId then varHeap)
(convertRhsStrictNodeIds then varHeap)
(convertRootExpr then varHeap)
(convertRhsNodeDefs else varHeap)
// MW was: (convertRootExpr then varHeap)
(convertRootExpr aliasDummyId then varHeap)
// MW was: (convertRhsNodeDefs else varHeap)
(convertRhsNodeDefs aliasDummyId else varHeap)
(convertRhsStrictNodeIds else varHeap)
(convertRootExpr else varHeap)
convertRootExpr (Conditional {if_cond=cond, if_then=then, if_else=No}) varHeap
// MW was: (convertRootExpr else varHeap)
(convertRootExpr aliasDummyId else varHeap)
// MW was:convertRootExpr (Conditional {if_cond=cond, if_then=then, if_else=No}) varHeap
convertRootExpr aliasDummyId (Conditional {if_cond=cond, if_then=then, if_else=No}) varHeap
= beGuardNode
(convertExpr cond varHeap)
(convertRhsNodeDefs then varHeap)
// MW was: (convertRhsNodeDefs then varHeap)
(convertRhsNodeDefs aliasDummyId then varHeap)
(convertRhsStrictNodeIds then varHeap)
(convertRootExpr then varHeap)
// MW was: (convertRootExpr then varHeap)
(convertRootExpr aliasDummyId then varHeap)
beNoNodeDefs
beNoStrictNodeIds
(beNormalNode (beBasicSymbol BEFailSymb) beNoArgs)
convertRootExpr expr varHeap
// MW was:convertRootExpr expr varHeap
convertRootExpr _ expr varHeap
= convertExpr expr varHeap
// RWS +++ rewrite
......@@ -1103,15 +1244,42 @@ defineLhsNodeDef freeVar pattern nodeDefs varHeap
(beNodeDef (getVariableSequenceNumber freeVar.fv_info_ptr varHeap) (convertPattern pattern varHeap))
(return nodeDefs)
/* MW was
collectNodeDefs :: Expression -> [Bind Expression FreeVar]
collectNodeDefs (Let {let_strict_binds, let_lazy_binds})
= let_strict_binds ++ let_lazy_binds
collectNodeDefs _
*/
collectNodeDefs :: Ident Expression -> [Bind Expression FreeVar]
collectNodeDefs aliasDummyId (Let {let_strict_binds, let_lazy_binds})
// MW was: = let_strict_binds ++ let_lazy_binds
= filterStrictAlias let_strict_binds let_lazy_binds
where
filterStrictAlias [] let_lazy_binds
= let_lazy_binds
filterStrictAlias [strict_bind=:{bind_src=App app}:strict_binds] let_lazy_binds
| app.app_symb.symb_name==aliasDummyId
// the compiled source was a strict alias like "#! x = y"
= case hd app.app_args of
Var _
// the node is still such an alias and must be ignored
-> filterStrictAlias strict_binds let_lazy_binds
hd_app_args
// the node is not an alias anymore: remove just the _dummyForStrictAlias call
-> [{ strict_bind & bind_src = hd_app_args } : filterStrictAlias strict_binds let_lazy_binds]
filterStrictAlias [strict_bind:strict_binds] let_lazy_binds
= [strict_bind: filterStrictAlias strict_binds let_lazy_binds]
// MW was:collectNodeDefs _
collectNodeDefs _ _
= []
/* MW was
convertRhsNodeDefs :: Expression VarHeap -> BEMonad BENodeDefP
convertRhsNodeDefs expr varHeap
= convertNodeDefs (collectNodeDefs expr) varHeap
*/
convertRhsNodeDefs :: Ident Expression VarHeap -> BEMonad BENodeDefP
convertRhsNodeDefs aliasDummyId expr varHeap
= convertNodeDefs (collectNodeDefs aliasDummyId expr) varHeap
convertNodeDef :: !(Bind Expression FreeVar) VarHeap -> BEMonad BENodeDefP
convertNodeDef {bind_src=expr, bind_dst=freeVar} varHeap
......@@ -1305,10 +1473,19 @@ convertVar varInfo varHeap
= beNodeId (getVariableSequenceNumber varInfo varHeap)
getVariableSequenceNumber :: VarInfoPtr VarHeap -> Int
/* MW was
getVariableSequenceNumber varInfoPtr varHeap
# (VI_SequenceNumber sequenceNumber)
= sreadPtr varInfoPtr varHeap
= sequenceNumber
*/
getVariableSequenceNumber varInfoPtr varHeap
# vi = sreadPtr varInfoPtr varHeap
= case vi of
VI_SequenceNumber sequenceNumber
-> sequenceNumber
VI_Alias {var_info_ptr}
-> getVariableSequenceNumber var_info_ptr varHeap
markExports :: DclModule {#ClassDef} {#CheckedTypeDef} {#ClassDef} {#CheckedTypeDef} (Optional {#Int}) -> Backender
markExports {dcl_conversions = Yes conversionTable} dclClasses dclTypes iclClasses iclTypes (Yes functionConversions)
......
......@@ -44,7 +44,9 @@ backEndInterface outputFileName commandLineArgs predefs syntaxTree errorFile fil
| not compatible
= (False, errorFile, files)
# varHeap
= backendPreprocess functionIndices syntaxTree.fe_icl syntaxTree.fe_varHeap
// MW was: = backendPreprocess functionIndices syntaxTree.fe_icl syntaxTree.fe_varHeap
= backendPreprocess predefs.[PD_DummyForStrictAliasFun].pds_ident functionIndices
syntaxTree.fe_icl syntaxTree.fe_varHeap
with
functionIndices
= flatten [[member \\ member <- group.group_members] \\ group <-: syntaxTree.fe_components]
......
......@@ -4,4 +4,5 @@ import checksupport
// assign sequence numbers to all variables in the syntax tree
backendPreprocess :: ![Index] !IclModule !*VarHeap -> *VarHeap
// MW was:backendPreprocess :: ![Index] !IclModule !*VarHeap -> *VarHeap
backendPreprocess :: !Ident ![Index] !IclModule !*VarHeap -> *VarHeap
......@@ -7,11 +7,18 @@ import Heap
import backendsupport
import RWSDebug
/* MW was
backendPreprocess :: ![Index] !IclModule !*VarHeap -> *VarHeap
backendPreprocess functionIndices iclModule varHeap
backendPreprocess predefSymblos functionIndices iclModule varHeap
= preprocess [iclModule.icl_functions.[i] \\ i <- functionIndices] varHeap
class preprocess a :: a -> Preprocessor
*/
backendPreprocess :: !Ident ![Index] !IclModule !*VarHeap -> *VarHeap
backendPreprocess aliasDummyId functionIndices iclModule varHeap
= preprocess aliasDummyId
[iclModule.icl_functions.[i] \\ i <- functionIndices] varHeap
// MW was class preprocess a :: a -> Preprocessor
class preprocess a :: !Ident a -> Preprocessor
:: Preprocessor
:== *PreprocessState -> *PreprocessState
:: PreprocessState
......@@ -23,31 +30,52 @@ instance preprocess {#a} | preprocess a & ArrayElem a where
/*2.0
instance preprocess {#a} | preprocess a & Array {#} a where
0.2*/
/* MW was
preprocess array
= foldStateA preprocess array
*/
preprocess aliasDummyId array
= foldStateA (preprocess aliasDummyId) array
instance preprocess [a] | preprocess a where
/* MW was
preprocess list
= foldState preprocess list
*/
preprocess aliasDummyId list
= foldState (preprocess aliasDummyId) list
// +++ this assigns sequence numbers per function, should be per alternative and move to backendconvert
instance preprocess FunDef where
/* MW was
preprocess funDef
= fromSequencerToPreprocessor (sequence funDef.fun_body)
*/
preprocess aliasDummyId funDef
= fromSequencerToPreprocessor aliasDummyId (sequence funDef.fun_body)
class sequence a :: a -> Sequencer
:: Sequencer
:== *SequenceState -> *SequenceState
:: SequenceState
= {ss_sequenceNumber :: !Int, ss_varHeap :: .VarHeap}
= {ss_sequenceNumber :: !Int, ss_varHeap :: .VarHeap, ss_aliasDummyId :: !Ident}
// MW added ss_aliasDummyId (remove it if you don't like it, Ronny)
/* MW was
toSequenceState varHeap
:== {ss_sequenceNumber = 0, ss_varHeap = varHeap}
*/
toSequenceState aliasDummyId varHeap
:== {ss_sequenceNumber = 0, ss_varHeap = varHeap, ss_aliasDummyId = aliasDummyId}
fromSequenceState sequenceState
:== sequenceState.ss_varHeap
/* MW was
fromSequencerToPreprocessor sequencer
:== toSequenceState
*/
fromSequencerToPreprocessor aliasDummyId sequencer
:== toSequenceState aliasDummyId
o` sequencer
o` fromSequenceState
......@@ -100,7 +128,8 @@ instance sequence Expression where
= sequence exp
o` sequence selections
sequence (AnyCodeExpr _ outParams _)
= sequence outParams
// MW was: = sequence outParams
= foldState (\{bind_dst}->sequence bind_dst) outParams
sequence _
= identity
......@@ -112,7 +141,27 @@ instance sequence Selection where
sequence (DictionarySelection dictionaryVar dictionarySelections _ index)
= sequence index
instance sequence (Bind a b) | sequence b where
// MW was:instance sequence (Bind a b) | sequence b where
instance sequence (Bind Expression FreeVar) where
// MW.. PD_DummyForStrictAliasFun
sequence {bind_src=App app , bind_dst}
= sequence` app bind_dst
where
sequence` {app_symb, app_args} bind_dst sequenceState=:{ss_aliasDummyId}
| app_symb.symb_name==ss_aliasDummyId
// the compiled source was a strict alias like "#! x = y"
= case hd app_args of
Var bound_var=:{var_info_ptr}
# (vi, ss_varHeap) = readPtr var_info_ptr sequenceState.ss_varHeap
non_alias_bound_var = case vi of
VI_SequenceNumber _ -> bound_var
VI_Alias alias_bound_var-> alias_bound_var
ss_varHeap = writePtr bind_dst.fv_info_ptr (VI_Alias non_alias_bound_var) ss_varHeap
-> { sequenceState & ss_varHeap = ss_varHeap }
_
-> sequence bind_dst sequenceState
= sequence bind_dst sequenceState
// ..MW
sequence bind
= sequence bind.bind_dst
......
......@@ -15,7 +15,6 @@ convertIndex :: !Index !Index !(Optional ConversionTable) -> !Index
determineTypeOfMemberInstance :: !SymbolType ![TypeVar] !InstanceType !Specials !*TypeHeaps -> (!SymbolType, !Specials, !*TypeHeaps)
arrayFunOffsetToPD_IndexTable :: !{# MemberDef} !v:{# PredefinedSymbol} -> (!{# Index}, !{#MemberDef}, !v:{#PredefinedSymbol})
arrayFunOffsetToPD_IndexTable :: !w:{# MemberDef} !v:{# PredefinedSymbol} -> (!{# Index}, !x:{#MemberDef}, !v:{#PredefinedSymbol}) , [w<=x]
makeElemTypeOfArrayFunctionStrict :: !SymbolType !Index !{# Index} -> SymbolType
......@@ -2197,14 +2197,14 @@ where
| bind_dst == fv_info_ptr
# (var_expr_ptr, expr_heap) = newPtr EI_Empty expr_heap
(let_expr_ptr, expr_heap) = newPtr EI_Empty expr_heap
-> (Let { let_lazy_binds = [], let_strict_binds = [
-> (Let { let_strict_binds = [], let_lazy_binds= [
{ bind_src = Var { var_name = fv_name, var_info_ptr = fv_info_ptr, var_expr_ptr = var_expr_ptr },
bind_dst = { fv_name = name, fv_info_ptr = var_info, fv_def_level = NotALevel, fv_count = 0 }}],
let_expr = result_expr, let_info_ptr = let_expr_ptr}, var_store, expr_heap, opt_dynamics, cs)
# (var_expr_ptr1, expr_heap) = newPtr EI_Empty expr_heap
(var_expr_ptr2, expr_heap) = newPtr EI_Empty expr_heap
(let_expr_ptr, expr_heap) = newPtr EI_Empty expr_heap
-> (Let { let_lazy_binds = [], let_strict_binds = [
-> (Let { let_strict_binds = [], let_lazy_binds= [
{ bind_src = Var { var_name = fv_name, var_info_ptr = fv_info_ptr, var_expr_ptr = var_expr_ptr1 },
bind_dst = { fv_name = name, fv_info_ptr = var_info, fv_def_level = NotALevel, fv_count = 0 }},
{ bind_src = Var { var_name = fv_name, var_info_ptr = fv_info_ptr, var_expr_ptr = var_expr_ptr2 },
......@@ -2215,10 +2215,11 @@ where
-> (result_expr, var_store, expr_heap, opt_dynamics, cs)
# (var_expr_ptr, expr_heap) = newPtr EI_Empty expr_heap
(let_expr_ptr, expr_heap) = newPtr EI_Empty expr_heap
-> (Let { let_lazy_binds = [], let_strict_binds =
-> (Let { let_strict_binds = [], let_lazy_binds=
[{ bind_src = Var { var_name = fv_name, var_info_ptr = fv_info_ptr, var_expr_ptr = var_expr_ptr },
bind_dst = { fv_name = name, fv_info_ptr = var_info, fv_def_level = NotALevel, fv_count = 0 }}],
let_expr = result_expr, let_info_ptr = let_expr_ptr}, var_store, expr_heap, opt_dynamics, cs)
transform_pattern_into_cases (AP_Algebraic cons_symbol type_index args opt_var) fun_arg result_expr var_store expr_heap opt_dynamics cs
# (var_args, result_expr, var_store, expr_heap, opt_dynamics, cs) = convertSubPatterns args result_expr var_store expr_heap opt_dynamics cs
type_symbol = {glob_module = cons_symbol.glob_module, glob_object = type_index}
......@@ -2335,13 +2336,14 @@ checkFunctions mod_index level from_index to_index fun_defs e_info heaps cs
checkMacros :: !Index !IndexRange !*{#FunDef} !*ExpressionInfo !*Heaps !*CheckState
-> (!*{#FunDef}, !*ExpressionInfo, !*Heaps, !*CheckState);
checkMacros mod_index range fun_defs e_info=:{ef_is_macro_fun=ef_is_macro_fun_old} heaps cs
# (fun_defs, e_info, heaps=:{hp_var_heap, hp_expression_heap}, cs=:{cs_symbol_table,cs_error})
# (fun_defs, e_info, heaps=:{hp_var_heap, hp_expression_heap}, cs=:{cs_symbol_table, cs_predef_symbols, cs_error})
= checkFunctions mod_index cGlobalScope range.ir_from range.ir_to fun_defs { e_info & ef_is_macro_fun=True } heaps cs
(e_info=:{ef_modules}) = { e_info & ef_is_macro_fun=ef_is_macro_fun_old }
(pds_alias_dummy, cs_predef_symbols) = cs_predef_symbols![PD_DummyForStrictAliasFun]
(fun_defs, ef_modules, hp_var_heap, hp_expression_heap, cs_symbol_table, cs_error)
= partitionateMacros range mod_index fun_defs ef_modules hp_var_heap hp_expression_heap cs_symbol_table cs_error
= partitionateMacros range mod_index pds_alias_dummy fun_defs ef_modules hp_var_heap hp_expression_heap cs_symbol_table cs_error
= (fun_defs, { e_info & ef_modules = ef_modules }, {heaps & hp_var_heap = hp_var_heap, hp_expression_heap = hp_expression_heap},
{ cs & cs_symbol_table = cs_symbol_table, cs_error = cs_error })
{ cs & cs_symbol_table = cs_symbol_table, cs_predef_symbols = cs_predef_symbols, cs_error = cs_error })
checkInstanceBodies :: !IndexRange !*{#FunDef} !*ExpressionInfo !*Heaps !*CheckState -> (!*{#FunDef},!*ExpressionInfo,!*Heaps, !*CheckState);
checkInstanceBodies {ir_from, ir_to} fun_defs e_info heaps cs
......@@ -2670,8 +2672,9 @@ checkModule {mod_type,mod_name,mod_imports,mod_imported_objects,mod_defs = cdefs
= adjust_instance_types_of_array_functions_in_std_array_icl dcl_modules class_instances icl_functions cs_predef_symbols
(untransformed_fun_bodies, icl_functions) = copy_bodies icl_functions
(pds_alias_dummy, cs_predef_symbols) = cs_predef_symbols![PD_DummyForStrictAliasFun]
(groups, icl_functions, dcl_modules, var_heap, expr_heap, cs_symbol_table, cs_error)
= partitionateAndLiftFunctions [icl_global_function_range, icl_instances] cIclModIndex icl_functions
= partitionateAndLiftFunctions [icl_global_function_range, icl_instances] cIclModIndex pds_alias_dummy icl_functions
dcl_modules var_heap expr_heap cs_symbol_table cs_error
icl_common = { icl_common & com_type_defs = e_info.ef_type_defs, com_selector_defs = e_info.ef_selector_defs, com_class_defs = e_info.ef_class_defs,
com_cons_defs = e_info.ef_cons_defs, com_member_defs = e_info.ef_member_defs, com_instance_defs = class_instances }
......@@ -2930,9 +2933,9 @@ check_needed_modules_are_imported mod_name extension cs=:{cs_needed_modules}
cs_error = popErrorAdmin cs_error
-> { cs & cs_error = cs_error }
arrayFunOffsetToPD_IndexTable :: !{# MemberDef} !v:{# PredefinedSymbol} -> (!{# Index}, !{#MemberDef}, !v:{#PredefinedSymbol})
arrayFunOffsetToPD_IndexTable :: !w:{# MemberDef} !v:{# PredefinedSymbol} -> (!{# Index}, !x:{#MemberDef}, !v:{#PredefinedSymbol}) , [w<=x]
arrayFunOffsetToPD_IndexTable member_defs predef_symbols
# nr_of_array_functions = size member_defs
#! nr_of_array_functions = size member_defs
= iFoldSt offset_to_PD_index PD_CreateArrayFun (PD_CreateArrayFun + nr_of_array_functions)
(createArray nr_of_array_functions NoIndex, member_defs, predef_symbols)
where
......@@ -3063,26 +3066,26 @@ checkDclModule {mod_name,mod_imports,mod_defs} mod_index modules icl_functions h
mem_inst <- memb_inst_defs & spec_types <-: all_spec_types ] ++
reverse rev_special_defs) }
com_instance_defs = dcl_common.com_instance_defs
com_instance_defs = { inst_def \\ inst_def <- [ inst_def \\ inst_def <-: com_instance_defs ] ++ new_class_instances }
(com_member_defs, com_instance_defs, dcl_functions, cs)
= adjust_predefined_symbols mod_index dcl_common.com_member_defs com_instance_defs dcl_functions { cs & cs_error = cs_error }
e_info = { ef_type_defs = com_type_defs, ef_selector_defs = dcl_common.com_selector_defs, ef_class_defs = com_class_defs,
ef_cons_defs = dcl_common.com_cons_defs, ef_member_defs = dcl_common.com_member_defs, ef_modules = modules,
ef_cons_defs = dcl_common.com_cons_defs, ef_member_defs = com_member_defs, ef_modules = modules,
ef_is_macro_fun = False }
(icl_functions, e_info, heaps, cs)