wip

google-research · Oct 6, 2024 · 84ab4f7 · 84ab4f7
1 parent 23e8832
commit 84ab4f7
Show file tree

Hide file tree

Showing 14 changed files with 2,928 additions and 3,098 deletions.
diff --git a/dex.cabal b/dex.cabal
@@ -53,7 +53,7 @@ library
                      -- , Imp
                      -- , ImpToLLVM
                      , IncState
-                     -- , Inference
+                     , Inference
                      -- , Inline
                      -- , JAX.Concrete
                      -- , JAX.Rename
@@ -77,7 +77,7 @@ library
                      -- , RuntimePrint
                      -- , Serialize
                      -- , Simplify
-                     -- , Subst
+                      , Subst
                      , SourceRename
                      , SourceIdTraversal
                      , TopLevel2
@@ -89,7 +89,7 @@ library
                      , Types.Source
                      , Types.Top2
                      -- , QueryType
-                     -- , QueryTypePure
+                     , QueryTypePure
                      , Util
                      -- , Vectorize
                      , Actor

diff --git a/src/lib/AbstractSyntax.hs b/src/lib/AbstractSyntax.hs
@@ -101,9 +101,8 @@ checkSourceBlockParses = \case
 type SyntaxM = Except
 
 topDecl :: CTopDeclW -> SyntaxM UTopDecl
-topDecl (WithSrcs sid sids topDecl') = undefined
--- topDecl (WithSrcs sid sids topDecl') = case topDecl' of
---   CSDecl ann d -> UTopLet <$> decl ann (WithSrcs sid sids d)
+topDecl (WithSrcs sid sids topDecl') = case topDecl' of
+  CSDecl ann d -> topCSDecl ann (WithSrcs sid sids d)
 --   CData name tyConParams givens constructors -> do
 --     tyConParams' <- fromMaybeM tyConParams Empty aExplicitParams
 --     givens' <- aOptGivens givens
@@ -132,6 +131,29 @@ topDecl (WithSrcs sid sids topDecl') = undefined
 --     return $ UInterface params' methodTys (fromSourceNameW name) (toNest methodNames)
 --   CInstanceDecl def -> aInstanceDef def
 
+topCSDecl :: LetAnn -> CSDeclW -> SyntaxM UTopDecl
+topCSDecl ann (WithSrcs sid _ d) = case d of
+  CLet binder rhs -> do
+    (b, ann) <- topBinderOptAnn binder
+    UTopLet b ann <$> (asExpr <$> block rhs)
+  CDefDecl def -> do
+    (name, lam) <- aDef def
+    return $ UTopLet (fromSourceNameW name) Nothing (WithSrcE sid (ULam lam))
+  CExpr g -> UTopExpr <$> expr g
+  CPass -> error "not implemented"
+
+-- Binder pattern with an optional type annotation
+topBinderOptAnn :: GroupW -> SyntaxM (TopBinder, Maybe (UType VoidS))
+topBinderOptAnn = \case
+  WithSrcs _ _ (CBin Colon lhs typeAnn) -> (,) <$> topBinder lhs <*> (Just <$> expr typeAnn)
+  WithSrcs _ _ (CParens [g]) -> topBinderOptAnn g
+  g -> (,Nothing) <$> topBinder g
+
+topBinder :: GroupW -> SyntaxM TopBinder
+topBinder (WithSrcs sid _ b) = case b of
+  CLeaf (CIdentifier name) -> return $ fromSourceNameW $ WithSrc sid name
+  _ -> throw sid UnexpectedBinder
+
 decl :: LetAnn -> CSDeclW -> SyntaxM (UDecl VoidS VoidS)
 decl ann (WithSrcs sid _ d) = WithSrcB sid <$> case d of
   CLet binder rhs -> do

diff --git a/src/lib/ConcreteSyntax.hs b/src/lib/ConcreteSyntax.hs
@@ -56,7 +56,8 @@ parseUModule name s = do
 {-# SCC parseUModule #-}
 
 preludeImportBlock :: SourceBlock
-preludeImportBlock = SourceBlock 0 0 "" mempty (Misc $ ImportModule Prelude)
+preludeImportBlock = SourceBlock 0 0 "" mempty (Misc EmptyLines)
+-- preludeImportBlock = SourceBlock 0 0 "" mempty (Misc $ ImportModule Prelude)
 
 sourceBlocks :: Parser [SourceBlock]
 sourceBlocks = manyTill (sourceBlock <* outputLines) eof