/* * Copyright (c) 2003-2008 The University of Wroclaw. * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * 3. The name of the University may not be used to endorse or promote * products derived from this software without specific prior * written permission. * * THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY ``AS IS'' AND ANY EXPRESS OR * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN * NO EVENT SHALL THE UNIVERSITY BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED * TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */ using Nemerle.Compiler; using Nemerle.Compiler.Typedtree; using Nemerle; using System.Text.RegularExpressions; using Nemerle.Collections; using Nemerle.Utility; using PT = Nemerle.Compiler.Parsetree; using TT = Nemerle.Compiler.Typedtree; using SCG = System.Collections.Generic; [assembly: Nemerle.Internal.OperatorAttribute ("Nemerle.Core", "is", false, 210, 211)] [assembly: Nemerle.Internal.OperatorAttribute ("Nemerle.Core", ".", false, 285, 301)] [assembly: Nemerle.Internal.OperatorAttribute ("Nemerle.Core", "++", true, 283, 284)] [assembly: Nemerle.Internal.OperatorAttribute ("Nemerle.Core", "?", true, 283, 284)] [assembly: Nemerle.Internal.OperatorAttribute ("Nemerle.Core", "--", true, 283, 284)] [assembly: Nemerle.Internal.OperatorAttribute ("Nemerle.Core", "where", false, 284, 300)] [assembly: Nemerle.Internal.OperatorAttribute ("Nemerle.Core", "/", false, 260, 261)] [assembly: Nemerle.Internal.OperatorAttribute ("Nemerle.Core", "%", false, 260, 261)] [assembly: Nemerle.Internal.OperatorAttribute ("Nemerle.Core", "->", false, 251, 250)] [assembly: Nemerle.Internal.OperatorAttribute ("Nemerle.Core", ":", false, 270, 246)] [assembly: Nemerle.Internal.OperatorAttribute ("Nemerle.Core", ":>", false, 270, 246)] [assembly: Nemerle.Internal.OperatorAttribute ("Nemerle.Core", "+", false, 240, 241)] [assembly: Nemerle.Internal.OperatorAttribute ("Nemerle.Core", "-", false, 240, 241)] [assembly: Nemerle.Internal.OperatorAttribute ("Nemerle.Core", "<<", false, 230, 231)] [assembly: Nemerle.Internal.OperatorAttribute ("Nemerle.Core", ">>", false, 230, 231)] [assembly: Nemerle.Internal.OperatorAttribute ("Nemerle.Core", "::", false, 221, 220)] [assembly: Nemerle.Internal.OperatorAttribute ("Nemerle.Core", "in", false, 120, 121)] [assembly: Nemerle.Internal.OperatorAttribute ("Nemerle.Core", "..", false, 230, 231)] [assembly: Nemerle.Internal.OperatorAttribute ("Nemerle.Core", "as", false, 215, 301)] [assembly: Nemerle.Internal.OperatorAttribute ("Nemerle.Core", "<", false, 210, 211)] [assembly: Nemerle.Internal.OperatorAttribute ("Nemerle.Core", ">", false, 210, 211)] [assembly: Nemerle.Internal.OperatorAttribute ("Nemerle.Core", "<=", false, 210, 211)] [assembly: Nemerle.Internal.OperatorAttribute ("Nemerle.Core", ">=", false, 210, 211)] [assembly: Nemerle.Internal.OperatorAttribute ("Nemerle.Core", "&", false, 190, 191)] [assembly: Nemerle.Internal.OperatorAttribute ("Nemerle.Core", "%&", false, 190, 191)] [assembly: Nemerle.Internal.OperatorAttribute ("Nemerle.Core", "%&&", false, 190, 191)] [assembly: Nemerle.Internal.OperatorAttribute ("Nemerle.Core", "^", false, 180, 181)] [assembly: Nemerle.Internal.OperatorAttribute ("Nemerle.Core", "%^", false, 180, 181)] [assembly: Nemerle.Internal.OperatorAttribute ("Nemerle.Core", "|", false, 170, 171)] [assembly: Nemerle.Internal.OperatorAttribute ("Nemerle.Core", "%|", false, 170, 171)] [assembly: Nemerle.Internal.OperatorAttribute ("Nemerle.Core", "==", false, 165, 166)] [assembly: Nemerle.Internal.OperatorAttribute ("Nemerle.Core", "!=", false, 165, 166)] [assembly: Nemerle.Internal.OperatorAttribute ("Nemerle.Core", "&&", false, 160, 161)] [assembly: Nemerle.Internal.OperatorAttribute ("Nemerle.Core", "||", false, 150, 151)] [assembly: Nemerle.Internal.OperatorAttribute ("Nemerle.Core", "??", false, 146, 145)] [assembly: Nemerle.Internal.OperatorAttribute ("Nemerle.Core", "=", false, 141, 140)] [assembly: Nemerle.Internal.OperatorAttribute ("Nemerle.Core", "*=", false, 141, 140)] [assembly: Nemerle.Internal.OperatorAttribute ("Nemerle.Core", "/=", false, 141, 140)] [assembly: Nemerle.Internal.OperatorAttribute ("Nemerle.Core", "%=", false, 141, 140)] [assembly: Nemerle.Internal.OperatorAttribute ("Nemerle.Core", "+=", false, 141, 140)] [assembly: Nemerle.Internal.OperatorAttribute ("Nemerle.Core", "-=", false, 141, 140)] [assembly: Nemerle.Internal.OperatorAttribute ("Nemerle.Core", "<<=", false, 141, 140)] [assembly: Nemerle.Internal.OperatorAttribute ("Nemerle.Core", ">>=", false, 141, 140)] [assembly: Nemerle.Internal.OperatorAttribute ("Nemerle.Core", "&=", false, 141, 140)] [assembly: Nemerle.Internal.OperatorAttribute ("Nemerle.Core", "^=", false, 141, 140)] [assembly: Nemerle.Internal.OperatorAttribute ("Nemerle.Core", "|=", false, 141, 140)] [assembly: Nemerle.Internal.OperatorAttribute ("Nemerle.Core", "when", false, 130, 131)] [assembly: Nemerle.Internal.OperatorAttribute ("Nemerle.Core", "with", false, 130, 131)] [assembly: Nemerle.Internal.OperatorAttribute ("Nemerle.Core", "=>", false, 145, 120)] // lambda expression [assembly: Nemerle.Internal.OperatorAttribute ("Nemerle.Core", "!", true, 281, 280)] [assembly: Nemerle.Internal.OperatorAttribute ("Nemerle.Core", "~", true, 281, 280)] namespace Nemerle.Imperative { macro Return (expr = null) syntax ("return", Optional (expr)) { if (expr == null || expr is <[ () ]>) <[ $("_N_return" : global) () ]> else <[ $("_N_return" : global) ($expr) ]> } macro Break () syntax ("break") { <[ $("_N_break" : global) () ]> } macro Continue () syntax ("continue") { <[ $("_N_continue" : global) () ]> } } namespace Nemerle.Core { /** MACROS EXTENDING SYNTAX OF LANGUAGE */ /** * The 'unchecked' macro, it is only a syntax-extension place holder. * All the real work is done inside the typer. */ macro @unchecked (expr) syntax ("unchecked", expr) { <[ dont_use_me ($expr) ]> } /** * The 'checked' macro, it is only a syntax-extension place holder. * All the real work is done inside the typer. */ macro @checked (expr) syntax ("checked", expr) { <[ dont_use_me ($expr) ]> } /// Yet another syntax extender. macro @yield (expr = null) syntax ("yield", expr) { <[ dont_use_me ($expr) ]> } /** specialized macro for [if] condition with good warning messages, it performs typing of given expressions to check their type correctness */ macro @if (cond, e1, e2) syntax ("if", "(", cond, ")", e1, Optional (";"), "else", e2) { <[ match ($cond) { | true => $e1 | _ => $e2 } ]> } /** this macro provides convenient way to write a simple while loop, which performs execution of [body] parameter as long as [condition] is true */ macro @while (cond, body) syntax ("while", "(", cond, ")", body) { def loop = Nemerle.Macros.Symbol (Util.tmpname ("while_")); <[ ($("_N_break" : global) : { def $(loop : name) () : void { when ($cond) { ($("_N_continue" : global) : { $body }) : void; $(loop : name) () } } $(loop : name) (); }) : void ]> } macro repeatmacro (times, body) syntax ("repeat", "(", times, ")", body) { <[ for (mutable t = $times; t > 0; --t) $body ]> } /** shortcut for [if (cond) body else ()] */ macro whenmacro (cond, body) syntax ("when", "(", cond, ")", body) { def res1 = match (cond) { | <[ $subCond is $pattern ]> with guard = null | <[ $subCond is $pattern when $guard ]> => def res2 = match (pattern) { | PT.PExpr.Call when guard != null => <[ match ($subCond) { | $pattern when $guard => $body : void | _ => () } ]> | PT.PExpr.Call => <[ match ($subCond) { | $pattern => $body : void | _ => () } ]> | _ => <[ match ($cond) { | true => $body : void | _ => () } ]> } res2 | _ => <[ match ($cond) { | true => $body : void | _ => () } ]> } res1 } macro @for (init, cond, change, body) syntax ("for", "(", Optional (init), ";", Optional (cond), ";", Optional (change), ")", body) { def init = if (init != null) init else <[ () ]>; def cond = if (cond != null) cond else <[ true ]>; def change = if (change != null) change else <[ () ]>; def loop = Nemerle.Macros.Symbol (Util.tmpname ("for_")); <[ $init; ($("_N_break" : global) : { def $(loop : name) () : void { when ($cond) { ($("_N_continue" : global) : { $body }) : void; $change; $(loop : name) () } } $(loop : name) (); }) : void ]> } /** shortcut for [if (cond) () else body] */ macro @unless (cond, body) syntax ("unless", "(", cond, ")", body) { <[ match ($cond) { | false => $body : void | _ => () } ]> } /** macro providing C# 'using' functionality http://msdn.microsoft.com/library/default.asp?url=/library/en-us/csspec/html/vclrfcsharpspec_8.asp http://msdn.microsoft.com/library/default.asp?url=/library/en-us/csref/html/vclrfusingstatement.asp */ macro @using (body, params args : array [expr]) syntax ("using", "(", args, ")", body) { def (preexps, postexps) = UsingMacroGenerator.ProcessUsingArgs (args); UsingMacroGenerator.OutputExpression (preexps, postexps, body, null); } macro using_catch (body, catch_block, params args : array [expr]) syntax ("using", "(", args, ")", body, "catch", catch_block) { def (preexps, postexps) = UsingMacroGenerator.ProcessUsingArgs (args); def cases = UsingMacroGenerator.ConvertMatchToCatchCases (catch_block); UsingMacroGenerator.OutputExpression (preexps, postexps, body, cases); } module UsingMacroGenerator { public ConvertMatchToCatchCases (_ : Parsetree.PExpr) : list [Parsetree.TryCase] { | <[ match ($_) { ..$cases } ]> => cases.Map (c => match (c) { | <[ case: $(x : name) is $exc => $exp ]> => Parsetree.TryCase.Catch (Parsetree.Splicable.Name (x), exc, exp) | <[ case: $(x : name) => $exp ]> => Parsetree.TryCase.Catch (Parsetree.Splicable.Name (x), <[ System.Exception ]>, exp) | _ => Message.Error ("expected simple catch pattern: '| x is Exception => body'"); null }) | _ => null } public ProcessUsingArgs (args : array [Parsetree.PExpr]) : list [Parsetree.PExpr] * list [Parsetree.PExpr] { def len = args.Length; def store_exprs (i, preexprs, postexprs) { if (i < len) { match (args[i]) { | <[ mutable $(str : name) = $e ]> => store_exprs (i + 1, <[ mutable $(str : name) = $e ]> :: preexprs, <[ maybe_valuetype_dispose ($(str : name)) ]> :: postexprs) | <[ def $(str : name) = $e ]> | <[ $(str : name) = $e ]> => store_exprs (i + 1, <[ def $(str : name) = $e ]> :: preexprs, <[ maybe_valuetype_dispose ($(str : name)) ]> :: postexprs) | e => def x = Macros.NewSymbol (); store_exprs (i + 1, <[ def $(x : name) = $e ]> :: preexprs, <[ maybe_valuetype_dispose ($(x : name)) ]> :: postexprs) } } else (preexprs, postexprs) }; store_exprs (0, [], []); } public OutputExpression (preexps : list[Parsetree.PExpr], postexps : list [Parsetree.PExpr], body : Parsetree.PExpr, catch_cases : list [Parsetree.TryCase]) : Parsetree.PExpr { def body = if (catch_cases == null) body else <[ try { $body } catch { ..$catch_cases } ]>; List.FoldLeft2 (preexps, postexps, body, fun (pre, post, acc) { <[ $pre; try { $acc } finally { $post } ]> }); } } // disposes given value, if it is reference type then check nullness before disposing macro maybe_valuetype_dispose (val) { // this should also work <[ def disp = $val : System.IDisposable; when (disp != null) disp.Dispose (); ]> /* def tval = Tyexpr.ty_expr (Nemerle.Macros.ImplicitCTX (), val); def tc = Tyutil.GetTypeTypeInfo (Tyexpr.type_of (tval)); if (tc != null && tc.IsValueType) <[ ($(tval : typed) :> System.IDisposable).Dispose () ]> else <[ when ($(tval : typed) != null) ($(tval : typed) :> System.IDisposable).Dispose () ]> */ } macro @lock (x, body) syntax ("lock", "(", x, ")", body) { def typer = Macros.ImplicitCTX (); def tx = typer.TypeExpr (x); typer.DelayMacro (fun (fail_loud) { match (tx.Type.Hint) { | Some (Class (tc, _)) when tc.IsValueType => when (fail_loud) Message.Error (x.Location, $"`$tc' is not a reference type as required by the lock expression"); None () | None => when (fail_loud) Message.Error (x.Location, "compiler was unable to analyze type of locked object, but it must verify that it is reference type"); None () | _ => def result = <[ def to_lock = $(tx : typed); System.Threading.Monitor.Enter (to_lock); try { $body } finally { System.Threading.Monitor.Exit (to_lock); } ]>; Some (result) } }); } macro dowhile (cond, body) syntax ("do", body, "while", "(", cond, ")") { def loop = Nemerle.Macros.Symbol (Util.tmpname ("do_while_")); <[ (($("_N_break" : global) : { def $(loop : name) () : void { ($("_N_continue" : global) : { $body }) : void; when ($cond) $(loop : name) (); } $(loop : name) () }) : void) ]> } /** * The 'foreach' macro introduces a construction equivalent * to C#'s 'foreach' keyword, iterating over a collection. */ macro @foreach (inexpr, body) syntax ("foreach", "(", inexpr, ")", body) { match (ListComprehensionHelper.ExpandRange (inexpr, body)) { | Some (expr) => Nemerle.Imperative.Return (expr) | None => {} } def (iter, collection) = match (inexpr) { | <[ $i in $c ]> => (i, c) | e => Message.FatalError ($ "the syntax is 'foreach (x in collection)', " "got $e"); } def typer = Macros.ImplicitCTX (); def tcollection = typer.TypeExpr (collection); // build the body of loop (may contain additional matching) def build_definition (val) { match (body) { | <[ match ($(null)) { ..$cases } ]> => match (iter) { | <[ $(x : name) ]> when char.IsLower (x.Id[0]) | <[ (..$_) ]> => () | _ => Message.FatalError ("only simple names available in pattern" " of foreach with direct matching") } <[ def $iter = $val; match ($iter) { ..$cases } ]> | _ => def mat = match (iter) { | <[ $pat :> $ty ]> => <[ match ($val :> $ty) { | $pat => $body; () | _ => () } ]> | _ => <[ match ($val) { | $iter => $body; () | _ => () } ]> } mat.cases.Iter (fun (x : PT.MatchCase) { x.disable_warnings = true }); mat } } // here we choose if we want to use enumerator pattern // of access GetEnumerator through IEnumarable // http://www.jaggersoft.com/csharp_standard/15.8.4.htm def decide_enumerator_pattern (tyinfo) { def all = tyinfo.LookupMember ("GetEnumerator"); def choosen = List.Exists (all, fun (mem : IMember) { | meth is IMethod when !meth.IsStatic && meth.GetParameters ().IsEmpty => match (meth.ReturnType.Fix ()) { // FIXME: do additional conservative checks | MType.Class (tc, _) when !tc.LookupMember ("MoveNext").IsEmpty && !tc.LookupMember ("Current").IsEmpty => true | _ => false } | _ => false }); if (choosen) <[ $(tcollection : typed).GetEnumerator () ]> else <[ ($(tcollection : typed) : System.Collections.IEnumerable).GetEnumerator () ]> } typer.DelayMacro (fun (fail_loudly) { match (tcollection.Type.Hint) { | Some (MType.Class (tc, args)) => if (tc.InternalType.Nemerle_list_tc != null && tc.SuperType (tc.InternalType.Nemerle_list_tc).IsSome) { def arg = List.Head (args); def definition = build_definition (<[ x ]>); Some (<[ // we explicitly set parameter type to list, because collection's type // can be more specific (list.Cons, etc.) ($("_N_break" : global) : { def foreach_loop (_ : list [$(arg : typed)]) : void { | x :: xs => ($("_N_continue" : global) : { $definition; }) : void; foreach_loop (xs) | _ => () } foreach_loop ($(tcollection : typed)) }) : void ]>) } else { def init_body = decide_enumerator_pattern (tc); def is_disposable = typer.JustTry (fun () { def expr = typer.TypeExpr (init_body); expr.Type.Require (<[ ttype: System.IDisposable ]>) }); def finally_body = if (is_disposable) <[ (enumerator : System.IDisposable).Dispose () ]> else <[ match (enumerator) { | x is System.IDisposable => x.Dispose (); | _ => () } ]>; def definition = build_definition (<[ enumerator.Current ]>); Some (<[ def enumerator = $init_body; ($("_N_break" : global) : { def loop () : void { when (enumerator.MoveNext ()) { ($("_N_continue" : global) : { $definition; }) : void; loop (); } } try { loop () } finally { $finally_body } }) : void ]>) } | Some (MType.Array (_ , rank)) => def indices = array (rank); def lengths = array (rank); for (mutable i = 0; i < rank; ++i) { indices [i] = Macros.NewSymbol (); lengths [i] = Macros.NewSymbol (); } def indices_list = List.RevMap (List.FromArray (indices), fun (x) { <[ $(x : name) ]> }); def build_loops (depth) { /// build expression defining iteration symbols | 0 => build_definition (<[ cached_collection [..$indices_list] ]>) | n => def idx = indices [n - 1]; <[ for (mutable $(idx : name) = 0; $(idx : name) < $(lengths [n - 1] : name); ++ $(idx : name)) $(build_loops (n - 1)) ]> } mutable sequence = [ <[ $(build_loops (rank)) ]> ]; if (rank == 1) sequence = <[ def $(lengths [0] : name) = cached_collection.Length ]> :: sequence; else for (mutable i = rank - 1; i >= 0; --i) sequence = <[ def $(lengths [(rank - 1) - i] : name) = cached_collection.GetLength ($(i : int)) ]> :: sequence; sequence = <[ def cached_collection = $(tcollection : typed) ]> :: sequence; Some (<[ { .. $sequence } ]>) | t => when (fail_loudly) { def guess = match (t) { | Some (t) => $ "current best guess about the type is $t" | None => "the compiler has no idea what the type might be" } Message.Error ($ "collection in foreach must be an array or " "type implementing enumerator pattern, $guess"); Message.Hint ("try specifing the type directly using 'expr : SomeType'"); } None () } }) } macro ignore (e) { <[ def _ = $e; () ]> } macro abort (message = <[ "" ]>) { <[ throw AssertionException ($(message.Location.File : string), $(message.Location.Line : int), "", $message) ]> } /** MACROS EXTENDING TYPE SYSTEM OF LANGUAGE */ /* NEW RECORD */ [Nemerle.MacroUsage (Nemerle.MacroPhase.BeforeInheritance, Nemerle.MacroTargets.Field, Inherited = false, AllowMultiple = false)] macro RecordIgnore (ty : TypeBuilder, fld : ParsedField) { MacrosHelper.MarkIgnored (ty, fld); } [Nemerle.MacroUsage (Nemerle.MacroPhase.BeforeInheritance, Nemerle.MacroTargets.Property, Inherited = false, AllowMultiple = false)] macro RecordIgnore (ty : TypeBuilder, fld : ParsedProperty) { MacrosHelper.MarkIgnored (ty, fld); } [Nemerle.MacroUsage(Nemerle.MacroPhase.BeforeInheritance, Nemerle.MacroTargets.Class, Inherited = false, AllowMultiple = false)] macro Record(ty : TypeBuilder, params _ : list [PExpr]) { ty.DisableImplicitConstructor(); } [Nemerle.MacroUsage(Nemerle.MacroPhase.BeforeTypedMembers, Nemerle.MacroTargets.Class, Inherited = false, AllowMultiple = false)] macro Record(ty : TypeBuilder, params options : list[PExpr]) { MacrosHelper.MakeRecord (ty, options); } module MacrosHelper { public InstanceFlags = BindingFlags.Instance %| BindingFlags.Public %| BindingFlags.NonPublic %| BindingFlags.DeclaredOnly; public MakeRecord (ty : TypeBuilder, options : list[PT.PExpr]) : void { def patterns = AnalyseNameInclusionPatterns (options); def fields = CollectFields (ty, patterns); InheritConstructorsAddingFields (ty, fields); } public InheritConstructorsAddingFields (ty : TypeBuilder, fields : list[PT.ClassMember.Field]) : void { def define_ctor (base_ctor : BaseConstructor) : void { def has_empty_ctor (ty) { def predicate(member) { | PT.ClassMember.Function as func => func.Name == ".ctor" && func.header.Parameters.IsEmpty; | _ => false; } ty.GetParsedMembers (true).Exists (predicate); } // Build parameters declarations def (lead_base_parms, trail_base_parms) = base_ctor.BaseParameters (ty); def this_parms = fields.Map (parm => <[parameter: $(parm.name) : $(parm.ty) ]>); def parms = lead_base_parms + this_parms + trail_base_parms; // Build base constructor call def base_call = base_ctor.BaseCall; // Deduce constructor attributes def modifiers = match (ty.GetTydecl ()) { | TypeDeclaration.Variant => NemerleAttributes.Protected | _ => NemerleAttributes.Public//base_ctor.Mods } def attrs = Modifiers (modifiers, []); // Skip generation of empty constructor if it exists when (!parms.IsEmpty || !has_empty_ctor (ty)) { def assigns = base_call :: fields.Map( parm => <[ this.$(parm.Name : usesite) = $(parm.ParsedName : name); ]>); def ctor = <[ decl: ..$attrs this (..$(parms)) { ..$assigns } ]>; ty.Define (ctor); } } def ctors = CollectBaseConstructors (ty); ctors.Iter (define_ctor); } public AnalyseNameInclusionPatterns (options : list[PT.PExpr]) : Regex * Regex { mutable inclusion = null; mutable exclusion = null; foreach (e in options) { | <[ Include = [..$names] ]> => inclusion = Regex ("^" + names.ToString("$|^") + "$") | <[ Include = $(regexp : string) ]> => inclusion = Regex (regexp) | <[ Exclude = [..$names] ]> => exclusion = Regex ("^" + names.ToString ("$|^") + "$") | <[ Exclude = $(regexp : string) ]> => exclusion = Regex (regexp) | e => Message.Error (e.Location, $"unsupported argument `$e' in macro, please specify 'Include/Exclude = [name1,name2]/pattern") } (inclusion, exclusion) } public NameMatchesPatterns (name : string, patterns : Regex * Regex) : bool { def (inclusion, exclusion) = patterns; (inclusion == null || inclusion.Match (name).Success) && (exclusion == null || !exclusion.Match (name).Success) } public MarkIgnored (ty : TypeBuilder, field : PT.ClassMember) : void { ignoreMap_[ty, field] = null; } public IsIgnored (tb : TypeBuilder, field : PT.ClassMember) : bool { ignoreMap_.ContainsKey(tb, field); } #region Implementation ignoreMap_ : SCG.Dictionary.[TypeBuilder * PT.ClassMember, object] = SCG.Dictionary(); private CollectFields (tb : TypeBuilder, patterns : Regex * Regex) : list[PT.ClassMember.Field] { def filter_type (member) { | PT.ClassMember.Field | PT.ClassMember.Property(_, _, [], // we treat autoproperties as fields... Some(PT.ClassMember.Function(_, _, FunBody.Abstract)), Some(PT.ClassMember.Function(_, _, FunBody.Abstract))) => !(member.modifiers.mods %&& NemerleAttributes.Static) && NameMatchesPatterns (member.Name, patterns) && !IsIgnored (tb, member) | _ => false; } tb.GetParsedMembers (true) .MapFiltered (filter_type, fun(_) { | PT.ClassMember.Field as field => field | PT.ClassMember.Property as p => <[ decl: $(p.Name : usesite) : $(p.ty) ]> | _ => assert(false) }) } private CollectBaseConstructors (ty : TypeBuilder) : list[BaseConstructor] { def collect_ctors (ty : TypeInfo) { | ty is TypeBuilder => // Base class is defined in the same assembly and is available in parsed form def filter (member) { | PT.ClassMember.Function as func => func.Name == ".ctor" && !(func.modifiers.mods %&& NemerleAttributes.Private); | _ => false; } ty.GetParsedMembers (true) .MapFiltered(filter, ctor => BaseConstructor.Parsed(ctor :> PT.ClassMember.Function)); | _ => // Base class is not available in parsed form because it is defined in some other assembly ty.GetConstructors (InstanceFlags) .MapFiltered (ctor => !ctor.IsPrivate, ctor => BaseConstructor.Compiled (ctor)); } if (ty.IsValueType) [BaseConstructor.Implicit (CallBase = false)]; else match (collect_ctors (ty.BaseType)) { | [] => [BaseConstructor.Implicit (CallBase = true)]; | ctors => ctors; }; } variant BaseConstructor { | Parsed { Ctor : PT.ClassMember.Function; public override BaseParameters(target_ty : TypeBuilder) : list[PT.Fun_parm] * list[PT.Fun_parm] { // Split leading and trailing parameters def is_param_array (parm) { parm.modifiers.custom_attrs .Exists(fun (attr) { | <[ System.ParamArrayAttribute ]> => true; |_ => false; }); } def (trail, lead) = Ctor.header.Parameters.Partition (is_param_array); def base_ty = target_ty.BaseType :> TypeBuilder; def subst = target_ty.SubtypingSubst(base_ty); // Build base ctor parameter based on type substitution def bind_to_target(varargs, parm) { def extract (parm) { match (parm.ty){ | PT.PExpr.ParmByRef (parm) => (parm, (parm, tyvar) => <[parameter: $(parm.Name : usesite) : ref $(tyvar : typed)]>); | PT.PExpr.ParmOut (parm) => (parm, (parm, tyvar) => <[parameter: $(parm.Name : usesite) : out $(tyvar : typed)]>); | parm => (parm, (parm, tyvar) => <[parameter: $(parm.Name : usesite) : $(tyvar : typed)]>); } } def (base_type, make_parm) = extract (parm); def bound_base_type = base_ty.MonoBindType (base_type); def this_type = subst.Apply (bound_base_type); def parm = make_parm (parm, this_type); when (varargs) parm.modifiers.custom_attrs ::= <[ System.ParamArrayAttribute ]>; parm; } (lead.Map (bind_to_target (false, _)), trail.Map (bind_to_target (true, _))); } public override BaseCall : PT.PExpr { get { def make_base_call_parm (parm : PT.Fun_parm) { match (parm.ty) { | PT.PExpr.ParmByRef => <[ ref $(parm.Name : usesite) ]>; | PT.PExpr.ParmOut => <[ out $(parm.Name : usesite) ]>; | _ => <[ $(parm.Name : usesite) ]>; } } def base_call_parms = Ctor.header.Parameters.Map (make_base_call_parm); <[ base(..$base_call_parms); ]> } } } | Compiled { Ctor : IMethod; public override BaseParameters(target_ty : TypeBuilder) : list[PT.Fun_parm] * list[PT.Fun_parm] { def parms = Ctor.GetParameters (); def (lead, trail) = if (Ctor.IsVarArgs && !parms.IsEmpty) { def (parms, last) = parms.DivideLast(); (parms, [last]); } else (parms, []); def base_ty = target_ty.BaseType; def subst = target_ty.SubtypingSubst(base_ty); def bind_to_target(varargs, parm) { def bound_type = parm.ty.Fix(); def this_type = subst.Apply (bound_type); def parm = <[parameter: $(parm.Name : usesite) : $(this_type : typed)]>; when (varargs) parm.modifiers.custom_attrs ::= <[ System.ParamArrayAttribute ]>; parm; } (lead.Map (bind_to_target (false, _)), trail.Map (bind_to_target (true, _))); } public override BaseCall : PT.PExpr { get { def make_base_call_parm (parm : TT.Fun_parm) { match (parm.kind) { | TT.ParmKind.Ref => <[ ref $(parm.Name : usesite) ]>; | TT.ParmKind.Out => <[ out $(parm.Name : usesite) ]>; | TT.ParmKind.Normal => <[ $(parm.Name : usesite) ]>; } } def base_call_parms = Ctor.GetParameters ().Map (make_base_call_parm); <[ base(..$base_call_parms); ]> } } } | Implicit { CallBase : bool; public override BaseParameters(_ : TypeBuilder) : list[PT.Fun_parm] * list[PT.Fun_parm] { ([], []); } public override BaseCall : PT.PExpr { get { if (CallBase) <[ base(); ]>; else <[ () ]>; } } } public abstract BaseParameters(target_ty : TypeBuilder) : list[PT.Fun_parm] * list[PT.Fun_parm]; public abstract BaseCall : PT.PExpr { get; } //public Mods : NemerleAttributes //{ // get // { // match (this) // { // | Parsed (ctor) => // if (ctor.modifiers.mods %&& NemerleAttributes.Internal) // NemerleAttributes.Internal // else // NemerleAttributes.Public; // | Compiled // | Implicit => // NemerleAttributes.Public; // } // } //} } #endregion // Implementation } /* OLD RECORD * / [Nemerle.MacroUsage (Nemerle.MacroPhase.BeforeInheritance, Nemerle.MacroTargets.Class, Inherited = false, AllowMultiple = false)] macro Record (par : TypeBuilder, params _ : list [PExpr]) { par.DisableImplicitConstructor (); } [Nemerle.MacroUsage (Nemerle.MacroPhase.WithTypedMembers, Nemerle.MacroTargets.Class, Inherited = false, AllowMultiple = false)] macro Record (par : TypeBuilder, params options : list [PExpr]) { def inclusion_regexs = MacrosHelper.AnalyseNameInclusionPatterns (options); def flds = par.GetFields (MacrosHelper.InstanceFlags).Filter (f => MacrosHelper.NameMatchesPatterns (f.Name, inclusion_regexs)); MacrosHelper.InheritConstructorsAddingFields (par, flds); } module MacrosHelper { public InstanceFlags = BindingFlags.Instance %| BindingFlags.Public %| BindingFlags.NonPublic %| BindingFlags.DeclaredOnly; public InheritConstructorsAddingFields (par : TypeBuilder, flds : list [IField]) : void { def make_ctor (is_value_type, base_ctor : IMethod) { def (ctor_parms, base_call) = if (base_ctor == null) ([], if (is_value_type) <[ () ]> else <[ base () ]>) else { def callparms = base_ctor.Header.ParametersReferences; (base_ctor.Header.ParametersDeclarations, <[ base (..$callparms) ]>) }; def collect (mem : IField, acc) { def n = Macros.UseSiteSymbol (mem.Name); def fp = <[ parameter: $(n : name) : $(mem.GetMemType () : typed) ]>; def ex = <[ this.$(n : name) = $(n : name) ]>; def (es, ps) = acc; (ex :: es, fp :: ps) }; def (assigns, parms) = flds.FoldLeft (([], []), collect); def body = <[ { ..$(base_call :: assigns) } ]>; def attrs = Modifiers (mods = match (par.GetTydecl ()) { | TypeDeclaration.Variant => NemerleAttributes.Protected | _ => NemerleAttributes.Public }, custom_attrs = []); def parms = ctor_parms.Append (parms.Reverse ()); def meth = <[ decl: ..$attrs this (..$parms) $body ]>; /// we do not try to add empty constructor if it exists if (parms.IsEmpty) { def existing = par.GetConstructors (MacrosHelper.InstanceFlags); unless (existing.Exists (c => c.GetParameters ().IsEmpty)) par.DefineAndReturn (meth).HasBeenUsed = true; } else par.DefineAndReturn (meth).HasBeenUsed = true; }; if (par.IsValueType) make_ctor (true, null) else if (par.BaseType != null) { def ctors = par.BaseType.GetConstructors (MacrosHelper.InstanceFlags); foreach (x when !x.IsPrivate in ctors) make_ctor (false, x) } else make_ctor (false, null) } public AnalyseNameInclusionPatterns (options : list [PT.PExpr]) : Regex * Regex { mutable inclusion = null; mutable exclusion = null; foreach (e in options) { | <[ Include = [..$names] ]> => inclusion = Regex ("^" + names.ToString ("$|^") + "$") | <[ Include = $(regexp : string) ]> => inclusion = Regex (regexp) | <[ Exclude = [..$names] ]> => exclusion = Regex ("^" + names.ToString ("$|^") + "$") | <[ Exclude = $(regexp : string) ]> => exclusion = Regex (regexp) | e => Message.Error (e.Location, $"unsupported argument `$e' in macro, please specify 'Include/Exclude = [name1,name2]/pattern") } (inclusion, exclusion) } public NameMatchesPatterns (name : string, patterns : Regex * Regex) : bool { def (inclusion, exclusion) = patterns; (inclusion == null || inclusion.Match (name).Success) && (exclusion == null || !exclusion.Match (name).Success) } } /* END RECORD */ [Nemerle.MacroUsage (Nemerle.MacroPhase.BeforeInheritance, Nemerle.MacroTargets.Class, Inherited = false, AllowMultiple = false)] macro ExternallyVisibleOptions (t : TypeBuilder) { match (t.ParsedDeclaration) { | PT.TopDeclaration.Variant (_, decls) as v => def tyvars = v.typarms.tyvars.Map (x => PT.PExpr.Ref (x.GetName ())); foreach (PT.ClassMember.TypeDeclaration (PT.TopDeclaration.VariantOption as vo) in decls) { def name = PT.Splicable.Name (PT.Name (vo.Name)); def mods = Modifiers (t.Attributes, []); def tyname = NString.Split (t.FullName, array ['.']) + [vo.Name]; def tyalias = <[ $(Util.ExprOfList (tyname)) [ ..$tyvars] ]>; def decl = PT.ClassMember.TypeDeclaration (t.Location, null, null, PT.TopDeclaration.Alias (t.Location, name, mods, v.typarms, tyalias)); match (t.DeclaringType) { | null => _ = t.ParsedName.context.Define (decl); | parent => _ = (parent :> TypeBuilder).DefineNestedType (decl); } } | _ => Message.FatalError ("ExternallyVisibleOptions attribute can only be applied to variant types.") } } [Nemerle.MacroUsage (Nemerle.MacroPhase.WithTypedMembers, Nemerle.MacroTargets.Parameter)] macro _N_ExtensionMethodOnThisParameter (tb : TypeBuilder, mb : MethodBuilder, p : ParameterBuilder) syntax ("this") { def add_attr (m) { unless (m.GetCustomAttributes ().Exists (_ is <[ Nemerle.Internal.Extension () ]>)){ m.AddCustomAttribute (<[ Nemerle.Internal.Extension () ]>); match(ManagerClass.Instance.CoreEnv.LookupType(["System", "Runtime", "CompilerServices", "ExtensionAttribute"])) { | Some(ti) => m.AddCustomAttribute(<[ $(Parsetree.PExpr.FromQualifiedIdentifier (ManagerClass.Instance, ti.FullName)) ]>) | _ => () } } } if (p : object != mb.GetParameters ().Head) Message.Error ("'this' modifier (for extension method) can only be " "used on the first parameter"); else if (!((mb.Attributes %&& NemerleAttributes.Public) && (mb.Attributes %&& NemerleAttributes.Static))) Message.Error ("extension methods need to be marked public static") else { add_attr (tb.GetModifiers ()); add_attr (mb.GetModifiers ()); mb.AddAsExtensionMethod (); } } } namespace Nemerle.Macros { [Nemerle.MacroUsage (Nemerle.MacroPhase.BeforeInheritance, Nemerle.MacroTargets.Method, Inherited = true, AllowMultiple = false)] macro Hygienic (_ : TypeBuilder, m : ParsedMethod) { def newBody = Util.locate(m.Body.Location, <[ def colors = ManagerClass.Instance.MacroColors; colors.PushNewColor (colors.UseColor, colors.UseContext); def result = $(m.Body); colors.PopColor (); result ]>); m.Body = newBody; } macro DefineCTX (ctx) { <[ def $(ImplicitCTX().Manager.MacrosRegistry.GetImplicitCTXName () : name) = $ctx ]> } macro ImplicitCTX () { <[ $(ImplicitCTX().Manager.MacrosRegistry.GetImplicitCTXName () : name) ]> } macro Manager () { <[ $(ImplicitCTX().Manager.MacrosRegistry.GetImplicitCTXName () : name).Manager ]> } /** creates new symbol with given id and current global context */ macro Symbol (id) { def env = Macros.ImplicitCTX().Env; def nr = env.GetMacroContext (); <[ PT.Name.NameInCurrentColor ($id, $("_N_MacroContexts" : dyn).Get ($(nr : int), Manager ())) ]> } macro pretty_print_expr (exp, expand : bool) { def ctx = if (expand) Some (Macros.ImplicitCTX()) else None (); PrettyPrint.PrintExpr (ctx, exp); <[ () ]> } macro ExprToString (exp, expandMacros : bool) { def ctx = if (expandMacros) Some (Macros.ImplicitCTX()) else None (); def str = PrettyPrint.SprintExpr (ctx, exp); <[ $(str : string) ]> } } namespace Nemerle.Extensions { /** * The `lambda' macro */ macro @lambda (parm : parameter, body) syntax ("lambda", parm, "->", body) { match (parm) { | <[ parameter: $(iname : name) : $ty ]> => <[ fun ($(iname : name) : $ty) { $body } ]> | _ => Message.FatalError ("expected a single parameter for the lambda abstraction"); } } [Nemerle.MacroUsage (Nemerle.MacroPhase.WithTypedMembers, Nemerle.MacroTargets.Class, Inherited = false, AllowMultiple = false)] macro TupleToString (t : TypeBuilder) { def flds = t.GetFields (BindingFlags.Public %| BindingFlags.NonPublic %| BindingFlags.Instance %| BindingFlags.DeclaredOnly); def appends = List.RevMap (flds, fun (x : IField) { <[ ignore (str.Append ($(x.Name : usesite))); ]> }); def body_seq = List.FoldLeft (List.Tail (appends), List.Head (appends) :: [<[ ignore (str.Append (")")); str.ToString () ]>], fun (x, acc) { x :: <[ ignore (str.Append (", ")) ]> :: acc }); def body_seq = <[ def str = System.Text.StringBuilder ("(") ]> :: body_seq; t.Define (<[ decl: public override ToString () : string { ..$body_seq } ]>); } [Nemerle.MacroUsage (Nemerle.MacroPhase.BeforeInheritance, Nemerle.MacroTargets.Class, Inherited = false, AllowMultiple = false)] macro DisableImplicitConstructor (t : TypeBuilder) { t.DisableImplicitConstructor (); } [Nemerle.MacroUsage (Nemerle.MacroPhase.WithTypedMembers, Nemerle.MacroTargets.Class, Inherited = false, AllowMultiple = false)] macro StructuralEquality (t : TypeBuilder) { def flds = t.GetFields (BindingFlags.Public %| BindingFlags.NonPublic %| BindingFlags.Instance %| BindingFlags.DeclaredOnly); def body = List.FoldLeft (flds, <[ true ]>, fun (x : IField, acc) { def nm = Macros.UseSiteSymbol (x.Name); <[ $acc && object.Equals($(nm : name), tup.$(nm : name)) ]> }); def tname = t.ParsedTypeName; def full = <[ if (o != null && o.GetType ().Equals (this.GetType ())){ def tup = (o :> $tname); $body } else false ]>; t.Define (<[ decl: public override Equals (o : System.Object) : bool { $full } ]>); } [Nemerle.MacroUsage (Nemerle.MacroPhase.WithTypedMembers, Nemerle.MacroTargets.Class, Inherited = false, AllowMultiple = false)] macro LexicographicCompareTo (t : TypeBuilder) { def tname = t.ParsedName; def flds = t.GetFields (BindingFlags.Public %| BindingFlags.NonPublic %| BindingFlags.Instance %| BindingFlags.DeclaredOnly); def compareField (fld : IField) { def nm = Macros.UseSiteSymbol (fld.Name); def hasLess = match (fld.GetMemType ()) { | MType.Class (ti, _) => def name = ti.FullName; match (name) { | "Nemerle.Core.string" | "System.String" | "Nemerle.Core.int" | "System.Int32" | "System.UInt32" | "Nemerle.Core.float" | "System.Single" | "Nemerle.Core.double" | "System.Double" | "Nemerle.Core.char" | "System.Char" => true | _ => false } | _ => false } if (hasLess) { <[ if (this.$(nm : name) < other.$(nm : name)) { -1 } else if (this.$(nm : name) > other.$(nm : name)) { 1 } else { 0 } ]> } else { <[ this.$(nm : name).CompareTo (other.$(nm : name)); ]> } } def body = List.FoldRight (flds, <[ 0 ]>, fun (x : IField, acc) { <[ def cmp = $(compareField (x)); if (cmp == 0) { $(acc) } else { cmp } ]> }); def full = if (t.IsValueType) { body } else { <[ if (object.ReferenceEquals (this, other)) { 0 } else if (object.ReferenceEquals (other, null)) { 1 } else { $(body) } ]> } t.Define (<[ decl: public CompareTo (other : $(tname : name)) : int { $full } ]>); t.Define (<[ decl: public CompareTo (Oother : object) : int { try { def other = Oother :> $(tname : name); this.CompareTo (other) } catch { | _ is System.InvalidCastException => throw System.ArgumentException () } } ]>); } [Nemerle.MacroUsage (Nemerle.MacroPhase.WithTypedMembers, Nemerle.MacroTargets.Class, Inherited = false, AllowMultiple = false)] macro StructuralHashCode (t : TypeBuilder) { def flds = t.GetFields (BindingFlags.Public %| BindingFlags.NonPublic %| BindingFlags.Instance %| BindingFlags.DeclaredOnly); def body = List.FoldLeft (flds, <[ 0 ]>, fun (x : IField, acc) { <[ $acc %^ $(x.Name : usesite).GetHashCode () ]> }); t.Define (<[ decl: public override GetHashCode () : int { $body } ]>); } /** MACROS, WHICH WE CAN DO BETTER THAN HASKELL */ macro SelectFromTuple (k : int, n : int, tupl) { def symb = Macros.NewSymbol (); mutable tup = []; for (mutable i = n; i > 0; --i) if (i == k) tup = <[ $(symb : name) ]> :: tup else tup = <[ _ ]> :: tup; <[ def (.. $tup) = $tupl; $(symb : name) ]> } macro TupleMap (f, tup) { match (tup) { | <[ (.. $elms) ]> => def mapped = List.Map (elms, fun (e) { <[ $f ($e) ]> }); <[ (.. $mapped) ]> | _ => Message.FatalError ("'TupleMap' macro expects function and tuple") } } macro PrintTuple (tup, size : int) { def symbols = array (size); mutable pvars = []; for (mutable i = size - 1; i >= 0; --i) { symbols[i] = Macros.NewSymbol (); pvars = <[ $(symbols[i] : name) ]> :: pvars; }; mutable exps = []; for (mutable i = size - 1; i >= 0; --i) exps = <[ System.Console.WriteLine ($(symbols[i] : name)) ]> :: exps; exps = <[ def (.. $pvars) = $tup ]> :: exps; <[ {.. $exps } ]> } macro PrintTupleTyped (tup) { def tup' = Macros.ImplicitCTX().TypeExpr (tup); match (tup'.Type.Hint) { | Some (MType.Tuple (args)) => def size = args.Length; def symbols = array (size); mutable pvars = []; for (mutable i = size - 1; i >= 0; --i) { symbols[i] = Macros.NewSymbol (); pvars = <[ $(symbols[i] : name) ]> :: pvars; }; mutable exps = []; for (mutable i = size - 1; i >= 0; --i) exps = <[ System.Console.WriteLine ($(symbols[i] : name)) ]> :: exps; exps = <[ def (.. $pvars) = $tup ]> :: exps; <[ {.. $exps } ]> | _ => Message.FatalError ("expected tuple") } } macro DefaultValue (ty) { def tty = Macros.ImplicitCTX().MonoBindType (ty); <[ $(Macros.DefaultValueOfType (tty)) : $ty ]> } [Nemerle.MacroUsage (Nemerle.MacroPhase.BeforeInheritance, Nemerle.MacroTargets.Field)] macro CompilerMutable (_ : TypeBuilder, fld : ParsedField) { fld.Attributes = fld.Attributes | NemerleAttributes.CompilerMutable; } } // end ns namespace Nemerle.Diagnostics { /** Insert given expression before every expression in every sequence of method's body. Implicitly visible variables are [_line : int], [_file : string], [_method : string], [_expr : string] Meaning current line number, filename, method's name, next expression which will be executed converted to human readable string */ [Nemerle.MacroUsage (Nemerle.MacroPhase.WithTypedMembers, Nemerle.MacroTargets.Method)] macro Trace (_ : TypeBuilder, m : MethodBuilder, tracecall = <[ Nemerle.IO.printf ("Trace: %s:%d: %s --> %s\n", $("_file" : usesite), $("_line" : usesite), $("_method" : usesite), $("_expr" : usesite)) ]>) { def exps_strings = Stack (); def add (in_pattern, is_post, x) { if (in_pattern) x else if (is_post) match (x) { | <[ {.. $seq } ]> => // we must process seqence in reversed order, because // stack was filled this way {push 1; 2; 3; push last 4} def nseq = List.Flatten (List.RevMap (List.Rev (seq), fun (e : Parsetree.PExpr) { [<[ def $("_line" : usesite) = $(e.Location.Line : int); def $("_expr" : usesite) = $(exps_strings.Pop () : string); $tracecall; ]>, e] })); <[ { ..$nseq } ]> | _ => x } else { match (x) { | <[ { .. $seq } ]> => foreach (e in seq) exps_strings.Push (PrettyPrint.SprintExpr (None (), e)); | _ => () } x } }; def bod = Macros.TraverseExpr (None (), m.Body, false, add); def newBody = Util.locate(m.Body.Location, <[ def $("_file" : usesite) = $(m.Body.Location.File : string); def $("_method" : usesite) = $(m.Name : string); $bod; ]>); m.Body = newBody; } [Nemerle.MacroUsage (Nemerle.MacroPhase.WithTypedMembers, Nemerle.MacroTargets.Class)] macro Trace (t : TypeBuilder, tracecall) { def meths = t.GetMethods (BindingFlags.Public %| BindingFlags.NonPublic %| BindingFlags.Instance %| BindingFlags.Static %| BindingFlags.DeclaredOnly); foreach (x :> MethodBuilder in meths) { x.AddMacroAttribute (<[ $("Nemerle" : usesite).Diagnostics.Trace ($tracecall) ]>); } } macro @time (code) syntax ("time", code) { def loc = code.Location.ToString (); <[ def begin = System.DateTime.Now; $code; def end = System.DateTime.Now; System.Console.WriteLine ($(loc : string) + ": execution took " + (end - begin).ToString ()); ]> } } namespace Nemerle { [Nemerle.MacroUsage (Nemerle.MacroPhase.BeforeInheritance, Nemerle.MacroTargets.Method)] macro NotImplemented (t : TypeBuilder, m : ParsedMethod) { def ignores = List.Map (m.header.parms, fun (x : PT.Fun_parm) { <[ _ = $(x.ReferencingExpr) ]> }); def message = "Method `" + m.name.GetName ().Id + "' in type `" + t.FullName + "' is not implemented yet."; def newBody = Util.locate(m.Body.Location, <[ { ..$ignores }; throw System.NotImplementedException ($(message : string)) ]>); m.Body = newBody; } [Nemerle.MacroUsage (Nemerle.MacroPhase.BeforeInheritance, Nemerle.MacroTargets.Method)] macro OverrideObjectEquals (t : TypeBuilder, m : ParsedMethod) { match (m.header.parms) { | [param] => mutable cases = [<[ case: | x is $(param.ty) => this.$(m.header.name.GetName () : name) (x) ]>, <[ case: | _ => false ]>]; unless (t.IsValueType) cases ::= <[ case: | x when x : object == this => true ]>; t.Define (<[ decl: public override Equals (other : object) : bool { match (other) { ..$cases } } ]>) | _ => Message.Error ("Equals()-like method shall have a single parameter") } } [Nemerle.MacroUsage (Nemerle.MacroPhase.BeforeInheritance, Nemerle.MacroTargets.Method)] macro ForwardThis (t : TypeBuilder, m : ParsedMethod, this_expr) { def pref = $ "_FT_$(m.header.name.GetName ().Id)_"; def meth = Nemerle.Macros.Symbol (Util.tmpname (pref)); t.Define (<[ decl: private $(meth : name) (.. $(m.header.parms)) : $(m.header.ret_type) { $(m.Body) } ]>); def parms = m.header.ParametersReferences; def newBody = Util.locate(m.Body.Location, <[ $this_expr . $(meth : name) (.. $parms) ]>); m.Body = newBody; } }