-- Kipper.7Casaba: November 17, 1985 3:04:50 pm PST
-- Sturgis, December 31, 1985 3:51:14 pm PST

KipperCentral: Control Module;

KipperMain1: Module =

Begin


-- this will go away when all is filled in

Junk: AbstractType[foo];
	Junk: AbstractProduction[];
		for Junk: AbstractProduction[]
			let foo[tree] _ 0;

foo: TreeRecursiveFunction[Tree] Returns[INT];
	
	
-- these should be built in

ROPE: CedarType From Rope;
INT, BOOLEAN: CedarType;


-- base types and functions

id: GenericToken = "tokenID";


Name: BaseType;
NameSeq: BaseType;

	BuildName: BaseFunction[id] Returns[Name];
	BuildNullName: BaseFunction Returns[Name];
	FakeCopyName: BaseFunction[Name.arg] Returns[Name.result];
	BuildImplModName: BaseFunction[id] Returns[Name];
	
	BuildEmptyNameSeq: BaseFunction Returns[NameSeq];
	AppendToNameSeq: BaseFunction[NameSeq.arg, Name] Returns[NameSeq.result]
		DamagedReps[NameSeq.arg];
	PrefixToNameSeq: BaseFunction[Name, NameSeq.arg] Returns[NameSeq.result]
		DamagedReps[NameSeq.arg];

ElementSeq: BaseType;

	BuildEmptyElementSeq: BaseFunction Returns[ElementSeq];
	AppendNameToElementSeq: BaseFunction[ElementSeq.arg, Name] Returns[ElementSeq.result]
		DamagedReps[ElementSeq.arg];

Type: BaseType;


FieldSeq: BaseType;
	
	BuildEmptyFieldSeq: BaseFunction Returns[FieldSeq];
	BuildOnePairFieldSeq: BaseFunction[NameSeq, Type] Returns[FieldSeq];
	ConcatFieldSeq: BaseFunction[FieldSeq.arg1, FieldSeq.arg2] Returns[FieldSeq.result]
		DamagedReps[FieldSeq.arg1]
		SharedReps[FieldSeq.arg2, FieldSeq.result];
	PrefixTypeToFieldSeq: BaseFunction[Type, FieldSeq.arg] Returns[FieldSeq.result]
		DamagedReps[FieldSeq.arg];


  -- here are the assorted type node construction functions
  	
	BuildNamedType: BaseFunction[NameSeq.a, NameSeq.b] Returns[Type];
	BuildEnumeratedType: BaseFunction[ElementSeq] Returns[Type];
	BuildRecordType: BaseFunction[FieldSeq] Returns[Type];
	BuildRefType: BaseFunction[Type.arg] Returns[Type.result];
	BuildRefAnyType: BaseFunction Returns[Type];
	BuildListType: BaseFunction[Type.arg] Returns[Type.result];
	BuildSeqType: BaseFunction[Name, Type.sizeType, Type.fieldType] Returns[Type.result];


TypeContext: BaseType;

	BuildEmptyTypeContext: BaseFunction[Name.defFile, Name.implFile] Returns[TypeContext];
	FakeCopyContext: BaseFunction[TypeContext.arg] Returns[TypeContext.result]
		DamagedReps[TypeContext.arg];
	NoteDefFileName: BaseFunction[TypeContext.arg, Name] Returns[TypeContext.result]
		DamagedReps[TypeContext.arg];
	NoteImplFileName: BaseFunction[TypeContext.arg, Name] Returns[TypeContext.result]
		DamagedReps[TypeContext.arg];
	RecordTypeDecl: BaseFunction[TypeContext.arg, Name.typeDefFile, Name.fcnDefFile, Name.fcnImplFile, NameSeq, Type] Returns[TypeContext.result]
		DamagedReps[TypeContext.arg];
	LookUpType: BaseFunction[TypeContext, NameSeq.arg1, NameSeq.arg2] Returns[Type];
	CloseTypeContext: BaseFunction[TypeContext.arg] Returns[TypeContext.result]
		DamagedReps[TypeContext.arg];
	

-- some recursive functions

FormName: TreeRecursiveFunction[Tree] Returns[Name];
FormNameSeq: TreeRecursiveFunction[Tree] Returns[NameSeq];
FormElementSeq: TreeRecursiveFunction[Tree] Returns[ElementSeq];
FormType: TreeRecursiveFunction[Tree] Returns[Type];
FormFieldSeq: TreeRecursiveFunction[Tree] Returns[FieldSeq];
FormTypeIdDesc: TreeRecursiveFunction[Tree] Returns[NameSeq.a, NameSeq.b];
EnlargeContext: TreeRecursiveFunction[Tree, Name.defFile, Name.implFile, TypeContext.arg] Returns[TypeContext.result]
	DamagedReps[TypeContext.arg];
FormContext: TreeRecursiveFunction[Tree] Returns[TypeContext];
FormWhenceFromDecl: TreeRecursiveFunction[Tree, Name.arg] Returns[Name.result];
FormId: TreeRecursiveFunction[Tree] Returns[id];
FormVCaseHead: TreeRecursiveFunction[Tree] Returns[id, Type];



-- abstract grammar

ModuleBody: AbstractType[FormContext];
	ModuleBody: AbstractProduction[id, DecList];

DecList: AbstractType[EnlargeContext];
	DecList.one: AbstractProduction[Declaration];
	DecList.more: AbstractProduction[DecList, Declaration];


Declaration: AbstractType[EnlargeContext];
	Declaration.type: AbstractProduction[IdListR, DeclFrom, TypeExp];

DeclFrom: AbstractType[FormWhenceFromDecl];
	DeclFrom.builtin: AbstractProduction[];
	DeclFrom.fromcedardef: AbstractProduction[id];
	DeclFrom.nominal: AbstractProduction[];


TypeExp: AbstractType[FormType];
	TypeExp.typeid: AbstractProduction[TypeId];
	TypeExp.elements: AbstractProduction[ElementList];
	TypeExp.record: AbstractProduction[FieldList];
	TypeExp.ref: AbstractProduction[TypeExp];
	TypeExp.refAny: AbstractProduction[];
	TypeExp.list: AbstractProduction[TypeExp];


TypeId: AbstractType[FormTypeIdDesc];
	TypeId.mod: AbstractProduction[id, TypeId];
	TypeId.one: AbstractProduction[IdListL];


ElementList: AbstractType[FormElementSeq];
	ElementList.empty: AbstractProduction[];
	ElementList.more: AbstractProduction[ElementList, Element];

Element: AbstractType[FormName];
	Element.id: AbstractProduction[id];

FieldList: AbstractType[FormFieldSeq];
	FieldList.empty: AbstractProduction[];
	FieldList.null: AbstractProduction[];
	FieldList.pairs: AbstractProduction[PairList];
	FieldList.vpairs: AbstractProduction[PairList, VPair];
	FieldList.types: AbstractProduction[TypeList];
	FieldList.vtypes: AbstractProduction[TypeList, VPart];


PairList: AbstractType[FormFieldSeq];
	PairList.empty: AbstractProduction[];
	PairList.one: AbstractProduction[PairItem];
	PairList.more: AbstractProduction[PairList, PairItem];

PairItem: AbstractType[FormFieldSeq];
	PairItem: AbstractProduction[IdListR, TypeExp];

VPair: AbstractType[FormFieldSeq];
	VPair: AbstractProduction[IdListR, VPart];

TypeList: AbstractType[FormFieldSeq];
	TypeList.empty: AbstractProduction[];
	TypeList.one: AbstractProduction[TypeExp];
	TypeList.more: AbstractProduction[TypeExp, TypeList];
	
VPart: AbstractType[FormType];
	VPart.seq: AbstractProduction[VCaseHead, TypeExp];

VCaseHead: AbstractType[FormVCaseHead];
	VCaseHead.ident: AbstractProduction[Ident, Tagtype];

Tagtype: AbstractType[FormType];
	Tagtype.exp: AbstractProduction[TypeExp];


IdListR: AbstractType[FormNameSeq];
	IdListR.one: AbstractProduction[id];
	IdListR.more: AbstractProduction[id, IdListR];

IdListL: AbstractType[FormNameSeq];
	IdListL.one: AbstractProduction[id];
	IdListL.more: AbstractProduction[IdListL, id];

Ident: AbstractType[FormId];
	Ident: AbstractProduction[id];
		
	
-- some recursive function implementations

for ModuleBody: AbstractProduction[id, DecList]
	let FormContext[tree] _ CloseTypeContext[context3]
		where context3 _ EnlargeContext[DecList, defModName, implModName, context2]
		where context2 _ NoteImplFileName[context1, implModName]
		where context1 _ NoteDefFileName[context0, defModName]
		where context0 _ BuildEmptyTypeContext[defModName, implModName]
		where implModName _ BuildImplModName[id]
		where defModName _ BuildName[id];

for DecList.one: AbstractProduction[Declaration]
	let EnlargeContext[tree, defModuleName, implModuleName, context] _
			EnlargeContext[Declaration, defModuleName, implModuleName, context];

for DecList.more: AbstractProduction[DecList, Declaration]
	let EnlargeContext[tree, defModuleName, implModuleName, context] _
			EnlargeContext[Declaration, defModuleName, implModuleName,
				EnlargeContext[DecList, defModuleName, implModuleName, context]];

for Declaration.type: AbstractProduction[IdListR, DeclFrom, TypeExp]
	let EnlargeContext[tree, defModuleName, implModuleName, context] _
			RecordTypeDecl[context, typeDefFile, defModuleName, implModuleName, typeNames, type]
		where typeDefFile _ FormWhenceFromDecl[DeclFrom, defModuleName]
		where typeNames _ FormNameSeq[IdListR]
		where type _ FormType[TypeExp];

for DeclFrom.builtin: AbstractProduction[]
	let FormWhenceFromDecl[tree, moduleName] _ BuildNullName[];

for DeclFrom.fromcedardef: AbstractProduction[id]
	let FormWhenceFromDecl[tree, moduleName] _ BuildName[id];

for DeclFrom.nominal: AbstractProduction[]
	let FormWhenceFromDecl[tree, moduleName] _ FakeCopyName[moduleName];

for TypeExp.typeid: AbstractProduction[TypeId]
	let FormType[tree] _ BuildNamedType[FormTypeIdDesc[TypeId]];
	
for TypeExp.elements: AbstractProduction[ElementList]
	let FormType[tree] _ BuildEnumeratedType[FormElementSeq[ElementList]];
	
for TypeExp.record: AbstractProduction[FieldList]
	let FormType[tree] _ BuildRecordType[FormFieldSeq[FieldList]];
	
for TypeExp.ref: AbstractProduction[TypeExp]
	let FormType[tree] _ BuildRefType[FormType[TypeExp]];
	
for TypeExp.refAny: AbstractProduction[]
	let FormType[tree] _ BuildRefAnyType[];
	
for TypeExp.list: AbstractProduction[TypeExp]
	let FormType[tree] _ BuildListType[FormType[TypeExp]];


for TypeId.mod: AbstractProduction[id, TypeId]
	let FormTypeIdDesc[tree] _ <PrefixToNameSeq[BuildName[id], seq1], seq2>
	where <seq1, seq2> _ FormTypeIdDesc[TypeId];

for TypeId.one: AbstractProduction[IdListL]
	let FormTypeIdDesc[tree] _ <BuildEmptyNameSeq[], FormNameSeq[IdListL]>;
	

for ElementList.empty: AbstractProduction[]
	let FormElementSeq[tree] _ BuildEmptyElementSeq[];
	
for ElementList.more: AbstractProduction[ElementList, Element]
	let FormElementSeq[tree] _
		AppendNameToElementSeq[FormElementSeq[ElementList], FormName[Element]];
	
	
for Element.id: AbstractProduction[id]
	let FormName[tree] _ BuildName[id];

for FieldList.empty: AbstractProduction[]
	let FormFieldSeq[tree] _ BuildEmptyFieldSeq[];

for FieldList.null: AbstractProduction[]
	let FormFieldSeq[tree] _ BuildEmptyFieldSeq[];

for FieldList.pairs: AbstractProduction[PairList]
	let FormFieldSeq[tree] _ FormFieldSeq[PairList];

for FieldList.vpairs: AbstractProduction[PairList, VPair]
	let FormFieldSeq[tree] _ ConcatFieldSeq[FormFieldSeq[PairList], FormFieldSeq[VPair]];

for FieldList.types: AbstractProduction[TypeList]
	let FormFieldSeq[tree] _ FormFieldSeq[TypeList];

for FieldList.vtypes: AbstractProduction[TypeList, VPart]
	let FormFieldSeq[tree] _ ConcatFieldSeq[FormFieldSeq[TypeList], vFieldSeq]
		where vFieldSeq _ PrefixTypeToFieldSeq[FormType[VPart], BuildEmptyFieldSeq[]];


for PairList.empty: AbstractProduction[]
	let FormFieldSeq[tree] _ BuildEmptyFieldSeq[];

for PairList.one: AbstractProduction[PairItem]
	let FormFieldSeq[tree] _ FormFieldSeq[PairItem];
	
for PairList.more: AbstractProduction[PairList, PairItem]
	let FormFieldSeq[tree] _ ConcatFieldSeq[FormFieldSeq[PairList], FormFieldSeq[PairItem]];
	
for PairItem: AbstractProduction[IdListR, TypeExp]
	let FormFieldSeq[tree] _ BuildOnePairFieldSeq[FormNameSeq[IdListR], FormType[TypeExp]];
	
for VPair: AbstractProduction[IdListR, VPart]
	let FormFieldSeq[tree] _ BuildOnePairFieldSeq[FormNameSeq[IdListR], FormType[VPart]];

for TypeList.empty: AbstractProduction[]
	let FormFieldSeq[tree] _ BuildEmptyFieldSeq[];

for TypeList.one: AbstractProduction[TypeExp]
	let FormFieldSeq[tree] _ PrefixTypeToFieldSeq[FormType[TypeExp], BuildEmptyFieldSeq[]];
	
for TypeList.more: AbstractProduction[TypeExp, TypeList]
	let FormFieldSeq[tree] _ PrefixTypeToFieldSeq[FormType[TypeExp], FormFieldSeq[TypeList]];


for VPart.seq: AbstractProduction[VCaseHead, TypeExp]
	let FormType[tree] _ BuildSeqType[sizeName, sizeType, fieldType]
		where sizeName _ BuildName[sizeId]
		where <sizeId, sizeType> _ FormVCaseHead[VCaseHead]
		where fieldType _ FormType[TypeExp];

for VCaseHead.ident: AbstractProduction[Ident, Tagtype]
	let FormVCaseHead[tree] _ <FormId[Ident], FormType[Tagtype]>;

for Tagtype.exp: AbstractProduction[TypeExp]
	let FormType[tree] _ FormType[TypeExp];
	
	
for IdListR.one: AbstractProduction[id]
	let FormNameSeq[tree] _ AppendToNameSeq[BuildEmptyNameSeq[], BuildName[id]];

for IdListR.more: AbstractProduction[id, IdListR]
	let FormNameSeq[tree] _ PrefixToNameSeq[BuildName[id], FormNameSeq[IdListR]];

for IdListL.one: AbstractProduction[id]
	let FormNameSeq[tree] _ AppendToNameSeq[BuildEmptyNameSeq[], BuildName[id]];

for IdListL.more: AbstractProduction[IdListL, id]
	let FormNameSeq[tree] _ AppendToNameSeq[FormNameSeq[IdListL], BuildName[id]];

for Ident: AbstractProduction[id]
	let FormId[tree] _ id


End;

KipperMain2: Module =

Begin

-- following here is the concrete syntax

	-- adapted from XCedar.grammar of lr1parsing stuff

{ ";" ":" "," "[" "]" "=" } : SimpleTokens;

{ "." "{" "}" "RECORD" "REF" "ANY" } : SimpleTokens;
 
{ "LIST" "SEQUENCE" "OF" } : SimpleTokens; 

{ "NULL" } : SimpleTokens;

{"FROM" } : SimpleTokens;

{ "TYPE" } : SimpleTokens;

{ "CEDAR" } : SimpleTokens;

{"MODULE" "BEGIN" "END" } : SimpleTokens;



MainGoal: NonTerminal Builds Junk;

	for MainGoal _ ModuleBody
		Build  Junk[];

ModuleBody: NonTerminal Builds ModuleBody; 
	
	for ModuleBody.nosemicolon _ id ":" "MODULE" "=" "BEGIN" declist "END" "."
		Build ModuleBody[id, declist];
	
	for ModuleBody.eithsemicolon _ id ":" "MODULE" "=" "BEGIN" declist ";" "END" "."
		Build ModuleBody[id, declist];

-- a fragment of the Cedar type syntax

          declist: NonTerminal Builds DecList;
               for declist.one _ declaration
               		Build DecList.one[declaration];
               for declist.more _ declist ";" declaration
               		Build DecList.more[declist, declaration];

                   declaration: NonTerminal Builds Declaration;
                     for declaration.type _ identlist "TYPE" "=" typeexp
                     	Build Declaration.type[identlist, DeclFrom.nominal[(identlist,typeexp)], typeexp];
                     for declaration.cedartype _ identlist "CEDAR" "TYPE" from "=" typeexp
                     	Build Declaration.type[identlist, from, typeexp];
                     	
                     
                     from: NonTerminal Builds DeclFrom;
                     	for from.no _
                     	  	Build DeclFrom.builtin[];
                     	for from.yes _ "FROM" id
                     	 	Build DeclFrom.fromcedardef[id];
                     	
            identlist: NonTerminal Builds IdListR;     	
               for identlist _ identlistP
               		Build identlistP;

                 identlistP: NonTerminal Builds IdListR;
                     for identlistP.id _ id ":"
                     	Build IdListR.one[id];
                     for identlistP.idmore_ id "," identlistP
                     	Build IdListR.more[id, identlistP];
            
            typeexp: NonTerminal Builds TypeExp;
               for typeexp.id _ id
               		Build TypeExp.typeid[TypeId.one[IdListL.one[id]]];
               for typeexp.typeid _ typeid
               		Build TypeExp.typeid[typeid];
               for typeexp.typecons _ typecons
               		Build typecons;
            
            typeid: NonTerminal Builds TypeId;
               for typeid.idid _ id.a id.b
               		Build TypeId.mod[id.a, TypeId.one[IdListL.one[id.b]]];
               for typeid.idtypeid _ id typeid
               		Build TypeId.mod[id, typeid];
               for typeid.typeidp _ typeidP
               		Build TypeId.one[typeidP];

                  typeidP: NonTerminal Builds IdListL;
                     for typeidP.two _ id.a "." id.b
                     	Build IdListL.more[IdListL.one[id.a], id.b];
                     for typeidP.more _ typeidP "." id
                     	Build IdListL.more[typeidP, id];
                     	
                     	
            typecons: NonTerminal Builds TypeExp;
               for typecons.elements _ "{" elementlist "}"
               		Build TypeExp.elements[elementlist];
               for typecons.record _ "RECORD" reclist
               		Build TypeExp.record[reclist];
               for typecons.ref _ "REF" typeexp
               		Build TypeExp.ref[typeexp];
               for typecons.refany _ "REF" "ANY"
               		Build TypeExp.refAny[];
               for typecons.list _ "LIST" "OF" typeexp
               		Build TypeExp.list[typeexp];
               		
               elementlist: NonTerminal Builds ElementList;
                     for elementlist.empty _
                     	Build ElementList.empty[];
                     for elementlist.nonempty _ elementlistP
                     	Build elementlistP;

                           
                         elementlistP: NonTerminal Builds ElementList;
                           for elementlistP.one _ element
                           		Build ElementList.more[ElementList.empty[[element, element)], element];
                           for elementlistP.more _ elementlistP "," element
                           		Build ElementList.more[elementlistP, element];

                               element: NonTerminal Builds Element;
                                 for element.id _ id
                                 	Build Element.id[id];
                                 	
                reclist: NonTerminal Builds FieldList;
                  for reclist.empty _ "[" "]"
                  		Build FieldList.empty[];
                  for reclist.null _ "NULL"
                  		Build FieldList.null[];
                  for reclist.pairs _ "[" pairlist "]"
                  		Build FieldList.pairs[pairlist];
                  for reclist.types _ "[" typelist "]"
                  		Build FieldList.types[typelist];
                  for reclist.vpairs _ "[" pairlist "," variantpair "]"
                  		Build FieldList.vpairs[pairlist, variantpair];
                  for reclist.vpart _ "[" variantpart "]"
                  		Build FieldList.vtypes[TypeList.empty[[variantpart, variantpart)], variantpart];
                  for reclist.vpair _ "[" variantpair "]"
                  		Build FieldList.vpairs[PairList.empty[[variantpair, variantpair)], variantpair];
                    
                    variantpair: NonTerminal Builds VPair;   		
                        for variantpair _ identlist variantpart
                        		Build VPair[identlist, variantpart];
                   
                   variantpart: NonTerminal Builds VPart;  
                     for variantpart.seq _ "SEQUENCE" vcasehead "OF" typeexp
                     		Build VPart.seq[vcasehead, typeexp];
                         
                         vcasehead: NonTerminal Builds VCaseHead;
                           for vcasehead.ident _ ident tagtype
                           		Build VCaseHead.ident[ident, tagtype];
                           
                              tagtype: NonTerminal Builds Tagtype;
                                 for tagtype.exp _ typeexp
                                 		Build Tagtype.exp[typeexp];
                         
                         ident: NonTerminal Builds Ident;
                         	for ident _ id ":"
                         		Build Ident[id];
                         	
                  		
                  		
             pairlist: NonTerminal Builds PairList;
               for pairlist.one _ pairitem
               		Build PairList.one[pairitem];
               for pairlist.more _ pairlist "," pairitem
               		Build PairList.more[pairlist, pairitem];

                   pairitem: NonTerminal Builds PairItem;
                     for pairitem _ identlist typeexp
                     	Build PairItem[identlist, typeexp];
                
             typelist: NonTerminal Builds TypeList;     	
               for typelist.typecons _ typecons
               		Build TypeList.one[typecons];
               for typelist.typeid _ typeid
               		Build TypeList.one[TypeExp.typeid[typeid]];
               for typelist.id _ id
               		Build TypeList.one[TypeExp.typeid[TypeId.one[IdListL.one[id]]]];
               for typelist.typeconsmore _ typecons "," typelist
               		Build TypeList.more[typecons, typelist];
               for typelist.typeidmore _ typeid "," typelist
               		Build TypeList.more[TypeExp.typeid[typeid], typelist];
               for typelist.idmore _ id "," typelist
               		Build TypeList.more[TypeExp.typeid[TypeId.one[IdListL.one[id]]], typelist]
                   

                                       
               
            	













End.