## highcode-basetypes.pkg
# Compiled by:
#
src/lib/compiler/core.sublib### "God is real, unless declared integer."
###
### -- J.Allan Toogood
###
### [ This is an old Fortran joke, based upon the fact that Fortran
### treated [I-N][A-Z0-9]* identifiers as integer and all others as
### float ("real") in the absence of explicit declaration otherwise.
### ]
stipulate
package btn = basetype_numbers; # basetype_numbers is from
src/lib/compiler/front/typer/basics/basetype-numbers.pkg package err = error_message; # error_message is from
src/lib/compiler/front/basics/errormsg/error-message.pkg package lms = list_mergesort; # list_mergesort is from
src/lib/src/list-mergesort.pkg package vec = vector; # vector is from
src/lib/std/src/vector.pkg fun bug s
=
err::impossible ("highcode_basetypes: " + s);
herein
package highcode_basetypes
: Highcode_Basetypes # Highcode_Basetypes is from
src/lib/compiler/back/top/highcode/highcode-basetypes.api {
# The Highcode_Basetypes enum defines the set of base type constructors.
#
# They probably don't have to be defined as a enum.
# A dictionary-like thing would serve better.
#
# The intermediate language can be thought as a language parameterized
# by the set of base type constructors and base functions --
# which can be represented by higher-order generics.
#
# By the way, DATAREP_GENERIC_MACHINE_WORD is an chunk we know nothing but that
# it is a pointer; or so-called canonical word representations; on a
# 32-bit machine, it can be a Pointer or a 31-bit integer; on 64-bit
# machines, it could be something else.
#
# In the future, we should also add arrow_kind and tuple_kind,
# or even array_kind, and vector_kind to denote various possible
# representation types. (ZHONG)
package b {
Highcode_Basetypes # Zhong Shao's thesis calls this "Lty", "LEXP type".
= TAGGED_INT # 31-bit integer
| INT1
# 32-bit integer
| FLOAT64
# 64-bit real
| STRING
# String type; always a pointer
| EXCEPTION
# Exception type
| RW_VECTOR
# Typeagnostic rw_vector Type
| VECTOR
# Typeagnostic vector Type
| REF
# Typeagnostic reference Type
| LIST
# Typeagnostic list Type
| EXCEPTION_TAG
# Exception tag type
| FATE
# General-fate Type
| CONTROL_FATE
# Control-fate Type
| FN
# Function Type
| NULL_OR
# Option Type is optional
| BOXED
# Boxed Type; used for wrapping
| TAGGED_TYPE
# Tagged Type; with a integer
| UNTAGGED_TYPE
# Untagged Type; no int tags
| SINGLE_WORD
# Transparent Type; fit-in-1-word
| DYNAMICALLY_TYPED
# Dynamic type; with runtime type
| GENERIC_MACHINE_WORD
# Generic machine word; supports GC
| CHUNK
| C_FUN
| BYTE_RW_VECTOR
| FLOAT64_RW_VECTOR
| SPINLOCK
#
| INTEGER
# indefinite-precision integer.
;
};
Highcode_Basetypes = b::Highcode_Basetypes;
# The base type constructor. Base type number is the key:
#
# Representation Arity Base type number
# ============================ ===== ==================
Basetype = ( Highcode_Basetypes, Int, Int );
# The set of base type constructors:
# Arity
# ====
basetype_tagged_int = (b::TAGGED_INT, 0, btn::basetype_number_tagged_int);
basetype_int1 = (b::INT1, 0, btn::basetype_number_int1);
basetype_float64 = (b::FLOAT64, 0, btn::basetype_number_float64);
basetype_string = (b::STRING, 0, btn::basetype_number_string);
basetype_exception = (b::EXCEPTION, 0, btn::basetype_number_exception);
basetype_truevoid = (b::GENERIC_MACHINE_WORD, 0, btn::basetype_number_truevoid);
#
basetype_rw_vector = (b::RW_VECTOR, 1, btn::basetype_number_rw_vector);
basetype_vector = (b::VECTOR, 1, btn::basetype_number_ro_vector);
basetype_ref = (b::REF, 1, btn::basetype_number_ref);
basetype_list = (b::LIST, 1, btn::basetype_number_list);
basetype_exception_tag = (b::EXCEPTION_TAG, 1, btn::basetype_number_etag);
basetype_fate = (b::FATE, 1, btn::basetype_number_fate);
basetype_control_fate = (b::CONTROL_FATE, 1, btn::basetype_number_control_fate);
#
basetype_arrow = (b::FN, 2, btn::basetype_number_arrow);
#
basetype_option = (b::NULL_OR, 1, btn::basetype_number_option);
basetype_boxed = (b::BOXED, 1, btn::basetype_number_boxed);
basetype_tgd = (b::TAGGED_TYPE, 1, btn::basetype_number_tgd);
basetype_utgd = (b::UNTAGGED_TYPE, 1, btn::basetype_number_utgd);
basetype_tnsp = (b::SINGLE_WORD, 1, btn::basetype_number_tnsp);
basetype_dyn = (b::DYNAMICALLY_TYPED, 1, btn::basetype_number_dyn);
#
basetype_chunk = (b::CHUNK, 0, btn::basetype_number_chunk);
basetype_cfun = (b::C_FUN, 0, btn::basetype_number_cfun);
basetype_byte_rw_vector = (b::BYTE_RW_VECTOR, 0, btn::basetype_number_barray);
basetype_float64_rw_vector = (b::FLOAT64_RW_VECTOR, 0, btn::basetype_number_rarray);
basetype_spinlock = (b::SPINLOCK, 0, btn::basetype_number_slock);
basetype_integer = (b::INTEGER, 0, btn::basetype_number_integer);
fun basetype_arity (_, i, _) # Get the arity of a particular base Type.
=
i;
fun basetype_to_int (_, _, k) # Each base type constructor is equipped with a key.
=
k;
basetype_from_int
=
{ btlist = [ basetype_tagged_int,
basetype_int1,
basetype_float64,
basetype_string,
basetype_exception,
basetype_truevoid,
basetype_rw_vector,
basetype_vector,
basetype_ref,
basetype_list,
basetype_exception_tag,
basetype_fate,
basetype_control_fate,
basetype_arrow,
basetype_option,
basetype_boxed,
basetype_tgd,
basetype_utgd,
basetype_tnsp,
basetype_dyn,
basetype_chunk,
basetype_cfun,
basetype_byte_rw_vector,
basetype_float64_rw_vector,
basetype_spinlock,
basetype_integer
];
fun gt ((_, _, n1), (_, _, n2))
=
n1 > n2;
btvec = vec::from_list (lms::sort_list gt btlist);
\\ k = vec::get (btvec, k)
except
INDEX_OUT_OF_BOUNDS = bug "unexpected integer in basetype_from_int";
};
# This fun is called from exactly one spot, in uniqtype_to_string in:
#
#
src/lib/compiler/back/top/highcode/highcode-form.pkg #
fun basetype_to_string (pt, _, _) # Printing out the base type constructor.
=
g pt
where
fun g b::TAGGED_INT => "TAGGED_INT";
g b::INT1 => "INT1";
g b::FLOAT64 => "FLOAT64";
g b::STRING => "STRING";
g b::EXCEPTION => "EXCEPTION";
g b::RW_VECTOR => "RW_VECTOR";
g b::VECTOR => "VECTOR";
g b::REF => "REF";
g b::LIST => "LIST";
g b::EXCEPTION_TAG => "EXCEPTION_TAG";
g b::FATE => "FATE";
g b::CONTROL_FATE => "CONTROL_FATE";
g b::FN => "FN";
g b::NULL_OR => "NULL_OR";
g b::BOXED => "BOXED";
g b::TAGGED_TYPE => "TAGGED_TYPE";
g b::UNTAGGED_TYPE => "UNTAGGED_TYPE";
g b::SINGLE_WORD => "SINGLE_WORD";
g b::DYNAMICALLY_TYPED => "DYNAMICALLY_TYPED";
g b::GENERIC_MACHINE_WORD => "GENERIC_MACHINE_WORD";
g b::CHUNK => "CHUNK";
g b::C_FUN => "C_FUN";
g b::BYTE_RW_VECTOR => "BYTE_RW_VECTOR";
g b::FLOAT64_RW_VECTOR => "FLOAT64_RW_VECTOR";
g b::SPINLOCK => "SPINLOCK";
g b::INTEGER => "INTEGER";
end;
end;
#
fun basetype_is_unboxed ((b::INT1
| b::FLOAT64), _, _) => TRUE;
# Check the boxity of values of each prim Type
basetype_is_unboxed _ => FALSE;
end;
fun bxupd ((b::TAGGED_INT
| b::INT1 | b::FLOAT64), _, _) => FALSE;
bxupd ((b::LIST
| b::NULL_OR | b::GENERIC_MACHINE_WORD), _, _) => FALSE;
bxupd ((b::SINGLE_WORD
| b::TAGGED_TYPE | b::UNTAGGED_TYPE | b::BOXED | b::DYNAMICALLY_TYPED), _, _) => FALSE;
bxupd _ => TRUE;
end;
fun ubxupd (b::TAGGED_INT, _, _) => TRUE;
ubxupd _ => FALSE;
end;
fun isvoid ((b::TAGGED_INT
| b::INT1 | b::FLOAT64 | b::STRING), _, _) => FALSE;
isvoid _ => TRUE;
end;
}; # package highcode_basetypes
end; # stipulate