Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

429 lines (382 sloc) 18.289 kb
//
// Anonymous Class Macro for Nemerle
// Copyright (c) 2010, Stanislav Matveev (hardcaseminator@gmail.com)
// All rights reserved.
//
// Redistribution and use in source and binary forms, with or without modification,
// are permitted provided that the following conditions are met:
//
// * Redistributions of source code must retain the above copyright notice,
// this list of conditions and the following disclaimer.
// * 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.
// * Neither the name of the author nor the names of its contributors may be
// used to endorse or promote products derived from this software without
// specific prior written permission.
//
// THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "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 COPYRIGHT OWNER OR CONTRIBUTORS 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 System;
using Nemerle;
using Nemerle.Assertions;
using Nemerle.Utility;
using Nemerle.Compiler;
using Nemerle.Collections;
using PT = Nemerle.Compiler.Parsetree;
using TT = Nemerle.Compiler.Typedtree;
namespace Nemerle.Extensions {
public macro AnonymousClassNormalCtor(params ctor_def : array[expr])
syntax("new", "(", ctor_def, ")")
{
AnonymousClassImpl.MakeNormalCtor(NList.ToList(ctor_def))
}
public macro AnonymousClassTupleCtor(e)
syntax("new", e)
{
def decorate(e) {
| <[ $left.$right ]> => <[ $(decorate(left)).$right ]>
| <[ $left.$right(..$args) ]> => <[ $(decorate(left)).$right(..$args) ]>
| <[ [ ..$ctor_def ] ( ..$ctor_arg ) ]> =>
AnonymousClassImpl.MakeTupleCtor(ctor_def, ctor_arg)
| _ =>
Message.FatalError("Usage: 'new [a, b, c](x, y, z)' or 'new [a, b, c](t)' where 't' is tuple.")
}
decorate(e)
}
/// <summary>
/// This macros fixes Mono compilation since Mono puts macros in the reverse order.
/// </summary>
public macro AnonymousClassNormalCtor2(params ctor_def : array[expr])
syntax("new", "(", ctor_def, ")")
{
AnonymousClassImpl.MakeNormalCtor(NList.ToList(ctor_def))
}
[MacroUsage(MacroPhase.BeforeInheritance, MacroTargets.Assembly)]
public macro AnonymousClassOptions(params opts : array[expr])
{
def set_visibility(_) {
| <[ Public ]> => AnonymousClassImpl.VisibilityAttribute = NemerleModifiers.Public;
| <[ Internal ]> => AnonymousClassImpl.VisibilityAttribute = NemerleModifiers.Internal;
| e => Message.Error($"Invalid anonymous class visibility option '$e', allowed only 'Public' and 'Internal' (default).")
}
foreach(opt in opts) {
| <[ visibility = $e ]>
| <[ Visibility = $e ]> => set_visibility(e)
| e => Message.Error($"Invalid anonymous class option '$e'. Usage: 'Visibility = Public'.");
}
}
[ManagerAccess(ManagerClass.Instance)]
internal module AnonymousClassImpl {
AnonymousClassNamespace = "<>_N_AnonymousClasses";
[Record]
private class FieldInfo {
[Accessor] field : PT.Name;
[Accessor] value : PT.PExpr;
public PropertyName : string { get { field.ToString() } }
public FieldName : string { get { "_" + field.ToString() } }
[RecordIgnore] mutable generic_arg : PT.Name = null;
public GenericArg : PT.Name {
get {
when(null == generic_arg)
generic_arg = Macros.NewSymbol();
generic_arg
}
}
}
public MakeNormalCtor(ctor_def : list[PT.PExpr]) : PT.PExpr {
def fields = ctor_def.FoldRight([], fun(cd, acc) {
def append_field_info(field_init) {
| <[ $(field : name) = $value ]> => FieldInfo(field, value) :: acc
| <[ $(field : name) ]> => FieldInfo(field, field_init) :: acc
| <[ $_.$(field : name) ]> => FieldInfo(field, field_init) :: acc
| _ => Message.Error($"Expected 'a = foo()' or 'foo().x' or 'foo' got '$cd'."); acc
}
match(cd) {
| PT.PExpr.Member(_, member) as member_access =>
append_field_info(<[ $(member.GetName() : name) = $member_access ]>)
| _ => append_field_info(cd)
}
});
def ty = FindOrBuildClass(fields);
<[ $(AnonymousClassNamespace : usesite).$(ty.Name : usesite) ( ..$(fields.Map(f => f.Value) ) ) ]>
}
public MakeTupleCtor(ctor_def : list[PT.PExpr], args : list[PT.PExpr]) : PT.PExpr {
def fields = ctor_def.FoldRight([], fun(cd, acc) {
def append_field_info(field_init) {
| <[ $(field : name) ]> => FieldInfo(field, <[ () ]>) :: acc
| _ => Message.Error($"Field name expected, got '$cd'."); acc
}
match(cd) {
| PT.PExpr.Member(_, member) as member_access =>
append_field_info(<[ $(member.GetName() : name) = $member_access ]>)
| _ => append_field_info(cd)
}
});
def ty = FindOrBuildClass(fields);
match(args, fields) {
| ([], []) =>
<[ $(AnonymousClassNamespace : usesite).$(ty.Name : usesite) ( ) ]>
| ([one], fields) when (0 < fields.Length) =>
<[ $(AnonymousClassNamespace : usesite).$(ty.Name : usesite) ( $one ) ]>
| (many, fields) when (many.Length == fields.Length) =>
<[ $(AnonymousClassNamespace : usesite).$(ty.Name : usesite) ( ..$many ) ]>
| _ =>
Message.FatalError("Invalid argument list for anonymous class constructor specified.")
}
}
public VisibilityAttribute : NemerleModifiers {
key : string = "Nemerle.Extensions.AnonymousClassImpl.VisibilityAttribute";
get {
match(Manager.UserData[key]) {
| null => NemerleModifiers.Internal
| obj => obj :> NemerleModifiers
}
}
set {
Manager.UserData[key] = value
}
}
private ClassTable : Hashtable.[string, TypeInfo] {
key : string = "Nemerle.Extensions.AnonymousClassImpl.ClassTable";
get {
match(Manager.UserData[key]) {
| null =>
def table = Hashtable();
Manager.UserData[key] = table;
table
| obj => obj :> Hashtable.[string, TypeInfo]
}
}
}
private unique_name_seed : long = DateTime.Now.Ticks;
private FindOrBuildClass(fields : list[FieldInfo]) : TypeInfo {
def id = fields.FoldLeft("_N_Anonymous_", (f, name) => name + $"<$(f.PropertyName)>_") + "<>";
def name = id + unchecked((DateTime.Now.Ticks * unique_name_seed) :> uint).ToString();
match(ClassTable.TryGetValue(id)) {
| (ty, true) => ty
| _ =>
def ty = BuildClass(name, id, fields);
ClassTable[id] = ty;
ty
}
}
private MIN_TUPLE_SIZE : int = 2;
private MAX_TUPLE_SIZE : int = 20;
private BuildClass(name : string, id : string, fields : list[FieldInfo]) : TypeInfo {
def generic_args = fields.Map(f => <[ $(f.GenericArg : name) ]>);
def ty_name = <[ $(AnonymousClassNamespace : usesite).$(name : usesite) ]>;
def ty_ref = match(fields) {
| [] => ty_name
| _ => <[ $ty_name [ ..$generic_args ] ]>
}
def anonymous_ref = <[ Nemerle.Extensions.IAnonymous ]>;
def equality_comparer(t) {
<[ System.Collections.Generic.EqualityComparer.[ $t ].Default ]>
}
def external_anonymous_types = Manager.CoreEnv.NameTree.NamespaceTree.LookupTypes([AnonymousClassNamespace, id], true);
def ty = {
// Format string for debugger view
def debugger_display_fmt = {
def field_fmt(f) {
$"$(f.PropertyName) = {$(f.PropertyName)}"
}
$<#\{ ..$(fields; ", "; field_fmt) \}#>
}
// fields and properties declaration
def members = fields.Map(field => <[ decl :
[Nemerle.Utility.Accessor($(field.PropertyName : usesite))]
private $(field.FieldName : usesite) : $(field.GenericArg : name);
]>);
def attrs = AttributesAndModifiers(VisibilityAttribute %| NemerleModifiers.Sealed, [
<[ Record ]>,
<[ StructuralHashCode ]>,
<[ System.Diagnostics.DebuggerDisplay( $(debugger_display_fmt : string), @Type = "<Anonymous Type>" )]> ]);
def env = Manager.CoreEnv.EnterIntoNamespace([AnonymousClassNamespace]);
env.Define(match(fields) {
| [] =>
<[ decl:
..$attrs
class $(name : usesite) : $anonymous_ref, System.IEquatable[ $ty_ref ] {
..$members
}
]>
| _ =>
def generic_args_decl = fields.Map(f => PT.Splicable.Name(f.GenericArg));
<[ decl:
..$attrs
class $(name : usesite) [ ..$generic_args_decl ] : $anonymous_ref, System.IEquatable[ $ty_ref ] {
..$members
}
]>
})
}
// GetFields() implementation
{
def field_list_name = Macros.NewSymbol("field_list");
def field_list = fields.Map(f => <[ $(f.PropertyName : string) ]>);
ty.Define(<[ decl:
private static $(field_list_name : name) : System.Collections.ObjectModel.ReadOnlyCollection[string] = System.Array.AsReadOnly(array[ ..$field_list ]);
]>);
ty.Define(<[ decl:
GetFields() : System.Collections.ObjectModel.ReadOnlyCollection[string] implements $anonymous_ref.GetFields {
$(field_list_name : name)
}
]>);
}
// Item indexer implementation
{
def body = match(fields) {
| [] => <[ ignore(field); null ]>
| _ =>
def cases = fields.FoldRight([<[ case : | _ => null ]>],
(f, cases) => <[ case: | $(f.PropertyName : string) => this.$(f.FieldName : usesite) : object ]> :: cases );
<[ match(field) { ..$cases } ]>
}
ty.Define(<[ decl:
Item[field : string] : object implements $anonymous_ref.Item {
get { $body }
}
]>);
}
def can_be_tuple(fields) {
def len = fields.Length;
(MIN_TUPLE_SIZE <= len) && (len <= MAX_TUPLE_SIZE)
}
// GetContent implementation
{
def body = match(fields) {
| [] => <[ null ]>
| [field] => <[ this.$(field.FieldName : usesite) ]>
| fields when can_be_tuple(fields) => <[ ToTuple() ]>
| _ =>
def list_items = fields.Map(f => <[ this.$(f.FieldName : usesite) : object ]>);
<[ [ ..$list_items ] ]>
}
ty.Define(<[ decl:
GetContent() : object implements $anonymous_ref.GetContent {
$body
}
]>);
}
// Tuple interop
match(fields) {
| [] | [_] => ()
| fields when can_be_tuple(fields) =>
// ToTuple method
{
def tuple_args = fields.Map(f => <[ this.$(f.FieldName : usesite) ]>);
ty.Define(<[ decl:
public ToTuple() : Nemerle.Builtins.Tuple.[ ..$generic_args ] {
Nemerle.Builtins.Tuple( ..$tuple_args )
}
]>);
}
| _ => Message.Warning("Anonymous class contains too many fields to be convertible to tuple.");
}
// ToString implementation
{
def (_, sb) = fields.FoldLeft( (" ", <[System.Text.StringBuilder("{")]> ),
(f, (div, sb)) => (", ", <[ $sb.Append($(div + f.PropertyName + " = " : string)).Append(this.$(f.FieldName : usesite)) ]>) );
ty.Define(<[ decl:
public override ToString() : string {
$sb.Append(" }").ToString()
}
]>);
}
def equals_generic_body = fields.FoldLeft(<[ true ]>, (f, body) => <[
$body && $(equality_comparer(PT.PExpr.Ref(f.GenericArg))).Equals(this.$(f.FieldName : usesite), other.$(f.FieldName : usesite))
]>);
// Equals(other : object) implementation
{
def body = match(fields) {
| [] => <[
match(other) {
| _ is $ty_ref => true
| other is $anonymous_ref => (other.GetFields().Count == 0)
| _ => false
}
]>
| _ => <[
match(other) {
| other is $ty_ref => $equals_generic_body
| other is $anonymous_ref =>
Nemerle.Extensions.Anonymous.Equals(this, other)
| _ => false
}
]>
}
ty.Define(<[ decl:
public override Equals(other : object) : bool { $body }
]>);
}
// Typed Equals implementation
{
def body = match(fields) {
| [] => <[ !ReferenceEquals(null, other) ]>
| _ => <[ !ReferenceEquals(null, other) && $equals_generic_body ]>
}
ty.Define(<[ decl:
Equals(other : $ty_ref) : bool implements System.IEquatable[ $ty_ref ].Equals { $body }
]>);
}
// Equality operation
{
def define_eq(a, b, body) {
ty.Define(<[ decl: public static @== (a : $a, b : $b) : bool { $body } ]>);
ty.Define(<[ decl: public static @!= (a : $a, b : $b) : bool { ! $body } ]>);
}
def define_eq_b(b) {
define_eq(ty_ref, b, <[ $(equality_comparer(b)).Equals(a, b) ]>)
}
def define_eq_a(a) {
define_eq(a, ty_ref, <[ $(equality_comparer(a)).Equals(b, a) ]>)
}
define_eq_b(ty_ref);
define_eq_b(<[ object ]>);
//define_eq_b(anonymous_ref);
define_eq_a(<[ object ]>);
//define_eq_a(anonymous_ref);
}
// External anonymous classes implicit conversions
foreach(ext_ty in external_anonymous_types) {
def ext_ty_name = <[ $(AnonymousClassNamespace : usesite).$(ext_ty.Name : usesite) ]>;
def ext_ty_ref = match(fields) {
| [] => ext_ty_name
| _ => <[ $ext_ty_name [ ..$generic_args ] ]>
}
// From
def body = fields.Map(f => <[ this.$(f.FieldName : usesite) = e.$(f.PropertyName : usesite) ]>);
ty.Define(<[ decl:
public this(e : $ext_ty_ref) {
..$body
}
]>);
ty.Define(<[ decl:
public static @: (e : $ext_ty_ref) : $ty_ref {
$ty_name(e)
}
]>);
// To
def body = fields.Map(f => <[ e.$(f.FieldName : usesite) ]>);
ty.Define(<[ decl:
public static @: (e : $ty_ref) : $ext_ty_ref {
$ext_ty_name( ..$body )
}
]>);
}
//unless(Message.ErrorCount > 0)
ty.Compile();
ty
}
}
}
Jump to Line
Something went wrong with that request. Please try again.