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

Bug fixing in module type_io. It now seems to generate the

proper type information.
parent 749dbe97
implementation module type_io implementation module type_io
//import DebugUtilities; import StdEnv, compare_constructor
F a b :== b
import StdEnv, compare_constructor // ,RWSDebug
import scanner, general, Heap, typeproperties, utilities, checksupport import scanner, general, Heap, typeproperties, utilities, checksupport
//import DebugUtilities;
F a b :== b;
// Unsupported:
// - type synonyms, expanded version must be stored. Which function in the compiler
// expands synonyms correctly.
// - abstract data type, what should be written?
//
class WriteTypeInfo a class WriteTypeInfo a
where where
write_type_info :: a !*File -> !*File write_type_info :: a !*File -> !*File
...@@ -81,6 +87,7 @@ where ...@@ -81,6 +87,7 @@ where
instance WriteTypeInfo TypeDef TypeRhs instance WriteTypeInfo TypeDef TypeRhs
where where
write_type_info {td_name,td_arity,td_args,td_rhs} tcl_file write_type_info {td_name,td_arity,td_args,td_rhs} tcl_file
| F ("TypeDef '" +++ td_name.id_name +++ "'") True
#! tcl_file #! tcl_file
= write_type_info td_name tcl_file = write_type_info td_name tcl_file
#! tcl_file #! tcl_file
...@@ -161,10 +168,10 @@ where ...@@ -161,10 +168,10 @@ where
instance WriteTypeInfo Ident instance WriteTypeInfo Ident
where where
write_type_info {id_name} tcl_file write_type_info {id_name} tcl_file
// # tcl_file # tcl_file
// = fwritei (size id_name) tcl_file = fwritei (size id_name) tcl_file
// = fwrites id_name tcl_file = fwrites id_name tcl_file
= write_type_info id_name tcl_file; // = write_type_info id_name tcl_file;
instance WriteTypeInfo FieldSymbol instance WriteTypeInfo FieldSymbol
where where
...@@ -220,8 +227,7 @@ where ...@@ -220,8 +227,7 @@ where
# tcl_file # tcl_file
= fwritec c tcl_file; = fwritec c tcl_file;
= tcl_file; = tcl_file;
// read // read
class ReadTypeInfo a class ReadTypeInfo a
where where
...@@ -231,11 +237,9 @@ instance ReadTypeInfo CommonDefs ...@@ -231,11 +237,9 @@ instance ReadTypeInfo CommonDefs
where where
read_type_info tcl_file read_type_info tcl_file
# (ok1,com_type_defs,tcl_file) # (ok1,com_type_defs,tcl_file)
// = (True,{},tcl_file);
= read_type_info tcl_file = read_type_info tcl_file
# (ok2,com_cons_defs,tcl_file) # (ok2,com_cons_defs,tcl_file)
= (True,{},tcl_file); = read_type_info tcl_file
// = read_type_info tcl_file
# common_defs # common_defs
= { CommonDefs | = { CommonDefs |
...@@ -302,7 +306,15 @@ where ...@@ -302,7 +306,15 @@ where
| c == SynTypeCode | c == SynTypeCode
= (True,UnknownType,tcl_file) = (True,UnknownType,tcl_file)
| c == RecordTypeCode | c == RecordTypeCode
= (True,UnknownType,tcl_file) # (ok,rt_fields,tcl_file)
= read_type_info tcl_file
# record_type
= { default_elem &
rt_fields = rt_fields
};
= (True,RecordType record_type,tcl_file)
| c == AbstractTypeCode | c == AbstractTypeCode
= (True,UnknownType,tcl_file) = (True,UnknownType,tcl_file)
...@@ -403,51 +415,18 @@ instance ReadTypeInfo Char ...@@ -403,51 +415,18 @@ instance ReadTypeInfo Char
where where
read_type_info :: !*File -> (!Bool,Char,!*File) read_type_info :: !*File -> (!Bool,Char,!*File)
read_type_info tcl_file read_type_info tcl_file
= freadc1 tcl_file = freadc tcl_file
where
// Input. The boolean output parameter reports success or failure of the operations.
freadc1::!*File -> (!Bool,!Char,!*File)
/* Reads a character from a text file or a byte from a datafile. */
freadc1 f
= code {
.inline freadc
.d 0 2 f
jsr readFC
.o 0 4 b c f
.end
}
/*
# (_,i,tcl_file)
= freadi tcl_file
# (q,tcl_file)
= freads tcl_file i;
| True
= abort ("dkskksdkdsksdkfklsklklsgfdklsdgfklgklklgklgkl " +++ toString q);
*/
instance ReadTypeInfo Ident instance ReadTypeInfo Ident
where where
read_type_info :: !*File -> (!Bool,Ident,!*File) read_type_info :: !*File -> (!Bool,Ident,!*File)
read_type_info tcl_file read_type_info tcl_file
/*
# (ok1,id_name,tcl_file)
= read_type_info tcl_file
*/
# (ok1,i,tcl_file) # (ok1,i,tcl_file)
= freadi tcl_file = freadi tcl_file
# (id_name,tcl_file) # (id_name,tcl_file)
= freads tcl_file i; = freads tcl_file i;
| F ("Ident " +++ toString i +++ " - " +++ id_name) True | F ("Ident " +++ toString i +++ " - " +++ id_name) True
# ident # ident
= { default_elem & = { default_elem &
id_name = id_name id_name = id_name
...@@ -499,30 +478,32 @@ where ...@@ -499,30 +478,32 @@ where
= if (c == '!') AN_Strict AN_None = if (c == '!') AN_Strict AN_None
= (ok1,annotation,tcl_file) = (ok1,annotation,tcl_file)
instance ReadTypeInfo FieldSymbol
where
read_type_info tcl_file
# (ok1,fs_name,tcl_file)
= read_type_info tcl_file
# (ok2,fs_var,tcl_file)
= read_type_info tcl_file
# (ok3,fs_index,tcl_file)
= read_type_info tcl_file
# field_symbol
= { FieldSymbol |
fs_name = fs_name
, fs_var = fs_var
, fs_index = fs_index
}
= (ok1&&ok2&&ok3,field_symbol,tcl_file)
// basic and structural write_type_info's // basic and structural write_type_info's
instance ReadTypeInfo Int instance ReadTypeInfo Int
where where
read_type_info :: !*File -> (!Bool,Int,!*File) read_type_info :: !*File -> (!Bool,Int,!*File)
read_type_info tcl_file read_type_info tcl_file
= freadi_new tcl_file = freadi tcl_file
where
// copy from StdEnv. The only difference is the dot before the Int in the type
// of freadi_new.
freadi_new ::!*File -> (!Bool,!Int,!*File)
/* Reads an integer from a textfile by skipping spaces, tabs and newlines and
then reading digits, which may be preceeded by a plus or minus sign.
From a datafile freadi will just read four bytes (a Clean Int). */
freadi_new f
= code {
.inline freadi
.d 0 2 f
jsr readFI
.o 0 4 b i f
.end
}
instance ReadTypeInfo {#b} | ReadTypeInfo b & DefaultElem b & ArrayElem b //| DefaultElem, createArray_u, select_u, size_u, update_u, ReadTypeInfo b instance ReadTypeInfo {#b} | ReadTypeInfo b & DefaultElem b & ArrayElem b
where where
read_type_info tcl_file read_type_info tcl_file
...@@ -567,10 +548,6 @@ where ...@@ -567,10 +548,6 @@ where
| not ok | not ok
= (False,[],tcl_file) = (False,[],tcl_file)
= read_type_info_loop (inc i) limit tcl_file [elem:elems] = read_type_info_loop (inc i) limit tcl_file [elem:elems]
// defaults // defaults
class DefaultElem a class DefaultElem a
...@@ -591,8 +568,6 @@ where ...@@ -591,8 +568,6 @@ where
, td_attribute = default_elem , td_attribute = default_elem
, td_pos = default_elem , td_pos = default_elem
} }
// = abort "aa";
instance DefaultElem Position instance DefaultElem Position
where where
...@@ -620,24 +595,16 @@ where ...@@ -620,24 +595,16 @@ where
instance DefaultElem TypeVar instance DefaultElem TypeVar
where where
// default_elem :: TypeVar
default_elem default_elem
= { TypeVar | = { TypeVar |
tv_name = default_elem tv_name = default_elem
, tv_info_ptr = default_elem , tv_info_ptr = default_elem
} }
/* instance DefaultElem (Ptr a)
instance DefaultElem Ptr TypeVarInfo
where where
default_elem default_elem
= nilPtr = nilPtr
*/
instance DefaultElem (Ptr a) // | DefaultElem a
where
default_elem
= nilPtr //default_elem
instance DefaultElem Ident instance DefaultElem Ident
where where
...@@ -743,51 +710,24 @@ instance DefaultElem Assoc ...@@ -743,51 +710,24 @@ instance DefaultElem Assoc
where where
default_elem default_elem
= NoAssoc = NoAssoc
/* instance DefaultElem RecordType
instance DefaultElem CommonDefs
where
default_elem
= { CommonDefs |
com_type_defs = default_elem
, com_cons_defs = default_elem
, com_selector_defs = undef //default_elem
, com_class_defs = undef
, com_member_defs = undef
, com_instance_defs = undef
}
*/
/*
instance DefaultElem ClassInstance
where where
default_elem default_elem
= { ClassInstance | = { RecordType |
ins_class = default_elem rt_constructor = default_elem
, ins_ident = default_elem , rt_fields = {}
, ins_type = default_elem
, ins_members = default_elem
, ins_specials = default_elem
, ins_pos = default_elem
} }
*/
/* instance DefaultElem FieldSymbol
instance DefaultElem SelectorDef
where where
default_elem default_elem
= { SelectorDef | = { FieldSymbol |
sd_symb = default_elem fs_name = default_elem
, sd_field = default_elem , fs_var = default_elem
, sd_type = default_elem , fs_index = default_elem
, sd_exi_vars = default_elem }
, sd_field_nr = default_elem
, sd_type_index = default_elem
, sd_type_ptr = default_elem
, sd_pos = default_elem
}
*/
instance DefaultElem {#a} | ArrayElem, DefaultElem a instance DefaultElem {#a} | ArrayElem, DefaultElem a
where where
......
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