git @ Cat's Eye Technologies SixtyPical / 7a7127f
Get storage location renaming almost right. Cat's Eye Technologies 8 years ago
2 changed file(s) with 79 addition(s) and 20 deletion(s). Raw diff Collapse all Expand all
+1
-1
src/SixtyPical/Checker.hs less more
6464 let
6565 program' = numberProgramLoops program
6666 program'' = renameBlockDecls program'
67 program''' = liftBlockDecls program'
67 program''' = liftBlockDecls program''
6868 program'''' = fillOutNamedLocationTypes program'''
6969 in
7070 Just program''''
+78
-19
src/SixtyPical/Transformer.hs less more
149149 routines' = map renameRoutineDecls routines
150150 in
151151 Program decls routines'
152
153 renameRoutineDecls (Routine name outputs block) =
154 let
155 (Block decls _) = block
156 (id', block') = foldDeclsRenaming decls 0 block
157 in
158 (Routine name outputs block')
159
160 -- TODO accumulator has to range across all routines too!
161 foldDeclsRenaming [] id block = (id, block)
162 foldDeclsRenaming ((Reserve name typ Nothing):decls) id block =
163 let
164 newName = "_temp_" ++ (show id)
165 id' = id + 1
166 block' = mapBlockNames name newName block
167 block'' = substDeclName name newName block'
168 in
169 foldDeclsRenaming decls id' block''
170
171
172 -- this is kind of horrible. that we do it this way, i mean
173 substDeclName n1 n2 (Block decls instrs) =
174 Block (map (s) decls) instrs
152175 where
153 renameRoutineDecls (Routine name outputs block) =
154 let
155 (Block decls _) = block
156 block' = foldDeclsRenaming decls block
157 in
158 (Routine name outputs block')
159
160 -- TODO will have to return new decls too
161 -- TODO will have to take accumulator too
162 -- TODO accumulator has to range across all routines too!
163 foldDeclsRenaming [] block = block
164 foldDeclsRenaming ((Reserve name typ Nothing):decls) block =
165 let
166 newName = "_temp_1" -- TODO base this on accumulator
167 block' = mapBlockNames name newName block
168 in
169 foldDeclsRenaming decls block'
176 s d@(Reserve name typ Nothing)
177 | name == n1 = (Reserve n2 typ Nothing)
178 | otherwise = d
179
170180
171181 mapBlockNames n1 n2 (Block decls instrs) =
172182 (Block decls $ mapInstrsNames n1 n2 instrs)
173183
174 -- TODO: write this
175 mapInstrsNames n1 n2 instrs = instrs
184 mapInstrsNames n1 n2 instrs =
185 map (mapInstrName n1 n2) instrs
186
187 mapInstrName n1 n2 (COPY sl1 sl2) =
188 COPY (mapStorageLocationName n1 n2 sl1) (mapStorageLocationName n1 n2 sl2)
189 mapInstrName n1 n2 (CMP sl1 sl2) =
190 CMP (mapStorageLocationName n1 n2 sl1) (mapStorageLocationName n1 n2 sl2)
191 mapInstrName n1 n2 (ADD sl1 sl2) =
192 ADD (mapStorageLocationName n1 n2 sl1) (mapStorageLocationName n1 n2 sl2)
193 mapInstrName n1 n2 (AND sl1 sl2) =
194 AND (mapStorageLocationName n1 n2 sl1) (mapStorageLocationName n1 n2 sl2)
195 mapInstrName n1 n2 (SUB sl1 sl2) =
196 SUB (mapStorageLocationName n1 n2 sl1) (mapStorageLocationName n1 n2 sl2)
197 mapInstrName n1 n2 (OR sl1 sl2) =
198 OR (mapStorageLocationName n1 n2 sl1) (mapStorageLocationName n1 n2 sl2)
199
200 {-
201 | XOR StorageLocation StorageLocation
202 | SHL StorageLocation StorageLocation
203 | SHR StorageLocation StorageLocation
204 | BIT StorageLocation
205 | JMPVECTOR StorageLocation
206 | IF InternalID Branch Block Block
207 | REPEAT InternalID Branch Block
208 | DELTA StorageLocation DataValue
209 | WITH WithInstruction Block
210 | COPYROUTINE RoutineName StorageLocation
211 -}
212
213 mapInstrName n1 n2 other =
214 other
215
216 mapStorageLocationName n1 n2 (Indirect sl) =
217 Indirect $ mapStorageLocationName n1 n2 sl
218 mapStorageLocationName n1 n2 (Indexed sl1 sl2) =
219 Indexed (mapStorageLocationName n1 n2 sl1) sl2
220 mapStorageLocationName n1 n2 (IndirectIndexed sl1 sl2) =
221 IndirectIndexed (mapStorageLocationName n1 n2 sl1) sl2
222
223 mapStorageLocationName n1 n2 sl@(NamedLocation typ name)
224 | name == n1 = NamedLocation typ n2
225 | otherwise = sl
226
227 mapStorageLocationName n1 n2 (LowByteOf sl) =
228 LowByteOf $ mapStorageLocationName n1 n2 sl
229
230 mapStorageLocationName n1 n2 (HighByteOf sl) =
231 HighByteOf $ mapStorageLocationName n1 n2 sl
232
233 mapStorageLocationName n1 n2 other =
234 other
176235
177236 -- -- -- --
178237