Loop numbering. Dear god, loop numbering.

README.markdown

@@ -238,7 +238,6 @@ TODO
 *   Character tables ("strings" to everybody else)
 *   External routines
 *   Work out the analyses again and document them
-*   number ifs and repeats
 *   `repeat jmp`
 *   Addressing modes; rename instructions to match
 *   no two routines with same name
@@ -424,12 +423,12 @@ No duplicate declarations.
     = main:
     =   lda screen
     =   cmp screen
-    =   BEQ _label_0
+    =   BEQ _label_1
     =   tay
-    =   jmp _past_0
-    = _label_0:
+    =   jmp _past_1
+    = _label_1:
     =   tax
-    = _past_0:
+    = _past_1:
     =   sta screen
     =   rts
 
@@ -454,10 +453,51 @@ No duplicate declarations.
     = main:
     =   ldy zero
     =   
-    = _repeat_0:
+    = _repeat_1:
     =   inc screen
     =   dey
     =   cpy zero
-    =   BNE _repeat_0
+    =   BNE _repeat_1
     =   sty screen
     =   rts
+
+Nested ifs.
+
+    | routine main {
+    |   if beq {
+    |     if bcc {
+    |       lda #0
+    |     } else {
+    |       if bvs {
+    |         lda #1
+    |       } else {
+    |         lda #2
+    |       }
+    |     }
+    |   } else {
+    |     lda #3
+    |   }
+    | }
+    = .org 0
+    = .word $0801
+    = .org $0801
+    = .byte $10, $08, $c9, $07, $9e, $32, $30, $36, $31, $00, $00, $00
+    =   jmp main
+    = main:
+    =   BEQ _label_3
+    =   lda #3
+    =   jmp _past_3
+    = _label_3:
+    =   BCC _label_2
+    =   BVS _label_1
+    =   lda #2
+    =   jmp _past_1
+    = _label_1:
+    =   lda #1
+    = _past_1:
+    =   jmp _past_2
+    = _label_2:
+    =   lda #0
+    = _past_2:
+    = _past_3:
+    =   rts

src/Main.hs

@@ -8,7 +8,7 @@ import System.Exit
 
 import SixtyPical.Model
 import SixtyPical.Parser (parseProgram)
-import SixtyPical.Checker (checkProgram)
+import SixtyPical.Checker (checkAndTransformProgram)
 import SixtyPical.Analyzer (analyzeProgram)
 import SixtyPical.Emitter (emitProgram)
 
@@ -18,6 +18,11 @@ usage = do
     putStrLn "Usage: sixtypical (parse|check|analyze|emit) filename.60pical"
     exitWith $ ExitFailure 1
 
+checkProgram p =
+    case checkAndTransformProgram p of
+        Just newprog ->
+            True
+
 main = do
     args <- getArgs
     case args of
@@ -28,16 +33,16 @@ main = do
                     putStrLn $ show $ program
                 ("check", Right program) -> do
                     putStrLn $ show $ checkProgram program
-                ("analyze", Right program) -> do
-                    case checkProgram program of
-                        True ->
-                            putStrLn $ show $ analyzeProgram program
-                ("emit", Right program) -> do
-                    case checkProgram program of
-                        True ->
-                            case analyzeProgram program of
+                ("analyze", Right program) ->
+                    case checkAndTransformProgram program of
+                        Just newprog ->
+                            putStrLn $ show $ analyzeProgram newprog
+                ("emit", Right program) ->
+                    case checkAndTransformProgram program of
+                        Just newprog ->
+                            case analyzeProgram newprog of
                                 _ ->
-                                    putStr $ emitProgram program
+                                    putStr $ emitProgram newprog
                 (_, Left problem) -> do
                     hPutStrLn stderr (show problem)
                     exitWith $ ExitFailure 1

src/SixtyPical/Checker.hs

@@ -62,7 +62,67 @@ noDuplicateDecls p@(Program decls routines) =
             where
                 name = getDeclLocationName decl
 
-checkProgram program =
-    trueOrDie "missing 'main' routine" (routineDeclared "main" program) &&
-      trueOrDie "undeclared location" (allUsedLocationsDeclared program) &&
-      noDuplicateDecls program
+checkAndTransformProgram :: Program -> Maybe Program
+checkAndTransformProgram program =
+    if
+        trueOrDie "missing 'main' routine" (routineDeclared "main" program) &&
+        trueOrDie "undeclared location" (allUsedLocationsDeclared program) &&
+        noDuplicateDecls program
+      then
+        Just $ numberProgramLoops program
+      else Nothing
+
+-- - - - - - -
+
+-- in the following "number" means "assign a unique ID to" and "loop"
+-- means "REPEAT or IF" (because i'm in such a good mood)
+
+numberProgramLoops :: Program -> Program
+numberProgramLoops (Program decls routines) =
+    let
+        (routines', _) = numberRoutinesLoops routines 0
+    in
+        (Program decls routines')
+
+numberRoutinesLoops :: [Routine] -> InternalID -> ([Routine], InternalID)
+numberRoutinesLoops [] iid = ([], iid)
+numberRoutinesLoops (routine:routines) iid =
+    let
+        (routine', iid') = numberRoutineLoops routine iid
+        (routines', iid'') = numberRoutinesLoops routines iid'
+    in
+        ((routine':routines'), iid'')
+
+numberRoutineLoops :: Routine -> InternalID -> (Routine, InternalID)
+numberRoutineLoops (Routine name instrs) iid =
+    let
+        (instrs', iid') = numberBlockLoops instrs iid
+    in
+        ((Routine name instrs'), iid')
+
+numberBlockLoops :: [Instruction] -> InternalID -> ([Instruction], InternalID)
+numberBlockLoops [] iid = ([], iid)
+numberBlockLoops (instr:instrs) iid =
+    let
+        (instr', iid') = numberInstruction instr iid
+        (instrs', iid'') = numberBlockLoops instrs iid'
+    in
+        ((instr':instrs'), iid'')
+
+numberInstruction :: Instruction -> InternalID -> (Instruction, InternalID)
+numberInstruction (IF _ branch b1 b2) iid =
+    let
+        (b1', iid') = numberBlockLoops b1 iid
+        (b2', iid'') = numberBlockLoops b2 iid'
+        newIid = iid'' + 1
+        newInstr = IF newIid branch b1' b2'
+    in
+        (newInstr, newIid)
+numberInstruction (REPEAT _ branch blk) iid =
+    let
+        (blk', iid') = numberBlockLoops blk iid
+        newIid = iid' + 1
+        newInstr = REPEAT newIid branch blk'
+    in
+        (newInstr, newIid)
+numberInstruction i iid = (i, iid)