Start working on Stage1 -> Stage2 re-assembler.

2 files changed, 55 insertions, 3 deletions

diff --git a/src/Language/Fiddle/Compiler.hs b/src/Language/Fiddle/Compiler.hs
index d3b519f..8d8d65c 100644
--- a/src/Language/Fiddle/Compiler.hs
+++ b/src/Language/Fiddle/Compiler.hs
@@ -12,7 +12,7 @@ data Level = Error | Warning | Info
 data Diagnostic = Diagnostic Level String SourceSpan
 
 -- Compilation monad. Has diagnostics. Optionally produces a value.
-data Compile s a = Compile (s -> (s, [Diagnostic], Maybe a))
+newtype Compile s a = Compile (s -> (s, [Diagnostic], Maybe a))
 
 instance Functor (Compile s) where
   fmap fn (Compile cfn) = Compile $ \s ->
diff --git a/src/Language/Fiddle/Compiler/Stage1.hs b/src/Language/Fiddle/Compiler/Stage1.hs
index d3f3e10..92ef09f 100644
--- a/src/Language/Fiddle/Compiler/Stage1.hs
+++ b/src/Language/Fiddle/Compiler/Stage1.hs
@@ -1,9 +1,61 @@
+{-# LANGUAGE DefaultSignatures #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE IncoherentInstances #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE UndecidableInstances #-}
+
 module Language.Fiddle.Compiler.Stage1 (toStage2) where
 
 import Control.Monad.Identity (Identity)
+import Data.Text (Text)
+import GHC.Generics
 import Language.Fiddle.Ast
+import Language.Fiddle.Compiler
+
+newtype Linkage = Linkage String
+
+-- Shorthand for Identity
+type I = Identity
+
+data Stage2CompilerState a
+  = Stage2CompilerState
+      -- Anonymous object type bodies that need to be re-linked
+      [(Linkage, ObjTypeBody Stage2 I a)]
+      -- Anonymous enum bodies that need to be re-linked
+      [(Linkage, EnumBody Stage2 I a)]
+
+class EasyStage2 t where
+  toS2 :: t s1 I a -> t s2 I a
+
+instance EasyStage2 Identifier where
+  toS2 (Identifier t a) = Identifier t a
+
+type M a = Compile (Stage2CompilerState a)
 
 -- The second stage is a simplified version of the AST without anonymous
 -- declarations.
-toStage2 :: FiddleUnit Stage1 Identity a -> FiddleUnit Stage2 Identity a
-toStage2 = undefined
+toStage2 :: FiddleUnit Stage1 I a -> Compile () (FiddleUnit Stage2 I a)
+toStage2 (FiddleUnit decls annot) =
+  subCompile (Stage2CompilerState [] []) $
+    FiddleUnit <$> mapM fiddleDeclToStage2 decls <*> pure annot
+
+fiddleDeclToStage2 :: FiddleDecl Stage1 I a -> M a (FiddleDecl Stage2 I a)
+fiddleDeclToStage2 = \case
+  (OptionDecl i1 i2 a) -> return $ OptionDecl (toS2 i1) (toS2 i2) a
+  (PackageDecl i body a) -> return $ PackageDecl (toS2 i) undefined a
+  (LocationDecl i expr a) -> LocationDecl (toS2 i) <$> toStage2Expr expr <*> pure a
+  (BitsDecl i typ a) -> return $ BitsDecl (toS2 i) undefined a
+  (ObjTypeDecl i body a) -> return $ ObjTypeDecl (toS2 i) undefined a
+  (ObjectDecl i expr typ a) ->
+    ObjectDecl (toS2 i) <$> toStage2Expr expr <*> pure undefined <*> pure a
+  _ -> undefined
+
+toStage2Expr :: Expression Stage1 I a -> M a (Expression Stage2 I a)
+toStage2Expr = \case
+  (Var i a) -> return $ Var (toS2 i) a
+  (LitNum t a) -> RealNum <$> parseNum t <*> pure a
+
+parseNum :: Text -> M a Integer
+parseNum = undefined