From f43612e6169d928faeabcf349ee3e6ef679bee24 Mon Sep 17 00:00:00 2001 From: Cat's Eye Technologies Date: Fri, 11 Apr 2014 22:13:35 +0100 Subject: [PATCH] Initial, awkward support for temporaries, with failing test. --- doc/Emitting.markdown | 37 +++++++++++++++++++++++++++++++++++++ src/SixtyPical/Analyzer.hs | 6 +++--- src/SixtyPical/Checker.hs | 4 ++-- src/SixtyPical/Context.hs | 2 +- src/SixtyPical/Emitter.hs | 6 +++--- src/SixtyPical/Model.hs | 16 ++++++++++------ src/SixtyPical/Parser.hs | 32 +++++++++++++++++++++----------- 7 files changed, 77 insertions(+), 26 deletions(-) diff --git a/doc/Emitting.markdown b/doc/Emitting.markdown index 1671539..f156af7 100644 --- a/doc/Emitting.markdown +++ b/doc/Emitting.markdown @@ -211,3 +211,40 @@ Reserving and assigning byte tables. = .space frequencies 16 = .alias screen 1024 +Temporary storage. Note that these temporaries are not unioned yet, but +they could be. + + | routine a + | temporary byte foo + | temporary word bar { + | lda foo + | sta >bar + | } + | routine b + | temporary byte baz + | temporary word quuz { + | lda baz + | sta InternalID -> (Routine, InternalID) -numberRoutineLoops (Routine name outputs instrs) iid = +numberRoutineLoops (Routine name outputs temps instrs) iid = let (instrs', iid') = numberBlockLoops instrs iid in - ((Routine name outputs instrs'), iid') + ((Routine name outputs temps instrs'), iid') numberBlockLoops :: [Instruction] -> InternalID -> ([Instruction], InternalID) numberBlockLoops [] iid = ([], iid) diff --git a/src/SixtyPical/Context.hs b/src/SixtyPical/Context.hs index 9453d0e..4f3f98a 100644 --- a/src/SixtyPical/Context.hs +++ b/src/SixtyPical/Context.hs @@ -65,7 +65,7 @@ ppAnalysis program progCtx = ppRoutines program [] = return () ppRoutines program ((name, routCtx):rest) = let - Just (Routine rname outputs _) = lookupRoutine program name + Just (Routine rname outputs temps _) = lookupRoutine program name in do putStrLn (rname ++ " (" ++ (show outputs) ++ ")") ppRoutine routCtx diff --git a/src/SixtyPical/Emitter.hs b/src/SixtyPical/Emitter.hs index 43369d2..df11d37 100644 --- a/src/SixtyPical/Emitter.hs +++ b/src/SixtyPical/Emitter.hs @@ -8,8 +8,8 @@ import SixtyPical.Model emitProgram p@(Program decls routines) = let - mains = filter (\(Routine name _ _) -> name == "main") routines - allElse = filter (\(Routine name _ _) -> name /= "main") routines + mains = filter (\(Routine name _ _ _) -> name == "main") routines + allElse = filter (\(Routine name _ _ _) -> name /= "main") routines initializedDecls = filter (\d -> isInitializedDecl d) decls uninitializedDecls = filter (\d -> not $ isInitializedDecl d) decls in @@ -47,7 +47,7 @@ emitRoutines _ [] = "" emitRoutines p (rout:routs) = emitRoutine p rout ++ "\n" ++ emitRoutines p routs -emitRoutine p r@(Routine name _ instrs) = +emitRoutine p r@(Routine name _ _ instrs) = name ++ ":\n" ++ emitInstrs p r instrs ++ " rts\n" emitInstrs _ _ [] = "" diff --git a/src/SixtyPical/Model.hs b/src/SixtyPical/Model.hs index b790ff0..5ee1046 100644 --- a/src/SixtyPical/Model.hs +++ b/src/SixtyPical/Model.hs @@ -81,7 +81,11 @@ data Instruction = COPY StorageLocation StorageLocation | NOP deriving (Show, Ord, Eq) -data Routine = Routine RoutineName [StorageLocation] [Instruction] +data Temporary = Temporary InternalID LocationName StorageType + deriving (Show, Ord, Eq) + +-- name outputs temporaries body +data Routine = Routine RoutineName [StorageLocation] [Temporary] [Instruction] deriving (Show, Ord, Eq) data Program = Program [Decl] [Routine] @@ -93,7 +97,7 @@ data Program = Program [Decl] [Routine] programSummary p@(Program decls routs) = show ((length $ show p) < 99999) -getRoutineName (Routine name _ _) = name +getRoutineName (Routine name _ _ _) = name getDeclLocationName (Assign name _ _) = name getDeclLocationName (Reserve name _ _) = name @@ -133,8 +137,8 @@ mapBlock :: (Instruction -> Instruction) -> [Instruction] -> [Instruction] mapBlock = map mapRoutine :: (Instruction -> Instruction) -> Routine -> Routine -mapRoutine f (Routine name outputs instrs) = - Routine name outputs (mapBlock f instrs) +mapRoutine f (Routine name outputs temps instrs) = + Routine name outputs temps (mapBlock f instrs) mapRoutines :: (Instruction -> Instruction) -> [Routine] -> [Routine] mapRoutines f [] = [] @@ -151,7 +155,7 @@ foldBlock :: (Instruction -> a -> a) -> a -> [Instruction] -> a foldBlock = foldr foldRoutine :: (Instruction -> a -> a) -> a -> Routine -> a -foldRoutine f a (Routine name outputs instrs) = +foldRoutine f a (Routine name outputs temps instrs) = foldBlock f a instrs foldRoutines :: (Instruction -> a -> a) -> a -> [Routine] -> a @@ -180,6 +184,6 @@ lookupRoutine (Program _ routines) name = lookupRoutine' routines name lookupRoutine' [] _ = Nothing -lookupRoutine' (rout@(Routine rname _ _):routs) name +lookupRoutine' (rout@(Routine rname _ _ _):routs) name | rname == name = Just rout | otherwise = lookupRoutine' routs name diff --git a/src/SixtyPical/Parser.hs b/src/SixtyPical/Parser.hs index 683b278..1df9ba7 100644 --- a/src/SixtyPical/Parser.hs +++ b/src/SixtyPical/Parser.hs @@ -10,14 +10,15 @@ import SixtyPical.Model {- -Toplevel := {Decl} {Routine}. -Decl := "reserve" StorageType LocationName [":" Literal] - | "assign" StorageType LocationName Literal - | "external" RoutineName Address. -StorageType := "byte" ["[" Literal "]"] | "word" | "vector". -Routine := "routine" RoutineName ["outputs" "(" {LocationName} ")"] Block. -Block := "{" {Command} "}". -Command := "if" Branch Block "else" Block +Toplevel ::= {Decl} {Routine}. +Decl ::= "reserve" StorageType LocationName [":" Literal] + | "assign" StorageType LocationName Literal + | "external" RoutineName Address. +StorageType ::= "byte" ["[" Literal "]"] | "word" | "vector". +Routine ::= "routine" RoutineName ["outputs" "(" {LocationName} ")"] Block. +Block ::= "{" {Temporary} {Command} "}". +Temporary ::= "temporary" StorageType LocationName +Command ::= "if" Branch Block "else" Block | "lda" (LocationName | Immediate) | "ldx" (LocationName | Immediate) | "ldy" (LocationName | Immediate) @@ -78,10 +79,10 @@ assign :: Parser Decl assign = do string "assign" nspaces - sz <- storage_type + typ <- storage_type name <- location_name addr <- literal_address - return $ Assign name sz addr + return $ Assign name typ addr external :: Parser Decl external = do @@ -91,6 +92,14 @@ external = do addr <- literal_address return $ External name addr +temporary :: Parser Temporary +temporary = do + string "temporary" + nspaces + typ <- storage_type + name <- location_name + return $ Temporary 0 name typ + storage :: String -> StorageType -> Parser StorageType storage s t = do string s @@ -118,8 +127,9 @@ routine = do nspaces name <- routineName outputs <- (try routine_outputs <|> return []) + temps <- many temporary instrs <- block - return (Routine name outputs instrs) + return (Routine name outputs temps instrs) routine_outputs :: Parser [StorageLocation] routine_outputs = do