[nem-pl] Takie tam
"Paweł W. Olszta"
Pawel.Olszta at adv.pl
Mon Dec 29 23:39:56 CET 2003
...
--
My opinions may have changed, but not the fact
that I am right. -- Ashley Brilliant
-------------- next part --------------
Index: boot/ncc.exe
===================================================================
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Index: ncc/cgexpr.n
===================================================================
--- ncc/cgexpr.n (revision 896)
+++ ncc/cgexpr.n (working copy)
@@ -517,7 +517,8 @@
}
| E_method_ref (o, m) =>
CE_method_ref (self (o), lookup_function (m.header))
- | E_base => CE_base ()
+ | E_base (ti) =>
+ CE_base (lookup_class (ti))
| E_ref (d) =>
if (d == ctx.current_fun)
match (d.kind) {
Index: ncc/tyexpr.n
===================================================================
--- ncc/tyexpr.n (revision 894)
+++ ncc/tyexpr.n (working copy)
@@ -540,7 +540,7 @@
Message.fatal_error ("type `" + baseti.fullname () + "' has no constructors")
| decls =>
def mkbase (d : Decl) {
- def e = E_base ();
+ def e = E_base (baseti);
e.expr_ty <- d.ty /- ti.subtyping_subst (baseti);
e.loc <- fnc.loc;
e
Index: ncc/testsuite/ok-cgil.n
===================================================================
--- ncc/testsuite/ok-cgil.n (revision 896)
+++ ncc/testsuite/ok-cgil.n (working copy)
@@ -1,24 +1,61 @@
public class CGILTest
{
+ public this () { }
+
public method_a (index : int) : int
{
mutable x <- 650;
def y = false;
def z = "Alamakota";
+
+ this.method_b (index)
+ }
+
+ public method_b (index : int) : int
+ {
+ mutable x <- 650;
x <- 750;
+
+ x
+ }
- if (y) {
- x * 2
- }
- else {
- x * 3
- }
+ public method_c (index : int) : int
+ {
+ def x = 255;
+ def y = false;
+
+ def z =
+ if (true)
+ x * 2
+ else
+ x * 3;
+
+ def text = "Ala ma kota!";
+
+(*
+ def sb = System.Text.StringBuilder (text, x);
+
+ def _ = sb.Append (' ');
+ def _ = sb.Append ("I psa!");
+
+ def text = sb.ToString ();
+
+ System.Console.WriteLine (text);
+*)
+
+ z
}
public static Main () : void
{
+ def x = CGILTest ();
+ def y = x.method_c (10);
+
+ when (y != 5) { def _ = x.method_b (7); () };
+
+ System.Console.WriteLine ("{0}", (y :> System.Object));
}
}
Index: ncc/typedtree.n
===================================================================
--- ncc/typedtree.n (revision 894)
+++ ncc/typedtree.n (working copy)
@@ -175,7 +175,7 @@
| E_try_finally { body : Expr; handler : Expr; }
| E_literal { val : Literal; }
| E_this
- | E_base
+ | E_base { base_class : Tyinfo; }
| E_type_conversion { expr : Expr; ty : Type; } // (expr :> ty)
| E_type_enforcement { expr : Expr; ty : Type; } // (expr : ty)
| E_sequence { e1 : Expr; e2 : Expr; }
Index: ncc/cgtree.n
===================================================================
--- ncc/cgtree.n (revision 896)
+++ ncc/cgtree.n (working copy)
@@ -142,7 +142,7 @@
| CE_mkarray { initializers : list (CG_expr); }
| CE_indexer { ty : CG_type; obj : CG_expr; args : list (CG_expr); }
- | CE_base
+ | CE_base { klass : CM_class; }
(*
these are introduced during tail recursion optimization and never
Index: ncc/cgil.n
===================================================================
--- ncc/cgil.n (revision 896)
+++ ncc/cgil.n (working copy)
@@ -42,9 +42,9 @@
*)
variant CGIL_tree {
| CGIL_class { type_builder : TypeBuilder; subtree : list (CGIL_tree); }
- | CGIL_field { field : CM_field; field_builder : FieldBuilder; }
- | CGIL_constructor { constructor : CM_method; constructor_builder : ConstructorBuilder; }
- | CGIL_method { method : CM_method; method_builder : MethodBuilder; }
+ | CGIL_field { class_name : string; field : CM_field; field_builder : FieldBuilder; }
+ | CGIL_constructor { class_name : string; constructor : CM_method; constructor_builder : ConstructorBuilder; }
+ | CGIL_method { class_name : string; method : CM_method; method_builder : MethodBuilder; }
}
@@ -63,6 +63,11 @@
(* create the type builder queue *)
this._type_builder_queue <- Queue ();
+ (* create the member builders storage *)
+ _field_builders <- Hashtable ();
+ _ctor_builders <- Hashtable ();
+ _method_builders <- Hashtable ();
+
(* create a weak assembly name and define a dynamic assembly *)
this._assembly_name <- System.Reflection.AssemblyName ();
this._assembly_name.Version <- System.Version (1, 0, 0, 0); // FIXME
@@ -74,7 +79,7 @@
(* create a dynamic module *)
this._module_builder <-
- this._assembly_builder.DefineDynamicModule ("CGILTest", "cgil-test.dll"); // FIXME
+ this._assembly_builder.DefineDynamicModule ("CGILTest", "cgil-test.exe", true); // FIXME
(* select the classes that have to be generated separately *)
def (aux_decls, standard_decls) =
@@ -104,9 +109,20 @@
(* execute the type builder queue *)
create_types_in_queue ();
+
+ (* set the entry point *)
+ def entry_point_class = reflect_type ("CGILTest");
+
+ assert (entry_point_class != null);
+
+ def entry_point_method_info =
+ entry_point_class.GetMethod ("Main");
+ _module_builder.SetUserEntryPoint (entry_point_method_info);
+ _assembly_builder.SetEntryPoint (entry_point_method_info, PEFileKinds.ConsoleApplication);
+
(* save the assembly *)
- this._assembly_builder.Save ("cgil-test.dll"); // FIXME
+ this._assembly_builder.Save ("cgil-test.exe"); // FIXME
}
@@ -243,8 +259,13 @@
def internal_type = reflect_nemerle_type (t);
this.reflect_type (internal_type.FullName + "[]", true, true)
- | CT_ref (name) =>
- this.reflect_type (name, true, true)
+ | CT_ref (name) =>
+ match (name) {
+ | "bool" => typeof (System.Boolean)
+ | "int" => typeof (System.Int32)
+ | "string" => typeof (System.String)
+ | _ => this.reflect_type (name, true, true)
+ }
| CT_tuple (arity) =>
this.reflect_type ("Nemerle.Tuple" + string_of_int (arity), false, false)
@@ -259,8 +280,47 @@
| CT_unreached => Util.ice ("nemerle_to_framework_type:CT_unreached")
}
}
+
+ (**
+ *
+ *)
+ internal split_global_ref (global_ref : string) : string * string
+ {
+ def last_dot = global_ref.LastIndexOf ('.');
+ assert (last_dot != -1);
+
+ (global_ref.Substring (0, last_dot), global_ref.Substring (last_dot + 1))
+ }
+ (**
+ *
+ *)
+ internal is_value_type (ty : CG_type) : bool
+ {
+ match (ty) {
+ | CT_bool => true
+ | CT_ref (name) =>
+ match (name) {
+ // FIXME: add all the other types here
+ // FIXME: implement intelligent type name unaliasing
+ // FIXME: move this function to tyutil or wherever it belongs...
+ | "bool"
+ | "System.Boolean"
+ | "char"
+ | "System.Char"
+ | "int"
+ | "Int32"
+ | "System.Int32"
+ | "float"
+ | "System.Single"
+ | "System.Double" => true
+ | _ => false
+ }
+ | _ => false
+ }
+ }
+
(**
* Converts Nemerle field modifiers to the CLI field attributes.
*)
@@ -324,7 +384,7 @@
(**
*
*)
- private type_list_to_type_array (x : list (System.Type)) : array (System.Type) {
+ internal type_list_to_type_array (x : list (System.Type)) : array (System.Type) {
def result =
(System.Array.CreateInstance (typeof (System.Type), List.length (x)) :> array (System.Type));
@@ -415,7 +475,8 @@
def walk_members (decls : list (CG_member)) : list (CGIL_tree) {
match (decls) {
| decl :: rest =>
- this.make_subtree (decl, new_type_builder) :: walk_members (rest)
+ this.make_subtree (new_type_builder.FullName, decl, new_type_builder)
+ :: walk_members (rest)
| [] => []
}
};
@@ -429,7 +490,7 @@
* This method walks the declarations tree, creating partial types
* and building the CGIL tree of the compilation unit.
*)
- make_subtree (m : CG_member, type_builder : TypeBuilder) : CGIL_tree
+ make_subtree (parent_class_name : string, m : CG_member, type_builder : TypeBuilder) : CGIL_tree
{
assert (type_builder != null);
@@ -438,7 +499,7 @@
this.make_class (m, type_builder)
| (CM_field) as f =>
- CGIL_field (f, null)
+ CGIL_field (parent_class_name, f, null)
| (CM_property) as p =>
Message.fatal_error ("emitting properties is not supported yet")
@@ -447,8 +508,8 @@
CGopt.tail_call_optimize (m);
match (m.ret_type) {
- | CT_unreached => CGIL_constructor (m, null)
- | _ => CGIL_method (m, null)
+ | CT_unreached => CGIL_constructor (parent_class_name, m, null)
+ | _ => CGIL_method (parent_class_name, m, null)
}
}
}
@@ -471,9 +532,9 @@
};
CGIL_class (type_builder, walk_members (members))
- | CGIL_field (field, _) =>
+ | CGIL_field (class_name, field, _) =>
assert (type_builder != null);
-
+
def field_builder =
type_builder.DefineField (field.name,
this.reflect_nemerle_type (field.ty),
@@ -483,17 +544,19 @@
field_builder.SetCustomAttribute (this.make_nemerle_type_attr (field.encoded_type));
};
- CGIL_field (field, field_builder)
+ _field_builders.Add (class_name + "." + field.name, field_builder);
+
+ CGIL_field (class_name, field, field_builder)
- | CGIL_constructor (constructor, _) =>
+ | CGIL_constructor (class_name, constructor, _) =>
assert (type_builder != null);
- this.make_constructor_skeleton (constructor, type_builder)
+ this.make_constructor_skeleton (class_name, constructor, type_builder)
- | CGIL_method (method, _) =>
+ | CGIL_method (class_name, method, _) =>
assert (type_builder != null);
- this.make_method_skeleton (method, type_builder)
+ this.make_method_skeleton (class_name, method, type_builder)
}
}
@@ -508,12 +571,12 @@
def walk_branches (branch) { this.add_implementations (branch) }; // FIXME: aargh
CGIL_class (type_builder, List.map (walk_branches, subtree))
- | (CGIL_constructor (constructor, constructor_builder)) as member =>
- this.add_constructor_body (constructor, constructor_builder);
+ | (CGIL_constructor (class_name, constructor, constructor_builder)) as member =>
+ this.add_constructor_body (class_name, constructor, constructor_builder);
member
- | (CGIL_method (method, method_builder)) as member =>
- this.add_method_body (method, method_builder);
+ | (CGIL_method (class_name, method, method_builder)) as member =>
+ this.add_method_body (class_name, method, method_builder);
member
| member => member
@@ -521,22 +584,27 @@
}
-
- private make_constructor_skeleton (m : CM_method, type_builder : TypeBuilder) : CGIL_tree
+ (**
+ *
+ *)
+ private make_constructor_skeleton (class_name : string, m : CM_method, type_builder : TypeBuilder) : CGIL_tree
{
(* build the parameter types array *)
def mkparm (v : CG_val) : System.Type {
this.reflect_nemerle_type (v.ty)
};
-
- def parameter_types = this.type_list_to_type_array (List.map (mkparm, m.parms));
+ def parm_types_list = List.map (mkparm, m.parms);
+ def parm_types_array = type_list_to_type_array (parm_types_list);
+
(* create the constructor builder *)
def constructor_builder =
- type_builder.DefineConstructor (this.make_method_attributes (m.modifiers),
- CallingConventions.Standard, parameter_types);
+ type_builder.DefineConstructor (make_method_attributes (m.modifiers),
+ CallingConventions.Standard, parm_types_array);
- CGIL_constructor (m, constructor_builder)
+ _ctor_builders.Add (encode_ctor_name (class_name, parm_types_list), constructor_builder);
+
+ CGIL_constructor (class_name, m, constructor_builder)
}
@@ -544,10 +612,20 @@
(**
*
*)
- private add_constructor_body (constructor : CM_method, constructor_builder : ConstructorBuilder) : void
+ private add_constructor_body (class_name : string, constructor : CM_method, constructor_builder : ConstructorBuilder) : void
{
def il_generator = constructor_builder.GetILGenerator ();
+ def class_type = reflect_type (class_name);
+ def base_type = class_type.BaseType;
+
+ def default_ctor_info = base_type.GetConstructor (System.Type.EmptyTypes);
+
+ il_generator.Emit (OpCodes.Ldarg_0);
+ il_generator.Emit (OpCodes.Call, default_ctor_info);
+
+ def _ = CodeGenerator (this, il_generator, class_name, constructor);
+
il_generator.Emit (OpCodes.Ret);
}
@@ -556,39 +634,37 @@
(**
*
*)
- private make_method_skeleton (m : CM_method, type_builder : TypeBuilder) : CGIL_tree
+ private make_method_skeleton (class_name : string, m : CM_method, type_builder : TypeBuilder) : CGIL_tree
{
(* build the return type and parameter types *)
def mkparm (v : CG_val) : System.Type {
this.reflect_nemerle_type (v.ty)
};
- def return_type = this.reflect_nemerle_type (m.ret_type);
+ def return_type = reflect_nemerle_type (m.ret_type);
- def parameter_types = this.type_list_to_type_array (List.map (mkparm, m.parms));
+ def parm_types_list = List.map (mkparm, m.parms);
+ def parm_types_array = type_list_to_type_array (parm_types_list);
(* add the method to the type builder *)
def method_builder =
- type_builder.DefineMethod (m.name, this.make_method_attributes (m.modifiers),
- return_type, parameter_types);
+ type_builder.DefineMethod (m.name, make_method_attributes (m.modifiers),
+ return_type, parm_types_array);
- CGIL_method (m, method_builder)
+ _method_builders.Add (encode_method_name (class_name, m.name, parm_types_list), method_builder);
+
+ CGIL_method (class_name, m, method_builder)
}
(**
*
*)
- private add_method_body (method : CM_method, method_builder : MethodBuilder) : void
+ private add_method_body (class_name : string, method : CM_method, method_builder : MethodBuilder) : void
{
def il_generator = method_builder.GetILGenerator ();
-
- when (method.name == "method_a") {
- def _ = CodeGenerator (this, il_generator, method.body);
- ()
- };
- il_generator.Emit (OpCodes.Ldstr, "Hello world, my name is not Jan B.!");
+ il_generator.Emit (OpCodes.Ldstr, "Hello world from '" + method.name + "'");
def system_console = typeof(System.Console);
@@ -596,8 +672,14 @@
system_console.GetMethod ("WriteLine", (mkarray [typeof(string)] :> array (System.Type)));
il_generator.Emit (OpCodes.Call, method_info);
- il_generator.Emit (OpCodes.Ret);
+ def _ = CodeGenerator (this, il_generator, class_name, method);
+
+ (* FIXME: kurwa maæ, ja sobie obieca³em ¿e nie bêdê przeklinaæ w kodzie, ale... ;-) *)
+ unless (class_name == "Nemerle.Core.Null_match" && method.name == "raise_self") {
+ il_generator.Emit (OpCodes.Ret)
+ };
+
(*
def (pref, r) = make_complex (flat (m.body));
def ret =
@@ -614,6 +696,112 @@
}
+
+ (**
+ *
+ *)
+ internal get_field_builder (field_name : string) : option (FieldBuilder)
+ {
+ _field_builders.Get (field_name)
+ }
+
+
+ (**
+ *
+ *)
+ internal get_field_info (field_name : string) : option (FieldInfo)
+ {
+ def field_builder = get_field_builder (field_name);
+
+ match (field_builder) {
+ | Some (field_builder) => Some ((field_builder :> FieldInfo))
+ | None =>
+ (* lookup the externals and the Framework *)
+ None () // FIXME
+ }
+ }
+
+ (**
+ *
+ *)
+ private encode_ctor_name (class_name : string, parms : list (System.Type)) : string
+ {
+ def iter_parms (parms : list (System.Type)) {
+ match (parms) {
+ | [] => ""
+ | parm :: rest =>
+ "%%" + parm.FullName + iter_parms (rest)
+ }
+ };
+
+ class_name + "<<" + iter_parms (parms) + ">>"
+ }
+
+ (**
+ *
+ *)
+ private encode_method_name (class_name : string, method_name : string, parms : list (System.Type)) : string
+ {
+ def iter_parms (parms : list (System.Type)) {
+ match (parms) {
+ | [] => ""
+ | parm :: rest =>
+ "%%" + parm.FullName + iter_parms (rest)
+ }
+ };
+
+ class_name + "::" + method_name + "<<" + iter_parms (parms) + ">>"
+ }
+
+ (**
+ *
+ *)
+ internal get_ctor_builder (encoded_ctor_name : string) : option (ConstructorBuilder)
+ {
+ _ctor_builders.Get (encoded_ctor_name)
+ }
+
+ (**
+ *
+ *)
+ internal get_ctor_info (class_name : string, parms : list (System.Type)) : option (ConstructorInfo)
+ {
+ def ctor_builder = get_ctor_builder (encode_ctor_name (class_name, parms));
+
+ match (ctor_builder) {
+ | Some (ctor_builder) => Some ((ctor_builder :> ConstructorInfo))
+ | None =>
+ (* lookup the externals and the Framework *)
+ None () // FIXME
+ }
+ }
+
+
+ (**
+ *
+ *)
+ internal get_method_builder (encoded_method_name : string) : option (MethodBuilder)
+ {
+ _method_builders.Get (encoded_method_name)
+ }
+
+ (**
+ *
+ *)
+ internal get_method_info (class_name : string, method_name : string,
+ parms : list (System.Type)) : option (MethodInfo)
+ {
+ def method_builder = get_method_builder (encode_method_name (class_name, method_name, parms));
+
+ match (method_builder) {
+ | Some (method_builder) => Some ((method_builder :> MethodInfo))
+ | None =>
+ (* lookup the externals and the Framework *)
+ None () // FIXME
+ }
+ }
+
+
(* -- PRIVATE FIELDS --------------------------------------------------- *)
private mutable _assembly_name : System.Reflection.AssemblyName;
@@ -621,22 +809,38 @@
private mutable _module_builder : ModuleBuilder;
private mutable _type_builder_queue : Queue (TypeBuilder);
private mutable _emit_nemerle_attributes : bool;
+ private mutable _field_builders : Hashtable (string, FieldBuilder);
+ private mutable _ctor_builders : Hashtable (string, ConstructorBuilder);
+ private mutable _method_builders : Hashtable (string, MethodBuilder);
}
+
+
+ (* ----------------------------------------------------------------------- *)
+ (* -- CODE GENERATOR CLASS ----------------------------------------------- *)
+ (* ----------------------------------------------------------------------- *)
+
+ (**
+ *
+ *)
internal class CodeGenerator
{
private mutable _cgil : CGIL;
private mutable _ilg : ILGenerator;
+ private mutable _class_name : string;
+ private mutable _parms : list (CG_val);
(**
*
*)
- internal this (cgil : CGIL, ilg : ILGenerator, method_body : CG_expr)
+ internal this (cgil : CGIL, ilg : ILGenerator, class_name : string, method : CM_method)
{
_cgil <- cgil;
_ilg <- ilg;
+ _class_name <- class_name;
+ _parms <- method.parms;
- emit (method_body)
+ emit (method.body)
}
(**
@@ -665,7 +869,7 @@
def cutoff_after_raise (e : list (CG_expr), acc : list (CG_expr)) : list (CG_expr) {
match (e) {
| [] => List.rev (acc)
- | (CE_raise) as expr :: _ =>
+ | (CE_raise) as expr :: _ =>
cutoff_after_raise ([], (expr : CG_expr) :: acc)
| (CE_restart) as expr :: _ =>
cutoff_after_raise ([], (expr : CG_expr) :: acc)
@@ -700,20 +904,31 @@
*)
| CE_let (let_val, let_in) =>
+ mutable cutoff <- false;
+
match (let_val.val) {
| CE_none =>
let_val.local_slot <- _ilg.DeclareLocal (_cgil.reflect_nemerle_type (let_val.ty));
+ let_val.local_slot.SetLocalSymInfo (let_val.name);
| _ =>
+ match (let_val.val) {
+ | CE_raise =>
+ Message.debug ("{CE_let _ = CE_raise} cutoff");
+ cutoff <- true
+ | _ => ()
+ };
+
emit (let_val.val);
- unless (is_dummy_type (let_val.ty)) {
+ unless (cutoff || is_dummy_type (let_val.ty)) {
let_val.local_slot <- _ilg.DeclareLocal (_cgil.reflect_nemerle_type (let_val.ty));
+ let_val.local_slot.SetLocalSymInfo (let_val.name);
_ilg.Emit (OpCodes.Stloc_S, let_val.local_slot);
}
};
- emit (let_in)
+ unless (cutoff) { emit (let_in) }
(*
def (p, r) = make_complex (flat (v.val));
@@ -726,13 +941,38 @@
CS_complex (pref ++ p, r)
*)
- | CE_assign (CE_ref (local_var), expr) =>
+
+ (* -- ASSIGNMENTS -------------------------------------------------- *)
+
+ | CE_assign (CE_ref (local_var), val) =>
assert (local_var.local_slot != null);
- emit (expr);
+ emit (val);
_ilg.Emit (OpCodes.Stloc_S, local_var.local_slot)
+
+ | CE_assign (CE_field_ref (base_object, field), val) =>
+ def base_class_type =
+ _cgil.reflect_nemerle_type (type_of (base_object));
+
+ assert (base_class_type != null);
+
+ def field_info =
+ _cgil.get_field_info (base_class_type.FullName + "." + field.name);
+ assert (Option.is_some (field_info));
+
+ emit (base_object);
+ emit (val);
+
+ _ilg.Emit (OpCodes.Stfld, Option.unsome (field_info));
+
+ | CE_assign (CE_property_ref (expr, prop), val) =>
+ ()
+
+ | CE_assign (CE_tuple_ref (expr, index), val) =>
+ ()
+
(*
| CE_assign (e1, e2) =>
Util.ice (
@@ -741,10 +981,8 @@
CS_complex (p1 ++ p2, r1 ++ " = " ++ r2)
*)
- | CE_call (function, instructions) =>
- List.iter (emit, instructions);
- emit (function)
+ (* -- IF/THEN/ELSE ------------------------------------------------- *)
| CE_if (_, CE_literal (L_bool (true)), e1, _) =>
emit (e1)
@@ -767,47 +1005,234 @@
_ilg.MarkLabel (label_condition_fi);
+
+ (* -- TYPE CONVERSIONS --------------------------------------------- *)
+
+ (* special case: do not cast values to the CT_void type *)
+ | CE_cast (expr, CT_void) =>
+ // FIXME: should this pop the stack?
+ Message.warning ("CGIL: emit: casting expression to CT_void");
+ emit (expr)
+
+ (* box value types, cast all the other types to System.Object *)
+ | CE_cast (expr, CT_object)
+ | CE_cast (expr, CT_ref ("System.Object")) =>
+ emit (expr);
+
+ Message.debug ("CE_cast to CT_object: " + pretty_print (expr));
+
+ def type_of_expr = type_of (expr);
+
+ if (_cgil.is_value_type (type_of_expr))
+ _ilg.Emit (OpCodes.Box, _cgil.reflect_nemerle_type (type_of_expr))
+ else
+ _ilg.Emit (OpCodes.Castclass, typeof(System.Object))
+
+ (* unbox, convert or upcast / downcast *)
+ | CE_cast (expr, cast_to_type) =>
+ emit (expr);
+
+ if (_cgil.is_value_type (cast_to_type)) {
+
+ if (_cgil.is_value_type (type_of (expr))) {
+
+ // conversion between value types
+ Message.debug ("CGIL: emit: CE_cast: conversion between value types")
+
+ // FIXME: add type checking / conversion here
+ }
+ else {
+
+ // unboxing
+ _ilg.Emit (OpCodes.Unbox)
+ }
+ }
+ else {
+
+ // upcasting / downcasting
+ _ilg.Emit (OpCodes.Castclass, _cgil.reflect_nemerle_type (cast_to_type))
+ }
+
+
+ (* -- REFERENCES --------------------------------------------------- *)
+
| CE_ref (decl) =>
- assert (decl.local_slot != null);
- _ilg.Emit (OpCodes.Ldloc, decl.local_slot)
+ match (find_parm (decl.name)) {
+ | Some ((parm, index)) =>
+ match (index) {
+ | 0 => _ilg.Emit (OpCodes.Ldarg_0)
+ | 1 => _ilg.Emit (OpCodes.Ldarg_1)
+ | 2 => _ilg.Emit (OpCodes.Ldarg_2)
+ | 3 => _ilg.Emit (OpCodes.Ldarg_3)
+ | n when n < 256 => _ilg.Emit (OpCodes.Ldarg_S, index)
+ | _ => _ilg.Emit (OpCodes.Ldarg, index)
+ }
+ | None =>
+ assert (decl.local_slot != null);
+ _ilg.Emit (OpCodes.Ldloc, decl.local_slot)
+ }
- | CE_global_ref (m) =>
+ | CE_field_ref (base_object, field) =>
+ def base_class_type =
+ _cgil.reflect_nemerle_type (type_of (base_object));
+
+ assert (base_class_type != null);
+
+ def field_info =
+ _cgil.get_field_info (base_class_type.FullName + "." + field.name);
+
+ assert (Option.is_some (field_info));
+
+ emit (base_object);
+
+ _ilg.Emit (OpCodes.Ldfld, Option.unsome (field_info));
+
+ | CE_property_ref (e, p) =>
+ ()
+
+ (* FIXME
+ def e = flat (e);
+ mono (e, csref (e) ++ "." ++ p.name)
+ *)
+
+ | CE_tuple_ref (e, n) =>
+ ()
+
+ (* FIXME
+ def e = flat (e);
+ mono (e, csref (e) ++ ".field" ++ string_of_int (n + 1))
+ *)
+
+
+ (* -- CALLS -------------------------------------------------------- *)
+
+ | CE_call (CE_ctor_ref (ctor_class), ctor_params) =>
+ List.iter (emit, ctor_params);
+
+ def mk_param (ctor_param : CG_expr) : System.Type {
+ _cgil.reflect_nemerle_type (type_of (ctor_param))
+ };
+
+ def parm_types_list = List.map (mk_param, ctor_params);
+
+ def ctor_info =
+ _cgil.get_ctor_info (ctor_class.ns + ctor_class.name, parm_types_list);
+
+ assert (Option.is_some (ctor_info));
+
+ _ilg.Emit (OpCodes.Newobj, Option.unsome (ctor_info))
+
+
+ | CE_call (CE_base (base_class), ctor_params) =>
+ List.iter (emit, ctor_params);
+
+ def mk_param (ctor_param : CG_expr) : System.Type {
+ _cgil.reflect_nemerle_type (type_of (ctor_param))
+ };
+
+ def parm_types_list = List.map (mk_param, ctor_params);
+
+ def ctor_info =
+ _cgil.get_ctor_info (base_class.ns + base_class.name, parm_types_list);
+
+ assert (Option.is_some (ctor_info));
+
+ _ilg.Emit (OpCodes.Call, Option.unsome (ctor_info))
+
+
+ | CE_call (CE_method_ref (base_object, method), method_params) =>
+ def mk_param (method_param : CG_expr) : System.Type {
+ _cgil.reflect_nemerle_type (type_of (method_param))
+ };
+
+ def parm_types_list = List.map (mk_param, method_params);
+
+ def base_class_type =
+ _cgil.reflect_nemerle_type (type_of (base_object));
+
+ assert (base_class_type != null);
+
+ def method_info =
+ _cgil.get_method_info (base_class_type.FullName, method.name, parm_types_list);
+
+ assert (Option.is_some (method_info));
+
+ emit (base_object);
+
+ List.iter (emit, method_params);
+
+ _ilg.Emit (OpCodes.Call, Option.unsome (method_info))
+
+
+ | CE_call (CE_global_ref (m), parms) =>
+ List.iter (emit, parms);
+
match (m.extern_name) {
// FIXME: add type information to the %op notation
// FIXME: add the checked/unchecked flags
+ // FIXME: handle the overloaded operators properly (see == and != for System.String)
| "%op+" => _ilg.Emit (OpCodes.Add_Ovf);
| "%op-" => _ilg.Emit (OpCodes.Sub_Ovf);
| "%op*" => _ilg.Emit (OpCodes.Mul_Ovf);
| "%op/" => _ilg.Emit (OpCodes.Div);
| "%op%" => _ilg.Emit (OpCodes.Rem);
- | _ => () // Message.debug ("CE_global_ref extern_name: '" + m.extern_name + "', name: '" + m.name + "'");
+ | "%op==" => _ilg.Emit (OpCodes.Ceq);
+ | "%op!=" =>
+ _ilg.Emit (OpCodes.Ceq);
+ _ilg.Emit (OpCodes.Ldc_I4_0);
+ _ilg.Emit (OpCodes.Ceq);
+ | _ =>
+ (* FIXME: this will fail for static methods defined in incomplete types *)
+
+ def mk_param (method_param : CG_expr) : System.Type {
+ _cgil.reflect_nemerle_type (type_of (method_param))
+ };
+
+ def parm_types_list = List.map (mk_param, parms);
+ def parm_types_array = _cgil.type_list_to_type_array (parm_types_list);
+
+ def (class_name, method_name) = _cgil.split_global_ref (m.extern_name);
+
+ def class_type = _cgil.reflect_type (class_name);
+ assert (class_type != null);
+
+ def method_info =
+ class_type.GetMethod (method_name, BindingFlags.Public + BindingFlags.Static +
+ BindingFlags.FlattenHierarchy, null, parm_types_array, null);
+ assert (method_info != null);
+
+ _ilg.Emit (OpCodes.Call, method_info)
}
+
+ | CE_call (function, instructions) =>
+ List.iter (emit, instructions);
-(*
- | CE_field_ref (e, f) =>
- def e = flat (e);
- mono (e, csref (e) ++ "." ++ f.name)
- | CE_property_ref (e, p) =>
- def e = flat (e);
- mono (e, csref (e) ++ "." ++ p.name)
+ emit (function)
- | CE_tuple_ref (e, n) =>
- def e = flat (e);
- mono (e, csref (e) ++ ".field" ++ string_of_int (n + 1))
- | CE_call (e, es) =>
- match ((e, flat (e))) {
- | (CE_base, CS_simple (s)) =>
- match (flat_call (s, es)) {
- | CS_simple (s) => base_class_ctor <- s; CS_simple (ST_leaf (""))
- | _ => Util.ice ("complex expressions in base call")
- }
- | (_, CS_simple (s)) => flat_call (s, es)
- | (_, CS_complex (pref, v)) =>
- Util.ice ("CE_call on a complex instruction (" + st_flatten(pref) + ": " + st_flatten(v) + ")")
- }
+ (* -- MISC --------------------------------------------------------- *)
+ | CE_this =>
+ _ilg.Emit (OpCodes.Ldarg_0)
+
+
+ | CE_raise (exc) =>
+ emit (exc);
+
+ _ilg.Emit (OpCodes.Throw)
+
+
+ | CE_tuple_ctor (es) =>
+ ()
+
+ (* FIXME: flat_call (ST_leaf ("new Nemerle.Tuple") ++ string_of_int (List.length (es)), es) *)
+
+
+ (* -- TODO --------------------------------------------------------- *)
+
+(*
+
| CE_indexer (_, obj, args) =>
def (obj_pre, obj_val) = make_complex (flat (obj));
mutable indexers_pre <- ST_leaf ("");
@@ -834,11 +1259,6 @@
mono (e, "((" ++ csref (e) ++ " == null &&" ++
" Nemerle.Core.Null_match.raise_self ()) || ("
++ csref (e) ++ " is " ++ flat_ty (t) ++ "))")
-
- | CE_raise (x) =>
- def (p, r) = make_complex (flat (x));
- CS_complex (p ++ "throw " ++ r ++ ";\n", ST_leaf ("null"))
-
| CE_try_with (e1', v, e2') =>
def (p1, e1) = make_complex (flat (e1'));
@@ -910,30 +1330,7 @@
};
def body = concat (ST_leaf ("{ "), initializers);
CS_complex (pref, body)
-
- | CE_this => CS_simple (ST_leaf ("this"))
- | CE_base => CS_simple (ST_leaf ("base"))
- | CE_skip => CS_simple (ST_leaf ("null"))
-
- | CE_cast (e, CT_void) => flat (e) // C# doesn't like (void)foo
-
- | CE_cast (e, t) =>
- def e = flat (e);
- mono (e, "((" ++ flat_ty (t) ++ ")" ++ csref (e) ++ ")")
-
- | CE_tuple_ctor (es) =>
- flat_call (ST_leaf ("new Nemerle.Tuple") ++ string_of_int (List.length (es)), es)
-
- | CE_ctor_ref (c) =>
- if (c.extern_name == "")
- Util.ice ("empty extern name " + c.ns + ":" + c.name)
- else
- CS_simple (ST_leaf ("new " + c.extern_name))
-
- | CE_method_ref (e, f) =>
- def e = flat (e);
- mono (e, csref (e) ++ "." ++ f.name)
-
+
| CE_block (e) =>
def (pref, val) = make_complex (flat (e));
CS_complex ("_N_block_beg:\n" ++ pref, val)
@@ -942,13 +1339,91 @@
CS_complex (ST_leaf ("goto _N_block_beg;"), ST_leaf ("null"))
*)
+ | CE_skip => ()
| CE_none => ()
- | _ => () // Message.warning ("CGIL: emit_il: expression match was not exhaustive")
+ | _ =>
+ Message.debug ("CGIL: emit_il: unmatched: " + pretty_print (expr));
}
}
+ (**
+ * FIXME: put these values in a lookup table?
+ *)
+ private find_parm (parm_name : string) : option (CG_val * int)
+ {
+ def find_parm_by_name (parms : list (CG_val), index) {
+ match (parms) {
+ | [] => None ()
+ | parm :: rest =>
+ if (parm.name == parm_name)
+ Some ((parm, index))
+ else
+ find_parm_by_name (rest, index + 1)
+ }
+ };
+
+ find_parm_by_name (_parms, 1);
+ }
+ private class_type (c : CM_class) : CG_type
+ {
+ CT_ref (c.ns + c.name)
+ }
+
+ private type_of (ex : CG_expr) : CG_type
+ {
+ match (ex) {
+ | CE_ref (d) => d.ty
+ | CE_global_ref ((CM_field) as f) => f.ty
+ | CE_global_ref ((CM_property) as p) => p.ty
+ | CE_field_ref (_, f) => f.ty
+ | CE_property_ref (_, p) => p.ty
+ | CE_tuple_ref => CT_object ()
+ | CE_call (CE_global_ref ((CM_method) as m), _) => m.ret_type
+ | CE_call (CE_method_ref (_, m), _) => m.ret_type
+ | CE_call (CE_ctor_ref (c), _) => class_type (c)
+ | CE_call (CE_base, _) => CT_void ()
+ | CE_call => Util.ice ()
+ | CE_assign => CT_void ()
+ | CE_let (_, b) => type_of (b)
+ | CE_has_type => CT_bool ()
+ | CE_raise => CT_unreached ()
+ | CE_if (t, _, _, _) => t
+ | CE_try_with (e, _, _) => type_of (e)
+ | CE_try_finally (e, _) => type_of (e)
+ | CE_literal (l) =>
+ match (l) {
+ | L_void => CT_void ()
+ | L_null => CT_object ()
+ | L_int => CT_ref ("int")
+ | L_char => CT_ref ("char")
+ | L_string => CT_ref ("string")
+ | L_float => CT_ref ("float")
+ | L_bool => CT_ref ("bool")
+ }
+ | CE_this => CT_ref (_class_name)
+ | CE_skip => CT_void ()
+ | CE_cast (_, t) => t
+ | CE_sequence (b) => type_of (List.last (b))
+ | CE_tuple_ctor (es) => CT_tuple (List.length (es))
+ // can't tell
+ | CE_none => Util.ice ()
+ // these are supported only as part of call
+ | CE_global_ref (CM_method) => Util.ice ()
+ | CE_global_ref (CM_class) => Util.ice ()
+ | CE_ctor_ref => Util.ice ()
+ | CE_method_ref => Util.ice ()
+ | CE_base => Util.ice ()
+ | CE_mkarray (x :: _) => CT_array (type_of (x))
+ | CE_mkarray ([]) => CT_array (CT_object ())
+ | CE_indexer (t, obj, args) => t
+ | CE_block (expr) => type_of (expr)
+ | CE_restart => CT_void ()
+ }
+ }
+
+
(**
*
*)
Index: lib/core.n
===================================================================
--- lib/core.n (revision 894)
+++ lib/core.n (working copy)
@@ -138,7 +138,7 @@
this._encoded_type
}
- private mutable _encoded_type : string;
+ public mutable _encoded_type : string;
}
(**
@@ -164,7 +164,7 @@
this._encoded_type
}
- private mutable _encoded_type : string;
+ public mutable _encoded_type : string;
}
}
Index: lib/aliases.n
===================================================================
--- lib/aliases.n (revision 894)
+++ lib/aliases.n (working copy)
@@ -43,10 +43,11 @@
public static `%` (x : int, y : int) : int = extern "%op%";
public static `/` (x : int, y : int) : int = extern "%op/";
+ public static 'a `==` (x : 'a, y : 'a) : bool = extern "%op==";
+ public static 'a `!=` (x : 'a, y : 'a) : bool = extern "%op!=";
+
public static `<` (x : int, y : int) : bool = extern "%op<";
public static `>` (x : int, y : int) : bool = extern "%op>";
- public static 'a `==` (x : 'a, y : 'a) : bool = extern "%op==";
- public static 'a `!=` (x : 'a, y : 'a) : bool = extern "%op!=";
public static `>=` (x : int, y : int) : bool = extern "%op>=";
public static `<=` (x : int, y : int) : bool = extern "%op<=";
@@ -54,7 +55,8 @@
public static `>` (x : char, y : char) : bool = extern "%op>";
public static `>=` (x : char, y : char) : bool = extern "%op>=";
public static `<=` (x : char, y : char) : bool = extern "%op<=";
-
+
+ (* FIXME: what is the meaning of these operators? *)
public static `<` (x : string, y : string) : bool = extern "%op<";
public static `>` (x : string, y : string) : bool = extern "%op>";
public static `>=` (x : string, y : string) : bool = extern "%op>=";
@@ -63,8 +65,10 @@
public static `-` (x : int) : int = extern "%op-";
public static `!` (x : bool) : bool = extern "%op!";
- public static `+` (x : string, y : string) : string = extern "%op+";
+ (* string concatenation operator *)
+ public static `+` (x : string, y : string) : string = extern "System.String.Concat";
+ (* FIXME: binary alternative over enum types *)
public static 'a where 'a :> System.Enum `+` (x : 'a, y : 'a) : 'a = extern "%op|";
public static print_string (s : string) : void = extern "System.Console.Write";
More information about the devel-pl
mailing list