Initial, awkward support for block-level declarations, including a failing test.

README.markdown

@@ -90,6 +90,16 @@ poisoned in the result context.
 (Same should apply for `repeat` and `with` and, really, many other cases
 which there just aren't enough test cases for yet.)
 
+Declarations can have block scope.  Such declarations may only be used within
+the block in which they are declared.  `reserve`d storage inside a block is not,
+however, like a local variable (or `auto` in C); rather, it is more like a
+`static` in C, except the value at that address is not guaranteed to be
+retained between invokations of the block.  This is intended to be used for
+temporary storage.  In addition, if analysis of the call graph indicates that
+two such temporary addresses are never used simultaneously, they may be merged
+to the same address.  (This is, however, not yet implemented, and may not be
+implemented for a while.)
+
 ### "It's a Partial Solution" ###
 
 SixtyPical does not attempt to force your typed, abstractly interpreted
@@ -121,18 +131,6 @@ For more information, see the docs (which are written in the form of
 Falderal literate test suites.  If you have Falderal installed, you can run
 the tests with `./test.sh`.)
 
-Ideas
------
-
-These aren't implemented yet:
-
-*   Inside a routine, an address may be declared with `temporary`.  This is like
-    `static` in C, except the value at that address is not guaranteed to be
-    retained between invokations of the routine.  Such addresses may only be used
-    within the routine where they are declared.  If analysis indicates that two
-    temporary addresses are never used simultaneously, they may be merged
-    to the same address.
-
 Internals
 ---------
 

doc/Emitting.markdown

@@ -211,3 +211,40 @@ Reserving and assigning byte tables.
     = .space frequencies 16
     = .alias screen 1024
 
+Temporary storage, in the form of block-local declarations.  Note that these
+temporaries are not unioned yet, but they could be.
+
+    | routine a {
+    |     reserve byte foo
+    |     reserve word bar
+    |     lda foo
+    |     sta >bar
+    | }
+    | routine b {
+    |     reserve byte baz
+    |     reserve word quuz
+    |     lda baz
+    |     sta <quuz
+    | }
+    | routine main {
+    |     jsr a
+    |     jsr b
+    | }
+    = main:
+    =   jsr a
+    =   jsr b
+    =   rts
+    = a:
+    =   lda _temp_1
+    =   sta _temp_2+1
+    =   rts
+    = b:
+    =   lda _temp_3
+    =   sta _temp_4
+    =   rts
+    = 
+    = .data
+    = .space _temp_1 1
+    = .space _temp_2 2
+    = .space _temp_3 1
+    = .space _temp_4 2

src/SixtyPical/Analyzer.hs

@@ -23,13 +23,16 @@ analyzeProgram program@(Program decls routines) =
       
       checkRoutine (Routine name outputs instrs) progCtx routCtx =
           checkBlock name instrs progCtx routCtx
+
+      checkBlock nm (Block decls instrs) progCtx routCtx =
+          checkInstrs nm instrs progCtx routCtx
       
-      checkBlock nm [] progCtx routCtx = routCtx
-      checkBlock nm (instr:instrs) progCtx routCtx =
+      checkInstrs nm [] progCtx routCtx = routCtx
+      checkInstrs nm (instr:instrs) progCtx routCtx =
           let
               routCtx' = checkInstr nm instr progCtx routCtx
           in
-              checkBlock nm instrs progCtx routCtx'
+              checkInstrs nm instrs progCtx routCtx'
       
       -- -- -- -- -- -- -- -- -- -- -- --
       

src/SixtyPical/Checker.hs

@@ -72,18 +72,27 @@ numberRoutinesLoops (routine:routines) iid =
         ((routine':routines'), iid'')
 
 numberRoutineLoops :: Routine -> InternalID -> (Routine, InternalID)
-numberRoutineLoops (Routine name outputs instrs) iid =
+numberRoutineLoops (Routine name outputs block) iid =
     let
-        (instrs', iid') = numberBlockLoops instrs iid
+        (block', iid') = numberBlockLoops block iid
     in
-        ((Routine name outputs instrs'), iid')
+        ((Routine name outputs block'), iid')
 
-numberBlockLoops :: [Instruction] -> InternalID -> ([Instruction], InternalID)
-numberBlockLoops [] iid = ([], iid)
-numberBlockLoops (instr:instrs) iid =
+numberBlockLoops :: Block -> InternalID -> (Block, InternalID)
+numberBlockLoops block iid =
+    let
+        (Block decls instrs) = block
+        (instrs', iid') = numberInstrsLoops instrs iid
+        block' = Block decls instrs'
+    in
+        (block', iid')
+
+numberInstrsLoops :: [Instruction] -> InternalID -> ([Instruction], InternalID)
+numberInstrsLoops [] iid = ([], iid)
+numberInstrsLoops (instr:instrs) iid =
     let
         (instr', iid') = numberInstruction instr iid
-        (instrs', iid'') = numberBlockLoops instrs iid'
+        (instrs', iid'') = numberInstrsLoops instrs iid'
     in
         ((instr':instrs'), iid'')
 

src/SixtyPical/Emitter.hs

@@ -47,8 +47,11 @@ emitRoutines _ [] = ""
 emitRoutines p (rout:routs) =
     emitRoutine p rout ++ "\n" ++ emitRoutines p routs
 
-emitRoutine p r@(Routine name _ instrs) =
-    name ++ ":\n" ++ emitInstrs p r instrs ++ "  rts\n"
+emitRoutine p r@(Routine name _ block) =
+    name ++ ":\n" ++ emitBlock p r block ++ "  rts\n"
+
+emitBlock p r (Block decls instrs) =
+    emitInstrs p r instrs
 
 emitInstrs _ _ [] = ""
 emitInstrs p r (instr:instrs) =
@@ -161,30 +164,30 @@ emitInstr p r (DELTA (NamedLocation st label) (-1)) = "dec " ++ label
 
 emitInstr p r (IF iid branch b1 b2) =
     (show branch) ++ " _label_" ++ (show iid) ++ "\n" ++
-    emitInstrs p r b2 ++
+    emitBlock p r b2 ++
     "  jmp _past_" ++ (show iid) ++ "\n" ++
     "_label_" ++ (show iid) ++ ":\n" ++
-    emitInstrs p r b1 ++
+    emitBlock p r b1 ++
     "_past_" ++ (show iid) ++ ":"
 
 emitInstr p r (REPEAT iid branch blk) =
     "\n_repeat_" ++ (show iid) ++ ":\n" ++
-    emitInstrs p r blk ++
+    emitBlock p r blk ++
     "  " ++ (show branch) ++ " _repeat_" ++ (show iid)
 
 emitInstr p r (WITH SEI blk) =
     "sei\n" ++
-    emitInstrs p r blk ++
+    emitBlock p r blk ++
     "  cli"
 
 emitInstr p r (WITH (PUSH A) blk) =
     "pha\n" ++
-    emitInstrs p r blk ++
+    emitBlock p r blk ++
     "  pla"
 
 emitInstr p r (WITH (PUSH AllFlags) blk) =
     "php\n" ++
-    emitInstrs p r blk ++
+    emitBlock p r blk ++
     "  plp"
 
 emitInstr p r (COPYROUTINE src (NamedLocation (Just Vector) dst)) =

src/SixtyPical/Model.hs

@@ -60,6 +60,9 @@ data WithInstruction = SEI
                      | PUSH StorageLocation
     deriving (Show, Ord, Eq)
 
+data Block = Block [Decl] [Instruction]
+    deriving (Show, Ord, Eq)
+    
 data Instruction = COPY StorageLocation StorageLocation
                  | CMP StorageLocation StorageLocation
                  | ADD StorageLocation StorageLocation
@@ -73,15 +76,15 @@ data Instruction = COPY StorageLocation StorageLocation
                  | JSR RoutineName
               -- | JSRVECTOR StorageLocation
                  | JMPVECTOR StorageLocation
-                 | IF InternalID Branch [Instruction] [Instruction]
-                 | REPEAT InternalID Branch [Instruction]
+                 | IF InternalID Branch Block Block
+                 | REPEAT InternalID Branch Block
                  | DELTA StorageLocation DataValue
-                 | WITH WithInstruction [Instruction]
+                 | WITH WithInstruction Block
                  | COPYROUTINE RoutineName StorageLocation
                  | NOP
     deriving (Show, Ord, Eq)
 
-data Routine = Routine RoutineName [StorageLocation] [Instruction]
+data Routine = Routine RoutineName [StorageLocation] Block
     deriving (Show, Ord, Eq)
 
 data Program = Program [Decl] [Routine]
@@ -129,12 +132,16 @@ routineDeclared routName p =
 
 --
 
-mapBlock :: (Instruction -> Instruction) -> [Instruction] -> [Instruction]
-mapBlock = map
+mapInstrs :: (Instruction -> Instruction) -> [Instruction] -> [Instruction]
+mapInstrs = map
+
+mapBlock :: (Instruction -> Instruction) -> Block -> Block
+mapBlock f (Block decls instrs) =
+    Block decls (mapInstrs f instrs)
 
 mapRoutine :: (Instruction -> Instruction) -> Routine -> Routine
-mapRoutine f (Routine name outputs instrs) =
-    Routine name outputs (mapBlock f instrs)
+mapRoutine f (Routine name outputs block) =
+    Routine name outputs (mapBlock f block)
 
 mapRoutines :: (Instruction -> Instruction) -> [Routine] -> [Routine]
 mapRoutines f [] = []
@@ -147,8 +154,12 @@ mapProgramRoutines f (Program decls routs) =
 
 --
 
-foldBlock :: (Instruction -> a -> a) -> a -> [Instruction] -> a
-foldBlock = foldr
+foldInstrs :: (Instruction -> a -> a) -> a -> [Instruction] -> a
+foldInstrs = foldr
+
+foldBlock :: (Instruction -> a -> a) -> a -> Block -> a
+foldBlock f a (Block decls instrs) =
+    foldInstrs f a instrs
 
 foldRoutine :: (Instruction -> a -> a) -> a -> Routine -> a
 foldRoutine f a (Routine name outputs instrs) =

src/SixtyPical/Parser.hs

@@ -16,7 +16,7 @@ Decl     := "reserve" StorageType LocationName [":" Literal]
           | "external" RoutineName Address.
 StorageType := "byte" ["[" Literal "]"] | "word" | "vector".
 Routine  := "routine" RoutineName ["outputs" "(" {LocationName} ")"] Block.
-Block    := "{" {Command} "}".
+Block    := "{" {Decl} {Command} "}".
 Command  := "if" Branch Block "else" Block
           | "lda" (LocationName | Immediate)
           | "ldx" (LocationName | Immediate)
@@ -134,14 +134,15 @@ routine_outputs = do
 
 location = (try explicit_register <|> named_location)
 
-block :: Parser [Instruction]
+block :: Parser Block
 block = do
     string "{"
     nspaces
+    ds <- many decl
     cs <- many command
     string "}"
     nspaces
-    return cs
+    return (Block ds cs)
 
 -- -- -- -- -- -- commands -- -- -- -- --