Track local variables, WIP code gen

5 files changed, 86 insertions, 70 deletions

diff --git a/src/Micro/Asm/Sdcc.hs b/src/Micro/Asm/Sdcc.hs
index 1fb05dd..a645129 100644
--- a/src/Micro/Asm/Sdcc.hs
+++ b/src/Micro/Asm/Sdcc.hs
@@ -1,16 +1,13 @@
 module Micro.Asm.Sdcc where
 
-import qualified Data.Map as Map
 import qualified Micro.Ast as A
-import Micro.Env (Sym (..), SymMap)
 
-toIdent :: A.Ident -> Bool -> String
-toIdent id False = "_" ++ id
-toIdent id True = id
+toIdent :: A.Ident -> String
+toIdent id = "_" ++ id
 
 toLabel :: A.Ident -> Bool -> String
-toLabel id False = toIdent id False ++ "::"
-toLabel id True = id ++ ":"
+toLabel id False = toIdent id ++ "::"
+toLabel id True = toIdent id ++ ":"
 
 toData :: A.Type -> String
 toData (A.Type t)
@@ -19,48 +16,67 @@ toData (A.Type t)
   | otherwise = ".ds 2"
 toData (A.FuncType _ _) = ".ds 2"
 
-toInit :: A.Type -> String
-toInit (A.Type t)
-  | t == "bool" || t == "u8" || t == "s8" = ".db"
-  | t == "u16" || t == "s16" = ".dw"
-  | otherwise = ".dw"
-toInit (A.FuncType _ _) = ".dw"
-
-onlyData :: SymMap -> [Sym]
-onlyData symm =
-  filter (\sym -> symRef sym) $
-    Map.elems symm
+toInit :: A.Type -> A.Expr -> String
+toInit (A.Type t) (A.Num v _)
+  | t == "bool" || t == "u8" || t == "s8" = ".db " ++ show v
+  | t == "u16" || t == "s16" = ".dw " ++ show v
+  | otherwise = ".dw " ++ show v
+toInit _ v = ".dw " ++ show v
 
 header :: String -> [String]
 header version = [";", "; File created by Micro v" ++ version ++ " (SDCC)", ";"]
 
-module' :: A.Expr -> [String]
-module' (A.Module name _) = ["\t.module " ++ name, "\t.optsdcc -mz80"]
-module' _ = ["\t.module main"] -- won't happen
+module' :: String -> String
+module' name = "\t.module " ++ name
 
-exports :: SymMap -> [String]
-exports symm =
-  [""]
-    ++ ( map (\sym -> "\t.globl " ++ toIdent (symId sym) False) $
-           Map.elems $ Map.filter (\sym -> not $ symPriv sym) symm
-       )
+optsdcc :: String
+optsdcc = "\t.optsdcc -mz80"
 
-dataVars :: SymMap -> [String]
-dataVars symm =
-  ["\n\t.area _DATA", "\t.area _INITIALIZED"]
-    ++ ( map (\sym -> toLabel (symId sym) (symPriv sym) ++ "\n\t" ++ toData (symType sym)) $
-           onlyData symm
-       )
+area :: String -> String
+area name = "\n\t.area " ++ name
 
-initVars :: SymMap -> [String]
-initVars symm =
-  ["\n\t.area _INITIALIZER"]
-    ++ ( map (\sym -> "__xinit_" ++ toLabel (symId sym) True ++ "\n\t" ++ toInit (symType sym) ++ " FIXME") $ onlyData symm
-       )
-    ++ ["\n\t.area _GSINIT", "\t.area _GSFINAL"]
+globl :: String -> String
+globl id = "\t.globl " ++ id
 
 code :: [String]
-code = ["\n\t.area _CODE"]
+code = [area "_CODE"]
+
+data Output = Output
+  { oPre :: [String],
+    oInit :: [String],
+    oData :: [String],
+    oCode :: [String]
+  }
+
+emit :: A.Expr -> Output
+emit x =
+  case x of
+    (A.Module name _) -> o {oPre = [module' name, optsdcc, ""]}
+    (A.Func ident params ret body priv anon pos) -> do
+      let out = map emit body
+      let code = concat (map oCode out)
+      o
+        { oPre = if priv then [] else [globl $ toIdent ident],
+          oCode = [toLabel ident priv] ++ code ++ (if last code /= "\tret" then ["\tret"] else [])
+        }
+    (A.Var id typ val priv False _) ->
+      o
+        { oPre = if priv then [] else [globl $ toIdent id],
+          oData = [toLabel id priv, "\t" ++ toData typ],
+          oInit = ["__xinit" ++ toLabel id True, "\t" ++ toInit typ val]
+        }
+    (A.Call (A.Variable id _) _ _) -> o {oCode = ["\tcall " ++ toIdent id]}
+    (A.Return (Just value) _) -> o {oCode = ["\tld hl, ???", "\tret"]}
+    (A.Return Nothing _) -> o {oCode = ["\tret"]}
+    _ -> o
+  where
+    o = Output [] [] [] []
 
-generate :: String -> SymMap -> [A.Expr] -> String
-generate version symm ast = unlines $ header version ++ module' (head ast) ++ exports symm ++ dataVars symm ++ code ++ initVars symm
+generate :: String -> [A.Expr] -> String
+generate version ast = do
+  out <- pure $ map emit ast
+  pre <- pure $ concat $ map oPre out
+  dat <- pure $ ["\n\t.area _DATA", "\t.area _INITIALIZED"] ++ concat (map oData out)
+  code <- pure $ ["\n\t.area _CODE"] ++ concat (map oCode out)
+  init <- pure $ ["\n\t.area _INITIALIZER"] ++ concat (map oInit out) ++ ["\n\t.area _GSINIT", "\t.area _GSFINAL"]
+  unlines $ header version ++ pre ++ dat ++ code ++ init
diff --git a/src/Micro/Ast.hs b/src/Micro/Ast.hs
index 45697de..ec9141e 100644
--- a/src/Micro/Ast.hs
+++ b/src/Micro/Ast.hs
@@ -24,8 +24,8 @@ data Expr
   | Bool' Bool SourcePos
   | BinOp Op SourcePos Expr Expr
   | Variable Ident SourcePos
-  | -- v type value private pos
-    Var Ident Type Expr Bool SourcePos
+  | -- v type value private local pos
+    Var Ident Type Expr Bool Bool SourcePos
   | -- fn [params] return body private anomyous pos
     Func Ident [FuncParam] (Maybe Type) [Expr] Bool Bool SourcePos
   | Call Expr [Expr] SourcePos
diff --git a/src/Micro/Compiler.hs b/src/Micro/Compiler.hs
index 89ba802..98fdae8 100644
--- a/src/Micro/Compiler.hs
+++ b/src/Micro/Compiler.hs
@@ -153,9 +153,9 @@ compileOne x = do
             Just err -> addError $ Error TypeError err pos
             Nothing -> pure rtyp
         _ -> addError $ Error NonCallable "non callable value in function call" pos
-    (A.Var ident typ val priv pos) -> do
+    (A.Var ident typ val priv local pos) -> do
       st <- get
-      (ev, errs) <- return $ foldlEither addSymUniq (stEnv st, stErr st) [Sym ident typ priv True pos]
+      (ev, errs) <- return $ foldlEither addSymUniq (stEnv st, stErr st) [Sym ident typ priv local pos]
       errs <-
         return $
           if not (definedType typ)
@@ -206,9 +206,9 @@ foldConstant x =
       fid <- foldConstant ident
       fargs <- traverse foldConstant args
       Right $ A.Call fid fargs pos
-    (A.Var ident typ val priv pos) -> do
+    (A.Var ident typ val priv local pos) -> do
       fv <- foldConstant val
-      Right $ A.Var ident typ fv priv pos
+      Right $ A.Var ident typ fv priv local pos
     (A.Return value pos) -> do
       fv <- traverse foldConstant value
       Right $ A.Return fv pos
@@ -231,6 +231,6 @@ compileToAst ast = do
 
 compile :: [A.Expr] -> Either [Error] String
 compile ast = do
-  sym <- evalState (compileAll ast) startState
+  _ <- evalState (compileAll ast) startState
   fast <- left (\e -> [e]) $ traverse foldConstant ast
-  return $ generate version sym fast
+  return $ generate version fast
diff --git a/src/Micro/Parser.hs b/src/Micro/Parser.hs
index 89f5bc0..2ac6b13 100644
--- a/src/Micro/Parser.hs
+++ b/src/Micro/Parser.hs
@@ -106,7 +106,7 @@ fdef ident priv anon pos = do
         do
           x <- fStatement
           pure $ [x]
-          <|> grVar True
+          <|> grVar True True
   return $ Func ident args rtyp (concat $ body) priv anon pos
 
 function :: Bool -> Parser Expr
@@ -117,26 +117,26 @@ function priv = do
   fdef ident priv False pos
 
 -- ident: type = value
-varWithValue :: Bool -> Parser Expr
-varWithValue priv = do
+varWithValue :: Bool -> Bool -> Parser Expr
+varWithValue local priv = do
   (ident, typ, _, pos) <- arg
   reservedOp "=" <?> "assignation"
   value <- expr
-  return $ Var ident typ value priv pos
+  return $ Var ident typ value priv local pos
 
 -- group variable declaration
-grVar :: Bool -> Parser [Expr]
-grVar priv = do
+grVar :: Bool -> Bool -> Parser [Expr]
+grVar local priv = do
   reserved "var"
-  xs <- parens $ commaSep $ varWithValue priv
+  xs <- parens $ commaSep $ varWithValue local priv
   reservedOp ";"
   return $ xs
 
 -- variable declaration
-var :: Bool -> Parser Expr
-var priv = do
+var :: Bool -> Bool -> Parser Expr
+var local priv = do
   reserved "var"
-  x <- varWithValue priv
+  x <- varWithValue priv local
   reservedOp ";"
   return $ x
 
@@ -194,12 +194,12 @@ exprStmt = do
 
 -- statements that appear in functions
 fStatement :: Parser Expr
-fStatement = try exprStmt <|> var True <|> return'
+fStatement = try exprStmt <|> var True True <|> return'
 
 -- top level statement
 statement :: Parser Expr
 statement =
-  try exprStmt <|> try (privateDf var)
+  try exprStmt <|> try (privateDf (var False))
     <|> return' -- this will raise an error
 
 module' :: Parser Expr
@@ -217,7 +217,7 @@ program = do
       do
         x <- try (privateDf function) <|> statement
         pure $ [x]
-        <|> privateDfn grVar
+        <|> privateDfn (grVar False)
   return $ [m] ++ (concat $ n)
 
 parse :: Parser [Expr]
diff --git a/test/Language.hs b/test/Language.hs
index 1965883..3e6a898 100644
--- a/test/Language.hs
+++ b/test/Language.hs
@@ -176,7 +176,7 @@ testCases =
           "module main\n\
           \var a: u8 = 10;"
           [ A.Module "main" $ newPos "-" 1 1,
-            A.Var "a" (A.Type "u8") (A.Num 10 $ newPos "-" 2 13) False $ newPos "-" 2 5
+            A.Var "a" (A.Type "u8") (A.Num 10 $ newPos "-" 2 13) False False $ newPos "-" 2 5
           ],
     TestLabel "parse a private variable declaration" $
       TestCase $
@@ -184,7 +184,7 @@ testCases =
           "module main\n\
           \private var a: u8 = 10;"
           [ A.Module "main" $ newPos "-" 1 1,
-            A.Var "a" (A.Type "u8") (A.Num 10 $ newPos "-" 2 21) True $ newPos "-" 2 13
+            A.Var "a" (A.Type "u8") (A.Num 10 $ newPos "-" 2 21) False True $ newPos "-" 2 13
           ],
     TestLabel "parse a group variable declaration" $
       TestCase $
@@ -193,8 +193,8 @@ testCases =
           \var (a: u8 = 10,\n\
           \b: bool = true);"
           [ A.Module "main" $ newPos "-" 1 1,
-            A.Var "a" (A.Type "u8") (A.Num 10 $ newPos "-" 2 14) False $ newPos "-" 2 6,
-            A.Var "b" (A.Type "bool") (A.Bool' True $ newPos "-" 3 11) False $ newPos "-" 3 1
+            A.Var "a" (A.Type "u8") (A.Num 10 $ newPos "-" 2 14) False False $ newPos "-" 2 6,
+            A.Var "b" (A.Type "bool") (A.Bool' True $ newPos "-" 3 11) False False $ newPos "-" 3 1
           ],
     TestLabel "parse a group of private variable declaration" $
       TestCase $
@@ -203,8 +203,8 @@ testCases =
           \private var (a: u8 = 10,\n\
           \b: bool = true);"
           [ A.Module "main" $ newPos "-" 1 1,
-            A.Var "a" (A.Type "u8") (A.Num 10 $ newPos "-" 2 22) True $ newPos "-" 2 14,
-            A.Var "b" (A.Type "bool") (A.Bool' True $ newPos "-" 3 11) True $ newPos "-" 3 1
+            A.Var "a" (A.Type "u8") (A.Num 10 $ newPos "-" 2 22) True False $ newPos "-" 2 14,
+            A.Var "b" (A.Type "bool") (A.Bool' True $ newPos "-" 3 11) True False $ newPos "-" 3 1
           ],
     TestLabel "parse assignation" $
       TestCase $
@@ -213,7 +213,7 @@ testCases =
           \var a: u8 = 0;\n\
           \a = 10;"
           [ A.Module "main" $ newPos "-" 1 1,
-            A.Var "a" (A.Type "u8") (A.Num 0 $ newPos "-" 2 13) False $ newPos "-" 2 5,
+            A.Var "a" (A.Type "u8") (A.Num 0 $ newPos "-" 2 13) False False $ newPos "-" 2 5,
             A.BinOp A.Assign (newPos "-" 3 5) (A.Variable "a" $ newPos "-" 3 1) (A.Num 10 $ newPos "-" 3 5)
           ],
     TestLabel "fold constant addition" $