diff --git a/stdlib/mlang/ast-builder.mc b/stdlib/mlang/ast-builder.mc index 5ce47b7a1..fe196fee0 100644 --- a/stdlib/mlang/ast-builder.mc +++ b/stdlib/mlang/ast-builder.mc @@ -12,6 +12,8 @@ recursive let mlang_bindF_ = use MLangAst in bindF_ (lam letexpr. lam expr. match letexpr with TmUse t then TmUse {t with inexpr = mlang_bindF_ f t.inexpr expr} + else match letexpr with TmInclude t then + TmInclude {t with inexpr = mlang_bindF_ f t.inexpr expr} else f letexpr expr -- Insert at the end of the chain ) letexpr expr @@ -34,6 +36,10 @@ let use_ = use UseAst in lam s. nuse_ (nameNoSym s) +let include_ = use IncludeAst in + lam p. + TmInclude {path = p, inexpr = uunit_, ty = tyunknown_, info = NoInfo {}} + -- Declarations -- diff --git a/stdlib/mlang/ast.mc b/stdlib/mlang/ast.mc index c2b481910..a551f11b4 100644 --- a/stdlib/mlang/ast.mc +++ b/stdlib/mlang/ast.mc @@ -35,6 +35,32 @@ lang UseAst = Ast (acc, TmUse {t with inexpr = inexpr}) end +--- TmInclude -- +lang IncludeAst = Ast + syn Expr = + | TmInclude {path : String, + inexpr : Expr, + ty : Type, + info : Info} + + sem infoTm = + | TmInclude t -> t.info + + sem tyTm = + | TmInclude t -> t.ty + + sem withInfo (info : Info) = + | TmInclude t -> TmInclude {t with info = info} + + sem withType (ty : Type) = + | TmInclude t -> TmInclude {t with ty = ty} + + sem smapAccumL_Expr_Expr (f : acc -> Expr -> (acc, Expr)) (acc : acc) = + | TmInclude t -> + match f acc t.inexpr with (acc, inexpr) in + (acc, TmInclude {t with inexpr = inexpr}) +end + -- Base fragment for MLang declarations -- lang DeclAst = Ast syn Decl = -- intentionally left blank @@ -142,7 +168,7 @@ lang MLangAst = MLangTopLevel -- Additional expressions - + UseAst + + UseAst + IncludeAst -- Declarations + LangDeclAst + SynDeclAst + SemDeclAst + LetDeclAst + TypeDeclAst diff --git a/stdlib/mlang/pprint.mc b/stdlib/mlang/pprint.mc index f6495caf1..b7b1d3bae 100644 --- a/stdlib/mlang/pprint.mc +++ b/stdlib/mlang/pprint.mc @@ -20,6 +20,18 @@ lang MLangIdentifierPrettyPrint = IdentifierPrettyPrint (env, s) end +lang IncludePrettyPrint = PrettyPrint + IncludeAst + sem isAtomic = + | TmInclude _ -> false + + sem pprintCode (indent : Int) (env: PprintEnv) = + | TmInclude t -> + match pprintCode indent env t.inexpr with (env,inexpr) in + (env, join ["include \"", escapeString t.path, "\"", pprintNewline indent, + "in", pprintNewline indent, + inexpr]) +end + lang UsePrettyPrint = PrettyPrint + UseAst + MLangIdentifierPrettyPrint sem isAtomic = @@ -207,7 +219,7 @@ end lang MLangPrettyPrint = MExprPrettyPrint + -- Extended expressions - UsePrettyPrint + + UsePrettyPrint + IncludePrettyPrint + -- Declarations DeclPrettyPrint + LangDeclPrettyPrint + SynDeclPrettyPrint + @@ -244,6 +256,7 @@ let prog: MLangProgram = { (pcon_ "Pear" (pvar_ "fs"), bindall_ [ ulet_ "strJoin" (unit_), + include_ "string.mc", appf2_ (var_ "strJoin") (var_ "x") (appf2_ (var_ "map") (var_ "float2string") (var_ "fs"))