From 8fe1fc0c2b0b10f64c43498481e738221fe03bb3 Mon Sep 17 00:00:00 2001
From: "Juan J. Martinez" <jjm@usebox.net>
Date: Mon, 12 Sep 2022 20:16:42 +0100
Subject: Track local variables, WIP code gen

---
 src/Micro/Asm/Sdcc.hs | 100 +++++++++++++++++++++++++++++---------------------
 1 file changed, 58 insertions(+), 42 deletions(-)

(limited to 'src/Micro/Asm/Sdcc.hs')

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
-- 
cgit v1.2.3