diff options
-rw-r--r-- | src/Language/Fiddle/Compiler.hs | 2 | ||||
-rw-r--r-- | src/Language/Fiddle/Compiler/Stage1.hs | 56 |
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 |