Commit bc3f3995 authored by Vincent Zweije's avatar Vincent Zweije
Browse files

Define Cocl to Sucl conversion of (algebraic) type specifications

parent 6657e71a
......@@ -5,11 +5,11 @@ definition module absmodule
from rule import Rule
:: Module sym pvar tsym tvar
= { exportedtypesymbols :: [tsym] // Exported type symbols (from DCL)
, typealias :: [(tsym,Rule tsym tvar)] // Alias types
, typeconstructors :: [(tsym,[sym])] // All constructor symbols of each declared algebraic type
= { //exportedtypesymbols :: [tsym] // Exported type symbols (from DCL)
//, typealias :: [(tsym,Rule tsym tvar)] // Alias types
typeconstructors :: [(tsym,[sym])] // All constructor symbols of each declared algebraic type
, exportedsymbols :: [sym] // Exported function/constructor symbols
, aliases :: [(sym,Rule sym pvar)] // Macros
//, aliases :: [(sym,Rule sym pvar)] // Macros
, typerules :: [(sym,(Rule tsym tvar,[Bool]))] // Info from type rules (actual type and argument strictnesses)
, rules :: [(sym,[Rule sym pvar])] // Rewrite rules of each symbol, absent if imported
}
......@@ -42,11 +42,11 @@ Module implementation.
*/
:: Module sym pvar tsym tvar
= { exportedtypesymbols :: [tsym] // Exported type symbols (from DCL)
, typealias :: [(tsym,Rule tsym tvar)] // Alias types
, typeconstructors :: [(tsym,[sym])] // All constructor symbols of each declared algebraic type
= {// exportedtypesymbols :: [tsym] // Exported type symbols (from DCL)
//, typealias :: [(tsym,Rule tsym tvar)] // Alias types
typeconstructors :: [(tsym,[sym])] // All constructor symbols of each declared algebraic type
, exportedsymbols :: [sym] // Exported function/constructor symbols
, aliases :: [(sym,Rule sym pvar)] // Macros
//, aliases :: [(sym,Rule sym pvar)] // Macros
, typerules :: [(sym,(Rule tsym tvar,[Bool]))] // Info from type rules (actual type and argument strictnesses)
, rules :: [(sym,[Rule sym pvar])] // Rewrite rules of each symbol, absent if imported
}
......
......@@ -153,7 +153,7 @@ typerule m sym
*/
clistrategy :: Cli ((Graph SuclSymbol SuclVariable) SuclVariable var -> Bool) -> Strategy SuclSymbol var SuclVariable answer | == var
clistrategy cli=:{exportedtypesymbols=tes,typealias=tas,typeconstructors=tcs,exportedsymbols=es,aliases=as,typerules=ts,rules=rs} matchable
clistrategy {typeconstructors=tcs,typerules=ts,rules=rs} matchable
= ( checkarity (typearity o maxtypeinfo ts) // Checks curried occurrences and strict arguments
o checklaws cleanlaws // Checks for special (hard coded) rules (+x0=x /y1=y ...)
o checkrules matchable (foldmap id [] rs) // Checks normal rewrite rules
......
......@@ -34,6 +34,11 @@ cts_exports ::
Int // Index of current module
-> [SuclSymbol]
//Cocl to Sucl for (algebraic) type specifications
cts_getconstrs ::
{#DclModule} // Info from used DCL modules
-> [(SuclTypeSymbol,[SuclSymbol])] // List of constructor symbols for each type symbol
//Sucl to Cocl for function bodies
stc_funcdef ::
{#DclModule} // DCL for looking up constructor types
......
......@@ -105,7 +105,7 @@ convert_atype atype (heap,(graph,rest,srest))
-> (heap``,updategraph typevar (typesym,typeargs) graph`,typevar)
where (heap``,(graph`,typeargs,_)) = convert_atypes (heap`,graph) atypes // _ => forget annotations of subtypes
[typevar:heap`] = heap
typesym = SuclUSER typename
typesym = SuclUSER typename.type_index
// A function type (a->b)
functype --> argtype
......@@ -143,6 +143,36 @@ convert_btype BT_File = SuclFILE
convert_btype BT_World = SuclWORLD
convert_btype _ = abort "convert: convert_btype: unhandled BasicType constructor"
/******************************************************************************
* ALGEBRAIC TYPE CONVERSION *
******************************************************************************/
cts_getconstrs ::
{#DclModule} // Info from used DCL modules
-> [(SuclTypeSymbol,[SuclSymbol])] // List of constructor symbols for each type symbol
cts_getconstrs dcl_mods
= flatten (zipwith f (a2l dcl_mods) [0..])
where f dcl_mod dcli
= [convert_typedef dcli typedef \\ typedef <-: dcl_mod.dcl_common.com_type_defs]
a2l a = [e \\ e<-:a]
convert_typedef :: Index (TypeDef TypeRhs) -> (SuclTypeSymbol,[SuclSymbol])
convert_typedef dcli typedef
= (SuclUSER (mkglobal dcli typedef.td_index),getconstrs dcli typedef.td_rhs)
getconstrs dcli (AlgType constrs)
= map mkalgconstr constrs
where mkalgconstr defsymb = SuclUser (SK_Constructor (mkglobal dcli defsymb.ds_index))
getconstrs _ _
= mstub "getconstrs" "unhandled TypeRhs form"
mkglobal gmod gob = {glob_module = gmod, glob_object = gob}
/******************************************************************************
* EXPRESSION CONVERSION *
******************************************************************************/
......
......@@ -17,7 +17,7 @@ from StdOverloaded import ==
from StdString import String
:: SuclTypeSymbol
= SuclUSER TypeSymbIdent // A user-defined type symbol
= SuclUSER (Global Index) // A user-defined type symbol (index into com_type_def array)
| SuclFN Int // THE function type for a function with specified arity
| SuclINT // Built-in integer
| SuclCHAR // Etc.
......
......@@ -12,7 +12,7 @@ import syntax
//import StdEnv
:: SuclTypeSymbol
= SuclUSER TypeSymbIdent
= SuclUSER (Global Index)
| SuclFN Int
| SuclINT
| SuclCHAR
......
......@@ -18,8 +18,8 @@ from general import BITVECT,Optional
from Heap import Heap,HeapN,Ptr,PtrN
from StdString import String
supercompile
:: !{# CommonDefs} // common_defs
supercompile ::
!{# CommonDefs} // common_defs
!IndexRange // array_instances
!{#DclModule} // dcl_mods
!Int // main_dcl_module_n
......
......@@ -8,8 +8,8 @@ import syntax
import transform
import trans
supercompile
:: !{# CommonDefs} // common_defs
supercompile ::
!{# CommonDefs} // common_defs
!IndexRange // array_instances
!{#DclModule} // dcl_mods
!Int // main_dcl_module_n
......@@ -39,5 +39,7 @@ supercompile common_defs array_instances dcl_mods main_dcl_module_n components f
_ = cts_function fun_defs
// Determine exported functions
_ = cts_exports fun_defs dcl_mods main_dcl_module_n
// Get constructor lists of algebraic types
_ = cts_getconstrs dcl_mods main_dcl_module_n
// Convert sucl-generated function body back to core clean
(expression_heap`,var_heap`,func_body) = stc_funcdef dcl_mods expression_heap var_heap undef
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