-- Kipper.ThreeC4: November 17, 1985 3:04:50 pm PST
-- Sturgis, May 20, 1986 1:35:40 pm PDT

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.