Add ContExpression syntax tree.

This is for expressions which must be calculatable at compile time.

1 files changed, 20 insertions, 8 deletions

diff --git a/src/Language/Fiddle/Compiler/Qualification.hs b/src/Language/Fiddle/Compiler/Qualification.hs
index 67d3f29..56f1122 100644
--- a/src/Language/Fiddle/Compiler/Qualification.hs
+++ b/src/Language/Fiddle/Compiler/Qualification.hs
@@ -94,6 +94,14 @@ instance
   where
   convertInStage _ _ _ _ = Present <$> uniqueString "reserved"
 
+instance AdvanceStage S (ConstExpression u) where
+  advanceStage ls (ConstExpression (RightV exp) a) =
+    case exp of
+      Var var _ -> do
+        (_, ExportedLocationDecl _ v) <- resolveOrFail =<< resolveName var ls
+        return $ ConstExpression (LeftV $ fromIntegral v) a
+      LitNum (RightV v) _ -> return $ ConstExpression (LeftV v) a
+
 deriving instance AdvanceStage S ObjTypeBody
 
 deriving instance AdvanceStage S DeferredRegisterBody
@@ -326,11 +334,11 @@ advanceFiddleDecls localState decls = fmap (reverse . fst) $ do
                   LocationDecl _ ident expr ann ->
                     let qualifiedName = qualify (NonEmpty.singleton (identToString ident))
                      in do
-                          exprValue <- expressionToIntM expr
+                          expr' <- advanceStage localState' expr
                           let decl =
                                 ExportedLocationDecl
                                   (metadata qualifiedName)
-                                  exprValue
+                                  (trueValue expr')
                           insertDecl decl
                           doReturn
                             =<< LocationDecl
@@ -355,7 +363,10 @@ advanceFiddleDecls localState decls = fmap (reverse . fst) $ do
                               <*> pure ann
                   ObjTypeDecl _ ident body ann ->
                     let qualifiedName = qualify (NonEmpty.singleton (identToString ident))
-                        localState'' = modifyCurrentScopePath (pushScope (NonEmpty.singleton $ identToString ident)) localState'
+                        localState'' =
+                          modifyCurrentScopePath
+                            (pushScope (NonEmpty.singleton $ identToString ident))
+                            localState'
                      in do
                           typeSize <- calculateTypeSize =<< resolveOrFail body
                           let decl =
@@ -373,7 +384,8 @@ advanceFiddleDecls localState decls = fmap (reverse . fst) $ do
                     let qualifiedName = qualify (NonEmpty.singleton (identToString ident))
                      in do
                           location <- resolveLocationExpression localState' loc
-                          exportedType <- objTypeToExport localState' typ
+                          typ' <- advanceStage localState' typ
+                          exportedType <- objTypeToExport localState' typ'
                           let decl =
                                 ExportedObjectDecl
                                   (metadata qualifiedName)
@@ -385,7 +397,7 @@ advanceFiddleDecls localState decls = fmap (reverse . fst) $ do
                               (qMd decl)
                               ident
                               <$> advanceStage localState' loc
-                              <*> advanceStage localState' typ
+                              <*> pure typ'
                               <*> pure ann
     )
     ([], localState)
@@ -395,16 +407,16 @@ insertDecl :: (ExportableDecl d) => d -> M ()
 insertDecl decl =
   modify $ \(GlobalState ui c) -> GlobalState (UnitInterface.insert decl ui) c
 
-objTypeToExport :: LocalState -> ObjType Expanded F A -> M ReferencedObjectType
+objTypeToExport :: LocalState -> ObjType Qualified F A -> M ReferencedObjectType
 objTypeToExport ls = \case
   ArrayObjType {arraySize = size, arrayObjType = objType} ->
     ArrayObjectType
       <$> objTypeToExport ls objType
-      <*> expressionToIntM size
+      <*> pure (trueValue size)
   ReferencedObjType {refName = n} -> do
     (full, _ :: ExportedTypeDecl) <- resolveOrFail =<< resolveName n ls
     case full of
-      (f:fs) -> return $ ReferencedObjectType (f :| fs)
+      (f : fs) -> return $ ReferencedObjectType (f :| fs)
       _ -> compilationFailure
 
 calculateTypeSize :: ObjTypeBody Expanded F A -> M (N Bytes)