TC-O Samples
Be warned, even small object-oriented Tiger programs may generate complicated desugared outputs.
empty-class.tig
let
class A {}
in
end
tc -X --object-desugar -A empty-class.tig
$ tc -X --object-desugar -A empty-class.tig
/* == Abstract Syntax Tree. == */
function _main() =
let
type _variant_Object = { exact_type : int }
type _variant_A_0 = { exact_type : int }
var _id_Object := 0
var _id_A_0 := 1
function _upcast_A_0_to_Object(source : _variant_A_0) : _variant_Object =
_variant_Object { exact_type = _id_A_0 }
function _new_Object() : _variant_Object =
_variant_Object { exact_type = _id_Object }
in
(
let
function _new_A_0() : _variant_A_0 =
let
in
_variant_A_0 { exact_type = _id_A_0 }
end
in
()
end;
()
)
end
$ echo $?
0
simple-class.tig
let
class B
{
var a := 42
method m() : int = self.a
}
var b := new B
in
b.a := 51
end
tc -X --object-desugar -A simple-class.tig
$ tc -X --object-desugar -A simple-class.tig
/* == Abstract Syntax Tree. == */
function _main() =
let
type _variant_Object = {
exact_type : int,
field_B_1 : _contents_B_1
}
type _contents_B_1 = { a : int }
type _variant_B_1 = {
exact_type : int,
field_B_1 : _contents_B_1
}
var _id_Object := 0
var _id_B_1 := 1
function _upcast_B_1_to_Object(source : _variant_B_1) : _variant_Object =
_variant_Object {
exact_type = _id_B_1,
field_B_1 = source.field_B_1
}
function _new_Object() : _variant_Object =
_variant_Object {
exact_type = _id_Object,
field_B_1 = nil
}
in
(
let
function _new_B_1() : _variant_B_1 =
let
var contents_B_1 := _contents_B_1 { a = 42 }
in
_variant_B_1 {
exact_type = _id_B_1,
field_B_1 = contents_B_1
}
end
function _method_B_1_m(self : _variant_B_1) : int =
self.field_B_1.a
function _dispatch_B_1_m(self : _variant_B_1) : int =
_method_B_1_m(self)
var b_2 := _new_B_1()
in
b_2.field_B_1.a := 51
end;
()
)
end
$ echo $?
0
override.tig
let
class C
{
var a := 0
method m() : int = self.a
}
class D extends C
{
var b := 9
/* Override C.m(). */
method m() : int = self.a + self.b
}
var d : D := new D
/* Valid upcast due to inclusion polymorphism. */
var c : C := d
in
c.a := 42;
/* Note that accessing `c.b' is not allowed, since `c' is
statically known as a `C', even though it is actually a `D'
at run time. */
let
/* Polymorphic call. */
var res := c.m()
in
print_int(res);
print("\n")
end
end
tc --object-desugar -A override.tig
$ tc --object-desugar -A override.tig
/* == Abstract Syntax Tree. == */
primitive print(string_0 : string)
primitive print_err(string_1 : string)
primitive print_int(int_2 : int)
primitive flush()
primitive getchar() : string
primitive ord(string_3 : string) : int
primitive chr(code_4 : int) : string
primitive size(string_5 : string) : int
primitive streq(s1_6 : string, s2_7 : string) : int
primitive strcmp(s1_8 : string, s2_9 : string) : int
primitive substring(string_10 : string, start_11 : int, length_12 : int) : string
primitive concat(fst_13 : string, snd_14 : string) : string
primitive not(boolean_15 : int) : int
primitive exit(status_16 : int)
function _main() =
let
type _variant_Object = {
exact_type : int,
field_C_18 : _contents_C_18,
field_D_20 : _contents_D_20
}
type _contents_C_18 = { a : int }
type _variant_C_18 = {
exact_type : int,
field_C_18 : _contents_C_18,
field_D_20 : _contents_D_20
}
type _contents_D_20 = { b : int }
type _variant_D_20 = {
exact_type : int,
field_D_20 : _contents_D_20,
field_C_18 : _contents_C_18
}
var _id_Object := 0
var _id_C_18 := 1
var _id_D_20 := 2
function _upcast_C_18_to_Object(source : _variant_C_18) : _variant_Object =
_variant_Object {
exact_type = _id_C_18,
field_C_18 = source.field_C_18,
field_D_20 = source.field_D_20
}
function _upcast_D_20_to_C_18(source : _variant_D_20) : _variant_C_18 =
_variant_C_18 {
exact_type = _id_D_20,
field_C_18 = source.field_C_18,
field_D_20 = source.field_D_20
}
function _upcast_D_20_to_Object(source : _variant_D_20) : _variant_Object =
_variant_Object {
exact_type = _id_D_20,
field_C_18 = source.field_C_18,
field_D_20 = source.field_D_20
}
function _new_Object() : _variant_Object =
_variant_Object {
exact_type = _id_Object,
field_C_18 = nil,
field_D_20 = nil
}
in
(
let
function _new_C_18() : _variant_C_18 =
let
var contents_C_18 := _contents_C_18 { a = 0 }
in
_variant_C_18 {
exact_type = _id_C_18,
field_C_18 = contents_C_18,
field_D_20 = nil
}
end
function _downcast_C_18_to_D_20(source : _variant_C_18) : _variant_D_20 =
_variant_D_20 {
exact_type = _id_D_20,
field_D_20 = source.field_D_20,
field_C_18 = source.field_C_18
}
function _method_C_18_m(self : _variant_C_18) : int =
self.field_C_18.a
function _dispatch_C_18_m(self : _variant_C_18) : int =
if self.exact_type = _id_D_20
then _method_D_20_m(_downcast_C_18_to_D_20(self))
else _method_C_18_m(self)
function _new_D_20() : _variant_D_20 =
let
var contents_D_20 := _contents_D_20 { b = 9 }
var contents_C_18 := _contents_C_18 { a = 0 }
in
_variant_D_20 {
exact_type = _id_D_20,
field_D_20 = contents_D_20,
field_C_18 = contents_C_18
}
end
function _method_D_20_m(self : _variant_D_20) : int =
self.field_C_18.a + self.field_D_20.b
function _dispatch_D_20_m(self : _variant_D_20) : int =
_method_D_20_m(self)
var d_21 : _variant_D_20 := _new_D_20()
var c_22 : _variant_C_18 := _upcast_D_20_to_C_18(d_21)
in
(
c_22.field_C_18.a := 42;
let
var res_23 := _dispatch_C_18_m(c_22)
in
(
print_int(res_23);
print("\n")
)
end
)
end;
()
)
end
$ echo $?
0
tc --object-desugar -L override.tig > override.lir
$ tc --object-desugar -L override.tig > override.lir
$ echo $?
0
havm override.lir
$ havm override.lir
51
$ echo $?
0