Commit d5075d7a authored by Martijn Vervoort's avatar Martijn Vervoort
Browse files

made module name optional

parent 86d417d0
...@@ -3,6 +3,9 @@ implementation module convertDynamics ...@@ -3,6 +3,9 @@ implementation module convertDynamics
import syntax, transform, utilities, convertcases import syntax, transform, utilities, convertcases
// Optional // Optional
USE_TUPLES tuple b :== b; // change also StdDynamic.icl and recompile all applications USE_TUPLES tuple b :== b; // change also StdDynamic.icl and recompile all applications
APPEND_DEFINING_TYPE_MODULE_NAMES_TO_TYPE_NAMES yes no :== no
import type_io; import type_io;
:: *ConversionInfo = :: *ConversionInfo =
...@@ -963,7 +966,7 @@ instance toString GlobalTCType ...@@ -963,7 +966,7 @@ instance toString GlobalTCType
where where
toString (GTT_Basic basic_type) = toString basic_type toString (GTT_Basic basic_type) = toString basic_type
toString GTT_Function = " -> " toString GTT_Function = " -> "
toString (GTT_Constructor type_symb_indent mod_name) = type_symb_indent.type_name.id_name +++ "'" +++ mod_name toString (GTT_Constructor type_symb_indent mod_name) = type_symb_indent.type_name.id_name +++ (APPEND_DEFINING_TYPE_MODULE_NAMES_TO_TYPE_NAMES ("'" +++ mod_name) "")
instance toString BasicType instance toString BasicType
where where
......
definition module type_io definition module type_io
// WARNING: It is essential to report changes in this module to martijnv@cs.kun.nl
// because the binary format for type-files is used by the dynamic run-time
// system.
import scanner, general, Heap, typeproperties, utilities, checksupport import scanner, general, Heap, typeproperties, utilities, checksupport
import StdEnv import StdEnv
......
implementation module type_io implementation module type_io
import StdEnv, compare_constructor // WARNING: It is essential to report changes in this module to martijnv@cs.kun.nl
// because the binary format for type-files is used by the dynamic run-time
// system.
import StdEnv, compare_constructor
import scanner, general, Heap, typeproperties, utilities, checksupport import scanner, general, Heap, typeproperties, utilities, checksupport
//import DebugUtilities; // normal form:
F a b :== b; // - type variables in type definitions are normalized by checkTypeDef in the
// module checktypes.icl. The position of a type variable in the left-hand
// Unsupported: // side of a type constructor is used.
// - type synonyms, expanded version must be stored. Which function in the compiler // - algebraic datatypes; constructors are alphabetically ordered in this
// expands synonyms correctly. // module
// - abstract data type, what should be written?
// //
// unsupported:
// - type synonyms
// - ADTs
// Records: //import DebugUtilities;
// - ordered fields F a b :== b;
//
// Constructors:
// - unordered
/*
:: TypeRhs = AlgType ![DefinedSymbol]
| SynType !AType
| RecordType !RecordType
| AbstractType !BITVECT
| UnknownType
{ ds_ident :: !Ident
, ds_arity :: !Int
, ds_index :: !Index
}
:: RecordType =
{ rt_constructor :: !DefinedSymbol
, rt_fields :: !{# FieldSymbol}
}
:: FieldSymbol =
{ fs_name :: !Ident
, fs_var :: !Ident
, fs_index :: !Index
}
:: ConsDef =
{ cons_symb :: !Ident
, cons_type :: !SymbolType
, cons_arg_vars :: ![[ATypeVar]]
, cons_priority :: !Priority
, cons_index :: !Index
, cons_type_index :: !Index
, cons_exi_vars :: ![ATypeVar]
// , cons_exi_attrs :: ![AttributeVar]
, cons_type_ptr :: !VarInfoPtr
, cons_pos :: !Position
}
:: TypeDef type_rhs =
{ td_name :: !Ident
, td_index :: !Int
, td_arity :: !Int
, td_args :: ![ATypeVar]
, td_attrs :: ![AttributeVar]
, td_context :: ![TypeContext]
, td_rhs :: !type_rhs
, td_attribute :: !TypeAttribute
, td_pos :: !Position
}
*/
class NormaliseTypeDef a class NormaliseTypeDef a
where where
normalise_type_def :: a -> a normalise_type_def :: a -> a
...@@ -90,42 +40,7 @@ instance NormaliseTypeDef TypeDef rhs | NormaliseTypeDef rhs ...@@ -90,42 +40,7 @@ instance NormaliseTypeDef TypeDef rhs | NormaliseTypeDef rhs
where where
normalise_type_def type_def=:{td_args,td_arity} normalise_type_def type_def=:{td_args,td_arity}
= type_def = type_def
/*
:: TypeVar =
{ tv_name :: !Ident
, tv_info_ptr :: !TypeVarInfoPtr
}
:: ATypeVar =
{ atv_attribute :: !TypeAttribute
, atv_annotation :: !Annotation
, atv_variable :: !TypeVar
}
:: TypeDef type_rhs =
{ td_name :: !Ident
, td_index :: !Int
, td_arity :: !Int
, td_args :: ![ATypeVar] // example Tree a b = ... field is [a,b]
, td_attrs :: ![AttributeVar]
, td_context :: ![TypeContext]
, td_rhs :: !type_rhs
, td_attribute :: !TypeAttribute
, td_pos :: !Position
}
*/
// CommonDefs
// TypeDef
loop []
= ""
loop [{ds_ident={id_name}}:xs]
= id_name +++ ", " +++ (loop xs)
class WriteTypeInfo a class WriteTypeInfo a
where where
...@@ -142,9 +57,11 @@ where ...@@ -142,9 +57,11 @@ where
instance WriteTypeInfo ConsDef instance WriteTypeInfo ConsDef
where where
write_type_info {cons_symb,cons_arg_vars,cons_priority,cons_index,cons_type_index,cons_exi_vars} tcl_file write_type_info {cons_symb,cons_type,cons_arg_vars,cons_priority,cons_index,cons_type_index,cons_exi_vars} tcl_file
# tcl_file # tcl_file
= write_type_info cons_symb tcl_file = write_type_info cons_symb tcl_file
# tcl_file
= write_type_info cons_type tcl_file
# tcl_file # tcl_file
= write_type_info cons_arg_vars tcl_file = write_type_info cons_arg_vars tcl_file
# tcl_file # tcl_file
...@@ -303,7 +220,163 @@ where ...@@ -303,7 +220,163 @@ where
# tcl_file # tcl_file
= write_type_info fs_index tcl_file = write_type_info fs_index tcl_file
= tcl_file = tcl_file
// NEW ->
instance WriteTypeInfo SymbolType
where
write_type_info {st_vars,st_args,st_arity,st_result} tcl_file
# tcl_file
= write_type_info st_vars tcl_file
# tcl_file
= write_type_info st_args tcl_file
# tcl_file
= write_type_info st_arity tcl_file
# tcl_file
= write_type_info st_result tcl_file
= tcl_file
instance WriteTypeInfo AType
where
write_type_info {/*at_attribute,*/ at_annotation,at_type} tcl_file
// # tcl_file
// = write_type_info at_attribute tcl_file
# tcl_file
= write_type_info at_annotation tcl_file
# tcl_file
= write_type_info at_type tcl_file
= tcl_file
TypeTACode =: (toChar 9) // TA
TypeArrowCode =: (toChar 10) // -->
TypeConsApplyCode =: (toChar 11) // :@:
TypeTBCode =: (toChar 12) // TB
TypeGTVCode =: (toChar 13) // GTV
TypeTVCode =: (toChar 14) // TV
TypeTQVCode =: (toChar 15) // TempTQV
TypeTECode =: (toChar 16) // TE
BT_IntCode =: (toChar 17)
BT_CharCode =: (toChar 18)
BT_RealCode =: (toChar 19)
BT_BoolCode =: (toChar 20)
BT_DynamicCode =: (toChar 21)
BT_FileCode =: (toChar 22)
BT_WorldCode =: (toChar 23)
BT_StringCode =: (toChar 24)
instance WriteTypeInfo Type
where
write_type_info (TA type_symb_ident atypes) tcl_file
# tcl_file
= fwritec TypeTACode tcl_file
# tcl_file
= write_type_info type_symb_ident tcl_file
# tcl_file
= write_type_info atypes tcl_file
= tcl_file
write_type_info (atype1 --> atype2) tcl_file
# tcl_file
= fwritec TypeArrowCode tcl_file
# tcl_file
= write_type_info atype1 tcl_file
# tcl_file
= write_type_info atype2 tcl_file
= tcl_file
write_type_info (cons_variable :@: atypes) tcl_file
# tcl_file
= fwritec TypeConsApplyCode tcl_file
# tcl_file
= write_type_info cons_variable tcl_file
# tcl_file
= write_type_info atypes tcl_file
= tcl_file
write_type_info tb=:(TB basic_type) tcl_file
# tcl_file
= case basic_type of
BT_Int -> fwritec BT_IntCode tcl_file
BT_Char -> fwritec BT_CharCode tcl_file
BT_Real -> fwritec BT_RealCode tcl_file
BT_Bool -> fwritec BT_BoolCode tcl_file
BT_Dynamic -> fwritec BT_DynamicCode tcl_file
BT_File -> fwritec BT_FileCode tcl_file
BT_World -> fwritec BT_WorldCode tcl_file
BT_String type
# tcl_file
= fwritec BT_StringCode tcl_file
# tcl_file
= write_type_info type tcl_file
-> tcl_file
_
-> abort "mismatch" ---> tb
= tcl_file
write_type_info (GTV type_var) tcl_file
# tcl_file
= fwritec TypeGTVCode tcl_file
# tcl_file
= write_type_info type_var tcl_file
= tcl_file
write_type_info (TV type_var) tcl_file
# tcl_file
= fwritec TypeTVCode tcl_file
# tcl_file
= write_type_info type_var tcl_file
= tcl_file
write_type_info (TQV type_var) tcl_file
# tcl_file
= fwritec TypeTQVCode tcl_file
# tcl_file
= write_type_info type_var tcl_file
= tcl_file
write_type_info TE tcl_file
# tcl_file
= fwritec TypeTECode tcl_file
= tcl_file
ConsVariableCVCode =: (toChar 25)
ConsVariableTempCVCode =: (toChar 26)
ConsVariableTempQCVCode =: (toChar 27)
instance WriteTypeInfo ConsVariable
where
write_type_info (CV type_var) tcl_file
# tcl_file
= fwritec ConsVariableCVCode tcl_file
# tcl_file
= write_type_info type_var tcl_file
= tcl_file
write_type_info (TempCV temp_var_id) tcl_file
# tcl_file
= fwritec ConsVariableTempCVCode tcl_file
# tcl_file
= write_type_info temp_var_id tcl_file
= tcl_file
write_type_info (TempQCV temp_var_id) tcl_file
# tcl_file
= fwritec ConsVariableTempQCVCode tcl_file
# tcl_file
= write_type_info temp_var_id tcl_file
= tcl_file
instance WriteTypeInfo TypeSymbIdent
where
write_type_info {type_name,type_arity} tcl_file
# tcl_file
= write_type_info type_name tcl_file
# tcl_file
= write_type_info type_arity tcl_file
= tcl_file
// basic and structural write_type_info's // basic and structural write_type_info's
instance WriteTypeInfo Int instance WriteTypeInfo Int
where where
...@@ -507,21 +580,27 @@ where ...@@ -507,21 +580,27 @@ where
read_type_info tcl_file read_type_info tcl_file
# (ok1,cons_symb,tcl_file) # (ok1,cons_symb,tcl_file)
= read_type_info tcl_file = read_type_info tcl_file
# (ok2,cons_arg_vars,tcl_file) ok2 = True
cons_type = undef
// # (ok2,cons_type,tcl_file)
// = read_type_info tcl_file
# (ok3,cons_arg_vars,tcl_file)
= read_type_info tcl_file = read_type_info tcl_file
# (ok3,cons_priority,tcl_file) # (ok4,cons_priority,tcl_file)
= read_type_info tcl_file = read_type_info tcl_file
# (ok4,cons_index,tcl_file) # (ok5,cons_index,tcl_file)
= read_type_info tcl_file = read_type_info tcl_file
# (ok5,cons_type_index,tcl_file) # (ok6,cons_type_index,tcl_file)
= read_type_info tcl_file = read_type_info tcl_file
# (ok6,cons_exi_vars,tcl_file) # (ok7,cons_exi_vars,tcl_file)
= read_type_info tcl_file = read_type_info tcl_file
# consdef # consdef
= { default_elem & = { default_elem &
cons_symb = cons_symb cons_symb = cons_symb
, cons_type = cons_type
, cons_arg_vars = cons_arg_vars , cons_arg_vars = cons_arg_vars
, cons_priority = cons_priority , cons_priority = cons_priority
...@@ -529,7 +608,7 @@ where ...@@ -529,7 +608,7 @@ where
, cons_type_index = cons_type_index , cons_type_index = cons_type_index
, cons_exi_vars = cons_exi_vars , cons_exi_vars = cons_exi_vars
} }
= (ok1&&ok2&&ok3&&ok4&&ok5&&ok6,consdef,tcl_file) = (ok1&&ok2&&ok3&&ok4&&ok5&&ok6&&ok7,consdef,tcl_file)
instance ReadTypeInfo Char instance ReadTypeInfo Char
where where
...@@ -615,6 +694,117 @@ where ...@@ -615,6 +694,117 @@ where
, fs_index = fs_index , fs_index = fs_index
} }
= (ok1&&ok2&&ok3,field_symbol,tcl_file) = (ok1&&ok2&&ok3,field_symbol,tcl_file)
/*
instance ReadTypeInfo SymbolType
where
read_type_info tcl_file
# (ok1,st_vars,tcl_file)
= read_type_info tcl_file
# (ok2,st_args,tcl_file)
= read_type_info tcl_file
# (ok3,st_arity,tcl_file)
= read_type_info tcl_file
# (ok4,st_result,tcl_file)
= read_type_info tcl_file
# symbol_type
= { default_elem &
st_vars = st_vars
, st_args = st_args
, st_arity = st_arity
, st_result = st_result
}
= (ok1&&ok2&&ok3&&ok4,symbol_type,tcl_file)
instance ReadTypeInfo AType
where
read_type_info tcl_file
# (ok1,at_annotation,tcl_file)
= read_type_info tcl_file
# (ok2,at_type,tcl_file)
= read_type_info tcl_file
# atype
= { default_elem &
at_annotation = at_annotation
, at_type = at_type
}
= (ok1&&ok2,atype,tcl_file)
instance ReadTypeInfo Type
where
read_type_info tcl_file
# (ok,c,tcl_file)
= freadc tcl_file
| not ok
= (False,default_elem,tcl_file)
| c == TypeTACode
# (ok1,type_symb_ident,tcl_file)
= read_type_info tcl_file
# (ok2,atypes,tcl_file)
= read_type_info tcl_file
= (ok1&&ok2,TA type_symb_ident atypes,tcl_file)
| c == TypeArrowCode
# (ok1,atype1,tcl_file)
= read_type_info tcl_file
# (ok2,atype2,tcl_file)
= read_type_info tcl_file
= (ok1&&ok2,atype1 --> atype2,tcl_file)
| c == TypeConsApplyCode
# (ok1,cons_variable,tcl_file)
= read_type_info tcl_file
# (ok2,atypes,tcl_file)
= read_type_info tcl_file
= (ok1&&ok2,cons_variable :@: atypes,tcl_file)
// TB BasicType
| c == BT_IntCode
= (True,TB BT_Int,tcl_file);
| c == BT_CharCode
= (True,TB BT_Char,tcl_file);
| c == BT_RealCode
= (True,TB BT_Real,tcl_file);
| c == BT_BoolCode
= (True,TB BT_Bool,tcl_file);
| c == BT_DynamicCode
= (True,TB BT_Dynamic,tcl_file);
| c == BT_FileCode
= (True,TB BT_File,tcl_file);
| c == BT_WorldCode
= (True,TB BT_World,tcl_file);
| c == BT_StringCode
# (ok,type,tcl_file)
= read_type_info tcl_file
= (ok,TB (BT_String type),tcl_file);
| c == TypeGTVCode
# (ok,type_var,tcl_file)
= read_type_info tcl_file
= (ok,GTV type_var,tcl_file);
| c == TypeTVCode
# (ok,type_var,tcl_file)
= read_type_info tcl_file
= (ok,TV type_var,tcl_file)
| c == TypeTQVCode
# (ok,type_var,tcl_file)
= read_type_info tcl_file
= (ok,TQV type_var,tcl_file)
| c == TypeTECode
= (True,TE,tcl_file)
//instance ReadTypeInfo ConsVariable
//where
*/
// basic and structural write_type_info's // basic and structural write_type_info's
instance ReadTypeInfo Int instance ReadTypeInfo Int
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment