diff options
Diffstat (limited to 'backend/backendconvert.icl')
| -rw-r--r-- | backend/backendconvert.icl | 150 |
1 files changed, 0 insertions, 150 deletions
diff --git a/backend/backendconvert.icl b/backend/backendconvert.icl index be93abc..958c444 100644 --- a/backend/backendconvert.icl +++ b/backend/backendconvert.icl @@ -314,7 +314,6 @@ 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) -// 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") @@ -419,80 +418,7 @@ 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 - declareVars list varHeap - = foldState (flip` declareVars varHeap) list - -instance declareVars (Ptr VarInfo) where - declareVars varInfoPtr varHeap - = declareVariable BELhsNodeId varInfoPtr "_var???" varHeap // +++ name - -instance declareVars FreeVar where - declareVars :: FreeVar VarHeap -> Backender - declareVars freeVar varHeap - = declareVariable BELhsNodeId freeVar.fv_info_ptr freeVar.fv_name.id_name varHeap - -instance declareVars (Bind a FreeVar) where - declareVars :: (Bind a FreeVar) VarHeap -> Backender - 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) VarHeap -> Backender | declareVars a - declareVars (Yes x) varHeap - = declareVars x varHeap - declareVars No _ - = identity - -instance declareVars FunctionPattern where - declareVars :: FunctionPattern !VarHeap -> Backender - declareVars (FP_Algebraic _ freeVars optionalVar) varHeap - = declareVars freeVars varHeap - o` declareVars optionalVar varHeap - declareVars (FP_Variable freeVar) varHeap - = declareVars freeVar varHeap - declareVars (FP_Basic _ optionalVar) varHeap - = declareVars optionalVar varHeap - declareVars FP_Empty varHeap - = identity - -instance declareVars Expression where - declareVars :: Expression !VarHeap -> Backender - declareVars (Let {let_strict_binds, let_lazy_binds, let_expr}) varHeap - = declareVars let_strict_binds varHeap - o` declareVars let_lazy_binds varHeap - o` declareVars let_expr varHeap - declareVars (Conditional {if_then, if_else}) varHeap - = declareVars if_then varHeap - o` declareVars if_else varHeap - declareVars (AnyCodeExpr _ outParams _) varHeap - = declareVars outParams varHeap - declareVars _ _ - = identity - -instance declareVars TransformedBody where - declareVars :: TransformedBody !VarHeap -> Backender - declareVars {tb_args, tb_rhs} varHeap - = declareVars tb_args varHeap - o` declareVars tb_rhs varHeap - -instance declareVars BackendBody where - declareVars :: BackendBody !VarHeap -> Backender - declareVars {bb_args, bb_rhs} varHeap - = declareVars bb_args varHeap - o` declareVars bb_rhs varHeap -*/ :: DeclVarsInput :== (!Ident, !VarHeap) class declareVars a :: a !DeclVarsInput -> Backender @@ -511,7 +437,6 @@ instance declareVars FreeVar where 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) @@ -553,7 +478,6 @@ instance declareVars Expression where 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 @@ -937,17 +861,6 @@ adjustArrayFunctions predefs arrayInstancesRange functions dcls varHeap adjustIclArrayInstance mapping index {fun_index} = beAdjustArrayFunction mapping.[fun_index] index cIclModIndex -/* -convertRules :: [(Int, FunDef)] VarHeap -> BEMonad BEImpRuleP -convertRules rules varHeap -// = foldr` (beRules o flip` convertRule varHeap) beNoRules rules - = 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) @@ -960,19 +873,13 @@ convertRules aliasDummyId rules varHeap be = (rulesP, be) convert [h:t] varHeap rulesP be # (ruleP, 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 -*/ 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) @@ -995,11 +902,6 @@ convertRule aliasDummyId (index, {fun_type=Yes type, fun_body=body, fun_pos, fun 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 @@ -1082,53 +984,37 @@ 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 -// 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)) -// 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 -// 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)) -// MW was:convertBackendBody functionIndex lineNumber body=:{bb_args, bb_rhs} varHeap convertBackendBody functionIndex lineNumber aliasDummyId body=:{bb_args, bb_rhs} varHeap = beNoNodeDefs ==> \noNodeDefs -// MW was -> declareVars body varHeap -> declareVars body (aliasDummyId, varHeap) o` beRuleAlt lineNumber (convertLhsNodeDefs bb_args noNodeDefs varHeap) (convertBackendLhs functionIndex bb_args varHeap) -// MW was: (convertRhsNodeDefs bb_rhs varHeap) (convertRhsNodeDefs aliasDummyId bb_rhs varHeap) (convertRhsStrictNodeIds bb_rhs varHeap) -// MW was: (convertRootExpr bb_rhs varHeap) (convertRootExpr aliasDummyId bb_rhs varHeap) convertStrings :: [{#Char}] -> BEMonad BEStringListP @@ -1197,16 +1083,6 @@ 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 -convertRootExpr (Conditional {if_cond=cond, if_then=then, if_else=Yes else}) varHeap - = convertConditional cond then else varHeap - 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 @@ -1217,29 +1093,21 @@ convertRootExpr aliasDummyId (Conditional {if_cond=cond, if_then=then, if_else=Y convertConditional aliasDummyId cond then else varHeap = beGuardNode (convertExpr cond varHeap) -// MW was: (convertRhsNodeDefs then varHeap) (convertRhsNodeDefs aliasDummyId then varHeap) (convertRhsStrictNodeIds then varHeap) -// MW was: (convertRootExpr then varHeap) (convertRootExpr aliasDummyId then varHeap) -// MW was: (convertRhsNodeDefs else varHeap) (convertRhsNodeDefs aliasDummyId else varHeap) (convertRhsStrictNodeIds else 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) -// MW was: (convertRhsNodeDefs then varHeap) (convertRhsNodeDefs aliasDummyId then varHeap) (convertRhsStrictNodeIds then varHeap) -// MW was: (convertRootExpr then varHeap) (convertRootExpr aliasDummyId then varHeap) beNoNodeDefs beNoStrictNodeIds (beNormalNode (beBasicSymbol BEFailSymb) beNoArgs) -// MW was:convertRootExpr expr varHeap convertRootExpr _ expr varHeap = convertExpr expr varHeap @@ -1269,14 +1137,8 @@ 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 :: 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 @@ -1293,15 +1155,9 @@ collectNodeDefs aliasDummyId (Let {let_strict_binds, let_lazy_binds}) -> [{ 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 @@ -1498,12 +1354,6 @@ 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 |