## core-type-types.pkg
## (C) 2001 Lucent Technologies, Bell Labs
# Compiled by:
# src/lib/compiler/front/typer-stuff/typecheckdata.sublib# Nomenclature
# ============
#
# "typ" abbreviates "type constructor",
#
# because (e.g.) 'List(Int)' constructs a new type
# from the input 'Int' type.
# a generic part of type-types.pkg (not Lib7 specific)
package core_type_types: (weak) api
arrow_stamp: stamp::Stamp;
arrow_typ: types::Type;
--> : (types::Type, types::Type) -> types::Type;
ref_stamp: stamp::Stamp;
ref_typ_sym: symbol::Symbol;
ref_con_sym: symbol::Symbol;
ref_typ: types::Type;
ref_dcon: types::Constructor;
ref_pattern_type: types::Type;
bool_stamp: stamp::Stamp;
bool_sym: symbol::Symbol;
false_sym: symbol::Symbol;
true_sym: symbol::Symbol;
bool_typ: types::Type;
bool_type: types::Type;
bool_api: access::Valcon_Signature;
false_dcon: types::Constructor;
true_dcon: types::Constructor;
void_symbol: symbol::Symbol;
void_typ: types::Type;
void_type: types::Type;
int_typ: types::Type;
int_type: types::Type;
string_typ: types::Type;
string_type: types::Type;
char_typ: types::Type;
char_type: types::Type;
float64_typ: types::Type;
float64_type: types::Type;
exception_typ: types::Type;
exception_type: types::Type;
tuple_type: List( types::Type ) -> types::Type;
record_type: List( (types::Label, types::Type) ) -> types::Type;
rw_vector_typ: types::Type;
vector_typ: types::Type;
end
{
package t= types; # types is from src/lib/compiler/front/typer-stuff/types/types.pkg package ip= inverse_path; # inverse_path is from src/lib/compiler/front/typer-stuff/basics/symbol-path.pkg package ptn= core_basetype_numbers; # core_basetype_numbers is from src/lib/compiler/front/typer-stuff/basics/core-basetype-numbers.pkg arrow_stamp = stamp::special "->";
ref_stamp = stamp::special "REF";
bool_stamp = stamp::special "bool";
void_symbol = symbol::make_type_symbol "Void";
ref_typ_sym = symbol::make_type_symbol "Ref";
ref_con_sym = symbol::make_value_symbol "REF";
bool_sym = symbol::make_type_symbol "Bool";
false_sym = symbol::make_value_symbol "FALSE";
true_sym = symbol::make_value_symbol "TRUE";
fun tc2t typ
=
t::TYPCON_TYPE (typ, []);
void_typ
=
t::DEFINED_TYP {
stamp => stamp::special "unit",
strict => [],
path => ip::INVERSE_PATH [void_symbol],
type_scheme => t::TYPE_SCHEME { arity => 0,
body => t::TYPCON_TYPE (tuples::make_tuple_typ 0, [])
}
};
void_type = tc2t void_typ;
fun pt2tc (symbol, arity, equality_property, ptn)
=
t::BASE_TYP {
stamp => stamp::special symbol,
path => ip::INVERSE_PATH [symbol::make_type_symbol symbol],
arity,
eq => REF equality_property,
kind => t::BASE ptn,
stub => NULL
};
fun pt2tct args
=
{ typ = pt2tc args;
(typ, tc2t typ);
};
# This stuff is duplicated here and src/lib/compiler/front/typer-stuff/types/core-type-types.pkg # -- can't we factor the duplication out somehow? XXX BUGGO FIXME
my ( int_typ, int_type) = pt2tct ("Int", 0, t::YES, ptn::basetype_number_int );
my ( string_typ, string_type) = pt2tct ("String", 0, t::YES, ptn::basetype_number_string);
my ( char_typ, char_type) = pt2tct ("Char", 0, t::YES, ptn::basetype_number_int );
my ( float64_typ, float64_type) = pt2tct ("Float", 0, t::NO, ptn::basetype_number_float64 );
my (exception_typ, exception_type) = pt2tct ("Exception", 0, t::NO, ptn::basetype_number_exn );
rw_vector_typ = pt2tc ("Rw_Vector", 1, t::CHUNK, ptn::basetype_number_rw_vector );
vector_typ = pt2tc ("Vector", 1, t::YES, ptn::basetype_number_vector);
arrow_typ
=
t::BASE_TYP {
#
stamp => arrow_stamp,
path => ip::INVERSE_PATH [symbol::make_type_symbol "->"],
arity => 2,
#
eq => REF t::NO,
kind => t::BASE ptn::basetype_number_arrow,
stub => NULL
};
infix -->;
fun t1 --> t2
=
t::TYPCON_TYPE (arrow_typ, [t1, t2]);
fun record_type (fields: List( (t::Label, t::Type)) )
=
t::TYPCON_TYPE (tuples::make_record_typ (map #1 fields), map #2 fields);
fun tuple_type types
=
t::TYPCON_TYPE (tuples::make_tuple_typ (length types), types);
my (ref_typ, ref_pattern_type, ref_dcon)
=
{ eq_ref = REF t::CHUNK;
alpha = t::TYPE_SCHEME_ARG_I 0;
ref_dom = alpha;
refsign = access::CSIG (1, 0);
ref_typ = t::BASE_TYP {
stub => NULL,
stamp => ref_stamp,
path => ip::INVERSE_PATH [ ref_typ_sym ],
arity => 1,
eq => eq_ref,
kind => t::DATATYPE {
index => 0,
stamps => #[ref_stamp],
free_typs => [],
root => NULL,
family => { properties => property_list::new_holder (),
mkey => ref_stamp,
members => #[ { typ_name => ref_typ_sym,
eq => eq_ref,
is_lazy => FALSE,
arity => 1,
an_api => access::CSIG (1, 0),
constructor_list => [ { name => ref_con_sym,
representation => access::REF_REP,
domain => THE ref_dom
}
]
}
]
}
}
};
ref_tyfun
=
t::TYPE_SCHEME { arity => 1, body => alpha --> t::TYPCON_TYPE (ref_typ, [alpha]) };
ref_pattern_type
=
t::TYPE_SCHEME_TYPE {
type_scheme_arg_eq_properties => [FALSE],
type_scheme => ref_tyfun
};
ref_dcon = t::VALCON { symbol => ref_con_sym,
const => FALSE,
is_lazy => FALSE,
form => access::REF_REP,
constructortype => ref_pattern_type,
an_api => refsign
};
(ref_typ, ref_pattern_type, ref_dcon);
};
bool_api = access::CSIG (0, 2);
my (bool_typ, bool_type, false_dcon, true_dcon)
=
{ booleq = REF t::YES;
bool_typ
=
t::BASE_TYP {
stamp => bool_stamp,
path => ip::INVERSE_PATH [bool_sym],
arity => 0,
eq => booleq,
stub => NULL,
kind => t::DATATYPE {
index => 0,
stamps => #[bool_stamp],
free_typs => [],
root => NULL,
family => { properties => property_list::new_holder (),
mkey => bool_stamp,
members => #[ { typ_name => bool_sym,
eq => booleq,
is_lazy => FALSE,
arity => 0,
an_api => bool_api,
constructor_list => [ { name => false_sym,
form => access::CONSTANT 0,
domain => NULL
},
{ name => true_sym,
form => access::CONSTANT 1,
domain => NULL
}
]
}
]
}
}
};
bool_type = t::TYPCON_TYPE (bool_typ, []);
false_dcon = t::VALCON
{
symbol => false_sym,
const => TRUE,
is_lazy => FALSE,
form => access::CONSTANT 0,
type => bool_type,
an_api => bool_api
};
true_dcon = t::VALCON
{
symbol => true_sym,
const => TRUE,
is_lazy => FALSE,
form => access::CONSTANT 1,
constructortype => bool_type,
an_api => bool_api
};
(bool_typ, bool_type, false_dcon, true_dcon);
};
};