Basic Macro

#pragma indent
using Nemerle;
using Nemerle.Collections;
using Nemerle.Compiler;
using Nemerle.Compiler.Parsetree;
using Nemerle.Compiler.Typedtree;
using System;
using System.Collections.Generic;
using System.Linq;

namespace YobaBasic.Macro
    public macro Basic(expr) syntax("BASIC", expr)
        BasicIml.Transform(Macros.ImplicitCTX(), expr)

    public module BasicIml
        public Transform(typer: Typer, expr : PExpr) : PExpr
            Macros.DefineCTX(typer)
            def getStrAndLoc(expr)
                | PExpr.Literal(Literal where(RawString = rs)) =>
                    if (rs.Length == 0 || rs[0] != '<')
                        Message.FatalError(expr.Location,
                            "The literal in 'BASIC' macro must be recursive string.")
                    else
                        def str = rs.Substring(2, rs.Length - 4)
                        def loc = expr.Location
                        def loc = Location(loc.FileIndex, loc.Line, loc.Column + 2,
                                           loc.EndLine, loc.EndColumn - 2)
                        (str, loc)
                | _                                            =>
                     Message.FatalError(expr.Location,
                        "You must pass recursive string with basic code into 'BASIC' macro.")
            def mkLines(vars, lines, gotoLines)
                def mkExpr(exprs)
                    def filtered = exprs.Filter(e => !(e is <[ () ]> || e is <[]>))
                    <[{..$filtered}]>
                def mkLabel(n, loc)
                    if(gotoLines.Contains <| n)
                        def voidv = typer.Manager.InternalType.Void
                        PExpr.Typed(loc, TExpr.Label(voidv, n, voidv |> TExpr.DefaultValue))
                    else <[]>
                def pvars = vars.Select(Name).Map(v => <[mutable $(v : name)]>)
                def pbody = lines \
                    .OrderBy(_.num).NToList() \
                    .FoldRight(<[]>, (l, a) => mkExpr <| [mkLabel(l.num, l.numloc), l.expr, a])
                mkExpr <| pvars + [pbody]
            def mkError(parser)
                def (pos, expected) = parser.GetMaxRollbackPosAndNames()
                def expected = expected.NToList()
                def msg =
                    if (expected.IsEmpty) "Unexpected character."
                    else match (expected.DivideLast())
                        | ([], last) => $"Expected $last."
                        | (expected, last) => $"Expected ..$expected or $last."
                Message.FatalError(parser.ToLocation(pos, pos + 1), msg)
            def (code, loc) = getStrAndLoc <| expr
            typer.Env.Manager.MacroColors.PushUseSiteColor()
            try
                def parser = BasicParser(loc, code, typer)
                match(parser.Parse <| code)
                    | Some(r) => mkLines(parser.Variables, r, parser.GotoLines)
                    | None    => mkError <| parser
            catch
                | _ => <[]>
            finally
                typer.Env.Manager.MacroColors.PopColor()