Skip to content

GitLab

Commit 1426b396 authored by John van Groningen's avatar John van Groningen
Browse files

add unit type

parent 44f0f49b
Hide whitespace changes
Inline Side-by-side
Showing with 329 additions and 234 deletions
backend/backendconvert.icl
View file @ 1426b396
......@@ -917,6 +917,24 @@ declareDynamicTemp :: PredefinedSymbols -> BackEnder
declareDynamicTemp predefs
= appBackEnd (BEDeclareDynamicTypeSymbol predefs.[PD_StdDynamic].pds_def predefs.[PD_Dyn_DynamicTemp].pds_def)
^= v be
:== (v,be)
@^ f f1 be
# (v1,be) = f1 be
:== f v1 be
@^^ f f1 f2 be
# (v1,be) = f1 be
(v2,be) = f2 be
:== f v1 v2 be
@^^^ f f1 f2 f3 be
# (v1,be) = f1 be
(v2,be) = f2 be
(v3,be) = f3 be
:== f v1 v2 v3 be
predefineSymbols :: DclModule PredefinedSymbols -> BackEnder
predefineSymbols {dcl_common} predefs
= appBackEnd (BEDeclarePredefinedModule (size dcl_common.com_type_defs) (size dcl_common.com_cons_defs))
......@@ -924,6 +942,7 @@ predefineSymbols {dcl_common} predefs
o` foldState predefineType types
o` foldState predefine_list_constructor list_constructors
o` foldState predefineConstructor constructors
o` define_unit_type
where
list_types :: [(Int,Int,Int)]
list_types
......@@ -997,6 +1016,16 @@ predefineSymbols {dcl_common} predefs
// ... sanity check
= appBackEnd (BEPredefineConstructorSymbol arity predefs.[index].pds_def cPredefinedModuleIndex symbolKind)
define_unit_type
# constructor_symbol_be_f = BEConstructorSymbol predefs.[PD_UnitConsSymbol].pds_def cPredefinedModuleIndex
type_be_f = @^^ BENormalTypeNode constructor_symbol_be_f BENoTypeArgs
constructors_be_f = @^^ BEConstructors (@^ BEConstructor type_be_f) BENoConstructors
type_symbol_be_f = BETypeSymbol predefs.[PD_UnitType].pds_def cPredefinedModuleIndex
flat_type_be_f = @^^^ BEFlatType type_symbol_be_f (^= BENoUniAttr) BENoTypeVars
= appBackEnd
( BEDeclareConstructor predefs.[PD_UnitConsSymbol].pds_def cPredefinedModuleIndex "_Unit"
o` BEDeclareType predefs.[PD_UnitType].pds_def cPredefinedModuleIndex "_Unit"
o` @^^ BEAlgebraicType flat_type_be_f constructors_be_f)
bindSpecialIdents :: PredefinedSymbols NumberSet -> BackEnder
bindSpecialIdents predefs usedModules
......
frontend/check.icl
View file @ 1426b396
......@@ -3330,8 +3330,8 @@ where
<=< adjustPredefSymbolAndCheckIndex PD_StringType mod_index PD_StringTypeIndex STE_Type
<=< adjust_predef_symbols PD_ListType PD_OverloadedListType mod_index STE_Type
<=< adjust_predef_symbols_and_check_indices PD_Arity2TupleType PD_Arity32TupleType PD_Arity2TupleTypeIndex mod_index STE_Type
<=< adjust_predef_symbols PD_LazyArrayType PD_UnboxedArrayType mod_index STE_Type
<=< adjust_predef_symbols PD_ConsSymbol PD_Arity32TupleSymbol mod_index STE_Constructor
<=< adjust_predef_symbols PD_LazyArrayType PD_UnitType mod_index STE_Type
<=< adjust_predef_symbols PD_ConsSymbol PD_UnitConsSymbol mod_index STE_Constructor
<=< (if tc_class_defined (adjustPredefSymbol PD_TypeCodeClass mod_index STE_Class) (\x->x))
<=< (if tc_class_defined (adjustPredefSymbol PD_TypeCodeMember mod_index STE_Member) (\x->x))
<=< adjustPredefSymbol PD_DummyForStrictAliasFun mod_index STE_DclFunction)
......@@ -3356,7 +3356,7 @@ where
<=< adjust_predef_symbols PD_Dyn_initial_unification_environment PD_Dyn_normalise mod_index STE_DclFunction
<=< adjustPredefSymbol PD_Dyn__to_TypeCodeConstructor mod_index STE_DclFunction
<=< adjustPredefSymbol PD_TypeCodeConstructor mod_index STE_Type
<=< adjust_predef_symbols PD_TC_Int PD_TC__UnboxedArray mod_index STE_Constructor
<=< adjust_predef_symbols PD_TC_Int PD_TC__Unit mod_index STE_Constructor
)
# (pre_mod, cs_predef_symbols) = cs_predef_symbols![PD_StdGeneric]
# type_bimap = predefined_idents.[PD_TypeBimap]
......
frontend/convertDynamics.icl
View file @ 1426b396
......@@ -560,6 +560,8 @@ where
-> type_code_constructor_expression PD_TC__StrictArray ci
PD_UnboxedArrayType
-> type_code_constructor_expression PD_TC__UnboxedArray ci
PD_UnitType
-> type_code_constructor_expression PD_TC__Unit ci
typeConstructor (GTT_Constructor fun_ident _) ci
# type_fun
= App {app_symb = fun_ident, app_args = [], app_info_ptr = nilPtr}
......
frontend/parse.icl
View file @ 1426b396
......@@ -2964,6 +2964,9 @@ trySimpleTypeT_after_OpenToken ArrowToken attr pState
= (ParseOk, {at_attribute = attr, at_type = TArrow}, pState)
= (ParseFailWithError,{at_attribute = attr, at_type = TE},
parseError "arrow type" (Yes token) ")" pState)
trySimpleTypeT_after_OpenToken CloseToken attr pState
#! unit_type_ident = predefined_idents.[PD_UnitType]
= (ParseOk,{at_attribute=attr,at_type=TA (MakeNewTypeSymbIdent unit_type_ident 0) []},pState)
trySimpleTypeT_after_OpenToken token attr pState
# (annot_with_pos,atype, pState) = wantAnnotatedATypeWithPositionT token pState
(token, pState) = nextToken TypeContext pState
......@@ -3387,19 +3390,37 @@ trySimplePatternT SquareOpenToken pState
# (list_expr, pState) = wantListExp cIsAPattern pState
= (True, list_expr, pState)
trySimplePatternT OpenToken pState
# (args=:[exp:exps], pState) = want_pattern_list pState
pState = wantToken FunctionContext "pattern list" CloseToken pState
| isEmpty exps
= case exp of
PE_Ident id
-> (True, PE_List [exp], pState)
_
-> (True, exp, pState)
= (True, PE_Tuple args, pState)
# (token, pState) = nextToken FunctionContext pState
= case token of
CloseToken
#! unit_cons_ident = predefined_idents.[PD_UnitConsSymbol]
-> (True,PE_Ident unit_cons_ident,pState)
_
# (args=:[exp:exps], pState) = want_pattern_list_t token pState
pState = wantToken FunctionContext "pattern list" CloseToken pState
| isEmpty exps
-> case exp of
PE_Ident id
-> (True, PE_List [exp], pState)
_
-> (True, exp, pState)
-> (True, PE_Tuple args, pState)
where
want_pattern_list_t token pState
# (expr, pState)
= case token of
CharListToken charList // To produce a better error message
-> charListError charList pState
_
-> wantPatternT token pState
= want_pattern_list_rest expr pState
want_pattern_list pState
# (expr, pState) = wantPattern pState
(token, pState) = nextToken FunctionContext pState
= want_pattern_list_rest expr pState
want_pattern_list_rest expr pState
# (token, pState) = nextToken FunctionContext pState
| token == CommaToken
# (exprs, pState) = want_pattern_list pState
= ([expr : exprs], pState)
......@@ -3492,19 +3513,38 @@ trySimpleExpressionT SquareOpenToken pState
# (list_expr, pState) = wantListExp cIsNotAPattern pState
= (True, list_expr, pState)
trySimpleExpressionT OpenToken pState
# (args=:[exp:exps], pState) = want_expression_list pState
pState = wantToken FunctionContext "expression list" CloseToken pState
| isEmpty exps
= case exp of
PE_Ident id
-> (True, PE_List [exp], pState)
_
-> (True, exp, pState)
= (True, PE_Tuple args, pState)
# (token, pState) = nextToken FunctionContext pState
= case token of
CloseToken
#! unit_cons_ident = predefined_idents.[PD_UnitConsSymbol]
-> (True,PE_Ident unit_cons_ident,pState)
_
# (args=:[exp:exps], pState) = want_expression_list_t token pState
pState = wantToken FunctionContext "expression list" CloseToken pState
| isEmpty exps
-> case exp of
PE_Ident id
-> (True, PE_List [exp], pState)
_
-> (True, exp, pState)
-> (True, PE_Tuple args, pState)
where
want_expression_list_t token pState
# (expr, pState)
= case token of
CharListToken charList
// To produce a better error message
-> charListError charList pState
_
-> wantExpressionT token pState
= want_expression_list_rest expr pState
want_expression_list pState
# (expr, pState) = wantExpression pState
(token, pState) = nextToken FunctionContext pState
= want_expression_list_rest expr pState
want_expression_list_rest expr pState
# (token, pState) = nextToken FunctionContext pState
| token == CommaToken
# (exprs, pState) = want_expression_list pState
= ([expr : exprs], pState)
......
frontend/predef.dcl
View file @ 1426b396
......@@ -23,7 +23,7 @@ PD_StringTypeIndex :== 0
PD_Arity2TupleTypeIndex :== 8
PD_Arity32TupleTypeIndex :== 38
/* identifiers not present the hastable */
/* identifiers not present the hashtable */
PD_PredefinedModule :== 0
......@@ -46,258 +46,264 @@ PD_LazyArrayType :== 40
PD_StrictArrayType :== 41
PD_UnboxedArrayType :== 42
PD_UnitType :== 43
// constructors:
FirstConstructorPredefinedSymbolIndex :== PD_ConsSymbol; // to compute index in com_cons_defs
PD_ConsSymbol :== 43
PD_StrictConsSymbol :== 44
PD_UnboxedConsSymbol :== 45
PD_TailStrictConsSymbol :== 46
PD_StrictTailStrictConsSymbol :== 47
PD_UnboxedTailStrictConsSymbol :== 48
PD_OverloadedConsSymbol :== 49
PD_NilSymbol :== 50
PD_StrictNilSymbol :== 51
PD_UnboxedNilSymbol :== 52
PD_TailStrictNilSymbol :== 53
PD_StrictTailStrictNilSymbol :== 54
PD_UnboxedTailStrictNilSymbol :== 55
PD_OverloadedNilSymbol :== 56
PD_Arity2TupleSymbol :== 57
PD_Arity32TupleSymbol :== 87
PD_ConsSymbol :== 44
PD_StrictConsSymbol :== 45
PD_UnboxedConsSymbol :== 46
PD_TailStrictConsSymbol :== 47
PD_StrictTailStrictConsSymbol :== 48
PD_UnboxedTailStrictConsSymbol :== 49
PD_OverloadedConsSymbol :== 50
PD_NilSymbol :== 51
PD_StrictNilSymbol :== 52
PD_UnboxedNilSymbol :== 53
PD_TailStrictNilSymbol :== 54
PD_StrictTailStrictNilSymbol :== 55
PD_UnboxedTailStrictNilSymbol :== 56
PD_OverloadedNilSymbol :== 57
PD_Arity2TupleSymbol :== 58
PD_Arity32TupleSymbol :== 88
PD_UnitConsSymbol :== 89
// end constructors
PD_TypeVar_a0 :== 88
PD_TypeVar_a31 :== 119
PD_TypeVar_a0 :== 90
PD_TypeVar_a31 :== 121
/* identifiers present in the hashtable */
PD_StdArray :== 120
PD_StdEnum :== 121
PD_StdBool :== 122
PD_StdArray :== 122
PD_StdEnum :== 123
PD_StdBool :== 124
PD_AndOp :== 123
PD_OrOp :== 124
PD_AndOp :== 125
PD_OrOp :== 126
/* Array functions */
PD_ArrayClass :== 125
PD_ArrayClass :== 127
PD_CreateArrayFun :== 126
PD__CreateArrayFun :== 127
PD_ArraySelectFun :== 128
PD_UnqArraySelectFun :== 129
PD_ArrayUpdateFun :== 130
PD_ArrayReplaceFun :== 131
PD_ArraySizeFun :== 132
PD_UnqArraySizeFun :== 133
PD_CreateArrayFun :== 128
PD__CreateArrayFun :== 129
PD_ArraySelectFun :== 130
PD_UnqArraySelectFun :== 131
PD_ArrayUpdateFun :== 132
PD_ArrayReplaceFun :== 133
PD_ArraySizeFun :== 134
PD_UnqArraySizeFun :== 135
/* Enum/Comprehension functions */
PD_SmallerFun :== 134
PD_LessOrEqualFun :== 135
PD_IncFun :== 136
PD_SubFun :== 137
PD_From :== 138
PD_FromThen :== 139
PD_FromTo :== 140
PD_FromThenTo :== 141
PD_SmallerFun :== 136
PD_LessOrEqualFun :== 137
PD_IncFun :== 138
PD_SubFun :== 139
PD_From :== 140
PD_FromThen :== 141
PD_FromTo :== 142
PD_FromThenTo :== 143
/* StdMisc */
PD_StdMisc :== 142
PD_abort :== 143
PD_undef :== 144
PD_StdMisc :== 144
PD_abort :== 145
PD_undef :== 146
PD_Start :== 145
PD_Start :== 147
PD_DummyForStrictAliasFun :== 146
PD_DummyForStrictAliasFun :== 148
PD_StdStrictLists:==147
PD_StdStrictLists:==149
PD_cons:==148
PD_decons:==149
PD_cons:==150
PD_decons:==151
PD_cons_u:==150
PD_decons_u:==151
PD_cons_u:==152
PD_decons_u:==153
PD_cons_uts:==152
PD_decons_uts:==153
PD_cons_uts:==154
PD_decons_uts:==155
PD_nil:==154
PD_nil_u:==155
PD_nil_uts:==156
PD_nil:==156
PD_nil_u:==157
PD_nil_uts:==158
PD_ListClass :== 157
PD_UListClass :== 158
PD_UTSListClass :== 159
PD_ListClass :== 159
PD_UListClass :== 160
PD_UTSListClass :== 161
/* Dynamics */
// TC class
PD_TypeCodeMember :== 160
PD_TypeCodeClass :== 161
PD_TypeCodeMember :== 162
PD_TypeCodeClass :== 163
// dynamic module
PD_StdDynamic :== 162
PD_StdDynamic :== 164
// dynamic type
PD_Dyn_DynamicTemp :== 163
PD_Dyn_DynamicTemp :== 165
// type code (type)
PD_Dyn_TypeCode :== 164
PD_Dyn_TypeCode :== 166
// unification (type)
PD_Dyn_UnificationEnvironment :== 165
PD_Dyn_UnificationEnvironment :== 167
// type code (expressions)
PD_Dyn_TypeScheme :== 166
PD_Dyn_TypeApp :== 167
PD_Dyn_TypeVar :== 168
PD_Dyn_TypeCons :== 169
PD_Dyn_TypeUnique :== 170
PD_Dyn__TypeFixedVar :== 171
PD_Dyn_TypeScheme :== 168
PD_Dyn_TypeApp :== 169
PD_Dyn_TypeVar :== 170
PD_Dyn_TypeCons :== 171
PD_Dyn_TypeUnique :== 172
PD_Dyn__TypeFixedVar :== 173
// unification (expressions)
PD_Dyn_initial_unification_environment :== 172
PD_Dyn_bind_global_type_pattern_var :== 173
PD_Dyn_unify :== 174
PD_Dyn_normalise :== 175
PD_Dyn_initial_unification_environment :== 174
PD_Dyn_bind_global_type_pattern_var :== 175
PD_Dyn_unify :== 176
PD_Dyn_normalise :== 177
/* Generics */
PD_StdGeneric :== 176
PD_StdGeneric :== 178
// Generics types
PD_TypeBimap :== 177
PD_TypeUNIT :== 178
PD_TypeEITHER :== 179
PD_TypePAIR :== 180
PD_TypeBimap :== 179
PD_TypeUNIT :== 180
PD_TypeEITHER :== 181
PD_TypePAIR :== 182
// for constructor info
PD_TypeCONS :== 181
PD_TypeRECORD :== 182
PD_TypeFIELD :== 183
PD_TypeOBJECT :== 184
PD_TGenericConsDescriptor :== 185
PD_TGenericRecordDescriptor :== 186
PD_TGenericFieldDescriptor :== 187
PD_TGenericTypeDefDescriptor :== 188
PD_TGenConsPrio :== 189
PD_TGenConsAssoc :== 190
PD_TGenType :== 191
PD_TypeGenericDict :== 192
PD_TypeCONS :== 183
PD_TypeRECORD :== 184
PD_TypeFIELD :== 185
PD_TypeOBJECT :== 186
PD_TGenericConsDescriptor :== 187
PD_TGenericRecordDescriptor :== 188
PD_TGenericFieldDescriptor :== 189
PD_TGenericTypeDefDescriptor :== 190
PD_TGenConsPrio :== 191
PD_TGenConsAssoc :== 192
PD_TGenType :== 193
PD_TypeGenericDict :== 194
// Generics fields
PD_map_to :== 193
PD_map_from :== 194
PD_map_to :== 195
PD_map_from :== 196
// Generics expression
PD_ConsBimap :== 195
PD_ConsUNIT :== 196
PD_ConsLEFT :== 197
PD_ConsRIGHT :== 198
PD_ConsPAIR :== 199
PD_ConsBimap :== 197
PD_ConsUNIT :== 198
PD_ConsLEFT :== 199
PD_ConsRIGHT :== 200
PD_ConsPAIR :== 201
// for constructor info
PD_ConsCONS :== 200
PD_ConsRECORD :== 201
PD_ConsFIELD :== 202
PD_ConsOBJECT :== 203
PD_CGenericConsDescriptor :== 204
PD_CGenericRecordDescriptor :== 205
PD_CGenericFieldDescriptor :== 206
PD_CGenericTypeDefDescriptor :== 207
PD_CGenConsNoPrio :== 208
PD_CGenConsPrio :== 209
PD_CGenConsAssocNone :== 210
PD_CGenConsAssocLeft :== 211
PD_CGenConsAssocRight :== 212
PD_CGenTypeCons :== 213
PD_CGenTypeVar :== 214
PD_CGenTypeArrow :== 215
PD_CGenTypeApp :== 216
PD_bimapId :== 217
PD_GenericBimap :== 218
PD_FromS :== 219
PD_FromTS :== 220
PD_FromSTS :== 221
PD_FromU :== 222
PD_FromUTS :== 223
PD_FromO :== 224
PD_FromThenS :== 225
PD_FromThenTS :== 226
PD_FromThenSTS :== 227
PD_FromThenU :== 228
PD_FromThenUTS :== 229
PD_FromThenO :== 230
PD_FromToS :== 231
PD_FromToTS :== 232
PD_FromToSTS :== 233
PD_FromToU :== 234
PD_FromToUTS :== 235
PD_FromToO :== 236
PD_FromThenToS :== 237
PD_FromThenToTS :== 238
PD_FromThenToSTS :== 239
PD_FromThenToU :== 240
PD_FromThenToUTS :== 241
PD_FromThenToO :== 242
PD_Dyn__to_TypeCodeConstructor :== 243
PD_TypeCodeConstructor :== 244
PD_TC_Int :== 245
PD_TC_Char :== 246
PD_TC_Real :== 247
PD_TC_Bool :== 248
PD_TC_Dynamic :== 249
PD_TC_File :== 250
PD_TC_World :== 251
PD_TC__Arrow :== 252
PD_TC__List :== 253
PD_TC__StrictList :== 254
PD_TC__UnboxedList :== 255
PD_TC__TailStrictList :== 256
PD_TC__StrictTailStrictList :== 257
PD_TC__UnboxedTailStrictList :== 258
PD_TC__Tuple2 :== 259
PD_TC__Tuple3 :== 260
PD_TC__Tuple4 :== 261
PD_TC__Tuple5 :== 262
PD_TC__Tuple6 :== 263
PD_TC__Tuple7 :== 264
PD_TC__Tuple8 :== 265
PD_TC__Tuple9 :== 266
PD_TC__Tuple10 :== 267
PD_TC__Tuple11 :== 268
PD_TC__Tuple12 :== 269
PD_TC__Tuple13 :== 270
PD_TC__Tuple14 :== 271
PD_TC__Tuple15 :== 272
PD_TC__Tuple16 :== 273
PD_TC__Tuple17 :== 274
PD_TC__Tuple18 :== 275
PD_TC__Tuple19 :== 276
PD_TC__Tuple20 :== 277
PD_TC__Tuple21 :== 278
PD_TC__Tuple22 :== 279
PD_TC__Tuple23 :== 280
PD_TC__Tuple24 :== 281
PD_TC__Tuple25 :== 282
PD_TC__Tuple26 :== 283
PD_TC__Tuple27 :== 284
PD_TC__Tuple28 :== 285
PD_TC__Tuple29 :== 286
PD_TC__Tuple30 :== 287
PD_TC__Tuple31 :== 288
PD_TC__Tuple32 :== 289
PD_TC__LazyArray :== 290
PD_TC__StrictArray :== 291
PD_TC__UnboxedArray :== 292
PD_NrOfPredefSymbols :== 293
PD_ConsCONS :== 202
PD_ConsRECORD :== 203
PD_ConsFIELD :== 204
PD_ConsOBJECT :== 205
PD_CGenericConsDescriptor :== 206
PD_CGenericRecordDescriptor :== 207
PD_CGenericFieldDescriptor :== 208
PD_CGenericTypeDefDescriptor :== 209
PD_CGenConsNoPrio :== 210
PD_CGenConsPrio :== 211
PD_CGenConsAssocNone :== 212
PD_CGenConsAssocLeft :== 213
PD_CGenConsAssocRight :== 214
PD_CGenTypeCons :== 215
PD_CGenTypeVar :== 216
PD_CGenTypeArrow :== 217
PD_CGenTypeApp :== 218
PD_bimapId :== 219
PD_GenericBimap :== 220
PD_FromS :== 221
PD_FromTS :== 222
PD_FromSTS :== 223
PD_FromU :== 224
PD_FromUTS :== 225
PD_FromO :== 226
PD_FromThenS :== 227
PD_FromThenTS :== 228
PD_FromThenSTS :== 229
PD_FromThenU :== 230
PD_FromThenUTS :== 231
PD_FromThenO :== 232
PD_FromToS :== 233
PD_FromToTS :== 234
PD_FromToSTS :== 235
PD_FromToU :== 236
PD_FromToUTS :== 237
PD_FromToO :== 238
PD_FromThenToS :== 239
PD_FromThenToTS :== 240
PD_FromThenToSTS :== 241
PD_FromThenToU :== 242
PD_FromThenToUTS :== 243
PD_FromThenToO :== 244
PD_Dyn__to_TypeCodeConstructor :== 245
PD_TypeCodeConstructor :== 246
PD_TC_Int :== 247
PD_TC_Char :== 248
PD_TC_Real :== 249
PD_TC_Bool :== 250
PD_TC_Dynamic :== 251
PD_TC_File :== 252
PD_TC_World :== 253