1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
|
/*
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 -> Preprocessor
:: Preprocessor
:== *PreprocessState -> *PreprocessState
:: PreprocessState
:== VarHeap
instance preprocess {#a} | preprocess a & Array {#} a where
preprocess aliasDummyId array
= foldStateA (preprocess aliasDummyId) array
instance preprocess [a] | preprocess a where
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
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_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 (OverloadedListPatterns _ 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
|
