diff --git a/src/stdlib/mexpr/json-debug.mc b/src/stdlib/mexpr/json-debug.mc index 52f1c5a55..753dd218e 100644 --- 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 index ae6162b5d..c0f8af9b0 100644 --- 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