Move exprAsDecl to mlang ast.mc

miking-lang · Jan 10, 2025 · 8a1c5fa · 8a1c5fa
1 parent 89221b7
commit 8a1c5fa
Show file tree

Hide file tree

Showing 2 changed files with 131 additions and 36 deletions.
diff --git a/src/stdlib/mexpr/json-debug.mc b/src/stdlib/mexpr/json-debug.mc
@@ -31,12 +31,6 @@ lang AstToJson = Ast + DeclAst
 
   sem infoToJson : Info -> JsonValue
   sem infoToJson = | info -> JsonString (info2str info)
-
-  -- TODO(vipa, 2024-05-16): This is a temporary helper until
-  -- https://github.com/miking-lang/miking/issues/826 is implemented
-  sem exprAsDecl : Expr -> Option (Decl, Expr)
-  sem exprAsDecl =
-  | _ -> None ()
 end
 
 lang VarToJson = AstToJson + VarAst
@@ -74,33 +68,7 @@ lang LamToJson = AstToJson + LamAst
     ] )
 end
 
-lang DeclsToJson = AstToJson + LetAst + LetDeclAst + RecLetsAst + RecLetsDeclAst + TypeAst + TypeDeclAst + DataAst + DataDeclAst + UtestAst + UtestDeclAst + ExtAst + ExtDeclAst
-  sem exprAsDecl =
-  | TmLet x -> Some
-    ( DeclLet {ident = x.ident, tyAnnot = x.tyAnnot, tyBody = x.tyBody, body = x.body, info = x.info}
-    , x.inexpr
-    )
-  | TmRecLets x -> Some
-    ( DeclRecLets {info = x.info, bindings = x.bindings}
-    , x.inexpr
-    )
-  | TmType x -> Some
-    ( DeclType {ident = x.ident, params = x.params, tyIdent = x.tyIdent, info = x.info}
-    , x.inexpr
-    )
-  | TmConDef x -> Some
-    ( DeclConDef {ident = x.ident, tyIdent = x.tyIdent, info = x.info}
-    , x.inexpr
-    )
-  | TmUtest x -> Some
-    ( DeclUtest {test = x.test, expected = x.expected, tusing = x.tusing, tonfail = x.tonfail, info = x.info}
-    , x.next
-    )
-  | TmExt x -> Some
-    ( DeclExt {ident = x.ident, tyIdent = x.tyIdent, effect = x.effect, info = x.info}
-    , x.inexpr
-    )
-
+lang DeclsToJson = AstToJson + MExprAsDecl
   sem exprToJson =
   | tm & (TmLet _ | TmRecLets _ | TmType _ | TmConDef _ | TmUtest _ | TmExt _) ->
     recursive let work = lam acc. lam expr.

diff --git a/src/stdlib/mlang/ast.mc b/src/stdlib/mlang/ast.mc
@@ -95,6 +95,17 @@ lang DeclAst = Ast
   sem sfold_Decl_Type f acc = | d -> (smapAccumL_Decl_Type (lam acc. lam a. (f acc a, a)) acc d).0
 end
 
+-- TODO(vipa, 2024-11-26): This enables working more or less as though
+-- https://github.com/miking-lang/miking/issues/826 were already
+-- implemented.
+lang ExprAsDecl = DeclAst
+  sem exprAsDecl : Expr -> Option (Decl, Expr)
+  sem exprAsDecl =
+  | _ -> None ()
+
+  sem declAsExpr : Expr -> Decl -> Expr
+end
+
 -- DeclLang --
 lang LangDeclAst = DeclAst
   syn Decl =
@@ -142,12 +153,12 @@ lang SynDeclAst = DeclAst
     (acc, DeclSyn {x with defs = defs})
 end
 
-lang SynProdExtDeclAst = DeclAst 
-  syn Decl = 
+lang SynProdExtDeclAst = DeclAst
+  syn Decl =
   | SynDeclProdExt {ident : Name,
                     extIdent : Name,
                     params : [Name],
-                    globalExt : Option Type, 
+                    globalExt : Option Type,
                     individualExts : [{ident : Name, tyIdent : Type}],
                     includes : [(String, String)],
                     info : Info}
@@ -233,6 +244,25 @@ lang LetDeclAst = DeclAst
     (acc, DeclLet {x with tyAnnot = tyAnnot, tyBody = tyBody})
 end
 
+lang LetAsDecl = ExprAsDecl + LetAst + LetDeclAst
+  sem exprAsDecl =
+  | TmLet x -> Some
+    ( DeclLet {ident = x.ident, tyAnnot = x.tyAnnot, tyBody = x.tyBody, body = x.body, info = x.info}
+    , x.inexpr
+    )
+
+  sem declAsExpr inexpr =
+  | DeclLet x -> TmLet
+    { ident = x.ident
+    , tyAnnot = x.tyAnnot
+    , tyBody = x.tyBody
+    , body = x.body
+    , info = x.info
+    , inexpr = inexpr
+    , ty = tyTm inexpr
+    }
+end
+
 -- DeclType --
 lang TypeDeclAst = DeclAst
   syn Decl =
@@ -253,6 +283,24 @@ lang TypeDeclAst = DeclAst
     (acc, DeclType {x with tyIdent = tyIdent})
 end
 
+lang TypeAsDecl = ExprAsDecl + TypeAst + TypeDeclAst
+  sem exprAsDecl =
+  | TmType x -> Some
+    ( DeclType {ident = x.ident, params = x.params, tyIdent = x.tyIdent, info = x.info}
+    , x.inexpr
+    )
+
+  sem declAsExpr inexpr =
+  | DeclType x -> TmType
+    { ident = x.ident
+    , params = x.params
+    , tyIdent = x.tyIdent
+    , info = x.info
+    , inexpr = inexpr
+    , ty = tyTm inexpr
+    }
+  end
+
 -- DeclRecLets --
 lang RecLetsDeclAst = DeclAst + RecLetsAst
   syn Decl =
@@ -283,6 +331,22 @@ lang RecLetsDeclAst = DeclAst + RecLetsAst
     (acc, DeclRecLets {x with bindings = bindings})
 end
 
+lang RecLetsAsDecl = ExprAsDecl + RecLetsAst + RecLetsDeclAst
+  sem exprAsDecl =
+  | TmRecLets x -> Some
+    ( DeclRecLets {info = x.info, bindings = x.bindings}
+    , x.inexpr
+    )
+
+  sem declAsExpr inexpr =
+  | DeclRecLets x -> TmRecLets
+    { bindings = x.bindings
+    , info = x.info
+    , inexpr = inexpr
+    , ty = tyTm inexpr
+    }
+end
+
 -- DeclConDef --
 lang DataDeclAst = DeclAst
   syn Decl =
@@ -302,6 +366,23 @@ lang DataDeclAst = DeclAst
     (acc, DeclConDef {x with tyIdent = tyIdent})
 end
 
+lang DataAsDecl = ExprAsDecl + DataAst + DataDeclAst
+  sem exprAsDecl =
+  | TmConDef x -> Some
+    ( DeclConDef {ident = x.ident, tyIdent = x.tyIdent, info = x.info}
+    , x.inexpr
+    )
+
+  sem declAsExpr inexpr =
+  | DeclConDef x -> TmConDef
+    { ident = x.ident
+    , tyIdent = x.tyIdent
+    , info = x.info
+    , inexpr = inexpr
+    , ty = tyTm inexpr
+    }
+end
+
 -- DeclUtest --
 lang UtestDeclAst = DeclAst
   syn Decl =
@@ -325,6 +406,25 @@ lang UtestDeclAst = DeclAst
     (acc, DeclUtest {x with test = test, expected = expected, tusing = tusing})
 end
 
+lang UtestAsDecl = ExprAsDecl + UtestAst + UtestDeclAst
+  sem exprAsDecl =
+  | TmUtest x -> Some
+    ( DeclUtest {test = x.test, expected = x.expected, tusing = x.tusing, tonfail = x.tonfail, info = x.info}
+    , x.next
+    )
+
+  sem declAsExpr inexpr =
+  | DeclUtest x -> TmUtest
+    { test = x.test
+    , expected = x.expected
+    , tusing = x.tusing
+    , tonfail = x.tonfail
+    , info = x.info
+    , next = inexpr
+    , ty = tyTm inexpr
+    }
+end
+
 -- DeclExt --
 lang ExtDeclAst = DeclAst
   syn Decl =
@@ -345,6 +445,24 @@ lang ExtDeclAst = DeclAst
     (acc, DeclExt {x with tyIdent = tyIdent})
 end
 
+lang ExtAsDecl = ExprAsDecl + ExtAst + ExtDeclAst
+  sem exprAsDecl =
+  | TmExt x -> Some
+    ( DeclExt {ident = x.ident, tyIdent = x.tyIdent, effect = x.effect, info = x.info}
+    , x.inexpr
+    )
+
+  sem declAsExpr inexpr =
+  | DeclExt x -> TmExt
+    { ident = x.ident
+    , tyIdent = x.tyIdent
+    , effect = x.effect
+    , info = x.info
+    , inexpr = inexpr
+    , ty = tyTm inexpr
+    }
+end
+
 -- DeclInclude --
 lang IncludeDeclAst = DeclAst
   syn Decl =
@@ -381,3 +499,12 @@ lang MLangAst =
   + TyUseAst + SynProdExtDeclAst
 
 end
+
+lang MExprAsDecl
+  = LetAsDecl
+  + TypeAsDecl
+  + RecLetsAsDecl
+  + DataAsDecl
+  + UtestAsDecl
+  + ExtAsDecl
+end