Initial population.

1 files changed, 703 insertions, 0 deletions

diff --git a/src/algebra/forttyp.spad.pamphlet b/src/algebra/forttyp.spad.pamphlet
new file mode 100644
index 00000000..334b236b
--- /dev/null
+++ b/src/algebra/forttyp.spad.pamphlet
@@ -0,0 +1,703 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/algebra forttyp.spad}
+\author{Mike Dewar}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{domain FST FortranScalarType}
+<<domain FST FortranScalarType>>=
+)abbrev domain FST FortranScalarType
+++ Author: Mike Dewar
+++ Date Created:  October 1992
+++ Date Last Updated: 
+++ Basic Operations:
+++ Related Domains:
+++ Also See:
+++ AMS Classifications:
+++ Keywords:
+++ Examples:
+++ References:
+++ Description: Creates and manipulates objects which correspond to the
+++ basic FORTRAN data types: REAL, INTEGER, COMPLEX, LOGICAL and CHARACTER
+FortranScalarType() : exports == implementation where
+
+  exports == CoercibleTo OutputForm with
+    coerce : String -> $     
+      ++ coerce(s) transforms the string s into an element of 
+      ++ FortranScalarType provided s is one of "real", "double precision",
+      ++ "complex", "logical", "integer", "character", "REAL",
+      ++ "COMPLEX", "LOGICAL", "INTEGER", "CHARACTER", 
+      ++ "DOUBLE PRECISION"
+    coerce : Symbol -> $ 
+      ++ coerce(s) transforms the symbol s into an element of 
+      ++ FortranScalarType provided s is one of real, complex,double precision,
+      ++ logical, integer, character, REAL, COMPLEX, LOGICAL,
+      ++ INTEGER, CHARACTER, DOUBLE PRECISION
+    coerce : $ -> Symbol
+      ++ coerce(x) returns the symbol associated with x
+    coerce : $ -> SExpression
+      ++ coerce(x) returns the s-expression associated with x
+    real?  : $ -> Boolean
+      ++ real?(t) tests whether t is equivalent to the FORTRAN type REAL.
+    double? : $ -> Boolean
+      ++ double?(t) tests whether t is equivalent to the FORTRAN type
+      ++ DOUBLE PRECISION
+    integer?  : $ -> Boolean
+      ++ integer?(t) tests whether t is equivalent to the FORTRAN type INTEGER.
+    complex?  : $ -> Boolean
+      ++ complex?(t) tests whether t is equivalent to the FORTRAN type COMPLEX.
+    doubleComplex?  : $ -> Boolean
+      ++ doubleComplex?(t) tests whether t is equivalent to the (non-standard)
+      ++ FORTRAN type DOUBLE COMPLEX.
+    character?  : $ -> Boolean
+      ++ character?(t) tests whether t is equivalent to the FORTRAN type 
+      ++ CHARACTER.
+    logical?  : $ -> Boolean
+      ++ logical?(t) tests whether t is equivalent to the FORTRAN type LOGICAL.
+    "=" : ($,$) -> Boolean
+      ++ x=y tests for equality
+
+  implementation == add
+
+    U == Union(RealThing:"real",
+               IntegerThing:"integer",
+               ComplexThing:"complex",
+               CharacterThing:"character",
+               LogicalThing:"logical",
+               DoublePrecisionThing:"double precision",
+               DoubleComplexThing:"double complex")
+    Rep := U
+
+    doubleSymbol : Symbol := "double precision"::Symbol
+    upperDoubleSymbol : Symbol := "DOUBLE PRECISION"::Symbol
+    doubleComplexSymbol : Symbol := "double complex"::Symbol
+    upperDoubleComplexSymbol : Symbol := "DOUBLE COMPLEX"::Symbol
+
+    u = v ==
+      u case RealThing and v case RealThing => true
+      u case IntegerThing and v case IntegerThing => true
+      u case ComplexThing and v case ComplexThing => true
+      u case LogicalThing and v case LogicalThing => true
+      u case CharacterThing and v case CharacterThing => true
+      u case DoublePrecisionThing and v case DoublePrecisionThing => true
+      u case DoubleComplexThing and v case DoubleComplexThing => true
+      false
+
+    coerce(t:$):OutputForm ==
+      t case RealThing => coerce(REAL)$Symbol
+      t case IntegerThing => coerce(INTEGER)$Symbol
+      t case ComplexThing => coerce(COMPLEX)$Symbol
+      t case CharacterThing => coerce(CHARACTER)$Symbol
+      t case DoublePrecisionThing => coerce(upperDoubleSymbol)$Symbol
+      t case DoubleComplexThing => coerce(upperDoubleComplexSymbol)$Symbol
+      coerce(LOGICAL)$Symbol
+
+    coerce(t:$):SExpression ==
+      t case RealThing => convert(real::Symbol)@SExpression
+      t case IntegerThing => convert(integer::Symbol)@SExpression
+      t case ComplexThing => convert(complex::Symbol)@SExpression
+      t case CharacterThing => convert(character::Symbol)@SExpression
+      t case DoublePrecisionThing => convert(doubleSymbol)@SExpression
+      t case DoubleComplexThing => convert(doubleComplexSymbol)@SExpression
+      convert(logical::Symbol)@SExpression
+
+    coerce(t:$):Symbol ==
+      t case RealThing => real::Symbol
+      t case IntegerThing => integer::Symbol
+      t case ComplexThing => complex::Symbol
+      t case CharacterThing => character::Symbol
+      t case DoublePrecisionThing => doubleSymbol
+      t case DoublePrecisionThing => doubleComplexSymbol
+      logical::Symbol
+
+    coerce(s:Symbol):$ ==
+      s = real => ["real"]$Rep
+      s = REAL => ["real"]$Rep
+      s = integer => ["integer"]$Rep
+      s = INTEGER => ["integer"]$Rep
+      s = complex => ["complex"]$Rep
+      s = COMPLEX => ["complex"]$Rep
+      s = character => ["character"]$Rep
+      s = CHARACTER => ["character"]$Rep
+      s = logical => ["logical"]$Rep
+      s = LOGICAL => ["logical"]$Rep
+      s = doubleSymbol => ["double precision"]$Rep
+      s = upperDoubleSymbol => ["double precision"]$Rep
+      s = doubleComplexSymbol => ["double complex"]$Rep
+      s = upperDoubleCOmplexSymbol => ["double complex"]$Rep
+
+    coerce(s:String):$ ==
+      s = "real" => ["real"]$Rep
+      s = "integer" => ["integer"]$Rep
+      s = "complex" => ["complex"]$Rep
+      s = "character" => ["character"]$Rep
+      s = "logical" => ["logical"]$Rep
+      s = "double precision" => ["double precision"]$Rep
+      s = "double complex" => ["double complex"]$Rep
+      s = "REAL" => ["real"]$Rep
+      s = "INTEGER" => ["integer"]$Rep
+      s = "COMPLEX" => ["complex"]$Rep
+      s = "CHARACTER" => ["character"]$Rep
+      s = "LOGICAL" => ["logical"]$Rep
+      s = "DOUBLE PRECISION" => ["double precision"]$Rep
+      s = "DOUBLE COMPLEX" => ["double complex"]$Rep
+      error concat([s," is invalid as a Fortran Type"])$String
+
+    real?(t:$):Boolean == t case RealThing
+
+    double?(t:$):Boolean == t case DoublePrecisionThing
+
+    logical?(t:$):Boolean == t case LogicalThing
+
+    integer?(t:$):Boolean == t case IntegerThing
+
+    character?(t:$):Boolean == t case CharacterThing
+
+    complex?(t:$):Boolean == t case ComplexThing
+
+    doubleComplex?(t:$):Boolean == t case DoubleComplexThing
+
+@
+\section{domain FT FortranType}
+<<domain FT FortranType>>=
+)abbrev domain FT FortranType 
+++ Author: Mike Dewar
+++ Date Created:  October 1992
+++ Date Last Updated: 
+++ Basic Operations:
+++ Related Domains:
+++ Also See:
+++ AMS Classifications:
+++ Keywords:
+++ Examples:
+++ References:
+++ Description: Creates and manipulates objects which correspond to FORTRAN
+++ data types, including array dimensions.
+FortranType() : exports == implementation where
+
+  FST    ==> FortranScalarType
+  FSTU   ==> Union(fst:FST,void:"void")
+
+  exports == SetCategory with
+    coerce : $ -> OutputForm
+      ++ coerce(x) provides a printable form for x
+    coerce : FST -> $
+      ++ coerce(t) creates an element from a scalar type
+    scalarTypeOf : $ -> FSTU
+      ++ scalarTypeOf(t) returns the FORTRAN data type of t
+    dimensionsOf : $ -> List Polynomial Integer
+      ++ dimensionsOf(t) returns the dimensions of t
+    external? : $ -> Boolean
+      ++ external?(u) returns true if u is declared to be EXTERNAL
+    construct : (FSTU,List Symbol,Boolean) -> $
+      ++ construct(type,dims) creates an element of FortranType
+    construct : (FSTU,List Polynomial Integer,Boolean) -> $
+      ++ construct(type,dims) creates an element of FortranType
+    fortranReal : () -> $
+      ++ fortranReal() returns REAL, an element of FortranType
+    fortranDouble : () -> $
+      ++ fortranDouble() returns DOUBLE PRECISION, an element of FortranType
+    fortranInteger : () -> $
+      ++ fortranInteger() returns INTEGER, an element of FortranType
+    fortranLogical : () -> $
+      ++ fortranLogical() returns LOGICAL, an element of FortranType
+    fortranComplex : () -> $
+      ++ fortranComplex() returns COMPLEX, an element of FortranType
+    fortranDoubleComplex: () -> $
+      ++ fortranDoubleComplex() returns DOUBLE COMPLEX, an element of 
+      ++ FortranType
+    fortranCharacter : () -> $
+      ++ fortranCharacter() returns CHARACTER, an element of FortranType
+
+  implementation == add
+
+    Dims == List Polynomial Integer
+    Rep := Record(type : FSTU, dimensions : Dims, external : Boolean)
+
+    coerce(a:$):OutputForm ==
+     t : OutputForm
+     if external?(a) then
+      if scalarTypeOf(a) case void then
+        t := "EXTERNAL"::OutputForm
+      else
+        t := blankSeparate(["EXTERNAL"::OutputForm,
+                           coerce(scalarTypeOf a)$FSTU])$OutputForm
+     else
+      t := coerce(scalarTypeOf a)$FSTU
+     empty? dimensionsOf(a) => t
+     sub(t,
+         paren([u::OutputForm for u in dimensionsOf(a)])$OutputForm)$OutputForm
+
+    scalarTypeOf(u:$):FSTU ==
+      u.type
+
+    dimensionsOf(u:$):Dims ==
+      u.dimensions
+
+    external?(u:$):Boolean ==
+      u.external
+
+    construct(t:FSTU, d:List Symbol, e:Boolean):$ ==
+      e and not empty? d => error "EXTERNAL objects cannot have dimensions"
+      not(e) and t case void => error "VOID objects must be EXTERNAL"
+      construct(t,[l::Polynomial(Integer) for l in d],e)$Rep
+
+    construct(t:FSTU, d:List Polynomial Integer, e:Boolean):$ ==
+      e and not empty? d => error "EXTERNAL objects cannot have dimensions"
+      not(e) and t case void => error "VOID objects must be EXTERNAL"
+      construct(t,d,e)$Rep
+
+    coerce(u:FST):$ ==
+      construct([u]$FSTU,[]@List Polynomial Integer,false)
+
+    fortranReal():$ == ("real"::FST)::$
+
+    fortranDouble():$ == ("double precision"::FST)::$
+
+    fortranInteger():$ == ("integer"::FST)::$
+
+    fortranComplex():$ == ("complex"::FST)::$
+
+    fortranDoubleComplex():$ == ("double complex"::FST)::$
+
+    fortranCharacter():$ == ("character"::FST)::$
+
+    fortranLogical():$ == ("logical"::FST)::$
+
+@
+\section{domain SYMTAB SymbolTable}
+<<domain SYMTAB SymbolTable>>=
+)abbrev domain SYMTAB SymbolTable
+++ Author: Mike Dewar
+++ Date Created:  October 1992
+++ Date Last Updated: 12 July 1994
+++ Basic Operations:
+++ Related Domains:
+++ Also See:
+++ AMS Classifications:
+++ Keywords:
+++ Examples:
+++ References:
+++ Description: Create and manipulate a symbol table for generated FORTRAN code
+SymbolTable() : exports == implementation where
+
+  T   ==> Union(S:Symbol,P:Polynomial Integer)
+  TL1 ==> List T
+  TU  ==> Union(name:Symbol,bounds:TL1)
+  TL  ==> List TU
+  SEX ==> SExpression
+  OFORM ==> OutputForm
+  L   ==> List
+  FSTU ==> Union(fst:FortranScalarType,void:"void")
+
+  exports ==> CoercibleTo OutputForm with
+    coerce : $ -> Table(Symbol,FortranType)
+      ++ coerce(x) returns a table view of x
+    empty  : () -> $
+      ++ empty() returns a new, empty symbol table
+    declare! : (L Symbol,FortranType,$) -> FortranType
+      ++ declare!(l,t,tab) creates new entrys in tab, declaring each of l 
+      ++ to be of type t
+    declare! : (Symbol,FortranType,$) -> FortranType
+      ++ declare!(u,t,tab) creates a new entry in tab, declaring u to be of
+      ++ type t
+    fortranTypeOf : (Symbol,$) -> FortranType
+      ++ fortranTypeOf(u,tab) returns the type of u in tab
+    parametersOf: $ -> L Symbol
+      ++ parametersOf(tab) returns a list of all the symbols declared in tab
+    typeList : (FortranScalarType,$) -> TL
+      ++ typeList(t,tab) returns a list of all the objects of type t in tab
+    externalList : $ -> L Symbol
+      ++ externalList(tab) returns a list of all the external symbols in tab
+    typeLists : $ -> L TL
+      ++ typeLists(tab) returns a list of lists of types of objects in tab
+    newTypeLists : $ -> SEX
+      ++ newTypeLists(x) \undocumented
+    printTypes: $ -> Void
+      ++ printTypes(tab) produces FORTRAN type declarations from tab, on the
+      ++ current FORTRAN output stream
+    symbolTable: L Record(key:Symbol,entry:FortranType) -> $
+      ++ symbolTable(l) creates a symbol table from the elements of l.
+
+  implementation ==> add
+
+    Rep := Table(Symbol,FortranType)
+
+    coerce(t:$):OFORM ==
+      coerce(t)$Rep
+
+    coerce(t:$):Table(Symbol,FortranType) ==
+      t pretend Table(Symbol,FortranType)
+
+    symbolTable(l:L Record(key:Symbol,entry:FortranType)):$ ==
+      table(l)$Rep
+
+    empty():$ ==
+      empty()$Rep
+
+    parametersOf(tab:$):L(Symbol) ==
+      keys(tab)
+
+    declare!(name:Symbol,type:FortranType,tab:$):FortranType ==
+      setelt(tab,name,type)$Rep
+      type
+
+    declare!(names:L Symbol,type:FortranType,tab:$):FortranType ==
+      for name in names repeat setelt(tab,name,type)$Rep
+      type
+
+    fortranTypeOf(u:Symbol,tab:$):FortranType ==
+      elt(tab,u)$Rep
+
+    externalList(tab:$):L(Symbol) ==
+     [u for u in keys(tab) | external? fortranTypeOf(u,tab)]
+
+    typeList(type:FortranScalarType,tab:$):TL ==
+      scalarList := []@TL
+      arrayList  := []@TL
+      for u in keys(tab)$Rep repeat
+        uType : FortranType := fortranTypeOf(u,tab)
+        sType : FSTU := scalarTypeOf(uType)
+        if (sType case fst and (sType.fst)=type) then
+          uDim : TL1 := [[v]$T for v in dimensionsOf(uType)]
+          if empty? uDim then 
+            scalarList := cons([u]$TU,scalarList) 
+          else 
+            arrayList := cons([cons([u],uDim)$TL1]$TU,arrayList)
+      -- Scalars come first in case they are integers which are later
+      -- used as an array dimension.
+      append(scalarList,arrayList)
+
+    typeList2(type:FortranScalarType,tab:$):TL ==
+      tl := []@TL
+      symbolType : Symbol := coerce(type)$FortranScalarType
+      for u in keys(tab)$Rep repeat
+        uType : FortranType := fortranTypeOf(u,tab)
+        sType : FSTU := scalarTypeOf(uType)
+        if (sType case fst and (sType.fst)=type) then
+          uDim : TL1 := [[v]$T for v in dimensionsOf(uType)]
+          tl := if empty? uDim then cons([u]$TU,tl)
+                else cons([cons([u],uDim)$TL1]$TU,tl)
+      empty? tl => tl
+      cons([symbolType]$TU,tl)
+
+    updateList(sType:SEX,name:SEX,lDims:SEX,tl:SEX):SEX ==
+      l : SEX := ASSOC(sType,tl)$Lisp
+      entry : SEX := if null?(lDims) then name else CONS(name,lDims)$Lisp
+      null?(l) => CONS([sType,entry]$Lisp,tl)$Lisp
+      RPLACD(l,CONS(entry,cdr l)$Lisp)$Lisp
+      tl
+
+    newTypeLists(tab:$):SEX ==
+      tl := []$Lisp
+      for u in keys(tab)$Rep repeat
+        uType : FortranType := fortranTypeOf(u,tab)
+        sType : FSTU := scalarTypeOf(uType)
+        dims  : L Polynomial Integer := dimensionsOf uType
+        lDims : L SEX := [convert(convert(v)@InputForm)@SEX for v in dims]
+        lType : SEX := if sType case void 
+          then convert(void::Symbol)@SEX 
+          else coerce(sType.fst)$FortranScalarType
+        tl := updateList(lType,convert(u)@SEX,convert(lDims)@SEX,tl)
+      tl
+
+    typeLists(tab:$):L(TL) ==
+      fortranTypes := ["real"::FortranScalarType, _
+             "double precision"::FortranScalarType, _
+             "integer"::FortranScalarType, _
+             "complex"::FortranScalarType, _
+             "logical"::FortranScalarType, _
+             "character"::FortranScalarType]@L(FortranScalarType)
+      tl := []@L TL
+      for u in fortranTypes repeat
+        types : TL := typeList2(u,tab)
+        if (not null types) then 
+          tl := cons(types,tl)$(L TL)
+      tl
+
+    oForm2(w:T):OFORM ==
+      w case S => w.S::OFORM
+      w case P => w.P::OFORM
+
+    oForm(v:TU):OFORM ==
+      v case name => v.name::OFORM
+      v case bounds =>
+        ll : L OFORM := [oForm2(uu) for uu in v.bounds]
+        ll :: OFORM
+
+    outForm(t:TL):L OFORM ==
+     [oForm(u) for u in t]
+
+    printTypes(tab:$):Void ==
+      -- It is important that INTEGER is the first element of this
+      -- list since INTEGER symbols used in type declarations must
+      -- be declared in advance.
+      ft := ["integer"::FortranScalarType, _
+             "real"::FortranScalarType, _
+             "double precision"::FortranScalarType, _
+             "complex"::FortranScalarType, _
+             "logical"::FortranScalarType, _
+             "character"::FortranScalarType]@L(FortranScalarType)
+      for ty in ft repeat
+        tl : TL := typeList(ty,tab)
+        otl : L OFORM := outForm(tl)
+        fortFormatTypes(ty::OFORM,otl)$Lisp
+      el : L OFORM := [u::OFORM for u in externalList(tab)]
+      fortFormatTypes("EXTERNAL"::OFORM,el)$Lisp
+      void()$Void
+
+@
+\section{domain SYMS TheSymbolTable}
+<<domain SYMS TheSymbolTable>>=
+)abbrev domain SYMS TheSymbolTable
+++ Author: Mike Dewar
+++ Date Created:  October 1992
+++ Date Last Updated: 
+++ Basic Operations:
+++ Related Domains:
+++ Also See:
+++ AMS Classifications:
+++ Keywords:
+++ Examples:
+++ References:
+++ Description: Creates and manipulates one global symbol table for FORTRAN
+++ code generation, containing details of types, dimensions, and argument 
+++ lists.
+TheSymbolTable() : Exports == Implementation where
+
+  S    ==> Symbol
+  FST  ==> FortranScalarType
+  FSTU ==> Union(fst:FST,void:"void")
+
+  Exports == CoercibleTo OutputForm with
+    showTheSymbolTable : () -> $
+      ++ showTheSymbolTable() returns the current symbol table.
+    clearTheSymbolTable : () -> Void
+      ++ clearTheSymbolTable() clears the current symbol table.
+    clearTheSymbolTable : Symbol -> Void
+      ++ clearTheSymbolTable(x) removes the symbol x from the table
+    declare! : (Symbol,FortranType,Symbol,$) -> FortranType
+      ++ declare!(u,t,asp,tab) declares the parameter u of subprogram asp
+      ++ to have type t in symbol table tab.
+    declare! : (List Symbol,FortranType,Symbol,$) -> FortranType
+      ++ declare!(u,t,asp,tab) declares the parameters u of subprogram asp
+      ++ to have type t in symbol table tab.
+    declare! : (Symbol,FortranType) -> FortranType
+      ++ declare!(u,t) declares the parameter u to have type t in the 
+      ++ current level of the symbol table.
+    declare! : (Symbol,FortranType,Symbol) -> FortranType
+      ++ declare!(u,t,asp) declares the parameter u to have type t in asp.
+    newSubProgram : Symbol -> Void
+      ++ newSubProgram(f) asserts that from now on type declarations are part
+      ++ of subprogram f.
+    currentSubProgram : () -> Symbol
+      ++ currentSubProgram() returns the name of the current subprogram being 
+      ++ processed
+    endSubProgram : () -> Symbol
+      ++ endSubProgram() asserts that we are no longer processing the current
+      ++ subprogram.
+    argumentList! : (Symbol,List Symbol,$) -> Void
+      ++ argumentList!(f,l,tab) declares that the argument list for subprogram f
+      ++ in symbol table tab is l.
+    argumentList! : (Symbol,List Symbol) -> Void
+      ++ argumentList!(f,l) declares that the argument list for subprogram f in
+      ++ the global symbol table is l.
+    argumentList! : List Symbol -> Void
+      ++ argumentList!(l) declares that the argument list for the current 
+      ++ subprogram in the global symbol table is l.
+    returnType! : (Symbol,FSTU,$) -> Void
+      ++ returnType!(f,t,tab) declares that the return type of subprogram f in
+      ++ symbol table tab is t.
+    returnType! : (Symbol,FSTU) -> Void
+      ++ returnType!(f,t) declares that the return type of subprogram f in
+      ++ the global symbol table is t.
+    returnType! : FSTU -> Void
+      ++ returnType!(t) declares that the return type of he current subprogram
+      ++ in the global symbol table is t.
+    printHeader : (Symbol,$) -> Void
+      ++ printHeader(f,tab) produces the FORTRAN header for subprogram f in
+      ++ symbol table tab on the current FORTRAN output stream.
+    printHeader : Symbol -> Void
+      ++ printHeader(f) produces the FORTRAN header for subprogram f in
+      ++ the global symbol table on the current FORTRAN output stream.
+    printHeader : () -> Void
+      ++ printHeader() produces the FORTRAN header for the current subprogram in
+      ++ the global symbol table on the current FORTRAN output stream.
+    printTypes:  Symbol -> Void
+      ++ printTypes(tab) produces FORTRAN type declarations from tab, on the
+      ++ current FORTRAN output stream
+    empty : () -> $
+      ++ empty() creates a new, empty symbol table.
+    returnTypeOf : (Symbol,$) -> FSTU
+      ++ returnTypeOf(f,tab) returns the type of the object returned by f
+    argumentListOf : (Symbol,$) -> List(Symbol) 
+      ++ argumentListOf(f,tab) returns the argument list of f
+    symbolTableOf : (Symbol,$) -> SymbolTable
+      ++ symbolTableOf(f,tab) returns the symbol table of f
+
+  Implementation == add
+
+    Entry : Domain  := Record(symtab:SymbolTable, _
+                              returnType:FSTU, _
+                              argList:List Symbol)
+
+    Rep := Table(Symbol,Entry)
+
+    -- These are the global variables we want to update:
+    theSymbolTable : $ := empty()$Rep
+    currentSubProgramName : Symbol := MAIN
+
+    newEntry():Entry ==
+      construct(empty()$SymbolTable,["void"]$FSTU,[]::List(Symbol))$Entry
+
+    checkIfEntryExists(name:Symbol,tab:$) : Void ==
+      key?(name,tab) => void()$Void
+      setelt(tab,name,newEntry())$Rep
+      void()$Void
+
+    returnTypeOf(name:Symbol,tab:$):FSTU ==
+      elt(elt(tab,name)$Rep,returnType)$Entry
+
+    argumentListOf(name:Symbol,tab:$):List(Symbol) ==
+      elt(elt(tab,name)$Rep,argList)$Entry
+
+    symbolTableOf(name:Symbol,tab:$):SymbolTable ==
+      elt(elt(tab,name)$Rep,symtab)$Entry
+
+    coerce(u:$):OutputForm ==
+      coerce(u)$Rep
+
+    showTheSymbolTable():$ ==
+      theSymbolTable
+
+    clearTheSymbolTable():Void ==
+      theSymbolTable := empty()$Rep
+      void()$Void
+
+    clearTheSymbolTable(u:Symbol):Void ==
+      remove!(u,theSymbolTable)$Rep
+      void()$Void
+
+    empty():$ ==
+      empty()$Rep
+
+    currentSubProgram():Symbol ==
+      currentSubProgramName
+
+    endSubProgram():Symbol ==
+    -- If we want to support more complex languages then we should keep
+    -- a list of subprograms / blocks - but for the moment lets stick with
+    -- Fortran.
+      currentSubProgramName := MAIN
+
+    newSubProgram(u:Symbol):Void ==
+      setelt(theSymbolTable,u,newEntry())$Rep
+      currentSubProgramName := u
+      void()$Void
+
+    argumentList!(u:Symbol,args:List Symbol,symbols:$):Void ==
+      checkIfEntryExists(u,symbols)
+      setelt(elt(symbols,u)$Rep,argList,args)$Entry
+
+    argumentList!(u:Symbol,args:List Symbol):Void ==
+      argumentList!(u,args,theSymbolTable)
+
+    argumentList!(args:List Symbol):Void ==
+      checkIfEntryExists(currentSubProgramName,theSymbolTable)
+      setelt(elt(theSymbolTable,currentSubProgramName)$Rep, _
+             argList,args)$Entry
+
+    returnType!(u:Symbol,type:FSTU,symbols:$):Void ==
+      checkIfEntryExists(u,symbols)
+      setelt(elt(symbols,u)$Rep,returnType,type)$Entry
+
+    returnType!(u:Symbol,type:FSTU):Void ==
+      returnType!(u,type,theSymbolTable)
+
+    returnType!(type:FSTU ):Void ==
+      checkIfEntryExists(currentSubProgramName,theSymbolTable)
+      setelt(elt(theSymbolTable,currentSubProgramName)$Rep, _
+             returnType,type)$Entry
+
+    declare!(u:Symbol,type:FortranType):FortranType ==
+      declare!(u,type,currentSubProgramName,theSymbolTable)
+
+    declare!(u:Symbol,type:FortranType,asp:Symbol,symbols:$):FortranType ==
+      checkIfEntryExists(asp,symbols)
+      declare!(u,type, elt(elt(symbols,asp)$Rep,symtab)$Entry)$SymbolTable
+
+    declare!(u:List Symbol,type:FortranType,asp:Symbol,syms:$):FortranType ==
+      checkIfEntryExists(asp,syms)
+      declare!(u,type, elt(elt(syms,asp)$Rep,symtab)$Entry)$SymbolTable
+
+    declare!(u:Symbol,type:FortranType,asp:Symbol):FortranType ==
+      checkIfEntryExists(asp,theSymbolTable)
+      declare!(u,type,elt(elt(theSymbolTable,asp)$Rep,symtab)$Entry)$SymbolTable
+
+    printHeader(u:Symbol,symbols:$):Void ==
+      entry := elt(symbols,u)$Rep
+      fortFormatHead(elt(entry,returnType)$Entry::OutputForm,u::OutputForm, _
+                     elt(entry,argList)$Entry::OutputForm)$Lisp
+      printTypes(elt(entry,symtab)$Entry)$SymbolTable
+
+    printHeader(u:Symbol):Void ==
+      printHeader(u,theSymbolTable)
+
+    printHeader():Void ==
+      printHeader(currentSubProgramName,theSymbolTable)
+
+    printTypes(u:Symbol):Void ==
+      printTypes(elt(elt(theSymbolTable,u)$Rep,symtab)$Entry)$SymbolTable
+
+@
+\section{License}
+<<license>>=
+--Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+--All rights reserved.
+--
+--Redistribution and use in source and binary forms, with or without
+--modification, are permitted provided that the following conditions are
+--met:
+--
+--    - Redistributions of source code must retain the above copyright
+--      notice, this list of conditions and the following disclaimer.
+--
+--    - Redistributions in binary form must reproduce the above copyright
+--      notice, this list of conditions and the following disclaimer in
+--      the documentation and/or other materials provided with the
+--      distribution.
+--
+--    - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--      names of its contributors may be used to endorse or promote products
+--      derived from this software without specific prior written permission.
+--
+--THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+--IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+--TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+--PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+--OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+--EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+--PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+--PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+--LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+--NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+--SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+@
+<<*>>=
+<<license>>
+
+<<domain FST FortranScalarType>>
+<<domain FT FortranType>>
+<<domain SYMTAB SymbolTable>>
+<<domain SYMS TheSymbolTable>>
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}