Commit bbee9443 authored by John van Groningen's avatar John van Groningen
Browse files

refactor, assign sequence numbers (VI_SequenceNumber and...

refactor, assign sequence numbers (VI_SequenceNumber and VI_AliasSequenceNumber) in declareVars in module backendconvert instead of sequence in module backendpreprocess, remove preprocess and sequence from module backendpreprocess
parent 9b27b895
......@@ -519,99 +519,117 @@ where
(write_to_var_heap cons_type_ptr VI_Empty be0)
be0
(|>) infixl
(|>) s f :== f s
:: DeclVarsInput :== Ident
:: *DeclVarsState = { dvs_backEnd :: !BackEnd, dvs_varHeap :: !*VarHeap, dvs_sequenceNumber :: !Int }
declareVariable :: Int (Ptr VarInfo) {#Char} !*DeclVarsState -> *DeclVarsState
declareVariable lhsOrRhs varInfoPtr name dvs
# (variable_sequence_number,dvs) = assignOrGetVariableSequenceNumber varInfoPtr dvs
= {dvs & dvs_backEnd = BEDeclareNodeId variable_sequence_number lhsOrRhs name dvs.dvs_backEnd}
where
assignOrGetVariableSequenceNumber :: !VarInfoPtr !*DeclVarsState -> (!Int,!*DeclVarsState)
assignOrGetVariableSequenceNumber varInfoPtr dvs=:{dvs_varHeap}
# (vi,dvs_varHeap) = readPtr varInfoPtr dvs_varHeap
#! dvs & dvs_varHeap=dvs_varHeap
= case vi of
VI_SequenceNumber sequenceNumber
-> (sequenceNumber,dvs)
VI_AliasSequenceNumber {var_info_ptr}
-> assignOrGetVariableSequenceNumber var_info_ptr dvs
_
# {dvs_sequenceNumber,dvs_varHeap} = dvs
dvs_varHeap = writePtr varInfoPtr (VI_SequenceNumber dvs_sequenceNumber) dvs_varHeap
dvs & dvs_sequenceNumber=dvs_sequenceNumber+1, dvs_varHeap=dvs_varHeap
-> (dvs_sequenceNumber,dvs)
class declareVars a :: a !DeclVarsInput -> BackEnder
class declareVars a :: a !DeclVarsInput !*DeclVarsState -> *DeclVarsState
instance declareVars [a] | declareVars a where
declareVars :: [a] !DeclVarsInput -> BackEnder | declareVars a
declareVars list dvInput
= foldState (flip declareVars dvInput) list
declareVars list dvInput dvs
= foldState (flip declareVars dvInput) list dvs
instance declareVars (Ptr VarInfo) where
declareVars varInfoPtr _
= declareVariable BELhsNodeId varInfoPtr "_var???" // +++ name
declareVars varInfoPtr _ dvs
= declareVariable BELhsNodeId varInfoPtr "_var???" dvs // +++ name
instance declareVars FreeVar where
declareVars :: FreeVar !DeclVarsInput -> BackEnder
declareVars freeVar _
= declareVariable BELhsNodeId freeVar.fv_info_ptr freeVar.fv_ident.id_name
declareVars freeVar _ dvs
= declareVariable BELhsNodeId freeVar.fv_info_ptr freeVar.fv_ident.id_name dvs
instance declareVars LetBind where
declareVars :: LetBind !DeclVarsInput -> BackEnder
declareVars {lb_src=App {app_symb, app_args=[Var _:_]}, lb_dst=freeVar} aliasDummyId
declareVars {lb_src=App {app_symb, app_args=[Var bound_var:_]}, lb_dst=freeVar} aliasDummyId dvs
| not (isNilPtr app_symb.symb_ident.id_info) && app_symb.symb_ident==aliasDummyId
= identity // we have an alias. Don't declare the same variable twice
= declareVariable BERhsNodeId freeVar.fv_info_ptr freeVar.fv_ident.id_name
declareVars {lb_dst=freeVar} _
= declareVariable BERhsNodeId freeVar.fv_info_ptr freeVar.fv_ident.id_name
declareVariable :: Int (Ptr VarInfo) {#Char} -> BackEnder
declareVariable lhsOrRhs varInfoPtr name
= \be0 -> let (variable_sequence_number,be) = getVariableSequenceNumber varInfoPtr be0 in
beDeclareNodeId variable_sequence_number lhsOrRhs name be
# (vi, dvs_varHeap) = readPtr bound_var.var_info_ptr dvs.dvs_varHeap
non_alias_bound_var = case vi of
VI_AliasSequenceNumber alias_bound_var -> alias_bound_var
_ -> bound_var
dvs & dvs_varHeap
= writePtr freeVar.fv_info_ptr (VI_AliasSequenceNumber non_alias_bound_var) dvs_varHeap
= dvs // we have an alias. Don't declare the same variable twice
= declareVariable BERhsNodeId freeVar.fv_info_ptr freeVar.fv_ident.id_name dvs
declareVars {lb_dst=freeVar} _ dvs
= declareVariable BERhsNodeId freeVar.fv_info_ptr freeVar.fv_ident.id_name dvs
instance declareVars (Optional a) | declareVars a where
declareVars :: (Optional a) !DeclVarsInput -> BackEnder | declareVars a
declareVars (Yes x) dvInput
= declareVars x dvInput
declareVars No _
= identity
declareVars (Yes x) dvInput dvs
= declareVars x dvInput dvs
declareVars No _ dvs
= dvs
instance declareVars FunctionPattern where
declareVars :: FunctionPattern !DeclVarsInput -> BackEnder
declareVars (FP_Algebraic _ freeVars) dvInput
= declareVars freeVars dvInput
declareVars (FP_Variable freeVar) dvInput
= declareVars freeVar dvInput
declareVars (FP_Algebraic _ freeVars) dvInput dvs
= declareVars freeVars dvInput dvs
declareVars (FP_Variable freeVar) dvInput dvs
= declareVars freeVar dvInput dvs
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_cond, if_then, if_else}) dvInput
= declareVars if_cond dvInput
o` declareVars if_then dvInput
o` declareVars if_else dvInput
declareVars (Case caseExpr) dvInput
= declareVars caseExpr dvInput
declareVars (AnyCodeExpr _ outParams _) _
= foldState declVar outParams
declareVars (Let {let_strict_binds, let_lazy_binds, let_expr}) dvInput dvs
= dvs |> declareVars let_strict_binds dvInput
|> declareVars let_lazy_binds dvInput
|> declareVars let_expr dvInput
declareVars (Conditional {if_cond, if_then, if_else}) dvInput dvs
= dvs |> declareVars if_cond dvInput
|> declareVars if_then dvInput
|> declareVars if_else dvInput
declareVars (Case caseExpr) dvInput dvs
= declareVars caseExpr dvInput dvs
declareVars (AnyCodeExpr _ outParams _) _ dvs
= foldState declVar outParams dvs
where
declVar {bind_dst=freeVar}
= declareVariable BERhsNodeId freeVar.fv_info_ptr freeVar.fv_ident.id_name
declareVars _ _
= identity
declareVars _ _ dvs
= dvs
instance declareVars TransformedBody where
declareVars :: TransformedBody !DeclVarsInput -> BackEnder
declareVars {tb_args, tb_rhs} dvInput
= declareVars tb_args dvInput
o` declareVars tb_rhs dvInput
declareVars {tb_args, tb_rhs} dvInput dvs
= dvs |> declareVars tb_args dvInput
|> declareVars tb_rhs dvInput
instance declareVars Case where
declareVars {case_expr, case_guards, case_default} dvInput
= declareVars case_guards dvInput
o` declareVars case_default dvInput
declareVars {case_expr, case_guards, case_default} dvInput dvs
= dvs |> declareVars case_guards dvInput
|> declareVars case_default dvInput
instance declareVars CasePatterns where
declareVars (AlgebraicPatterns _ patterns) dvInput
= declareVars patterns dvInput
declareVars (BasicPatterns _ patterns) dvInput
= declareVars patterns dvInput
declareVars (OverloadedPatterns _ decons_expr patterns) dvInput
= declareVars patterns dvInput
declareVars (AlgebraicPatterns _ patterns) dvInput dvs
= declareVars patterns dvInput dvs
declareVars (BasicPatterns _ patterns) dvInput dvs
= declareVars patterns dvInput dvs
declareVars (OverloadedPatterns _ decons_expr patterns) dvInput dvs
= declareVars patterns dvInput dvs
instance declareVars AlgebraicPattern where
declareVars {ap_vars, ap_expr} dvInput
= declareVars ap_vars dvInput
o` declareVars ap_expr dvInput
declareVars {ap_vars, ap_expr} dvInput dvs
= dvs |> declareVars ap_vars dvInput
|> declareVars ap_expr dvInput
instance declareVars BasicPattern where
declareVars {bp_expr} dvInput
= declareVars bp_expr dvInput
declareVars {bp_expr} dvInput dvs
= declareVars bp_expr dvInput dvs
class declare a :: ModuleIndex a -> BackEnder
......@@ -1883,14 +1901,14 @@ where
# (type_arg_p,bes) = beNoTypeArgs bes
= (type_arg_p,type_var_heap,bes)
convertTransformedBody :: Int Int Ident TransformedBody Int -> BEMonad BERuleAltP
convertTransformedBody functionIndex lineNumber aliasDummyId body main_dcl_module_n
convertTransformedBody :: Int Int Ident TransformedBody Int *BackEndState -> *(BERuleAltP,*BackEndState)
convertTransformedBody functionIndex lineNumber aliasDummyId body main_dcl_module_n bes
# {dvs_backEnd,dvs_varHeap}
= declareVars body aliasDummyId {dvs_backEnd=bes.bes_backEnd, dvs_varHeap=bes.bes_varHeap, dvs_sequenceNumber=0}
bes & bes_backEnd=dvs_backEnd, bes_varHeap=dvs_varHeap
| isCodeBlock body.tb_rhs
= declareVars body aliasDummyId
o` convertCodeBody functionIndex lineNumber aliasDummyId body main_dcl_module_n
// otherwise
= declareVars body aliasDummyId
o` convertBody True functionIndex lineNumber aliasDummyId (map FP_Variable body.tb_args) body.tb_rhs main_dcl_module_n
= convertCodeBody functionIndex lineNumber aliasDummyId body main_dcl_module_n bes
= convertBody True functionIndex lineNumber aliasDummyId (map FP_Variable body.tb_args) body.tb_rhs main_dcl_module_n bes
isCodeBlock :: Expression -> Bool
isCodeBlock (Case {case_expr=Var _, case_guards=AlgebraicPatterns _ [{ap_expr}]})
......
/*
module owner: Ronny Wichers Schreur
*/
implementation module backendpreprocess
// assign sequence numbers to all variables in the syntax tree
import checksupport
import Heap
import backendsupport
// import RWSDebug
backEndPreprocess :: !Ident ![Index] !IclModule !*VarHeap -> *VarHeap
backEndPreprocess aliasDummyId functionIndices iclModule varHeap
= preprocess aliasDummyId
[iclModule.icl_functions.[i] \\ i <- functionIndices] varHeap
class preprocess a :: !Ident a !*PreprocessState -> *PreprocessState
:: PreprocessState
:== VarHeap
instance preprocess {#a} | preprocess a & Array {#} a where
preprocess aliasDummyId array pst
= foldStateA (preprocess aliasDummyId) array pst
instance preprocess [a] | preprocess a where
preprocess aliasDummyId list pst
= foldState (preprocess aliasDummyId) list pst
// +++ this assigns sequence numbers per function, should be per alternative and move to backendconvert
instance preprocess FunDef where
preprocess aliasDummyId funDef pst
= fromSequencerToPreprocessor aliasDummyId (sequence funDef.fun_body) pst
class sequence a :: a -> Sequencer
:: Sequencer
:== *SequenceState -> *SequenceState
:: SequenceState
= {ss_sequenceNumber :: !Int, ss_varHeap :: .VarHeap, ss_aliasDummyId :: !Ident}
toSequenceState aliasDummyId varHeap
:== {ss_sequenceNumber = 0, ss_varHeap = varHeap, ss_aliasDummyId = aliasDummyId}
fromSequenceState sequenceState
:== sequenceState.ss_varHeap
fromSequencerToPreprocessor aliasDummyId sequencer
:== toSequenceState aliasDummyId
o` sequencer
o` fromSequenceState
assignSequenceNumber :: VarInfoPtr *SequenceState -> *SequenceState
assignSequenceNumber varInfoPtr sequenceState
# (varInfo, ss_varHeap) = readPtr varInfoPtr sequenceState.ss_varHeap
| alreadySequenced varInfo
= sequenceState
// otherwise
= { sequenceState
& ss_varHeap = writePtr varInfoPtr (VI_SequenceNumber sequenceState.ss_sequenceNumber) sequenceState.ss_varHeap
, ss_sequenceNumber = sequenceState.ss_sequenceNumber + 1
}
where
alreadySequenced :: VarInfo -> Bool
alreadySequenced (VI_SequenceNumber _)
= True
alreadySequenced (VI_AliasSequenceNumber _)
= True
alreadySequenced _
= False
instance sequence [a] | sequence a where
sequence list
= foldState sequence list
instance sequence (Optional a) | sequence a where
sequence (Yes x)
= sequence x
sequence No
= identity
// +++ this assigns sequence numbers per function, should be per alternative and moved to backendconvert
instance sequence FunctionBody where
sequence (TransformedBody transformedBody)
= sequence transformedBody
sequence body
= abort "preprocess (FunctionBody): unknown body"// <<- body
// case test ...
instance sequence TransformedBody where
sequence body
= sequence body.tb_args
o` sequence body.tb_rhs
// ... case test
instance sequence FreeVar where
sequence freeVar
= sequence freeVar.fv_info_ptr
instance sequence Expression where
sequence (Let {let_strict_binds, let_lazy_binds, let_expr})
= sequence let_strict_binds
o` sequence let_lazy_binds
o` sequence let_expr
sequence (Conditional {if_cond, if_then, if_else})
= sequence if_cond
o` sequence if_then
o` sequence if_else
sequence (App {app_args})
= sequence app_args
sequence (f @ arg)
= sequence f
o` sequence arg
sequence (Selection _ exp selections)
= sequence exp
o` sequence selections
sequence (AnyCodeExpr _ outParams _)
= foldState (\{bind_dst}->sequence bind_dst) outParams
sequence (Case caseExpr)
= sequence caseExpr
sequence _
= identity
instance sequence Case where
sequence {case_expr, case_guards, case_default}
= sequence case_expr
o` sequence case_guards
o` sequence case_default
instance sequence CasePatterns where
sequence (AlgebraicPatterns _ patterns)
= sequence patterns
sequence (BasicPatterns _ patterns)
= sequence patterns
sequence (OverloadedPatterns _ decons_expr patterns)
= sequence patterns
instance sequence AlgebraicPattern where
sequence {ap_vars, ap_expr}
= sequence ap_vars
o` sequence ap_expr
instance sequence BasicPattern where
sequence {bp_expr}
= sequence bp_expr
instance sequence Selection where
sequence (RecordSelection _ _)
= identity
sequence (ArraySelection _ _ index)
= sequence index
sequence (DictionarySelection dictionaryVar dictionarySelections _ index)
= sequence index
instance sequence LetBind where
sequence {lb_src=App app , lb_dst}
= sequence` app lb_dst
where
sequence` {app_symb, app_args} lb_dst sequenceState=:{ss_aliasDummyId}
| not (isNilPtr app_symb.symb_ident.id_info) // nilPtr's are generated for Case's with case_ident=No in convertcases
&& app_symb.symb_ident==ss_aliasDummyId
// the compiled source was a strict alias like "#! x = y"
= case hd app_args of
Var bound_var=:{var_info_ptr}
# sequenceState = assignSequenceNumber var_info_ptr sequenceState
(vi, ss_varHeap) = readPtr var_info_ptr sequenceState.ss_varHeap
non_alias_bound_var = case vi of
VI_SequenceNumber _ -> bound_var
VI_AliasSequenceNumber alias_bound_var-> alias_bound_var
ss_varHeap = writePtr lb_dst.fv_info_ptr (VI_AliasSequenceNumber non_alias_bound_var) ss_varHeap
-> { sequenceState & ss_varHeap = ss_varHeap }
_
-> sequence lb_dst sequenceState
= sequence lb_dst sequenceState
sequence bind
= sequence bind.lb_dst
instance sequence (Ptr VarInfo) where
sequence varInfoPtr
= assignSequenceNumber varInfoPtr
= varHeap
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment