[nem-en] Re: [svn] r6779: nemerle/trunk: . Build-1-phase.cmd
Build.cmd BuildAndReg-Release.cmd BuildAndReg.cmd NCC.npro...
Kamil Skalski
kamil.skalski at gmail.com
Sat Oct 28 17:55:42 CEST 2006
>Author: VladD2
>Date: Tue Oct 24 14:05:01 2006
>New Revision: 6779
>
> - public override IsDelegate : bool
> - {
> - get
> - {
> - parent_type != null &&
> - parent_type.tycon.FullName == "System.MulticastDelegate"
> - }
> - }
> -
Was it necessary? The new way of marking type as delegate does not
work with macros - if macro adds new delegate in a later stage of
compilation, then members gets created during call to Define - and
they use IsDelegate property on the type they are declared in. But if
you mark type as delegate AFTER call to Define, it is too late for its
members to notice this.
Because of this, the testsuite/macroprog.n test is failing.
I would rather bring the old implementation, maybe optimize it by
comparing parent type to a cached TypeInfo from InternalTypes. What do
you think?
> public override IsInterface : bool
> {
> get { if (TyManager.run_phase <= 2)
> @@ -248,6 +245,12 @@
> get { IsStruct || is_enum }
> }
>
> + //TODO: Move it member to parent class
> + public /*override*/ IsVariantOption : bool
> + {
> + get { pt_tydecl is PT.TopDeclaration.VariantOption }
> + }
> +
> public override GetModifiers () : Modifiers
> {
> modifiers
> @@ -378,7 +381,10 @@
> | PT.TopDeclaration.Class as td => td.t_extends += [t]
> | PT.TopDeclaration.Interface as td => td.t_extends += [t]
> | PT.TopDeclaration.Variant as td => td.t_extends += [t]
> - | _ => Message.Error ("cannot add interface to this kind of type")
> + | _ =>
> + Message.Error (pt_tydecl.Location,
> + $"cannot add interface to $(pt_tydecl.GetType().Name.ToLower())"
> + " ($(pt_tydecl.Name)).")
> }
> }
>
> @@ -554,6 +560,12 @@
> attributes |= NemerleAttributes.SpecialName
> }
>
> + internal MarkAsDeledate () : void
> + {
> + is_delegate = true;
> + MarkWithSpecialName ();
> + }
> +
> /**
> * Return list of types that we directly subtype.
> *
> @@ -1052,7 +1064,8 @@
> | PT.TopDeclaration.Variant (t_extends = hd :: tl)
> | PT.TopDeclaration.Enum (t_extends = hd :: tl) =>
> def hd' = bind_to_class (hd);
> - if (hd'.tycon.IsInterface) {
> + if (hd'.tycon.IsInterface)
> + {
> this.t_implements = [hd'];
> this.parent_type = null
> }
> @@ -1210,7 +1223,8 @@
> false
> }
> };
> - unless (List.ForAll2 (args, args', check_eq)) {
> + unless (List.ForAll2 (args, args', check_eq))
> + {
> Message.Error ($ "type `$(subtyped)' is implemented by type "
> "`$(FullName)' twice under different "
> "instantiations");
> @@ -1361,7 +1375,7 @@
> BindType (tenv, t)
> }
>
> - internal MonoBindType (t : PT.PExpr) : MType
> + public MonoBindType (t : PT.PExpr) : MType
> {
> MonoBindType (tenv, t)
> }
> @@ -1374,7 +1388,7 @@
> other_tenv.Bind (this.GlobalEnv, this, t, allow_tyvars = true, check_parms = true)
> }
>
> - internal MonoBindType (other_tenv : TyVarEnv, t : PT.PExpr) : MType
> + public MonoBindType (other_tenv : TyVarEnv, t : PT.PExpr) : MType
> {
> other_tenv.MonoBind (this.GlobalEnv, this, t, check_parms = true)
> }
> @@ -2277,7 +2291,7 @@
> {
> foreach (meth in meths)
> // the word ``method'' comes from meth.ToString
> - Message.Error ($ "unimplemented interface $(meth)")
> + Message.Error ($ "unimplemented interface $(meth) (in $(this.FullName) type)")
> }
>
> iface_methods.Iter (scream_about_unimplemented);
> @@ -2606,13 +2620,66 @@
> )
> : void
> {
> - loc = Completion.Relocate(loc, fileIndex, line, ch, lineOffset, chOffset);
> - parts_location = parts_location.Map(Completion.Relocate(_, fileIndex, line, ch, lineOffset, chOffset));
> + //def timer = System.Diagnostics.Stopwatch.StartNew();
> + def info = RelocationInfo (fileIndex, line, ch, lineOffset, chOffset);
> + // The RelocateImpl() is autogenerated by SupportRelocation macro.
> + RelocateImpl (info/*, ""*/);
> +
> + //System.Diagnostics.Trace.WriteLine($"builder.Relocate() took: $(timer.Elapsed)");
> + //System.Diagnostics.Trace.WriteLine($"info.VisitCount=$(info.VisitCount) info.NodeCount=$(info.NodeCount)");
> + }
> +
> +
> + /// Get direct (derived directly) subtypes of given type.
> + public GetDirectSubTypes() : list[TypeBuilder]
> + {
> + def nameTree = this.GlobalEnv.NameTree;
> + def nsRoot = nameTree.NamespaceTree;
> + def typeBuilders = nsRoot.GetTypeBuilders();
> +
> + $[ t | t in typeBuilders, t.BaseType : object == this ]
> + }
> +
> + /// Get all subtypes of given type.
> + public GetAllSubTypes() : list[TypeBuilder]
> + {
> + def nameTree = this.GlobalEnv.NameTree;
> + def nsRoot = nameTree.NamespaceTree;
> + def typeBuilders = nsRoot.GetTypeBuilders();
> +
> + def subTypes = Hashtable();
> +
> + def getDirectSubTypes(ty)
> + {
> + def subTypes1 = SCG.List();
> + foreach (t when t.BaseType : object == ty in typeBuilders)
> + unless (subTypes.ContainsKey (t))
> + {
> + subTypes[t] = 0 : byte;
> + subTypes1.Add(t);
> + }
> +
> + foreach (subType in subTypes1)
> + getDirectSubTypes(subType)
> + }
> +
> + def isImplementInterface(t)
> + {
> + //System.Diagnostics.Trace.Assert(t.Name != "MemberBuilder");
> + t.t_implements.Exists(x => x.tycon : object == this)
> + }
> +
> + when (IsInterface)
> + foreach (t when t.t_implements != null && isImplementInterface (t) in typeBuilders)
> + unless (subTypes.ContainsKey (t))
> + {
> + subTypes[t] = 0 : byte;
> + getDirectSubTypes(t);
> + }
> +
> + getDirectSubTypes(this);
>
> - // IT:
> - // There is a bug here. The member can an inner type.
> - foreach (member :> MemberBuilder in member_list)
> - member.Relocate(fileIndex, line, ch, lineOffset, chOffset);
> + subTypes.Keys.ToList()
> }
> }
> } // ns
>
> Modified: nemerle/trunk/ncc/parsing/AST.n
> ==============================================================================
> --- nemerle/trunk/ncc/parsing/AST.n (original)
> +++ nemerle/trunk/ncc/parsing/AST.n Tue Oct 24 14:05:01 2006
> @@ -214,13 +214,13 @@
> | SpecialName = 0x08000
> | Partial = 0x10000
> | Extern = 0x20000
> - | CompilerMutable = 0x40000 // field is immutable, but compiler overrides it and can assign something
> + /// field is immutable, but compiler overrides it and can assign something
> + | CompilerMutable = 0x40000
>
> | VirtualityModifiers = New %| Abstract %| Virtual %| Override
> | AccessModifiers = Public %| Private %| Protected %| Internal
> }
>
> -
> public partial class Modifiers
> {
> public mutable mods : NemerleAttributes;
>
> Modified: nemerle/trunk/ncc/parsing/ParseTree.n
> ==============================================================================
> --- nemerle/trunk/ncc/parsing/ParseTree.n (original)
> +++ nemerle/trunk/ncc/parsing/ParseTree.n Tue Oct 24 14:05:01 2006
> @@ -128,6 +128,37 @@
> }
> }
> }
> +
> + public IsMutable () : bool { modifiers.mods %&& NemerleAttributes.Mutable }
> +
> + public override ToString() : string
> + {
> + def attrs1 = Attributes.ToString().ToLower().Replace(",", "");
> + def attrs = if (attrs1 == "") attrs1 else (attrs1 + " ");
> + def ifMutable () { if (IsMutable ()) "mutable " else "" }
> + def prefix() { $"$(attrs)$(ifMutable())" }
> + def name = this.Name;
> +
> + match (this)
> + {
> + | TypeDeclaration(td) => $"TopDeclaration: $(prefix())Name=$name ($td)"
> + | Field(ty) => $"Field: $(prefix())$name : $ty;"
> + | Function(header, _, _) => $"Function: $(prefix())$header;"
> + | Property(ty, _, dims, get, set) =>
> + def getSet = match ((get, set))
> + {
> + | (Some, Some) => " { get; set; }"
> + | (None, Some) => " { set; }"
> + | (Some, None) => " { get; }"
> + | (None, None) => ";"
> + }
> +
> + $"Property: $(prefix())$name : $ty" + (if (dims.IsEmpty) "" else dims.ToString()) + getSet
> +
> + | Event(ty, _, _, _) => $"Event: $(prefix())$name : $ty;"
> + | EnumOption(value) => $"$name" + match (value) { | Some(v) => $" = $v" | None => "" }
> + }
> + }
> }
>
> [Record]
> @@ -172,6 +203,11 @@
> public constraints : list [Constraint];
>
> public static Empty : Typarms = Typarms ([], []);
> +
> + public override ToString() : string
> + {
> + if (tyvars.IsEmpty) "" else ("[" + tyvars.Map(_.ToString()).ToString(", ") + "]")
> + }
> }
>
> /** class encapsulating name of variable for purpose of
> @@ -385,6 +421,11 @@
> | _ => throw System.ArgumentException ($"incorrect expression supplied for parameter creation: $from")
> }
> }
> +
> + public override ToString() : string
> + {
> + $"$(this.Name) : $ty"
> + }
> }
>
> public class Fun_header : Located
> @@ -420,6 +461,12 @@
> this (loc, name, ret_type, parms);
> this.typarms = typarms;
> }
> +
> + public override ToString() : string
> + {
> + def parms = parms.ToString (", ");
> + $"$name$typarms($parms) : $ret_type"
> + }
> }
>
> [Record]
>
> Modified: nemerle/trunk/ncc/parsing/PreParser.n
> ==============================================================================
> --- nemerle/trunk/ncc/parsing/PreParser.n (original)
> +++ nemerle/trunk/ncc/parsing/PreParser.n Tue Oct 24 14:05:01 2006
> @@ -29,16 +29,19 @@
> using Nemerle.Compiler;
> using Nemerle.Collections;
> using Nemerle.Compiler.Parsetree;
> +using Nemerle.Utility;
> using SCG = System.Collections.Generic;
>
> namespace Nemerle.Compiler
> {
> - class PreParserException : System.Exception {
> - public Location : Location;
> + class PreParserException : System.Exception
> + {
> + [Accessor]
> + public mutable _location : Location;
>
> - public this (loc : Location, msg : string) {
> + public this (location : Location, msg : string) {
> base (msg);
> - this.Location = loc;
> + _location = location;
> }
> }
>
>
> Modified: nemerle/trunk/ncc/passes.n
> ==============================================================================
> --- nemerle/trunk/ncc/passes.n (original)
> +++ nemerle/trunk/ncc/passes.n Tue Oct 24 14:05:01 2006
> @@ -29,6 +29,7 @@
> using SCG = System.Collections.Generic;
> using Nemerle.Collections;
> using Nemerle.Compiler.Parsetree;
> +using Nemerle.Utility;
>
> namespace Nemerle.Compiler
> {
> @@ -105,7 +106,8 @@
> internal mutable Message_emitted_hints : Hashtable [string, int] = Hashtable ();
>
> protected internal mutable Message_output : System.IO.TextWriter;
> - public LocationStack : Vector [Location] = Vector (32);
> + [Accessor]
> + private mutable _locationStack : Vector [Location] = Vector (32);
>
> /** Called by parser when simple "using" directive parsed .
> * name : list [string] - qualified identifier/
> @@ -431,5 +433,21 @@
> Hierarchy.RemoveProgramTypes();
> }
> }
> +
> + public Lookup (type_name : string) : TypeInfo
> + {
> + match (NameTree.LookupExactType (type_name)) {
> + | Some (t) => t
> + | None => Util.ice ("internal type " + type_name + " not found")
> + }
> + }
> +
> + public Lookup (type_name : string, args_count : int) : TypeInfo
> + {
> + match (NameTree.LookupExactType (type_name, args_count)) {
> + | Some (t) => t
> + | None => Util.ice ("internal type " + type_name + " not found")
> + }
> + }
> }
> }
>
> Modified: nemerle/trunk/ncc/typing/TypedTree.n
> ==============================================================================
> --- nemerle/trunk/ncc/typing/TypedTree.n (original)
> +++ nemerle/trunk/ncc/typing/TypedTree.n Tue Oct 24 14:05:01 2006
> @@ -278,7 +278,7 @@
>
> public override ToString () : string
> {
> - name
> + $"$name($(parms.ToString(\", \"))) : $ret_type"
> }
>
> public GetRetTypeRequiredModifiers () : array [System.Type]
>
> Modified: nemerle/trunk/ncc/typing/Typer-CallTyper.n
> ==============================================================================
> --- nemerle/trunk/ncc/typing/Typer-CallTyper.n (original)
> +++ nemerle/trunk/ncc/typing/Typer-CallTyper.n Tue Oct 24 14:05:01 2006
> @@ -393,7 +393,8 @@
> // handled already in DeduceFunctionType
> ReportError (messenger, $ "wrong number of parameters in "
> "call, needed $formal_count, got "
> - "$actual_count");
> + "$actual_count"
> + + (if (header != null) $" (in '$header')" else ""));
> }
> }
> }
>
> _______________________________________________
> https://nemerle.org/mailman/listinfo/svn
>
--
Kamil Skalski
http://nazgul.omega.pl
More information about the devel-en
mailing list