1 * interp/Makefile.in (OBJS): Remove foam_l.$(FASLEXT), $(ASCOMP).

(ASCOMP, ASAUTO): Remove. * interp/axext_l.lisp: Remove. * interp/foam_l.lisp: Likewise. * interp/ax.boot: Likewise. * interp/as.boot: Likewise. * interp/daase.lisp: Adjust. * interp/i-syscmd.boot: Likewise.
author: dos-reis <gdr@axiomatics.org> 2011-06-21 18:51:36 +0000
committer: dos-reis <gdr@axiomatics.org> 2011-06-21 18:51:36 +0000
commit: 8b45d02f8f861fe0eab071ccbfcf5ef8bd6593d6 (patch)
tree: 8d3c3bb0bdc0ce060e3a622704b6f04709dfcd1c /src
parent: 4e5497862c2e37f86114b21f03e443072ec6abf0 (diff)
download: open-axiom-8b45d02f8f861fe0eab071ccbfcf5ef8bd6593d6.tar.gz
10 files changed, 28 insertions, 3316 deletions
diff --git a/src/ChangeLog b/src/ChangeLog
index 0aad1b5a..c0e20a55 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,5 +1,16 @@
 2011-06-21  Gabriel Dos Reis  <gdr@cs.tamu.edu>
 
+	* interp/Makefile.in (OBJS): Remove foam_l.$(FASLEXT), $(ASCOMP).
+	(ASCOMP, ASAUTO): Remove.
+	* interp/axext_l.lisp: Remove.
+	* interp/foam_l.lisp: Likewise.
+	* interp/ax.boot: Likewise.
+	* interp/as.boot: Likewise.
+	* interp/daase.lisp: Adjust.
+	* interp/i-syscmd.boot: Likewise.
+
+2011-06-21  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
 	* interp/buildom.boot (MappingCategory): Take argument by value.
 
 2011-06-21  Gabriel Dos Reis  <gdr@cs.tamu.edu>
diff --git a/src/interp/Makefile.in b/src/interp/Makefile.in
index aca72a48..ec291d40 100644
--- a/src/interp/Makefile.in
+++ b/src/interp/Makefile.in
@@ -75,7 +75,7 @@ OBJS=   boot-pkg.$(FASLEXT)	types.$(FASLEXT)	 \
 	cattable.$(FASLEXT)	posit.$(FASLEXT)	\
 	cformat.$(FASLEXT)	clam.$(FASLEXT)		\
 	clammed.$(FASLEXT)	nlib.$(FASLEXT)	        \
-	comp.$(FASLEXT)	        foam_l.$(FASLEXT) 	\
+	comp.$(FASLEXT)	                          	\
 	pathname.$(FASLEXT)	compat.$(FASLEXT)      	\
 	serror.$(FASLEXT)	ptrees.$(FASLEXT)	\
 	cparse.$(FASLEXT)	cstream.$(FASLEXT)	\
@@ -110,7 +110,7 @@ OBJS=   boot-pkg.$(FASLEXT)	types.$(FASLEXT)	 \
 	                       	termrw.$(FASLEXT)	\
 	trace.$(FASLEXT)	daase.$(FASLEXT)  	\
 	fortcall.$(FASLEXT) 	i-parser.$(FASLEXT) 	\
-	$(OCOBJS) $(BROBJS) $(ASCOMP) $(INOBJS)
+	$(OCOBJS) $(BROBJS) $(INOBJS)
 
 # Last minite patches.
 # FIXMEL: should be folded into the main object list.
@@ -141,11 +141,6 @@ BROBJS=	bc-matrix.$(FASLEXT)				\
 
 autoload_objects += $(BFOBJS)
 
-ASCOMP= as.$(FASLEXT) axext_l.$(FASLEXT)
-
-ASAUTO= ${AUTO}/ax.$(FASLEXT)
-
-autoload_objects += $(ASAUTO)
 TIMESTAMP=$(axiom_targetdir)/timestamp
 YEARWEEK=(progn (defconstant timestamp "${TIMESTAMP}") \
                 (setq *build-version* "$(PACKAGE_STRING)") \
@@ -209,15 +204,15 @@ makeint.lisp: Makefile
 	@ echo '(in-package "BOOT")' >> makeint.lisp
 	@ touch ${TIMESTAMP}
 	@ echo '${YEARWEEK}' >> makeint.lisp
-	@ echo '(unless (or |$$StandardLinking| (|%basicSystemIsComplete|)) (build-interpsys (quote ($(patsubst %, "%", ${ASAUTO}))))(|clearClams|))' >> makeint.lisp
-	@ echo '#+:akcl (setq compiler::*suppress-compiler-notes* t)' >> makeint.lisp
-	@ echo '#+:akcl (si::gbc-time 0)' >> makeint.lisp
+	@ echo '(unless (or |$$StandardLinking| (|%basicSystemIsComplete|)) (build-interpsys)(|clearClams|))' >> makeint.lisp
+	@ echo '#+:gcl (setq compiler::*suppress-compiler-notes* t)' >> makeint.lisp
+	@ echo '#+:gcl (si::gbc-time 0)' >> makeint.lisp
 	@ echo '#+:GCL (si::gbc t)' >> makeint.lisp
 
 ${SAVESYS}: database.date \
 		$(axiom_targetdir)/algebra/exposed.$(FASLEXT) \
 		$(axiom_target_datadir)/msgs/s2-us.msgs \
-		$(ASAUTO) $(OBJS) makeint.$(LNKEXT)
+		$(OBJS) makeint.$(LNKEXT)
 	$(DRIVER) --execpath=$(BOOTSYS) \
 		--syslib=$(axiom_target_libdir) \
 		--system="$(AXIOM)/" --system-algebra \
@@ -234,7 +229,7 @@ all-axiomsys: ${AXIOMSYS}
 ${AXIOMSYS}: database.date \
 		$(axiom_targetdir)/algebra/exposed.$(FASLEXT) \
 		$(axiom_target_datadir)/msgs/s2-us.msgs \
-		$(ASAUTO) $(OBJS) makeint.$(LNKEXT)
+		$(OBJS) makeint.$(LNKEXT)
 	$(DRIVER) --execpath=$(BOOTSYS) \
 		--syslib=$(axiom_target_libdir) \
 		--system="$(AXIOM)/" \
@@ -340,10 +335,6 @@ newfort.$(FASLEXT): macros.$(FASLEXT)
 lisplib.$(FASLEXT): nlib.$(FASLEXT) c-util.$(FASLEXT) debug.$(FASLEXT)
 interop.$(FASLEXT): interop.boot c-util.$(FASLEXT) hashcode.$(FASLEXT)
 c-doc.$(FASLEXT): c-util.$(FASLEXT)
-
-## Interface with the Aldor compiler.
-ax.$(FASLEXT): as.$(FASLEXT)
-as.$(FASLEXT): macros.$(FASLEXT)
 server.$(FASLEXT): macros.$(FASLEXT)
 
 ##
@@ -400,7 +391,7 @@ bits.$(FASLEXT): boot-pkg.$(FASLEXT)
 dq.$(FASLEXT): types.$(FASLEXT)
 
 ## General support and utilities.
-daase.$(FASLEXT): macros.$(FASLEXT) foam_l.$(FASLEXT)
+daase.$(FASLEXT): macros.$(FASLEXT)
 spaderror.$(FASLEXT): macros.$(FASLEXT)
 debug.$(FASLEXT): macros.$(FASLEXT) parsing.$(FASLEXT)
 spad.$(FASLEXT): bootlex.$(FASLEXT) postpar.$(FASLEXT) debug.$(FASLEXT)
@@ -437,8 +428,6 @@ sys-constants.$(FASLEXT): types.$(FASLEXT)
 hash.$(FASLEXT): types.$(FASLEXT)
 union.$(FASLEXT): vmlisp.$(FASLEXT)
 ggreater.$(FASLEXT): vmlisp.$(FASLEXT)
-axext_l.$(FASLEXT): foam_l.$(FASLEXT)
-foam_l.$(FASLEXT): vmlisp.$(FASLEXT) sys-constants.$(FASLEXT)
 lisp-backend.$(FASLEXT): sys-macros.$(FASLEXT)
 sys-utility.$(FASLEXT): vmlisp.$(FASLEXT) sys-os.$(FASLEXT) hash.$(FASLEXT)
 vmlisp.$(FASLEXT): types.$(FASLEXT) sys-globals.$(FASLEXT)
diff --git a/src/interp/as.boot b/src/interp/as.boot
deleted file mode 100644
index c7533f8b..00000000
--- a/src/interp/as.boot
+++ /dev/null
@@ -1,1190 +0,0 @@
--- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
--- All rights reserved.
--- Copyright (C) 2007-2011, Gabriel Dos Reis.
--- 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.
-
-
-import macros
-namespace BOOT
-
---global hash tables for new compiler
-$docHash  := MAKE_-HASH_-TABLE()
-$conHash  := MAKE_-HASH_-TABLE()
-$opHash   := MAKE_-HASH_-TABLE()
-$asyPrint := false
-
-asList() ==
-  removeFile '"temp.text"
-  OBEY '"ls as/*.asy > temp.text"
-  instream := inputTextFile '"temp.text"
-  lines := [line := readLine instream while line ~= %nothing]
-  closeStream instream
-  lines
-
-asAll lines ==
-  for x in lines repeat
-    sayBrightly ['"-----> ",x]
-    asTran x
-  'done
-
-as name ==
-  astran strconc(STRINGIMAGE name,'".asy")
-  'done
-
-astran asyFile ==
---global hash tables for new compiler
-  $docHash  := MAKE_-HASH_-TABLE()
-  $conHash := MAKE_-HASH_-TABLE()
-  $constantHash := MAKE_-HASH_-TABLE()
-  $niladics : local := nil
-  $asyFile: local := asyFile
-  $asFilename: local := strconc(PATHNAME_-NAME asyFile,'".as")
-  asytran asyFile
-  conlist := [x for x in HKEYS $conHash | tableValue($conHash,x) isnt [.,.,"function",:.]]
-  $mmAlist : local :=
-    [[con,:asyConstructorModemap con] for con in conlist]
-  $docAlist : local :=
-    [[con,:removeDuplicates asyDocumentation con] for con in conlist]
-  $parentsHash : local := MAKE_-HASH_-TABLE()
---$childrenHash: local := MAKE_-HASH_-TABLE()
-  for con in conlist repeat
-    parents := asyParents con
-    tableValue($parentsHash,con) := asyParents con
---  for [parent,:pred] in parents repeat
---    parentOp := opOf parent
---    tableValue($childrenHash,parentOp) := insert([con,:pred],tableValue($childrenHash,parentOp))
-  $newConlist := union(conlist, $newConlist)
-  [[x,:asMakeAlist x] for x in HKEYS $conHash]
-
-asyParents(conform) ==
-  acc := nil
-  con:= opOf conform
---formals := TAKE(#formalParams,$TriangleVariableList)
-  modemap := LASSOC(con,$mmAlist)
-  $constructorCategory :local := asySubstMapping modemap.mmTarget
-  for x in folks $constructorCategory repeat
---  x := applySubst(pairList(formals,formalParams),x)
---  x := applySubst(pairList(formalParams,IFCDR conform),x)
---  x := substitute('Type,'Object,x)
-    acc := [:explodeIfs x,:acc]
-  reverse! acc
-
-asySubstMapping u ==
-  u is [op,:r] =>
-    op = "->" =>
-       [s, t] := r
-       args :=
-          s is [op,:u] and asyComma? op => [asySubstMapping y for y in u]
-          [asySubstMapping s]
-       ['Mapping, asySubstMapping t, :args]
-    [asySubstMapping x for x in u]
-  u
-
---asyFilePackage asyFile ==
---  name := makeSymbol PATHNAME_-NAME asyFile
---  modemap :=
---    [[[name],['CATEGORY,'domain,
---      :[asyMkSignature(con,mm.mmSignature) for [con,:mm] in $mmAlist]]],['T,name]]
---  opAlist := [[con,[mm.mmSignature]] for [con,:mm] in $mmAlist]
---  documentation :=
---    [[con,[mm.mmSignature,fn LASSOC(con,$docAlist)]] for [con,:mm] in $mmAlist]
---      where fn u ==
---            LASSOC('constructor,u) is [[=nil,doc]] => doc
---            '""
---  res := [['constructorForm,name],['constant,:'true],
---           ['constructorKind,:'file],
---             ['constructorModemap,:modemap],
---               ['sourceFile,:PNAME name],
---                 ['operationAlist,:zeroOneConversion opAlist],
---                     ['documentation,:documentation]]
---asyDisplay(name,res)
---  [name,:res]
-
-asyMkSignature(con,sig) ==
---  atom sig => ['TYPE,con,sig]
--- following line converts constants into nullary functions
-  atom sig => ['SIGNATURE,con,[sig]]
-  ['SIGNATURE,con,sig]
-
-asMakeAlist con ==
-  record := tableValue($conHash,con)
-  [form,sig,predlist,kind,exposure,comments,typeCode,:filename] := first record
---TTT in case we put the wrong thing in for niladic catgrs
---if atom(form) and kind='category then form:=[form]
-  if atom(form) then form:=[form]
-  kind is 'function => asMakeAlistForFunction con
-  abb := asyAbbreviation(con,#(KDR sig))
-  if null KDR form then
-    property(opOf form,'NILADIC) := 'T
-  modemap := asySubstMapping LASSOC(con,$mmAlist)
-  $constructorCategory :local := modemap.mmTarget
-  parents := mySort tableValue($parentsHash,con)
---children:= mySort tableValue($childrenHash,con)
-  alists  := tableValue($opHash,con)
-  opAlist := applySubst(pairList(KDR form,$FormalMapVariableList),CDDR alists)
-  ancestorAlist :=
-    applySubst(pairList(KDR form,$FormalMapVariableList),first alists)
-  catAttrs := [[x,:true] for x in getAttributesFromCATEGORY $constructorCategory]
-  attributeAlist := removeDuplicates [:second alists,:catAttrs]
-  documentation :=
-    applySubst(pairList(KDR form,$FormalMapVariableList),LASSOC(con,$docAlist))
-  filestring := strconc(PATHNAME_-NAME STRINGIMAGE filename,'".as")
-  constantPart := tableValue($constantHash,con) and [['constant,:true]]
-  niladicPart := symbolMember?(con,$niladics) and [['NILADIC,:true]]
-  falist :=  TAKE(#KDR form,$FormalMapVariableList)
-  constructorCategory :=
-    kind is 'category =>
-      talist := TAKE(#KDR form, $TriangleVariableList)
-      applySubst(pairList(falist,talist),$constructorCategory)
-    applySubst(pairList(KDR form,falist),$constructorCategory)
-  if constructorCategory='Category then kind := 'category
-  exportAlist := asGetExports(kind, form, constructorCategory)
-  constructorModemap := applySubst(pairList(KDR form,falist),modemap)
---TTT fix a niladic category constructormodemap (remove the joins)
-  if kind is 'category then
-     constructorModemap.mmTarget := $Category
-  res := [['constructorForm,:form],:constantPart,:niladicPart,
-           ['constructorKind,:kind],
-             ['constructorModemap,:constructorModemap],
-              ['abbreviation,:abb],
-               ['constructorCategory,:constructorCategory],
-                ['parents,:parents],
-                 ['attributes,:attributeAlist],
-                  ['ancestors,:ancestorAlist],
-                   --                ['children,:children],
-                   ['sourceFile,:filestring],
-                    ['operationAlist,:zeroOneConversion opAlist],
-                     ['modemaps,:asGetModemaps(exportAlist,form,kind,modemap)],
-                       ['sourcefile,:$asFilename],
-                         ['typeCode,:typeCode],
-                          ['documentation,:documentation]]
-  if $asyPrint then asyDisplay(con,res)
-  res
-
-asGetExports(kind, conform, catform) ==
-  u := asCategoryParts(kind, conform, catform, true) or return nil
-  -- ensure that signatures are lists
-  [[op, sigpred] for [op,sig,:pred] in CDDR u] where
-    sigpred() ==
-      pred :=
-        pred = "T" => nil
-        pred
-      [sig, nil, :pred]
-
-asMakeAlistForFunction fn ==
-  record := tableValue($conHash,fn)
-  [form,sig,predlist,kind,exposure,comments,typeCode,:filename] := first record
-  modemap := LASSOC(fn,$mmAlist)
-  newsig := asySignature(sig,nil)
-  opAlist := [[fn,[newsig,nil,:predlist]]]
-  res := [['modemaps,:asGetModemaps(opAlist,fn,'function,modemap)],
-            ['typeCode,:typeCode]]
-  if $asyPrint then asyDisplay(fn,res)
-  res
-
-getAttributesFromCATEGORY catform ==
-  catform is ['CATEGORY,.,:r] => [y for x in r | x is ['ATTRIBUTE,y]]
-  catform is ['Join,:m,x]     => getAttributesFromCATEGORY x
-  nil
-
-displayDatabase x == main where
-  main() ==
-    for y in
-     '(("form" . getConstructorFormFromDB) _
-       ("kind" . getConstructorKindFromDB) _
-       ("modemap" . getConstructorModemapFromDB) _
-       ("abbreviation" . getConstructorAbbreviationFromDB) _
-       ("category" . getConstructorCategoryFromDB) _
-       ("parents" . getConstructorParentsFromDB) _
-       ("attributes" . getConstructorAttributesFromDB)  _
-       ("ancestors" . getConstructorAncestorsFromDB) _
-       ("source file" . getConstructorSourceFileFromDB) _
-       ("all operations" . getConstructorOperationsFromDB) _
-       ("operation modemap" . getOperationModemapsFromDB)  _
-       ("documentation" . getConstructorDocumentationFromDB)) repeat fn(x,y)
-   where
-    fn(x,y) ==
-      sayBrightly ['"----------------- ",first y,'" --------------------"]
-      pp FUNCALL(rest y, x)
-
--- For some reason Dick has modified as.boot to convert the
--- identifier |0| or |1| to an integer in the list of operations.
--- This is WRONG, all existing code assumes that operation names
--- are always identifiers not numbers.
--- This function breaks the ability of the interpreter to find
--- |0| or |1| as exports of new compiler domains.
--- Unless someone has a strong reason for keeping the change,
--- this function should be no-opped, i.e.
--- zeroOneConversion opAlist == opAlist
--- If this change is made, then we are able to find asharp constants again.
---   bmt Mar 26, 1994  and executed by rss
-
-zeroOneConversion opAlist == opAlist
---   for u in opAlist repeat
---     [op,:.] := u
---     digit? stringChar(PNAME op,0) => u.first := string2Integer PNAME op
---   opAlist
-
-asyDisplay(con,alist) ==
-  banner := '"=============================="
-  sayBrightly [banner,'" ",con,'" ",banner]
-  for [prop,:value] in alist repeat
-    sayBrightlyNT [prop,'": "]
-    pp value
-
-asGetModemaps(opAlist,oform,kind,modemap) ==
-  acc:= nil
-  rpvl:=
-    kind in '(category function) => rest $PatternVariableList -- *1 is special for $
-    $PatternVariableList
-  form := [opOf oform,:[y for x in KDR oform for y in rpvl]]
-  dc :=
-    kind in '(category function) => "*1"
-    form
-  pred1 :=
-    kind is 'category => [["*1",form]]
-    nil
-  signature  := modemap.mmSignature
-  domainList :=
-    [[a,m] for a in rest form for m in rest signature |
-       asIsCategoryForm m]
-  catPredList:=
-    kind is 'function => [["isFreeFunction","*1",opOf form]]
-    [['ofCategory,:u] for u in [:pred1,:domainList]]
---  for [op,:itemlist] in applySubst(pairList($FormalMapVariableList,rpvl),opAlist) repeat
---  the code seems to oscillate between generating $FormalMapVariableList 
---  and generating $TriangleVariableList
-  for [op,:itemlist] in applySubst(pairList($FormalMapVariableList,rpvl),opAlist) repeat
-    for [sig0, pred] in itemlist repeat
-      sig := substitute(dc,"$",sig0)
-      pred:= substitute(dc,"$",pred)
-      sig := applySubst(pairList(KDR oform,rpvl),sig)
-      pred:= applySubst(pairList(KDR oform,rpvl),pred)
-      pred := pred or 'T
-  ----------> Constants change <--------------
-      if IDENTP sig0 then
-          sig := [sig]
-          pred := MKPF([pred,'(isAsConstant)],'AND)
-      pred' := MKPF([pred,:catPredList],'AND)
-      mm := [[dc,:sig],[pred']]
-      acc := [[op,:interactiveModemapForm mm],:acc]
-  reverse! acc
-
-asIsCategoryForm m ==
-  m = "BasicType" or getConstructorKindFromDB opOf m = "category"
-
-asyDocumentation con ==
-  docHash := tableValue($docHash,con)
-  u := [[op,:[fn(x,op) for x in rec]] for op in HKEYS docHash
-           | rec := tableValue(docHash,op)] where fn(x,op) ==
-    [form,sig,pred,origin,where?,comments,:.] := x
-    ----------> Constants change <--------------
-    if IDENTP sig then sig := [sig]
-    [asySignature(sig,nil),trimComments comments]
-  [form,sig,pred,origin,where?,comments] := first tableValue($conHash,con)
-  --above "first" assumes only one entry
-  comments := trimComments asyExtractDescription comments
-  [:u,['constructor,[nil,comments]]]
-
-asyExtractDescription str ==
-  k := STRPOS('"Description:",str,0,nil) => asyExtractDescription subString(str,k + 12)
-  k := STRPOS('"Author:",str,0,nil) => asyExtractDescription subString(str,0,k)
-  str
-
-trimComments str ==
-  str = nil or str is '"" => '""
-  m := maxIndex str
-  str := subString(str,0,m)
-  trimString str
-
-asyExportAlist con ==
---format of 'operationAlist property of LISPLIBS (as returned from koOps):
---    <sig slotNumberOrNil optPred optELT>
---    <sig sig'            predOrT "Subsumed">
---!!! asyFile NEED: need to know if function is implemented by domain!!!
-  docHash := tableValue($docHash,con)
-  [[op,:[fn(x,op) for x in rec]] for op in HKEYS docHash | rec := tableValue(docHash,op)]
-       where fn(x,op) ==
-    [form,sig,pred,origin,where?,comments,:.] := x
-    tail :=
-      pred => [pred]
-      nil
-    newSig := asySignature(sig,nil)
-    [newSig,nil,:tail]
-
-asyMakeOperationAlist(con,proplist, key) ==
-  oplist :=
-    u := symbolLassoc('domExports,proplist) =>
-      kind := 'domain
-      u
-    u := symbolLassoc('catExports,proplist) =>
-      kind := 'category
-      u
-    key is 'domain =>
-      kind := 'domain
-      u := nil
-    return nil
-  ht := MAKE_-HASH_-TABLE()
-  ancestorAlist := nil
-  for ['Declare,id,form,r] in oplist repeat
-    id = "%%" =>
-      opOf form = con => nil
-      y := asyAncestors form
-      [attrs, na] := asyFindAttrs y
-      y := na
-      if opOf(y) ~= con then ancestorAlist := [ [y,:true],:ancestorAlist]
-    idForm   :=
-      form is ['Apply,'_-_>,source,target] => [id,:asyArgs source]
-  ----------> Constants change <--------------
-      id
-    pred :=
-      symbolLassoc('condition,r) is p => hackToRemoveAnd p
-      nil
-    sig := asySignature(asytranForm(form,[idForm],nil),nil)
-    entry :=
-      --id ~= "%%" and IDENTP idForm => [[sig],nil,nil,'ASCONST]
-      id ~= "%%" and IDENTP idForm =>
-          pred => [[sig],nil,asyPredTran pred,'ASCONST]
-          [[sig],nil,true,'ASCONST]
-      pred => [sig,nil,asyPredTran pred]
-      [sig]
-    tableValue(ht,id) := [entry,:tableValue(ht,id)]
-  opalist := [[op,:removeDuplicates tableValue(ht,op)] for op in HKEYS ht]
-  --tableValue($opHash,con) := [ancestorAlist,attributeAlist,:opalist]
-  tableValue($opHash,con) := [ancestorAlist,nil,:opalist]
-
-hackToRemoveAnd p ==
----remove this as soon as .asy files do not contain forms (And pred) forms
-  p is ['And,q,:r] =>
-    r => ['AND,q,:r]
-    q
-  p
-
-asyAncestors x ==
-  x is ['Apply,:r] => asyAncestorList r
-  x is [op,y,:.] and op in '(PretendTo RestrictTo) => asyAncestors y
-  atom x =>
-    x is '_% => '_$
-    symbolMember?(x, $niladics)       => [x]
-    niladicConstructorFromDB x => [x]
-    x
-  asyAncestorList x
-
-asyAncestorList x == [asyAncestors y for y in x]
---============================================================================
---       Build Operation Alist from sig
---============================================================================
-
---format of operations as returned from koOps
---    <sig pred pakOriginOrNil TifPakExposedOrNil>
---    <sig pred origin         exposed?>
-
---abb,kind,file,sourcefile,coSig,dbLineNumber,constructorArgs,libfile
---((sig  where(NIL or #)  condition(T or pred)  ELTorSubsumed) ...
---expanded lists are: sig, predicate, origin, exposeFlag, comments
-
---============================================================================
---       Building Hash Tables for Operations/Constructors
---============================================================================
-asytran fn ==
---put operations into table format for browser:
---    <sig pred origin         exposed? comments>
-  inStream := inputTextFile fn
-  sayBrightly ['"   Reading ",fn]
-  u := VMREAD inStream
-  $niladics := mkNiladics u
-  for x in $niladics repeat PUT(x,'NILADIC,true)
-  for d in u repeat
-    ['Declare,name,:.] := d
-    name = "%%" => 'skip       --skip over top-level properties
-    $docHashLocal: local := MAKE_-HASH_-TABLE()
-    asytranDeclaration(d,'(top),nil,false)
-    if null name then hohohoho()
-    tableValue($docHash,name) := $docHashLocal
-  closeStream inStream
-  'done
-
-mkNiladics u ==
-  [name for x in u | x is ['Declare,name,y,:.] and y isnt ['Apply,'_-_>,:.]]
-
---OLD DEFINITION FOLLOWS
-asytranDeclaration(dform,levels,predlist,local?) ==
-  ['Declare,id,form,r] := dform
-  id is 'failed => id
-  KAR dform isnt 'Declare => systemError '"asytranDeclaration"
-  if levels is '(top) then
-    if form isnt ['Apply,"->",:.] then tableValue($constantHash,id) := true
-  comments := symbolLassoc('documentation,r) or '""
-  idForm   :=
-    levels is ['top,:.] =>
-      form is ['Apply,'_-_>,source,target] => [id,:asyArgs source]
-      id
-  ----------> Constants change <--------------
-    id
-  newsig  := asytranForm(form,[idForm,:levels],local?)
-  key :=
-    levels is ['top,:.] =>
-      id in '(%% Category Type) => 'constant
-      asyLooksLikeCatForm? form => 'category
-      form is ['Apply, '_-_>,.,u] =>
-        if u is ['Apply, construc,:.] then u:= construc
-        getConstructorKindFromDB opOf u = "domain"  => "function"
-        asyLooksLikeCatForm? u => "category"
-        'domain
-      'domain
-    first levels
-  typeCode := symbolLassoc('symeTypeCode,r)
-  record := [idForm,newsig,asyMkpred predlist,key,true,comments,typeCode,:$asyFile]
-  if not local? then
-    ht :=
-      levels is '(top) => $conHash
-      $docHashLocal
-    tableValue(ht,id) := [record,:tableValue(ht,id)]
-  if levels is '(top) then asyMakeOperationAlist(id,r, key)
-  ['Declare,id,newsig,r]
-
-asyLooksLikeCatForm? x ==
---TTT don't see a Third in my version ....
-  x is ['Define, ['Declare, ., ['Apply, 'Third,:.],:.],:.] or
-   x is ['Define, ['Declare, ., 'Category ],:.]
-
---asytranDeclaration(dform,levels,predlist,local?) ==
---  ['Declare,id,form,r] := dform
---  id is 'failed => id
---  levels isnt ['top,:.] => asytranForm(form,[id,:levels],local?)
---  idForm   :=
---    form is ['Apply,'_-_>,source,target] => [id,:asyArgs source]
---    id
---  if form isnt ['Apply,"->",:.] then tableValue($constantHash,id) := true
---  comments := symbolLassoc('documentation,r) or '""
---  newsig  := asytranForm(form,[idForm,:levels],local?)
---  key :=
---    id in '(%% Category Type) => 'constant
---    form is ['Apply,'Third,:.] => 'category
---    form is ['Apply,.,.,target] and target is ['Apply,name,:.]
---      and name in '(Third Join) => 'category
---    'domain
---  record := [newsig,asyMkpred predlist,key,true,comments,:$asyFile]
---  if not local? then
---    ht :=
---      levels is '(top) => $conHash
---      $docHashLocal
---    tableValue(ht,id) := [record,:tableValue(ht,id)]
---  if levels is '(top) then asyMakeOperationAlist(id,r)
---  ['Declare,id,newsig,r]
-
-asyIsCatForm form ==
-  form is ['Apply,:r] =>
-    r is ['_-_>,.,a] => asyIsCatForm a
-    r is ['Third,'Type,:.] => true
-    false
-  false
-
-asyArgs source ==
-  args :=
-    source is [op,:u] and asyComma? op => u
-    [source]
-  [asyArg x for x in args]
-
-asyArg x ==
-  x is ['Declare,id,:.] => id
-  x
-
-asyMkpred predlist ==
-  null predlist => nil
-  predlist is [p] => p
-  ['AND,:predlist]
-
-asytranForm(form,levels,local?) ==
-  u := asytranForm1(form,levels,local?)
-  null u => hahah()
-  u
-
-asytranForm1(form,levels,local?) ==
-  form is ['With,left,cat] =>
---  left ~= nil       => error '"WITH cannot take a left argument yet"
-    asytranCategory(form,levels,nil,local?)
-  form is ['Apply,:.]   => asytranApply(form,levels,local?)
-  form is ['Declare,:.] => asytranDeclaration(form,levels,nil,local?)
-  form is ['Comma,:r]  => ['Comma,:[asytranForm(x,levels,local?) for x in r]]
---form is ['_-_>,:s] => asytranMapping(s,levels,local?)
-  form is [op,a,b] and a in '(PretendTo RestrictTo) =>
-    asytranForm1(a,levels,local?)
-  form is ['LitInteger,s] =>
-        READ_-FROM_-STRING(s)
-  form is ['Define,:.]  =>
-    form is ['Define,['Declare,.,x,:.],rest] =>
---TTT i don't know about this one but looks ok
-      x is 'Category => asytranForm1(rest,levels, local?)
-      asytranForm1(x,levels,local?)
-    error '"DEFINE forms are not handled yet"
-  if form is '_% then $hasPerCent := true
-  IDENTP form =>
-    form is "%" => "$"
-    form has NILADIC => [form]
-    form
-  [asytranForm(x,levels,local?) for x in form]
-
-asytranApply(['Apply,name,:arglist],levels,local?) ==
-  name in '(Record Union) =>
-    [name,:[asytranApplySpecial(x, levels, local?) for x in arglist]]
-  null arglist => [name]
-  name is [ 'RestrictTo, :.] => 
-    asytranApply(['Apply, second name,:arglist], levels, local?)
-  name is [ 'Qualify, :.] => 
-    asytranApply(['Apply, second name,:arglist], levels, local?)
-  name is 'string => asytranLiteral first arglist
-  name is 'integer => asytranLiteral first arglist
-  name is 'float => asytranLiteral first arglist
-  name is 'Enumeration =>
-    ["Enumeration",:[asytranEnumItem arg for arg in arglist]]
-  [:argl,lastArg] := arglist
-  [name,:[asytranFormSpecial(arg,levels,true) for arg in argl],
-          asytranFormSpecial(lastArg,levels,false)]
-
-asytranLiteral(lit) ==
-  second lit
-
-asytranEnumItem arg ==
-  arg is ['Declare, name, :.] => name
-  error '"Bad Enumeration entry"
-
-asytranApplySpecial(x, levels, local?) ==
-  x is ['Declare, name, typ, :.] => [":",name,asytranForm(typ, levels, local?)]
-  asytranForm(x, levels, local?)
-
-asytranFormSpecial(x, levels, local?) ==  --> this throws away variable name (revise later)
-  x is ['Declare, name, typ, :.] => asytranForm(typ, levels, local?)
-  asytranForm(x, levels, local?)
-
-asytranCategory(form,levels,predlist,local?) ==
-  cat :=
-    form is ['With,left,right] =>
-      right is ['Blank,:.] => ['Sequence]
-      right
-    form
-  left :=
-    form is ['With,left,right] =>
-      left is ['Blank,:.] => nil
-      left
-    nil
-  $hasPerCent: local := nil
-  items :=
-    cat is ['Sequence,:s] => s
-    [cat]
-  catTable := MAKE_-HASH_-TABLE()
-  catList  := nil
-  for x in items | x repeat
-    if null x then systemError()
-    dform := asytranCategoryItem(x,levels,predlist,local?)
-    null dform => nil
-    dform is ['Declare,id,record,r] =>
-      tableValue(catTable,id) := [asyWrap(record,predlist),:tableValue(catTable,id)]
-    catList := [asyWrap(dform,predlist),:catList]
-  keys := listSort(function GLESSEQP,HKEYS catTable)
-  right1 := reverse! catList
-  right2 := [[key,:tableValue(catTable,key)] for key in keys]
-  right :=
-    right2 => [:right1,['Exports,:right2]]
-    right1
-  res :=
-    left => [left,:right]
-    right
-  res is [x] and x is ['IF,:.] => x
-  ['With,:res]
-
-asyWrap(record,predlist) ==
-  predlist => ['IF,MKPF(predlist,'AND),record]
-  record
-
-asytranCategoryItem(x,levels,predlist,local?) ==
-  x is ['If,predicate,item,:r] =>
-    IFCAR r => error '"ELSE expressions not allowed yet in conditionals"
-    pred :=
-      predicate is ['Test,r] => r
-      predicate
-    asytranCategory(item,levels,[pred,:predlist],local?)
-  KAR x in '(Default Foreign) => nil
-  x is ['Declare,:.] => asytranDeclaration(x,levels,predlist,local?)
-  x
-
---============================================================================
---          Extending Constructor Datatable
---============================================================================
---FORMAT of $constructorDataTable entry:
---abb kind libFile sourceFile coSig constructorArgs
---alist is ((kind . domain) (libFile . MATRIX) (sourceFile . "matrix")
---         (coSig NIL T) (dbLineNumber . 29187) (constructorArgs R)
---  (modemap . (
---    (|Matrix| |#1|)
---      (Join (MatrixCategory #1 (Vector #1) (Vector #1))
---        (CATEGORY domain
---          (SIGNATURE diagonalMatrix ($ (Vector #1)))
---          (IF (has #1 (Field))
---            (SIGNATURE inverse ((Union $ "failed") $)) %noBranch)))
---      (Ring))
---    (T Matrix))   )
-extendConstructorDataTable() ==
---  tb := $constructorDataTable
-  for x in listSort(function GLESSEQP,HKEYS $conHash) repeat
---     if LASSOC(x,tb) then tb := DELLASOS(x,tb)
-     record := tableValue($conHash,x)
-     [form,sig,predlist,origin,exposure,comments,typeCode,:filename] := first record
-     abb := asyAbbreviation(x,#(rest sig))
-     kind := 'domain
-     --Note: this "first" assumes that there is ONLY one sig per name
-     cosig := [nil,:asyCosig sig]
-     args  := asyConstructorArgs sig
-     tb :=
-       [[x,abb,
-          ['kind,:kind],
-            ['cosig,:cosig],
-              ['libfile,filename],
-                ['sourceFile,STRINGIMAGE filename],
-                  ['constructorArgs,:args]],:tb]
-  listSort(function GLESSEQP,ASSOCLEFT tb)
-
-asyConstructorArgs sig ==
-  sig is ['With,:.] => nil
-  sig is ['_-_>,source,target] =>
-    source is [op,:argl] and asyComma? op => [asyConstructorArg x for x in argl]
-    [asyConstructorArg source]
-
-asyConstructorArg x ==
-  x is ['Declare,name,t,:.] => name
-  x
-
-asyCosig sig ==    --can be a type or could be a signature
-  atom sig or sig is ['With,:.] => nil
-  sig is ['_-_>,source,target] =>
-    source is [op,:argl] and asyComma? op => [asyCosigType x for x in argl]
-    [asyCosigType source]
-  error false
-
-asyCosigType u ==
-  u is [name,t] =>
-    t is [fn,:.] =>
-      asyComma? fn => fn
-      fn is 'With  => 'T
-      nil
-    t is 'Type => 'T
-    error '"Unknown atomic type"
-  error false
-
-asyAbbreviation(id,n) ==  chk(id,main) where   --> n = number of arguments
-  main() ==
-    a := createAbbreviation id => a
-    name := PNAME id
---  #name < 8 => makeSymbol stringUpcase name
-    parts := asySplit(name,maxIndex name)
-    newname := strconc/[asyShorten x for x in parts]
-    #newname < 8 => makeSymbol newname
-    tryname := subString(name,0,7)
-    not createAbbreviation tryname => makeSymbol stringUpcase tryname
-    nil
-  chk(conname,abb) ==
-    (xx := asyGetAbbrevFromComments conname) => xx
-    con := abbreviation? abb =>
-      conname = con => abb
-      conname
-    abb
-
-asyGetAbbrevFromComments con ==
-  docHash := tableValue($docHash,con)
-  u := [[op,:[fn(x,op) for x in rec]] for op in HKEYS docHash
-           | rec := tableValue(docHash,op)] where fn(x,op) ==
-    [form,sig,pred,origin,where?,comments,:.] := x
-    ----------> Constants change <--------------
-    if IDENTP sig then sig := [sig]
-    [asySignature(sig,nil),trimComments comments]
-  [form,sig,pred,origin,where?,comments] := first tableValue($conHash,con)
-  --above "first" assumes only one entry
-  x := asyExtractAbbreviation comments
-  x => intern x
-  nil
-
-asyExtractAbbreviation str ==
-        not (k:= STRPOS('"Abbrev: ",str,0,nil)) => nil
-        str := subString(str, k+8)
-        k := STRPOS($stringNewline, str,0,nil)
-        k => subString(str, 0, k)
-        str
-
-asyShorten x ==
-  y := createAbbreviation x
-    or LASSOC(x,
-        '(("Small" . "SM") ("Single" ."S") ("Half" . "H")("Point" . "PT")
-            ("Floating" . "F") ("System" . "SYS") ("Number" . "N")
-             ("Inventor" . "IV")
-              ("Finite" . "F") ("Double" . "D") ("Builtin" . "BI"))) => y
-  UPCASE x
-
-asySplit(name,end) ==
-  end < 1 => [name]
-  k := 0
-  for i in 1..end while lowerCase? name.i repeat k := i
-  k := k + 1
-  [subString(name,0,k),:asySplit(subString(name,k),end-k)]
-
-createAbbreviation s ==
-  if string? s then s := makeSymbol s
-  a := getConstructorAbbreviationFromDB s
-  a ~= s => a
-  nil
-
---============================================================================
---       extending getConstructorModemapFromDB Property
---============================================================================
---Note: modemap property is built when getConstructorModemapFromDB is called
-
-asyConstructorModemap con ==
-  tableValue($conHash,con) isnt [record,:.] => nil   --not there
-  [form,sig,predlist,kind,exposure,comments,typeCode,:filename] := record
-  $kind: local := kind
-  --NOTE: sig has the form (-> source target) or simply (target)
-  $constructorArgs: local := KDR form
-  signature := asySignature(sig,false)
-  formals := ['_$,:TAKE(#$constructorArgs,$FormalMapVariableList)]
-  mm := [[[con,:$constructorArgs],:signature],['T,con]]
-  applySubst(pairList(['_%,:$constructorArgs],formals),mm)
-
-asySignature(sig,names?) ==
-  sig is ['Join,:.] => [asySig(sig,nil)]
-  sig is ['With,:.] => [asySig(sig,nil)]
-  sig is ['_-_>,source,target] =>
-    target :=
-      names? => ['dummy,target]
-      target
-    source is [op,:argl] and asyComma? op =>
-      [asySigTarget(target,names?),:[asySig(x,names?) for x in argl]]
-    [asySigTarget(target,names?),asySig(source,names?)]
-  ----------> The following is a hack for constants which are category names<--
-  sig is ['Third,:.] => [asySig(sig,nil)]
-  ----------> Constants change <--------------
-  asySig(sig,nil)
-
-asySigTarget(u,name?) == asySig1(u,name?,true)
-
-asySig(u,name?) == asySig1(u,name?,false)
-
-asySig1(u,name?,target?) ==
-  x :=
-    name? and u is [name,t] => t
-    u
-  x is [fn,:r] =>
-    fn is 'Join => asyTypeJoin r       ---------> jump out to newer code 4/94
-    fn in '(RestrictTo PretendTo) => asySig(first r,name?)
-    asyComma? fn =>
-      u := [asySig(x,name?) for x in r]
-      target? =>
-        null u => $Void
-        -- this implies a multiple value return, not currently supported
-        -- in the interpreter
-        ['Multi,:u]
-      u
-    fn is 'With  => asyCATEGORY r
-    fn is 'Third =>
-      r is [b] =>
-        b is ['With,:s]  => asyCATEGORY s
-        b is ['Blank,:.] => asyCATEGORY nil
-      error x
-    fn is 'Apply and r is ['_-_>,:s] => asyMapping(s,name?)
-    fn is '_-_> => asyMapping(r,name?)
-    fn is 'Declare and r is [name,typ,:.] =>
-        asySig1(typ, name?, target?)
-    x is '(_%) => '(_$)
-    [fn,:[asySig(x,name?) for x in r]]
---x is 'Type => $Type
-  x is '_% => '_$
-  x
-
--- old version was :
---asyMapping([a,b],name?) ==
---  a := asySig(a,name?)
---  b := asySig(b,name?)
---  args :=
---    a is [op,:r] and asyComma? op => r
---    [a]
---  ['Mapping,b,:args]
-
-asyMapping([a,b],name?) ==
-  newa := asySig(a,name?)
-  b    := asySig(b,name?)
-  args :=
-    a is [op,:r] and asyComma? op => newa
-    [a]
-  ['Mapping,b,:args]
-
---============================================================================
---       code for asySignatures of the form (Join,:...)
---============================================================================
-asyType x ==
-  x is [fn,:r] =>
-    fn is 'Join => asyTypeJoin r
-    fn in '(RestrictTo PretendTo) => asyType first r
-    asyComma? fn =>
-      u := [asyType x for x in r]
-      u
-    fn is 'With  => asyCATEGORY r
-    fn is '_-_> => asyTypeMapping r
-    fn is 'Apply => r
---  fn is 'Declare and r is [name,typ,:.] => typ
-    x is '(_%) => '(_$)
-    x
---x is 'Type => $Type
-  x is '_% => '_$
-  x
-
-asyTypeJoin r ==
-  $conStack : local := nil
-  $opStack  : local := nil
-  $predlist : local := nil
-  for x in r repeat asyTypeJoinPart(x,$predlist)
-  catpart :=
-    $opStack => ['CATEGORY,$kind,:asyTypeJoinStack reverse $opStack]
-    nil
-  conpart := asyTypeJoinStack reverse $conStack
-  conpart =>
-    catpart     => ['Join,:conpart,catpart]
-    rest conpart => ['Join,:conpart]
-    conpart
-  catpart
-
-asyTypeJoinPart(x,$predlist) ==
-  x is ['Join,:y] => for z in y repeat asyTypeJoinPart(z, $predlist)
-  x is ['With,:y] => for p in y repeat asyTypeJoinPartWith p
-  asyTypeJoinPartWith x
-
-asyTypeJoinPartWith x ==
-  x is ['Exports,:y] => for p in y repeat asyTypeJoinPartExport p
-  x is ['Exports,:.] => systemError 'exports
-  x is ['Comma]  => nil
-  x is ['Export,:y]  => nil
-  x is ['IF,:r] => asyTypeJoinPartIf r
-  x is ['Sequence,:x] => for y in x repeat asyTypeJoinItem y
-  asyTypeJoinItem x
-
-asyTypeJoinPartIf [pred,value] ==
-  predlist := [asyTypeJoinPartPred pred,:$predlist]
-  asyTypeJoinPart(value,predlist)
-
-asyTypeJoinPartPred x ==
-  x is ['Test, y] => asyTypeUnit y
-  asyTypeUnit x
-
-asyTypeJoinItem x ==
-  result := asyTypeUnit x
-  isLowerCaseLetter stringChar(symbolName opOf result,0) =>
-    $opStack := [[['ATTRIBUTE,result],:$predlist],:$opStack]
-  $conStack := [[result,:$predlist],:$conStack]
-
-asyTypeMapping([a,b]) ==
-  a := asyTypeUnit a
-  b := asyTypeUnit b
-  args :=
-    a is [op,:r] and asyComma? op => r
-    [a]
-  ['Mapping,b,:args]
-
-asyTypeUnit x ==
-  x is [fn,:r] =>
-    fn is 'Join => systemError 'Join ----->asyTypeJoin r
-    fn in '(RestrictTo PretendTo) => asyTypeUnit first r
-    asyComma? fn =>
-      u := [asyTypeUnit x for x in r]
-      u
-    fn is 'With  => asyCATEGORY r
-    fn is '_-_> => asyTypeMapping r
-    fn is 'Apply => asyTypeUnitList r
-    fn is 'Declare and r is [name,typ,:.] => asyTypeUnitDeclare(name,typ)
-    x is '(_%) => '(_$)
-    [fn,:asyTypeUnitList r]
-  GETL(x,"NILADIC") => [x]
---x is 'Type => $Type
-  x is '_% => '_$
-  x
-
-asyTypeUnitList x == [asyTypeUnit y for y in x]
-
-asyTypeUnitDeclare(op,typ) ==
-  typ is ['Apply, :r] => asyCatSignature(op,r)
-  asyTypeUnit typ
---============================================================================
---               Translator for ['With,:.]
---============================================================================
-asyCATEGORY x ==
-  if x is [join,:y] and join is ['Apply,:s] then
-    exports := y
-    joins :=
-      s is ['Join,:r] => [asyJoinPart u for u in r]
-      [asyJoinPart s]
-  else if x is [id,:y] and IDENTP id then
-    joins := [[id]]
-    exports := y
-  else
-    joins   := nil
-    exports := x
-  cats       := exports
-  operations := nil
-  if exports is [:r,['Exports,:ops]] then
-    cats := r
-    operations := ops
-  exportPart :=
-    ['CATEGORY,'domain,:append/[asyCatItem y for y in operations]]
-  [attribs, na] := asyFindAttrs joins
-  joins := na
-  cats := "append"/[asyCattran c for c in cats]
-  [a, na] := asyFindAttrs cats
-  cats := na
-  attribs := append(attribs, a)
-  attribs := [['ATTRIBUTE, x] for x in attribs]
-  exportPart := [:exportPart,:attribs]
-  joins or cats or attribs =>
-    ['Join,:joins,:cats, exportPart]
-  exportPart
-
-asyFindAttrs l ==
-  attrs := []
-  notattrs := []
-  for x in l repeat 
-    x0 := x
-    while cons? x repeat x := first x
-    if symbolMember?(x, $BuiltinAttributes) then attrs := [:attrs, x]
-    else notattrs := [:notattrs, x0]
-  [attrs, notattrs]
-
-simpCattran x ==
-  u := asyCattran x
-  u is [y] => y
-  ['Join,:u]
-
-asyCattran x ==
-  x is ['With,:r] => "append"/[asyCattran1 x for x in r]
-  x is ['IF,:.]   => "append"/[asyCattranConstructors(x,nil)]
-  [x]
-
-asyCattran1 x ==
-  x is ['Exports,:y] => "append"/[asyCattranOp u for u in y]
-  x is ['IF,:.]      => "append"/[asyCattranConstructors(x,nil)]
-  systemError nil
-
-asyCattranOp [op,:items] ==
-  "append"/[asyCattranOp1(op,item,nil) for item in items]
-
-asyCattranOp1(op, item, predlist) ==
-  item is ['IF, p, x] =>
-    pred := asyPredTran
-      p is ['Test,t] => t
-      p
---    x is ['IF,:.] => "append"/[asyCattranOp1('IF, x, [pred,:predlist])]
---  This line used to call asyCattranOp1 with too few arguments.  Following
---  fix suggested by RDJ.
-    x is ['IF,:.] => "append"/[asyCattranOp1(op,y,[pred,:predlist]) for y in x]
-    [['IF, asySimpPred(pred,predlist), asyCattranSig(op,x), '%noBranch]]
-  [asyCattranSig(op,item)]
-
-asyPredTran p == asyPredTran1 asyJoinPart p
-
-asyPredTran1 p ==
-  p is ['Has,x,y] => ["has",x, simpCattran y]
-  p is ['Test, q] => asyPredTran1 q
-  p is [op,:r] and op in '(AND OR NOT) =>
-    [op,:[asyPredTran1 q for q in r]]
-  p
-
-asyCattranConstructors(item, predlist) ==
-  item is ['IF, p, x] =>
-    pred := asyPredTran
-      p is ['Test,t] => t
-      p
-    x is ['IF,:.] => "append"/[asyCattranConstructors(x, [pred,:predlist])]
-    form := ['ATTRIBUTE, asyJoinPart x]
-    [['IF, asySimpPred(pred,predlist), form, '%noBranch]]
-  systemError()
-
-asySimpPred(p, predlist) ==
-  while predlist is [q,:predlist] repeat p := quickAnd(q,p)
-  p
-
-asyCattranSig(op,y) ==
-  y isnt ["->",source,t] =>
---     ['SIGNATURE, op, asyTypeUnit y]
--- following makes constants into nullary functions
-     ['SIGNATURE, op, [asyTypeUnit y]]
-  s :=
-    source is ['Comma,:s] => [asyTypeUnit z for z in s]
-    [asyTypeUnit source]
-  t := asyTypeUnit t
-  null t => ['SIGNATURE,op,s]
-  ['SIGNATURE,op,[t,:s]]
-
-asyJoinPart x ==
-  IDENTP x => [x]
-  asytranForm(x,nil,true)
-
-asyCatItem item ==
-  atom item  => [item]
-  item is ['IF,.,.] => [item]
-  [op,:sigs] := item
-  [asyCatSignature(op,sig) for sig in sigs | sig]
-
-asyCatSignature(op,sig) ==
-  sig is ['_-_>,source,target] =>
-     ['SIGNATURE,op, [asyTypeItem target,:asyUnTuple source]]
-  ----------> Constants change <--------------
---  ['TYPE,op,asyTypeItem sig]
--- following line converts constants into nullary functions
-  ['SIGNATURE,op,[asyTypeItem sig]]
-
-asyUnTuple x ==
-  x is [op,:u] and asyComma? op => [asyTypeItem y for y in u]
-  [asyTypeItem x]
-
-asyTypeItem x ==
-  atom x =>
-    x is '_%         => '_$
-    x
-  x is ['_-_>,a,b] =>
-      ['Mapping,b,:asyUnTuple a]
-  x is ['Apply,:r] =>
-    r is ['_-_>,a,b] =>
-      ['Mapping,b,:asyUnTuple a]
-    r is ['Record,:parts] =>
-      ['Record,:[[":",a,b] for ['Declare,a,b,:.] in parts]]
-    r is ['Segment,:parts] =>
-      ['Segment,:[asyTypeItem x for x in parts]]
-    asytranApply(x,nil,true)
-  x is ['Declare,.,t,:.] => asyTypeItem t
-  x is ['Comma,:args] =>
-    -- this implies a multiple value return, not currently supported
-    -- in the interpreter
-    args => ['Multi,:[asyTypeItem y for y in args]]
-    ['Void]
-  [asyTypeItem y for y in x]
-
---============================================================================
---               Utilities
---============================================================================
-asyComma? op == op in '(Comma Multi)
-
-
-hput(table,name,value) ==
-  if null name then systemError()
-  tableValue(table,name) := value
-
---============================================================================
---               category parts
---============================================================================
-
--- this constructs operation information from a category.
--- NB: This is categoryParts, but with the kind supplied by
--- an arguments
-asCategoryParts(kind,conform,category,:options) == main where
-  main() ==
-    cons? := IFCAR options  --means to include constructors as well
-    $attrlist: local := nil
-    $oplist  : local := nil
-    $conslist: local := nil
-    conname := opOf conform
-    for x in exportsOf(category) repeat build(x,true)
-    $attrlist := listSort(function GLESSEQP,$attrlist)
-    $oplist   := listSort(function GLESSEQP,$oplist)
-    res := [$attrlist,:$oplist]
-    if cons? then res := [listSort(function GLESSEQP,$conslist),:res]
-    if kind is 'category then
-      tvl := TAKE(#rest conform,$TriangleVariableList)
-      res := applySubst(pairList(tvl,$FormalMapVariableList),res)
-    res
-   where
-    build(item,pred) ==
-      item is ['SIGNATURE,op,sig,:.] => $oplist   := [[opOf op,sig,:pred],:$oplist]
-      --note: opOf is needed!!! Bug in compiler puts in (One) and (Zero)
-      item is ['ATTRIBUTE,attr] =>
-        constructor? opOf attr =>
-          $conslist := [[attr,:pred],:$conslist]
-          nil
-        opOf attr is 'nothing => 'skip
-        $attrlist := [[opOf attr,IFCDR attr,:pred],:$attrlist]
-      item is ['TYPE,op,type] =>
-          $oplist := [[op,[type],:pred],:$oplist]
-      item is ['IF,pred1,s1,s2] =>
-        build(s1,quickAnd(pred,pred1))
-        s2 => build(s2,quickAnd(pred,['NOT,pred1]))
-      item is ['PROGN,:r] => for x in r repeat build(x,pred)
-      item in '(%noBranch) => 'ok
-      null item => 'ok
-      systemError '"build error"
-    exportsOf(target) ==
-      target is ['CATEGORY,.,:r] => r
-      target is ['Join,:r,f] =>
-        for x in r repeat $conslist := [[x,:true],:$conslist]
-        exportsOf f
-      $conslist := [[target,:true],:$conslist]
-      nil
-
---============================================================================
---               Dead Code (for a very odd value of 'dead')
---============================================================================
-asyTypeJoinPartExport x ==
-  [op,:items] := x
-  for y in items repeat
-    y isnt ["->",source,t] =>
---       sig := ['TYPE, op, asyTypeUnit y]
--- converts constants to nullary functions (this code isn't dead)
-       sig := ['SIGNATURE, op, [asyTypeUnit y]]
-       $opStack := [[sig,:$predlist],:$opStack]
-    s :=
-      source is ['Comma,:s] => [asyTypeUnit z for z in s]
-      [asyTypeUnit source]
-    t := asyTypeUnit t
-    sig :=
-      null t => ['SIGNATURE,op,s]
-      ['SIGNATURE,op,[t,:s]]
-    $opStack := [[sig,:$predlist],:$opStack]
-
---============================================================================
---               Code to create opDead Code
---============================================================================
-asyTypeJoinStack r ==
-  al := [[[x while r is [[x, :q],:s] and p = q and (r := s; true)],:p]
-           while r is [[.,:p],:.]]
-  result := "append"/[fn for [y,:p] in al] where fn() ==
-    p => [['IF,asyTypeMakePred p,:y]]
-    y
-  result
-
-asyTypeMakePred [p,:u] ==
-  while u is [q,:u] repeat p := quickAnd(q,p)
-  p
-
-
-
-
diff --git a/src/interp/ax.boot b/src/interp/ax.boot
deleted file mode 100644
index e3728a78..00000000
--- a/src/interp/ax.boot
+++ /dev/null
@@ -1,385 +0,0 @@
--- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
--- All rights reserved.
--- Copyright (C) 2007-2011, Gabriel Dos Reis.
--- 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.
-
-
-import as
-namespace BOOT
-
-$stripTypes := false
-$pretendFlag := false
-$defaultFlag := false
-$baseForms := nil
-$literals  := nil
-
-spad2AxTranslatorAutoloadOnceTrigger any == true
-
-sourceFilesToAxFile(filename, sourceFiles) ==
-  makeAxFile(filename, MAPCAN('fileConstructors, sourceFiles))
-
-
-$extendedDomains := nil
-
-setExtendedDomains(l) == 
-        $extendedDomains := l
-
-fileConstructors name ==
-   [makeSymbol(con,"BOOT") for con in SRCABBREVS SOURCEPATH STRING name]
-
-makeAxFile(filename, constructors) ==
-  $defaultFlag : local := false
-  $literals := []
-  axForms :=
-     [modemapToAx(modemap) for cname in constructors |
-            (modemap:=getConstructorModemapFromDB cname) and
-              not (cname in '(Tuple Exit Type)) and
-                not isDefaultPackageName cname]
-  if $baseForms then
-     axForms := [:$baseForms, :axForms]
-  if $defaultFlag then
-     axForms :=
-        [['Foreign, ['Declare, 'dummyDefault, 'Exit], 'Lisp], :axForms]
-  axForms := append(axDoLiterals(), axForms)
-  axForm := ['Sequence, _
-               ['Import, [], 'AxiomLib], ['Import, [], 'Boolean], :axForms]
-  st := MAKE_-OUTSTREAM(filename)
-  PPRINT(axForm,st)
-  closeStream st
-
-makeAxExportForm(filename, constructors) ==
-  $defaultFlag : local := false
-  $literals := []
-  axForms :=
-     [modemapToAx(modemap) for cname in constructors |
-            (modemap:=getConstructorModemapFromDB cname) and
-              not (cname in '(Tuple Exit Type)) and
-                not isDefaultPackageName cname]
-  if $baseForms then
-     axForms := [:$baseForms, :axForms]
-  if $defaultFlag then
-     axForms :=
-        [['Foreign, ['Declare, 'dummyDefault, 'Exit], 'Lisp], :axForms]
-  axForms := append(axDoLiterals(), axForms)
-  axForm := ['Sequence, _
-               ['Import, [], 'AxiomLib], ['Import, [], 'Boolean], :axForms]
-  axForm
-
-
-stripType type ==
-  $stripTypes =>
-     categoryForm? type => 'Type
-     type
-  type
-
-modemapToAx(modemap) ==
-  modemap is [[consform, target,:argtypes],.]
-  consform is [constructor,:args]
-  argdecls:=['Comma, : [axFormatDecl(a,stripType t) for a in args for t in argtypes]]
-  resultType :=  axFormatType stripType target
-  categoryForm? constructor =>
-      categoryInfo := getConstructorCategoryFromDB constructor
-      categoryInfo := applySubst(pairList($TriangleVariableList,$FormalMapVariableList), 
-                       categoryInfo)
-      null args =>
-          ['Define,['Declare, constructor,'Category],
-               addDefaults(constructor, axFormatType categoryInfo)]
-      ['Define,
-          ['Declare, constructor, ['Apply, "->", optcomma argdecls, 'Category]],
-           ['Lambda, argdecls, 'Category,
-             ['Label, constructor,
-               addDefaults(constructor, axFormatType categoryInfo)]]]
-  symbolMember?(constructor,$extendedDomains) =>
-     null args =>
-        ['Extend, ['Define, ['Declare, constructor, resultType],
-            ['Add, ['PretendTo, ['Add, [], []], resultType], []]]]
-     conscat := makeSymbol(strconc(symbolName(constructor), "ExtendCategory"),"BOOT")
-     rtype := ['Apply, conscat, :args]
---     if resultType is ['With,a,b] then
---        if not(b is ['Sequence,:withseq]) then withseq := [b]
---        cosigs := rest getDualSignatureFromDB constructor
---        exportargs := [['Export, [], arg, []] for arg in args for p in cosigs | p]
---        resultType := ['With,a,['Sequence,:append(exportargs, withseq)]]
-     consdef := ['Define,
-        ['Declare, conscat, ['Apply, "->", optcomma argdecls, 'Category]],
-          ['Lambda, argdecls, 'Category, ['Label, conscat, resultType]]]
-     ['Sequence, consdef,
-      ['Extend, ['Define,
-        ['Declare, constructor, ['Apply, "->", optcomma argdecls, rtype]],
-          ['Lambda, argdecls, rtype,
-            ['Label, constructor,
-                ['Add, ['PretendTo, ['Add, [], []], rtype], []]]]]]]
-  null args =>
-     ['Export, ['Declare, constructor, resultType],[],[]]
---  if resultType is ['With,a,b] then
---     if not(b is ['Sequence,:withseq]) then withseq := [b]
---     cosigs := rest getDualSignatureFromDB constructor
---     exportargs := [['Export, [], arg, []] for arg in args for p in cosigs | p]
---     resultType := ['With,a,['Sequence,:append(exportargs, withseq)]]
-  ['Export, ['Declare, constructor, ['Apply, "->", optcomma argdecls, resultType]],[],[]]
-
-optcomma [op,:args] ==
-   # args = 1 => first args
-   [op,:args]
-
-axFormatDecl(sym, type) ==
-   if sym is '$ then sym := '%
-   opOf type in '(StreamAggregate FiniteLinearAggregate) =>
-        ['Declare, sym, 'Type]
-   ['Declare, sym, axFormatType type]
-
-makeTypeSequence l ==
-   ['Sequence,: removeSymbol(l,'Type)]
-
-axFormatAttrib(typeform) ==
-  atom typeform => typeform
-  axFormatType typeform
-
-axFormatType(typeform) ==
-  atom typeform =>
-     typeform is '$ => '%
-     string? typeform =>
-        ['Apply,'Enumeration, makeSymbol typeform]
-     integer? typeform =>
-       -- need to test for PositiveInteger vs Integer
-        axAddLiteral('integer, 'PositiveInteger, 'Literal)
-        ['RestrictTo, ['LitInteger, STRINGIMAGE typeform ], 'PositiveInteger]
-     FLOATP typeform => ['LitFloat, STRINGIMAGE typeform]
-     symbolMember?(typeform,$TriangleVariableList) =>
-       applySubst(pairList($TriangleVariableList, $FormalMapVariableList), typeform)
-     symbolMember?(typeform, $FormalMapVariableList) => typeform
-     axAddLiteral('string, 'Symbol, 'Literal)
-     ['RestrictTo, ['LitString, symbolName typeform], 'Symbol]
-  typeform is ['construct,: args] =>
-      axAddLiteral('bracket, ['Apply, 'List, 'Symbol], [ 'Apply, 'Tuple, 'Symbol])
-      axAddLiteral('string, 'Symbol, 'Literal)
-      ['RestrictTo, ['Apply, 'bracket, 
-                        :[axFormatType a for a in args]],
-                          ['Apply, 'List, 'Symbol] ]
-  typeform is [op] =>
-    op is '$ => '%
-    op is 'Void => ['Comma]
-    op
-  typeform is ['local, val] => axFormatType val
-  typeform is ['QUOTE, val] => axFormatType val
-  typeform is ['Join,:cats,lastcat] =>
-      lastcat is ['CATEGORY,type,:ops] =>
-         ['With, [],
-            makeTypeSequence(
-               append([axFormatType c for c in cats],
-                        [axFormatOp op for op in ops]))]
-      ['With, [], makeTypeSequence([axFormatType c for c in rest typeform])]
-  typeform is ['CATEGORY, type, :ops] =>
-      ['With, [],  axFormatOpList ops]
-  typeform is ['Mapping, target, :argtypes] =>
-      ['Apply, "->",
-               ['Comma, :[axFormatType t for t in argtypes]],
-                axFormatType target]
-  typeform is ['_:, name, type] => axFormatDecl(name,type)
-  typeform is ['Union, :args] =>
-      first args is ['_:,.,.] =>
-         ['Apply, 'Union, :[axFormatType a for a in args]]
-      taglist := []
-      valueCount := 0
-      for x in args repeat
-          tag :=
-            string? x => makeSymbol x
-            x is ['QUOTE,val] and string? val => makeSymbol val
-            valueCount := valueCount + 1
-            INTERNL("value", STRINGIMAGE valueCount)
-          taglist := [tag ,: taglist]
-      ['Apply, 'Union, :[axFormatDecl(name,type) for name in reverse taglist
-                                for type in args]]
-  typeform is ['Dictionary,['Record,:args]] =>
-      ['Apply, 'Dictionary,
-          ['PretendTo, axFormatType second typeform, 'SetCategory]]
-  typeform is ['FileCategory,xx,['Record,:args]] =>
-      ['Apply, 'FileCategory, axFormatType xx,
-          ['PretendTo, axFormatType third typeform, 'SetCategory]]
-  typeform is [op,:args] =>
-      $pretendFlag and constructor? op and
-        getConstructorModemapFromDB op is [[.,target,:argtypes],.] =>
-          ['Apply, op,
-               :[['PretendTo, axFormatType a, axFormatType t]
-                     for a in args for t in argtypes]]
-      op in '(SquareMatrix SquareMatrixCategory DirectProduct
-         DirectProductCategory RadixExpansion) and
-            getConstructorModemapFromDB op is [[.,target,arg1type,:restargs],.] =>
-               ['Apply, op,
-                  ['PretendTo, axFormatType first args, axFormatType arg1type],
-                     :[axFormatType a for a in rest args]]
-      ['Apply, op, :[axFormatType a for a in args]]
-  error "unknown entry type"
-
-axFormatOpList ops == ['Sequence,:[axFormatOp o for o in ops]]
-
-axOpTran(name) ==
-   atom name =>
-      name is 'elt => 'apply
-      name is 'setelt => 'set!
-      name is 'SEGMENT => ".."
-      name is 1 => '_1
-      name is 0 => '_0
-      name
-   opOf name is 'Zero => '_0
-   opOf name is 'One => '_1
-   error "bad op name"
-
-axFormatOpSig(name, [result,:argtypes]) ==
-   ['Declare, axOpTran name,
-         ['Apply, "->", ['Comma, :[axFormatType t for t in argtypes]],
-                        axFormatType result]]
-
-axFormatConstantOp(name, [result]) ==
-   ['Declare, axOpTran name, axFormatType result]
-
-axFormatPred pred ==
-   atom pred => pred
-   [op,:args] := pred
-   op is 'IF => axFormatOp pred
-   op = "has" =>
-      [name,type] := args
-      if name is '$ then name := '%
-      else name := axFormatOp name
-      ftype := axFormatOp type
-      if ftype is ['Declare,:.] then
-           ftype := ['With, [], ftype]
-      ['Test,['Has,name, ftype]]
-   axArglist := [axFormatPred arg for arg in args]
-   op is 'AND => ['And,:axArglist]
-   op is 'OR  => ['Or,:axArglist]
-   op is 'NOT => ['Not,:axArglist]
-   error "unknown predicate"
-
-
-axFormatCondOp op ==
-  $pretendFlag:local := true
-  axFormatOp op
-
-
-axFormatOp op ==
-   op is ['IF, pred, trueops, falseops] =>
-      null(trueops) or trueops='%noBranch =>
-         ['If, ['Test,['Not, axFormatPred pred]],
-              axFormatCondOp falseops,
-                axFormatCondOp trueops]
-      ['If, axFormatPred pred,
-             axFormatCondOp trueops,
-              axFormatCondOp falseops]
-       -- ops are either single op or ['PROGN, ops]
-   op is ['SIGNATURE, name, type] => axFormatOpSig(name,type)
-   op is ['SIGNATURE, name, type, 'constant] =>
-            axFormatConstantOp(name,type)
-   op is ['ATTRIBUTE, attributeOrCategory] =>
-       categoryForm? attributeOrCategory =>
-           axFormatType attributeOrCategory
-       ['RestrictTo, axFormatAttrib attributeOrCategory, 'Category]
-   op is ['PROGN, :ops] => axFormatOpList ops
-   op is '%noBranch => []
-   axFormatType op
-
-addDefaults(catname, withform) ==
-  withform isnt ['With, joins, ['Sequence,: oplist]] =>
-     error "bad category body"
-  null(defaults := getDefaultingOps catname) => withform
-  defaultdefs := [makeDefaultDef(decl) for decl in defaults]
-  ['With, joins,
-     ['Sequence, :oplist, ['Default, ['Sequence,: defaultdefs]]]]
-
-makeDefaultDef(decl) ==
-  decl isnt ['Declare, op, type] =>
-       error "bad default definition"
-  $defaultFlag := true
-  type is ['Apply, "->", args, result] =>
-       ['Define, decl, ['Lambda, makeDefaultArgs args, result,
-                    ['Label, op, 'dummyDefault]]]
-  ['Define, ['Declare, op, type], 'dummyDefault]
-
-makeDefaultArgs args ==
-  args isnt ['Comma,:argl] => error "bad default argument list"
-  ['Comma,: [['Declare,v,t] for v in $TriangleVariableList for t in argl]]
-
-getDefaultingOps catname ==
-  not(name:=hasDefaultPackage catname) => nil
-  $infovec: local := getInfovec name
-  opTable := $infovec.1
-  $opList:local  := nil
-  for i in 0..maxIndex opTable repeat
-    op := opTable.i
-    i := i + 1
-    startIndex := opTable.i
-    stopIndex :=
-      i + 1 > maxIndex opTable => maxIndex getCodeVector()
-      opTable.(i + 2)
-    curIndex := startIndex
-    while curIndex < stopIndex repeat
-      curIndex := get1defaultOp(op,curIndex)
-  $pretendFlag : local := true
-  catops := getConstructorOperationsFromDB catname
-  [axFormatDefaultOpSig(op,sig,catops) for opsig in $opList | opsig is [op,sig]]
-
-axFormatDefaultOpSig(op, sig, catops) ==
-  #sig > 1 => axFormatOpSig(op,sig)
-  nsig := MSUBST('$,'($), sig) -- dcSig listifies '$ ??
-  (catsigs := LASSOC(op, catops)) and
-    (catsig := assoc(nsig, catsigs)) and last(catsig) is 'CONST =>
-       axFormatConstantOp(op, sig)
-  axFormatOpSig(op,sig)
-
-get1defaultOp(op,index) ==
-  numvec := getCodeVector()
-  segment := getOpSegment index
-  numOfArgs := numvec.index
-  index := index + 1
-  predNumber := numvec.index
-  index := index + 1
-  signumList :=
- -- following substitution fixes the problem that default packages
- -- have $ added as a first arg, thus other arg counts are off by 1.
-    applySubst(pairList(rest $FormalMapVariableList,$FormalMapVariableList), 
-             dcSig(numvec,index,numOfArgs))
-  index := index + numOfArgs + 1
-  slotNumber := numvec.index
-  if not listMember?([op,signumList],$opList) then
-     $opList := [[op,signumList],:$opList]
-  index + 1
-
-axAddLiteral(name, type, dom) == 
-  elt := [name, type, dom]
-  if not member( elt, $literals) then
-     $literals := [elt, :$literals]
-
-axDoLiterals() == 
-  [ [ 'Import,
-          [ 'With, [], 
-            ['Declare, name, [ 'Apply, '_-_> , dom , '_% ]]],
-                 type ] for [name, type, dom] in $literals]
-
diff --git a/src/interp/axext_l.lisp b/src/interp/axext_l.lisp
deleted file mode 100644
index ad3d5088..00000000
--- a/src/interp/axext_l.lisp
+++ /dev/null
@@ -1,208 +0,0 @@
-;; Copyright (C) 1991-2002, The Numerical Algorithms Group Ltd.
-;; All rights reserved.
-;; Copyright (C) 2007-2008, Gabriel Dos Reis.
-;; 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.
-
-
-;; File containing primitives needed by exextend in order to interop with axiom
-;; This file could do with some declares
-
-(import-module "foam_l")
-(in-package "FOAM-USER")
-
-;; Literals should be null-terminated strings
-
-;; SingleInteger
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (progn
-
-(defmacro |AXL-LiteralToSingleInteger| (l)
-  `(parse-integer ,l :junk-allowed t))
-
-(defmacro |AXL-LiteralToInteger| (l)
-  `(parse-integer ,l :junk-allowed t))
-
-(defmacro |AXL-LiteralToDoubleFloat| (l)
-  `(read-from-string ,l nil (|DFlo0|)
-                     :preserve-whitespace t))
-
-(defmacro |AXL-LiteralToString| (l)
-  `(subseq ,l 0 (- (length ,l) 1)))
-
-(defmacro |AXL-SingleIntegerToInteger| (si)
-  `(coerce (the |SInt| ,si) |BInt|))
-
-(defmacro |AXL-StringToFloat| (s)
-  `(boot::|string2Float| ,s))
-
-(defmacro |AXL-IntegerIsNonNegative| (i)
-  `(not (< ,i 0)))
-
-(defmacro |AXL-IntegerIsPositive| (i)
-  `(< 0 (the |BInt| ,i)))
-
-(defmacro |AXL-plusInteger| (a b)
-  `(the |BInt| (+ (the |BInt| ,a)
-                  (the |BInt| ,b))))
-
-(defmacro |AXL-minusInteger| (a b)
-  `(the |BInt| (- (the |BInt| ,a)
-                  (the |BInt| ,b))))
-
-(defmacro |AXL-timesInteger| (a b)
-  `(the |BInt| (* (the |BInt| ,a)
-                  (the |BInt| ,b))))
-
-(defmacro |AXL-eqInteger| (a b)
-  `(= (the |BInt| ,a)
-      (the |BInt| ,b)))
-
-(defmacro |AXL-ltInteger| (a b)
-  `(< (the |BInt| ,a)
-      (the |BInt| ,b)))
-
-(defmacro |AXL-leInteger| (a b)
-  `(<= (the |BInt| ,a)
-       (the |BInt| ,b)))
-
-(defmacro |AXL-gtInteger| (a b)
-  `(> (the |BInt| ,a)
-      (the |BInt| ,b)))
-
-(defmacro |AXL-geInteger| (a b)
-  `(>= (the |BInt| ,a)
-       (the |BInt| ,b)))
-
-(defmacro |AXL-plusSingleInteger| (a b)
-  `(the |SInt| (+ (the |SInt| ,a)
-                  (the |SInt| ,b))))
-
-(defmacro |AXL-minusSingleInteger| (a b)
-  `(the |SInt| (- (the |SInt| ,a)
-                  (the |SInt| ,b))))
-
-(defmacro |AXL-timesSingleInteger| (a b)
-  `(the |SInt| (* (the |SInt| ,a)
-                  (the |SInt| ,b))))
-
-(defmacro |AXL-eqSingleInteger| (a b)
-  `(= (the |SInt| ,a)
-      (the |SInt| ,b)))
-
-(defmacro |AXL-ltSingleInteger| (a b)
-  `(< (the |SInt| ,a)
-      (the |SInt| ,b)))
-
-(defmacro |AXL-leSingleInteger| (a b)
-  `(<= (the |SInt| ,a)
-       (the |SInt| ,b)))
-
-(defmacro |AXL-gtSingleInteger| (a b)
-  `(> (the |SInt| ,a)
-      (the |SInt| ,b)))
-
-(defmacro |AXL-geSingleInteger| (a b)
-  `(>= (the |SInt| ,a)
-       (the |SInt| ,b)))
-
-(defmacro |AXL-incSingleInteger| (i)
-  `(the |SInt| (+ (the |SInt| ,i) 1)))
-
-(defmacro |AXL-decSingleInteger| (i)
-  `(- (the |SInt| ,i)
-     (the |SInt| 1)))
-
-(defmacro |AXL-onefnSingleInteger|  () '(the |SInt| 1))
-(defmacro |AXL-zerofnSingleInteger| () '(the |SInt| 0))
-
-(defmacro |AXL-cons| (x y)
-  `(cons ,x ,y))
-
-(defmacro |AXL-nilfn| () nil)
-
-(defmacro |AXL-car| (x) `(car ,x))
-
-(defmacro |AXL-cdr| (x) `(cdr ,x))
-
-(defmacro |AXL-null?| (x) `(null ,x))
-
-(defmacro |AXL-rplaca| (x y) `(rplaca ,x ,y))
-
-(defmacro |AXL-rplacd| (x y) `(rplacd ,x ,y))
-
-(defmacro |AXL-error| (msg) `(error ,msg))
-  
-;; arrays
-;; 0 based!
-(defmacro |AXL-arrayRef| (arr i)
-  `(|AElt| ,arr ,i))
-
-(defmacro |AXL-arraySet| (arr i v)
-  `(setf (|AElt| ,arr ,i) ,v))
-
-(defmacro |AXL-arrayToList| (x)
-  `(coerce ,x 'list))
-
-(defmacro |AXL-arraySize| (x)
-  `(length ,x))
-
-(defmacro |AXL-arrayNew| (n)
-  `(make-array ,n))
-
-(defmacro |AXL-arrayCopy| (x)
-  `(copy-seq ,x))
-
-;; Vectors
-
-;; tacky but means we can run programs
-
-(defun H-integer (l e)
-  (|AXL-LiteralToInteger| l))
-        
-(defun  H-string (l e)
-  (|AXL-LiteralToString| l))
-
-(defun  H-error (l e)
-  (|AXL-error| l))
-
-))
-
-(eval-when (load eval)
-           (defconstant |G-axclique_string_305639517| (cons #'H-String nil))
-           (defconstant |G-axclique_integer_685864888| (cons #'H-integer nil))
-           (defconstant |G-axclique_error_011667951| (cons #'H-error nil)))
-
-;; Testing
-
-(defun |AXL-spitSInt| (x)
-  (print x))
-
diff --git a/src/interp/daase.lisp b/src/interp/daase.lisp
index 1a86d669..ad849541 100644
--- a/src/interp/daase.lisp
+++ b/src/interp/daase.lisp
@@ -1,6 +1,6 @@
 ;; Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
 ;; All rights reserved.
-;; Copyright (C) 2007-2010, Gabriel Dos Reis.
+;; Copyright (C) 2007-2011, Gabriel Dos Reis.
 ;; All rights reserved.
 ;;
 ;; Redistribution and use in source and binary forms, with or without
@@ -110,7 +110,7 @@
 
 
 ; This file contains the code to build, open and access the .DAASE
-; files this file contains the code to )library NRLIBS and asy files
+; files this file contains the code to )library NRLIBS
 
 ; There is a major issue about the data that resides in these
 ; databases.  the fundamental problem is that the system requires more
@@ -202,7 +202,6 @@
 
 (import-module "macros")
 (in-package "AxiomCore")
-(import-module "foam_l")
 (in-package "BOOT")
 
 (defstruct database
@@ -324,18 +323,8 @@
 (defvar *allOperations* nil
   "a list of all the operations in the system")
 
-(defvar *asharpflags*
-  "-O -laxiom -Fasy -Flsp" "library compiler flags")
-
 (defvar |$ConstructorCache| nil)
 
-(defun asharp (file &optional (flags *asharpflags*))
- "call the asharp compiler"
- (|runProgram|
-   (concatenate 'string (|systemRootDirectory|) "/compiler/bin/axiomxl")
-    (list flags file)))
-
-
 (defun |closeAllDatabaseStreams| nil
   (close *interp-stream*)
   (close *operation-stream*)
@@ -826,10 +815,6 @@
 	     (setq stream *interp-stream*)
 	     (when (setq struct (get constructor 'database))
 	       (setq data (database-object struct))))
-	    (asharp?
-	     (setq stream *interp-stream*)
-	     (when (setq struct (get constructor 'database))
-	       (setq data (database-object struct))))
 	    (niladic
 	     (setq stream *interp-stream*)
 	     (when (setq struct (get constructor 'database))
@@ -946,10 +931,6 @@
 		     (concatenate 'string 
 				  (|systemRootDirectory|)
 				  "src/algebra/" data))))
-	    (asharp?			; is this asharp code?
-	     (if (consp data)
-		 (setq data (cdr data))
-	       (setq data nil)))
 	    (object		       ; fix up system object pathname
 	     (if (consp data)
 		 (setq data
@@ -973,8 +954,6 @@
   
 ; localdatabase tries to find files in the order of:
 ;  NRLIB/index.KAF
-;  .asy
-;  .ao, then asharp to .asy
 
 (defun localdatabase (filelist options &optional (make-database? nil))
   "read a local filename and update the hash tables"
@@ -1000,13 +979,11 @@
 		      (aldorFiles (|getAllAldorObjectFiles| dirarg)))
 		  (values
 		   indexFiles
-		   (first aldorFiles)
-		   (second aldorFiles)
 		   ;; At the moment we will only look for user.lib: others 
-		   ;; are taken care of by localasy and localnrlib.
+		   ;; are taken care of by localnrlib.
 		   nil
 		   ))))
-   (let (thisdir nrlibs asos asys libs object only dir key 
+   (let (thisdir nrlibs libs object only dir key 
 		 (|$forceDatabaseUpdate| t) noexpose)
      (declare (special |$forceDatabaseUpdate|))
      (setq thisdir (get-current-directory))
@@ -1016,7 +993,7 @@
      (if make-database? 
 	 (setq noexpose t))
      (if dir 
-       (multiple-value-setq (nrlibs asys asos libs)
+       (multiple-value-setq (nrlibs libs)
           (processDir (|ensureTrailingSlash| (string dir)))))
      (dolist (file filelist)
        (let ((filename (pathname-name file))
@@ -1031,18 +1008,6 @@
 				    ".NRLIB/"
 				    |$IndexFilename|)))
 	   (push (namestring file) nrlibs))
-	  ((setq file (probe-file
-		       (concatenate 'string 
-				    namedir 
-				    filename
-				    ".asy")))
-	   (push (namestring file) asys))
-	  ((setq file (probe-file
-		       (concatenate 'string 
-				    namedir 
-				    filename
-				    ".ao")))
-	   (push (namestring file) asos))
 	  ('else (format t "   )library cannot find the file ~a.~%" filename)))))
      (dolist (file (|reverse!| nrlibs))
        (setq key (pathname-name (first (last (pathname-directory file)))))
@@ -1050,108 +1015,9 @@
 				 (directory-namestring file) 
 				 "code." |$faslType|))
        (localnrlib key file object make-database? noexpose))
-     (dolist (file (|reverse!| asys))
-       (setq object
-	     (concatenate 'string 
-			  (directory-namestring file)
-			  (pathname-name file)))
-       (localasy (|astran| file) object only make-database? noexpose))
-     (dolist (file (|reverse!| asos))
-       (setq object
-	     (concatenate 'string 
-			  (directory-namestring file)
-			  (pathname-name file)))
-       (asharp file)
-       (setq file (|astran| (concatenate 'string 
-					 (pathname-name file) 
-					 ".asy")))
-       (localasy file object only make-database? noexpose))
      (HCLEAR |$ConstructorCache|))))
 
 
-(defun localasy (asy object only make-database? noexpose)
-  "given an alist from the asyfile and the objectfile update the database"
-  (labels (
-	   (fetchdata (alist index)
-		      (cdr (assoc index alist :test #'string=))))
-	  (let (cname kind key alist (systemdir? nil) 
-		      oldmaps asharp-name dbstruct abbrev)
-   (set-file-getter object)  ; sets the autoload property for G-object
-   (dolist (domain asy)
-     (setq key (first domain))
-     (setq alist (rest domain))
-     (setq asharp-name
-           (foam::axiomxl-global-name (pathname-name object) key
-                                     (lassoc '|typeCode| alist)))
-     (if (< (length alist) 4) ;we have a naked function object
-         (let ((opname key)
-               (modemap (car (LASSOC '|modemaps| alist))) )
-           (setq oldmaps (|getOperationFromDB| opname))
-           (setf (gethash opname *operation-hash*)
-                 (adjoin (subst asharp-name opname (cdr modemap))
-                         oldmaps :test #'equal))
-           (asharpMkAutoloadFunction object asharp-name))
-       (when (if (null only) (not (eq key '%%)) (member key only))
-	 (setq *allOperations* nil)        ; force this to recompute
-	 (setq oldmaps (|getOperationModemapsFromDB| key))
-	 (setq dbstruct (make-database))
-	 (setf (get key 'database) dbstruct)
-	 (setq *allconstructors* (adjoin key *allconstructors*))
-	 (setf (database-constructorform dbstruct)
-	       (fetchdata alist "constructorForm"))
-	 (setf (database-constructorkind dbstruct)
-	       (fetchdata alist "constructorKind"))
-	 (setf (database-constructormodemap dbstruct)
-	       (fetchdata alist "constructorModemap"))
-	 (unless (setf (database-abbreviation dbstruct)
-		       (fetchdata alist "abbreviation"))
-	   (setf (database-abbreviation dbstruct) key)) ; default
-	 (setq abbrev (database-abbreviation dbstruct))
-	 (setf (get abbrev 'abbreviationfor) key)
-	 (setf (database-constructorcategory dbstruct)
-	       (fetchdata alist "constructorCategory"))
-	 (setf (database-attributes dbstruct)
-	       (fetchdata alist "attributes"))
-	 (setf (database-sourcefile dbstruct)
-	       (fetchdata alist "sourceFile"))
-	 (setf (database-operationalist dbstruct)
-	       (fetchdata alist "operationAlist"))
-	 (setf (database-modemaps dbstruct)
-	       (fetchdata alist "modemaps"))
-	 (setf (database-documentation dbstruct)
-	       (fetchdata alist "documentation"))
-	 (setf (database-predicates dbstruct)
-	       (fetchdata alist "predicates"))
-	 (setf (database-niladic dbstruct)
-	       (fetchdata alist "NILADIC"))
-	 (addoperations key oldmaps)
-	 (setq cname  (|opOf| (database-constructorform dbstruct)))
-	 (setq kind (database-constructorkind dbstruct))
-	 (if (null noexpose) (|setExposeAddConstr| (cons cname nil)))
-	 (unless make-database?
-	   (|updateDatabase| key cname systemdir?) ;makes many hashtables???
-	   (|installConstructor| cname kind)
-	   ;; following can break category database build
-	   (if (eq kind '|category|)
-	       (setf (database-ancestors dbstruct)
-		     (fetchdata alist "ancestors")))
-	   (if (eq kind '|domain|)
-	       (dolist (pair (cdr (assoc "ancestors" alist :test #'string=)))
-		 (setf (gethash (cons cname (caar pair)) *hascategory-hash*)
-		       (cdr pair))))
-	   (if |$InteractiveMode| 
-	       (setq |$CategoryFrame| |$EmptyEnvironment|)))
-	 (setf (database-cosig dbstruct)
-	       (cons nil (mapcar #'|categoryForm?|
-				 (cddar (database-constructormodemap dbstruct)))))
-	 (setf (database-object dbstruct) (cons object asharp-name))
-	 (if (eq kind '|category|)
-	     (asharpMkAutoLoadCategory object cname asharp-name
-				       (database-cosig dbstruct))
-	   (asharpMkAutoLoadFunctor object cname asharp-name
-				    (database-cosig dbstruct)))
-	 (|sayKeyedMsg| 'S2IU0001 (list cname object))))))))
-
 (defun localnrlib (key nrlib object make-database? noexpose)
   "given a string pathname of an index.KAF and the object update the database"
   (labels 
@@ -1339,7 +1205,6 @@
                                         ; does gethash calls into it rather than doing a getdatabase call.
   (write-interpdb)
 #+:AKCL  (write-warmdata)
-  (create-initializers)
   (when (probe-file (final-name "compress"))
         (delete-file (final-name "compress")))
   (rename-file "compress.build" (final-name "compress"))
@@ -1609,202 +1474,3 @@
     (maphash #'(lambda (k v) (declare (ignore v)) (push k *allOperations*))
 	     *operation-hash*))
   *allOperations*)
-
-; the variable NOPfuncall is a funcall-able object that is a dummy
-; initializer for libaxiom asharp domains.
-(defvar NOPfuncall (cons 'identity nil))
-
-(defun create-initializers ()
-;; since libaxiom is now built with -name=axiom following unnecessary
-;; (dolist (con (|allConstructors|))
-;;   (let ((sourcefile (|getConstructorSourceFileFromDB| con)))
-;;     (if sourcefile
-;;       (set (foam::axiomxl-file-init-name (pathname-name sourcefile))
-;;             NOPfuncall))))
- (setf (symbol-value (foam::axiomxl-file-init-name "axiom")) NOPfuncall)
-;; (set (foam::axiomxl-file-init-name "axclique") NOPfuncall)
- (setf (symbol-value (foam::axiomxl-file-init-name "filecliq")) NOPfuncall)
- (setf (symbol-value (foam::axiomxl-file-init-name "attrib")) NOPfuncall)
-;; following needs to happen inside restart since $AXIOM may change
- (let ((asharprootlib (strconc (|systemRootDirectory|) "/aldor/lib/")))
-   (set-file-getter (strconc asharprootlib "runtime"))
-   (set-file-getter (strconc asharprootlib "lang"))
-   (set-file-getter (strconc asharprootlib "attrib"))
-   (set-file-getter (strconc asharprootlib "axlit"))
-   (set-file-getter (strconc asharprootlib "minimach"))
-   (set-file-getter (strconc asharprootlib "axextend"))))
-
-
-
-;---------------------------------------------------------------------
-
-; how the magic works:
-;  when a )library is done on a new compiler file we set up multiple
-;  functions (refered to as autoloaders). there is an autoloader
-;  stored in the symbol-function of the G-filename (e.g. G-basic)
-;  (see set-file-getter function)
-;  and an autoloader stored in the symbol-function of every domain
-;  in the basic.as file ( asharpMkAutoloadFunctor )
-; When a domain is needed the autoloader for the domain is executed.
-;  this autoloader invokes file-getter-name to get the name of the
-;  file (eg basic) and evaluates the name. the FIRST time this is done
-;  for a file the file will be loaded by its autoloader, then it will
-;  return the file object. every other time the file is already
-;  loaded and the file object is returned directly.
-; Once the file object is gotten getconstructor is called to get the
-;  domain. the FIRST time this is done for the domain the autoloader
-;  invokes the file object. every other time the domain already
-;  exists.
-;(defvar *this-file* "no-file")
-
-(defmacro |CCall| (fun &rest args)
-  (let ((ccc (gensym)) (cfun (gensym)) (cenv (gensym)))
-    `(let ((,ccc ,fun))
-       (let ((,cfun (|ClosFun| ,ccc))
-             (,cenv (|ClosEnv| ,ccc)))
-         (funcall ,cfun ,@args ,cenv )))))
-
-(defmacro |ClosFun| (x) `(car ,x))
-(defmacro |ClosEnv| (x) `(cdr ,x))
-
-(defun file-runner (name)
- (declare (special foam-user::|G-domainPrepare!|))
-  (|CCall| foam-user::|G-domainPrepare!| (|CCall| name)))
-
-(defun getConstructor (file-fn asharp-name)
- (|CCall| file-fn)
-; (eval (cdr (assoc file-id (get name 'asharp-name) :test #'equal))))
- (eval asharp-name))
-
-(defun getop (dom op type)
- (declare (special foam-user::|G-domainGetExport!|))
-  (|CCall| foam-user::|G-domainGetExport!| dom
-      (|hashString| (symbol-name op)) type))
-
-; the asharp compiler will allow both constant domains and domains
-; which are functions. localasy sets the autoload property so that
-; the symbol-function contains a function that, when invoked with
-; the correct number of args will return a domain.
-
-; this function is called if we are given a new compiler domain
-; which is a function. the symbol-function of the domain is set
-; to call the function with the correct number of arguments.
-
-(defun wrapDomArgs (obj type?)
-  (cond ((not type?) obj)
-        (t (|makeOldAxiomDispatchDomain| obj))))
-
-(defun asharpMkAutoLoadFunctor (file cname asharp-name cosig)
-  (setf (symbol-function cname)
-  #'(lambda (&rest args)
-     (let ((func (getconstructor (eval (file-getter-name file)) asharp-name)))
-      (setf (symbol-function cname)
-       (if (vectorp (car func))
-        #'(lambda () func) ;; constant domain
-        #'(lambda (&rest args)
-            (apply (|ClosFun| func)
-                   (|append!|
-                    (mapcar #'wrapDomArgs args (cdr cosig))
-                    (list (|ClosEnv| func)))))))
-      (apply cname args)))))
-
-(defun asharpMkAutoLoadCategory (file cname asharp-name cosig)
-  (asharpMkAutoLoadFunctor file cname asharp-name cosig)
-  (let ((packname (INTERN (STRCONC cname '"&"))))
-    (setf (symbol-function packname)
-  #'(lambda (self &rest args)
-     (let ((func (getconstructor (eval (file-getter-name file)) asharp-name)))
-      (setf (symbol-function packname)
-       (if (vectorp (car func))
-        #'(lambda (self)
-            (|CCall| (elt (car func) 5) (cdr func) (wrapDomArgs self t))) ;; constant category
-        #'(lambda (self &rest args)
-            (let ((precat
-                   (apply (|ClosFun| func)
-                          (|append!|
-                           (mapcar #'wrapDomArgs args (cdr cosig))
-                           (list (|ClosEnv| func))))))
-              (|CCall| (elt (car precat) 5) (cdr precat) (wrapDomArgs self t))))))
-      (apply packname self args))))))
-
-(defun asharpMkAutoLoadFunction (file asharpname)
-  (setf (symbol-value asharpname)
-   (cons
-    #'(lambda (&rest l)
-        (let ((args (butlast l))
-              (func (getconstructor (eval (file-getter-name file)) asharpname)))
-          (apply (car func) (append args (list (cdr func))))))
-        ())))
-
-; this function will return the internal name of the file object getter
-
-(defun file-getter-name (filename)
-   (foam::axiomxl-file-init-name (pathname-name filename)))
-
-;;need to initialize |G-filename| to a function which loads file
-;; and then returns the new value of |G-filename|
-
-(defun set-file-getter (filename)
-  (let ((getter-name (file-getter-name filename)))
-    (setf (symbol-value getter-name)
-         (cons #'init-file-getter  (cons getter-name filename)))))
-
-(defun init-file-getter (env)
-  (let ((getter-name (car env))
-        (filename (cdr env)))
-    (load filename)
-    (|CCall| (eval getter-name))))
-
-(defun set-lib-file-getter (filename cname)
-  (let ((getter-name (file-getter-name filename)))
-    (setf (symbol-value getter-name)
-         (cons #'init-lib-file-getter  (cons getter-name cname)))))
-
-(defun init-lib-file-getter (env)
-  (let* ((getter-name (car env))
-         (cname (cdr env))
-         (filename (|getConstructorModuleFromDB| cname)))
-    (load filename)
-    (|CCall| (eval getter-name))))
-
-;; following 2 functions are called by file-exports and file-imports macros
-(defun foam::process-import-entry (entry)
-  (let* ((asharpname (car entry))
-         (stringname (cadr entry))
-         (hcode (caddr entry))
-         (libname (cadddr entry))
-         (bootname (intern stringname 'boot)))
-    (declare (ignore libname))
-    (if (and (eq hcode 'foam-user::|initializer|) (not (boundp asharpname)))
-        (error (format nil "AxiomXL file ~s is missing!" stringname)))
-    (unless (or (not (numberp hcode)) (zerop hcode) (boundp asharpname))
-          (when (|constructor?| bootname)
-                (setf (symbol-value asharpname)
-                     (if (|niladicConstructorFromDB| bootname)
-                         (|makeLazyOldAxiomDispatchDomain| (list bootname))
-                       (cons '|runOldAxiomFunctor|  bootname))))
-          (when (|attribute?| bootname)
-                (setf (symbol-value asharpname)
-		      (|makeLazyOldAxiomDispatchDomain| bootname))))))
-          
-                 
-
-;(defun foam::process-export-entry (entry)
-;  (let* ((asharpname (car entry))
-;        (stringname (cadr entry))
-;        (hcode (caddr entry))
-;        (libname (cadddr entry))
-;        (bootname (intern stringname 'boot)))
-;    (declare (ignore libname))
-;    (when (numberp hcode)
-;         (setf (get bootname 'asharp-name)
-;               (cons (cons *this-file* asharpname)
-;                     (get bootname 'asharp-name)))
-;         )))
-
-
-
-
-
-
-
diff --git a/src/interp/foam_l.lisp b/src/interp/foam_l.lisp
deleted file mode 100644
index d2ca464c..00000000
--- a/src/interp/foam_l.lisp
+++ /dev/null
@@ -1,842 +0,0 @@
-;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
-;; All rights reserved.
-;; Copyright (C) 2007-2011, Gabriel Dos Reis.
-;; 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.
-
-
-;;
-;; FOAM is the intermediate language for the aldor compiler. FOAM
-;; means "first order abstract machine" and functions similar to
-;; RTL for the GCC compiler. It is a "machine" that is used as the
-;; target for meta-assembler level statments. These are eventually
-;; expanded for the real target machine (or interpreted directly)
-;;
-
-;;;
-;;; FOAM Operations for Common Lisp
-;;;
-
-;;
-;; Client files should begin with
-;;   (in-package "FOAM-USER" :use '("FOAM" "LISP"))
-;;
-;;
-;; To Do:
-;;    Test cases.
-;;    Scan and format functions need to be rewritten to handle complete syntax.
-;;    Deftypes for each Foam type?
-;;
-
-#+:common-lisp (in-package "COMMON-LISP-USER")
-#-:common-lisp (in-package "USER")
-
-(defpackage "FOAM"
-  #+:common-lisp (:use "COMMON-LISP")
-  #-:common-lisp (:use "LISP"))
-
-
-;; FOAM-USER is the package containing foam statements and macros
-;; that get inserted into user code versus the foam package which
-;; provides support for compiler code.
-
-(defpackage "FOAM-USER"
-  #+:common-lisp (:use "COMMON-LISP")
-  #-:common-lisp (:use "LISP")
-  (:use "FOAM"))
-
-#+:gcl (in-package "BOOT")
-(in-package "AxiomCore")
-(import-module "vmlisp")
-(import-module "sys-constants")
-
-(in-package "FOAM")
-
-(export '(
- compile-as-file cases
-
- |Clos| |Char| |Bool| |Byte| |HInt| |SInt| |BInt| |DFlo| |Ptr| 
- |Word| |Arb| |Env| |Level| |Arr| |Record| |Nil|
-
- |ClosInit| |CharInit| |BoolInit| |ByteInit| |HIntInit| |SIntInit| 
- |BIntInit| |DFloInit| |PtrInit| |WordInit| |ArbInit| |EnvInit|
- |ArrInit| |RecordInit| |LevelInit| 
-
- |BoolFalse| |BoolTrue| |BoolNot| |BoolAnd| |BoolOr| |BoolEQ| |BoolNE|
-
- |CharSpace| |CharNewline| |CharMin| |CharMax| |CharIsDigit|
- |CharIsLetter| |CharEQ| |CharNE| |CharLT| |CharLE|
- |CharLower| |CharUpper| |CharOrd| |CharNum| |CharCode0|
-
- |DFlo0| |DFlo1| |DFloMin| |DFloMax| |DFloEpsilon|
- |DFloIsZero| |DFloIsNeg| |DFloIsPos| |DFloEQ| |DFloNE|
- |DFloLT| |DFloLE| |DFloNegate| |DFloPrev| |DFloNext|
- |DFloPlus| |DFloMinus| |DFloTimes| |DFloTimesPlus|
- |DFloDivide| |DFloRPlus| |DFloRMinus| |DFloRTimes|
- |DFloRTimesPlus| |DFloRDivide| |DFloDissemble|
- |DFloAssemble| |Byte0| |Byte1| |ByteMin| |ByteMax|
-
- |HInt0| |HInt1| |HIntMin| |HIntMax|
-
- |SInt0| |SInt1| |SIntMin| |SIntMax| |SIntIsZero| |SIntIsNeg|
- |SIntIsPos| |SIntIsEven| |SIntIsOdd| |SIntEQ| |SIntNE|
- |SIntLT| |SIntLE| |SIntNegate| |SIntPrev| |SIntNext|
- |SIntPlus| |SIntMinus| |SIntTimes| |SIntTimesPlus|
- |SIntMod| |SIntQuo| |SIntRem| |SIntDivide| |SIntGcd|
- |SIntPlusMod| |SIntMinusMod| |SIntTimesMod|
- |SIntTimesModInv| |SIntLength| |SIntShiftUp|
- |SIntShiftDn| |SIntBit| |SIntNot| |SIntAnd| |SIntOr|
-
- |WordTimesDouble| |WordDivideDouble| |WordPlusStep| |WordTimesStep|
-
- |BInt0| |BInt1| |BIntIsZero| |BIntIsNeg| |BIntIsPos| |BIntIsEven|
- |BIntIsOdd| |BIntIsSingle| |BIntEQ| |BIntNE| |BIntLT|
- |BIntLE| |BIntNegate| |BIntPrev| |BIntNext| |BIntPlus|
- |BIntMinus| |BIntTimes| |BIntTimesPlus| |BIntMod|
- |BIntQuo| |BIntRem| |BIntDivide| |BIntGcd|
- |BIntSIPower| |BIntBIPower| |BIntLength| |BIntShiftUp|
- |BIntShiftDn| |BIntBit|
-
- |PtrNil| |PtrIsNil| |PtrMagicEQ| |PtrEQ| |PtrNE|
-
- |FormatDFlo| |FormatSInt| |FormatBInt|
- |fgetss| |fputss|
-
- |ScanDFlo| |ScanSInt| |ScanBInt|
-
- |ByteToSInt| |SIntToByte| |HIntToSInt|
- |SIntToHInt| |SIntToBInt| |BIntToSInt|
- |SIntToDFlo| |BIntToDFlo| |PtrToSInt|
- |SIntToPtr| |BoolToSInt|
-
- |ArrToDFlo| |ArrToSInt| |ArrToBInt|
-
- |PlatformRTE| |PlatformOS| |Halt|
-
- |Clos| |CCall| |ClosEnv| |ClosFun| |SetClosEnv| |SetClosFun|
- |DDecl| |RNew| |ANew| |RElt| |EElt| |AElt| |Lex|
- |SetLex| |SetRElt| |SetAElt| |SetEElt|
- |FoamFree|
-
- declare-prog declare-type
- defprog ignore-var block-return
- defspecials file-exports file-imports
- typed-let foamfn |FoamProg| |alloc-prog-info|
-
- |MakeEnv| |EnvLevel| |EnvNext| |EnvInfo| |SetEnvInfo| |FoamEnvEnsure|
- |MakeLit| |MakeLevel|
- |printNewLine| |printChar| |printString| |printSInt| |printBInt|
- |printDFloat| 
- |strLength| |formatSInt| |formatBInt| |formatDFloat|
- 
- |ProgHashCode| |SetProgHashCode| |ProgFun|
- |G-mainArgc| |G-mainArgv|
- |stdinFile| |stdoutFile| |stderrFile|
- |fputc| |fputs| |foamfun|
-
-
- ;; trancendental functions
- |sqrt| |pow| |log| |exp| |sin| |cos| |tan| |sinh| |cosh| |tanh| 
- |asin| |acos| |atan| |atan2|
-
- ;; debuging
- |fiSetDebugVar| |fiGetDebugVar| |fiSetDebugger| |fiGetDebugger|
- ;; Blatent hacks..
- |G-stdoutVar| |G-stdinVar| |G-stderrVar|
- |fiStrHash|
-
- axiomxl-file-init-name
- axiomxl-global-name
-))
-
-
-;; type defs for Foam types
-(deftype |Char| () 'BOOT::|%Char|)
-(deftype |Clos| () 'list)
-(deftype |Bool| () '(member t nil))
-(deftype |Byte| () 'BOOT::|%Byte|)
-(deftype |HInt| () '(integer #.(- (expt 2 15)) #.(1- (expt 2 15))))
-(deftype |SInt| () 'BOOT::|%Short|)
-
-(deftype |BInt| () 'BOOT::|%Integer|)
-
-(deftype |DFlo| () 'BOOT::|%DoubleFloat|)
-
-(deftype |Level| () t) ;; structure??
-
-(deftype |Nil|  () t)
-(deftype |Ptr|  () t)
-(deftype |Word| () t)
-(deftype |Arr|  () t)
-(deftype |Record| () t)
-(deftype |Arb|  () t)
-(deftype |Env|  () t)  ; (or cons nil)
-
-;; default values for types.  Used as initializers in lets.
-(defconstant |CharInit| (the |Char| '#\Space))
-(defconstant |ClosInit| (the |Clos| nil))
-(defconstant |BoolInit| (the |Bool| nil))
-(defconstant |ByteInit| (the |Byte| 0))
-(defconstant |HIntInit| (the |HInt| 0))
-(defconstant |SIntInit| (the |SInt| 0))
-(defconstant |BIntInit| (the |BInt|  0))
-(defconstant |DFloInit| (coerce 0 '|DFlo|))
-(defconstant |PtrInit|  (the |Ptr|  nil))
-(defconstant |ArrInit|  (the |Arr|  nil))
-(defconstant |RecordInit|  (the |Record|  nil))
-(defconstant |WordInit| (the |Word| nil))
-(defconstant |ArbInit|  (the |Arb|  nil))
-(defconstant |EnvInit|  (the |Env|  nil))
-(defconstant |LevelInit|  (the |Level|  nil))
-
-;; Bool values are assumed to be either 'T or NIL.
-;; Thus non-nil values are canonically represented.
-(defmacro |BoolFalse|     () NIL)
-(defmacro |BoolTrue|      () 'T)
-(defmacro |BoolNot|      (x) `(NOT ,x))
-(defmacro |BoolAnd|    (x y)
-  `(let ((xx ,x) (yy ,y)) (AND xx yy))) ;; force evaluation of both args
-(defmacro |BoolOr|     (x y)
-  `(let ((xx ,x) (yy ,y)) (OR  xx yy))) ;; force evaluation of both args
-(defmacro |BoolEQ|     (x y) `(EQ ,x ,y))
-(defmacro |BoolNE|     (x y) `(NOT (|BoolEQ| ,x ,y)))
-
-(defconstant |CharCode0| (code-char 0))
-
-(defmacro |CharSpace|    () '#\Space)
-(defmacro |CharNewline|  () '#\Newline)
-(defmacro |CharMin|      ()  |CharCode0|)
-(defmacro |CharMax|      ()  #.(code-char (1- char-code-limit)))
-(defmacro |CharIsDigit| (x) `(if (DIGIT-CHAR-P (the |Char| ,x)) 't nil))
-(defmacro |CharIsLetter|(x) `(ALPHA-CHAR-P (the |Char| ,x)))
-(defmacro |CharLT|    (x y) `(CHAR< (the |Char| ,x) (the |Char| ,y)))
-(defmacro |CharLE|    (x y) `(CHAR<= (the |Char| ,x) (the |Char| ,y)))
-(defmacro |CharEQ|    (x y) `(CHAR= (the |Char| ,x) (the |Char| ,y)))
-(defmacro |CharNE|    (x y) `(CHAR/= (the |Char| ,x) (the |Char| ,y)))
-(defmacro |CharLower|   (x) `(the |Char| (CHAR-DOWNCASE (the |Char| ,x))))
-(defmacro |CharUpper|   (x) `(the |Char| (CHAR-UPCASE (the |Char| ,x))))
-(defmacro |CharOrd|     (x) `(CHAR-INT (the |Char| ,x)))
-(defmacro |CharNum|     (x) `(INT-CHAR (the |SInt| ,x)))
-
-(defmacro |DFlo0|         () (coerce 0 '|DFlo|))
-(defmacro |DFlo1|         () (coerce 1 '|DFlo|))
-(defmacro |DFloMin|       () BOOT::|$DoubleFloatMinimum|)
-(defmacro |DFloMax|       () BOOT::|$DoubleFloatMaximum|)
-(defmacro |DFloEpsilon|   () BOOT::|$DoubleFloatEpsilon|)
-(defmacro |DFloIsZero|   (x) `(zerop (the |DFlo| ,x)))
-(defmacro |DFloIsNeg|    (x) `(minusp (the |DFlo| ,x)))
-(defmacro |DFloIsPos|    (x) `(plusp (the |DFlo| ,x)))
-(defmacro |DFloLE|     (x y) `(<= (the |DFlo| ,x) (the |DFlo| ,y)))
-(defmacro |DFloEQ|     (x y) `(= (the |DFlo| ,x) (the |DFlo| ,y)))
-(defmacro |DFloLT|     (x y) `(< (the |DFlo| ,x) (the |DFlo| ,y)))
-(defmacro |DFloNE|     (x y) `(/= (the |DFlo| ,x) (the |DFlo| ,y)))
-(defmacro |DFloNegate|   (x) `(the |DFlo| (- (the |DFlo| ,x))))
-(defmacro |DFloNext|     (x) `(the |DFlo| (+ (the |DFlo| ,x) |DFlo1|)))
-(defmacro |DFloPrev|     (x) `(the |DFlo| (- (the |DFlo| ,x) |DFlo1|)))
-(defmacro |DFloPlus|   (x y) `(the |DFlo| (+ (the |DFlo| ,x) (the |DFlo| ,y))))
-(defmacro |DFloMinus|  (x y) `(the |DFlo| (- (the |DFlo| ,x) (the |DFlo| ,y))))
-(defmacro |DFloTimes|  (x y) `(the |DFlo| (* (the |DFlo| ,x) (the |DFlo| ,y))))
-(defmacro |DFloDivide| (x y) `(the |DFlo| (/ (the |DFlo| ,x) (the |DFlo| ,y))))
-(defmacro |DFloTimesPlus| (x y z)
-  `(the |DFlo| (+ (* (the |DFlo| ,x) (the |DFlo| ,y)) (the |DFlo| ,z))))
-
-(defmacro |DFloRPlus|  (x y r) `(error "unimplemented operation -- DFloRPlus"))
-(defmacro |DFloRMinus| (x y r) `(error "unimplemented operation -- DFloRTimes"))
-(defmacro |DFloRTimes| (x y r) `(error "unimplemented operation -- DFloRTimes"))
-(defmacro |DFloRTimesPlus| (x y z r) `(error "unimplemented operation -- DFloTimesPlus"))
-(defmacro |DFloRDivide|(x y r) `(error "unimplemented operation -- DFloDivide"))
-
-(defmacro |DFloDissemble| (x) `(error "unimplemented operation -- DFloDissemble"))
-(defmacro |DFloAssemble| (w x y z) `(error "unimplemented operation -- DFloAssemble"))
-
-;; Not builtins anymore
-;;(defmacro |DFloRound|    (x) `(the |BInt| (round (the |DFlo| ,x))))
-;;(defmacro |DFloTruncate| (x) `(the |BInt| (truncate (the |DFlo| ,x))))
-;;(defmacro |DFloFloor|    (x) `(the |BInt| (floor (the |DFlo| ,x))))
-;;(defmacro |DFloCeiling|  (x) `(the |BInt| (ceiling (the |DFlo| ,x))))
-
-(defmacro |Byte0|         () 0)
-(defmacro |Byte1|         () 1)
-(defmacro |ByteMin|       () 0)
-(defmacro |ByteMax|       () 255)
-
-(defmacro |HInt0|         () 0)
-(defmacro |HInt1|         () 1)
-(defmacro |HIntMin|       () #.(- (expt 2 15)))
-(defmacro |HIntMax|       () #.(1- (expt 2 15)))
-
-(defmacro |SInt0|         () 0)
-(defmacro |SInt1|         () 1)
-(defmacro |SIntMin|       () `(the |SInt| BOOT::|$ShortMinimum|))
-(defmacro |SIntMax|       () `(the |SInt| BOOT::|$ShortMaximum|))
-(defmacro |SIntIsZero|   (x) `(zerop (the |SInt| ,x)))
-(defmacro |SIntIsNeg|    (x) `(minusp (the |SInt| ,x)))
-(defmacro |SIntIsPos|    (x) `(plusp (the |SInt| ,x)))
-(defmacro |SIntIsEven|   (x) `(evenp (the |SInt| ,x)))
-(defmacro |SIntIsOdd|    (x) `(oddp (the |SInt| ,x)))
-(defmacro |SIntLE|     (x y) `(<= (the |SInt| ,x) (the |SInt| ,y)))
-(defmacro |SIntEQ|     (x y) `(= (the |SInt| ,x) (the |SInt| ,y)))
-(defmacro |SIntLT|     (x y) `(< (the |SInt| ,x) (the |SInt| ,y)))
-(defmacro |SIntNE|     (x y) `(/= (the |SInt| ,x) (the |SInt| ,y)))
-(defmacro |SIntNegate|   (x) `(the |SInt| (- (the |SInt| ,x))))
-(defmacro |SIntPrev|      (x) `(the |SInt| (1- (the |SInt| ,x))))
-(defmacro |SIntNext|      (x) `(the |SInt| (1+ (the |SInt| ,x))))
-(defmacro |SIntPlus|   (x y) `(the |SInt| (+ (the |SInt| ,x) (the |SInt| ,y))))
-(defmacro |SIntMinus|  (x y) `(the |SInt| (- (the |SInt| ,x) (the |SInt| ,y))))
-(defmacro |SIntTimes|  (x y) `(the |SInt| (* (the |SInt| ,x) (the |SInt| ,y))))
-(defmacro |SIntTimesPlus| (x y z)
-  `(the |SInt| (+ (* (the |SInt| ,x) (the |SInt| ,y)) (the |SInt| ,z))))
-(defmacro |SIntMod|    (x y) `(the |SInt| (mod(the |SInt| ,x)(the |SInt| ,y))))
-(defmacro |SIntQuo|    (x y)
-  `(the |SInt| (values (truncate (the |SInt| ,x) (the |SInt| ,y)))))
-(defmacro |SIntRem|    (x y) `(the |SInt| (rem(the |SInt| ,x)(the |SInt| ,y))))
-;;! declare all let variables
-(defmacro |SIntDivide| (x y) `(truncate (the |SInt| ,x) (the |SInt| ,y)))
-(defmacro |SIntGcd|  (x y) `(the |SInt| (gcd (the |SInt| ,x) (the |SInt| ,y))))
-
-(defmacro |SIntPlusMod|  (a b c)
-  `(the |SInt| (mod (+ (the |SInt| ,a) (the |SInt| ,b)) (the |SInt| ,c))))
-(defmacro |SIntMinusMod| (a b c)
-  `(the |SInt| (mod (- (the |SInt| ,a) (the |SInt| ,b)) (the |SInt| ,c))))
-(defmacro |SIntTimesMod| (a b c)
-  `(the |SInt| (mod (* (the |SInt| ,a) (the |SInt| ,b)) (the |SInt| ,c))))
-;; |SIntTimesModInv|
-(defmacro |SIntLength|  (x) `(the |SInt| (integer-length (the |SInt| ,x))))
-(defmacro |SIntShiftUp| (x y) `(the |SInt| (ash (the |SInt| ,x) (the |SInt| ,y))))
-(defmacro |SIntShiftDn| (x y) `(the |SInt| (ash (the |SInt| ,x) (the |SInt| (- (the |SInt| ,y))))))
-
-(defmacro |SIntBit|   (x i)
-  `(let ((xx ,x) (ii ,i)) (declare (type |SInt| xx ii)) (logbitp ii xx)))
-(defmacro |SIntNot|     (a) `(the |SInt| (lognot (the |SInt| ,a))))
-(defmacro |SIntAnd|   (a b)
-  `(the |SInt| (logand (the |SInt| ,a) (the |SInt| ,b))))
-(defmacro |SIntOr|    (a b)
-  `(the |SInt| (logior (the |SInt| ,a) (the |SInt| ,b))))
-
-;; WordTimesDouble
-;; WordDivideDouble
-;; WordPlusStep
-;; WordTimesStep
-
-(defmacro |SIntSIPower| (x y)
-  `(let ((xx ,x) (yy ,y))
-     (declare (type |SInt| xx yy))
-     (if (minusp yy) (error "cannot raise integers to negative powers")
-       (the |SInt| (expt xx yy)))))
-(defmacro |SIntBIPower| (x y)
-  `(let ((xx ,x) (yy ,y))
-     (declare (type |SInt| xx))
-     (declare (type |BInt| yy))
-     (if (minusp yy) (error "cannot raise integers to negative powers")
-       (the |SInt| (expt xx yy)))))
-
-(defmacro |BInt0|        () 0)
-(defmacro |BInt1|        () 1)
-(defmacro |BIntIsZero|  (x) `(zerop (the |BInt| ,x)))
-(defmacro |BIntIsNeg|   (x) `(minusp(the |BInt| ,x)))
-(defmacro |BIntIsPos|   (x) `(plusp (the |BInt| ,x)))
-(defmacro |BIntIsEven|  (x) `(evenp (the |BInt| ,x)))
-(defmacro |BIntIsOdd|   (x) `(oddp  (the |BInt| ,x)))
-(defmacro |BIntIsSingle| (x) `(typep ,x '|SInt|))
-(defmacro |BIntLE|    (x y) `(<= (the |BInt| ,x) (the |BInt| ,y)))
-(defmacro |BIntEQ|    (x y) `(=  (the |BInt| ,x) (the |BInt| ,y)))
-(defmacro |BIntLT|    (x y) `(<  (the |BInt| ,x) (the |BInt| ,y)))
-(defmacro |BIntNE|    (x y) `(/= (the |BInt| ,x) (the |BInt| ,y)))
-(defmacro |BIntNegate|  (x) `(the |BInt| (-   (the |BInt| ,x))))
-(defmacro |BIntPrev|     (x) `(the |BInt| (1-  (the |BInt| ,x))))
-(defmacro |BIntNext|     (x) `(the |BInt| (1+  (the |BInt| ,x))))
-(defmacro |BIntPlus|  (x y) `(the |BInt| (+ (the |BInt| ,x) (the |BInt| ,y))))
-(defmacro |BIntMinus| (x y) `(the |BInt| (- (the |BInt| ,x) (the |BInt| ,y))))
-(defmacro |BIntTimes| (x y) `(the |BInt| (* (the |BInt| ,x) (the |BInt| ,y))))
-(defmacro |BIntTimesPlus| (x y z)
-  `(the |BInt| (+ (* (the |BInt| ,x) (the |BInt| ,y)) (the |BInt| ,z))))
-(defmacro |BIntMod|   (x y) `(the |BInt| (mod(the |BInt| ,x)(the |BInt| ,y))))
-(defmacro |BIntQuo|   (x y)
-  `(the |BInt| (values (truncate (the |BInt| ,x) (the |BInt| ,y)))))
-(defmacro |BIntRem|   (x y)
-  `(the |BInt| (rem (the |BInt| ,x) (the |BInt| ,y))))
-(defmacro |BIntDivide| (x y) `(truncate (the |BInt| ,x) (the |BInt| ,y)))
-(defmacro |BIntGcd|   (x y)
-  `(the |BInt| (gcd (the |BInt| ,x) (the |BInt| ,y))))
-(defmacro |BIntSIPower| (x y)
-  `(let ((xx ,x) (yy ,y))
-     (declare (type |BInt| xx))
-     (declare (type |SInt| yy))
-     (if (minusp yy) (error "cannot raise integers to negative powers")
-       (the |BInt| (expt xx yy)))))
-(defmacro |BIntBIPower| (x y)
-  `(let ((xx ,x) (yy ,y))
-     (declare (type |BInt| xx))
-     (declare (type |BInt| yy))
-     (if (minusp yy) (error "cannot raise integers to negative powers")
-       (the |BInt| (expt xx yy)))))
-(defmacro |BIntLength|  (x) `(the |SInt| (integer-length (the |BInt| ,x))))
-(defmacro |BIntShiftUp| (x y) `(the |BInt| (ash (the |BInt| ,x)(the |SInt| ,y))))
-(defmacro |BIntShiftDn| (x y) `(the |BInt| (ash (the |BInt| ,x) (the |SInt| (- (the |SInt| ,y))))))
-
-(defmacro |BIntBit|   (x i)
-  `(let ((xx ,x) (ii ,i)) (declare (type |BInt| xx) (type |SInt| ii))
-        (logbitp ii xx)))
-;;(defmacro |BIntAbs|     (x) `(the |BInt| (abs (the |BInt| ,x))))
-
-(defmacro |PtrNil|      () ())
-(defmacro |PtrIsNil|   (x) `(NULL ,x))
-(defmacro |PtrEQ|    (x y) `(eq ,x ,y))
-(defmacro |PtrNE|    (x y) `(not (eq ,x ,y)))
-
-;; |WordTimesDouble| |WordDivideDouble| |WordPlusStep| |WordTimesStep|
-
-
-;;(defvar |FoamOutputString|
-;;  (make-array 80 :element-type 'string-char :adjustable t :fill-pointer 0))
-(defun |FormatNumber| (c arr i)
-  (let ((str (format nil "~a" c)))
-    (replace arr str :start1 i)
-;;  (incf i (fill-pointer |FoamOutputString|))
-;;  (if (> i (length arr)) (error "not enough space"))
-;;  (setf (fill-pointer |FoamOutputString|) 0)
-    (+ i (length str))))
-
-(defmacro |FormatDFlo| (c arr i) `(|FormatNumber| ,c ,arr ,i))
-(defmacro |FormatSInt| (c arr i) `(|FormatNumber| ,c ,arr ,i))
-(defmacro |FormatBInt| (c arr i) `(|FormatNumber| ,c ,arr ,i))
-
-(set-syntax-from-char (code-char 0) #\space) ;;makes null char act like white space
-
-(defmacro |ScanDFlo| (arr i)
-  `(read-from-string ,arr nil (|DFlo0|)
-                     :start ,i :preserve-whitespace t))
-(defmacro |ScanSInt| (arr i)
-  `(parse-integer ,arr :start ,i :junk-allowed t))
-(defmacro |ScanBInt| (arr i)
-  `(parse-integer ,arr :start ,i :junk-allowed t))
-
-;; 18/8/93: Evil bug in genfoam---nil generated.
-(defmacro hacked-the (type x)
-  (if x `(the ,type ,x) `(the ,type 0)))
-
-(defmacro |ByteToSInt| (x) `(coerce (hacked-the |Byte| ,x) '|SInt|))
-(defmacro |BoolToSInt|  (x) `(if ,x 1 0))
-(defmacro |BIntToSInt| (x) `(hacked-the |SInt| ,x))
-(defmacro |SIntToBInt| (x) `(hacked-the |BInt| ,x))
-(defmacro |SIntToByte| (x) `(coerce (hacked-the |SInt| ,x) '|Byte|))
-(defmacro |SIntToHInt| (x) `(coerce (hacked-the |SInt| ,x) '|HInt|))
-(defmacro |SIntToDFlo| (x) `(coerce (hacked-the |SInt| ,x) '|DFlo|))
-(defmacro |BIntToDFlo| (x) `(coerce (hacked-the |BInt| ,x) '|DFlo|))
-(defmacro |ArrToDFlo|  (x) `(read-from-string ,x nil (|DFlo0|)))
-(defmacro |ArrToSInt|  (x) `(read-from-string ,x nil (|SInt0|)))
-(defmacro |ArrToBInt|  (x) `(read-from-string ,x nil (|BInt0|)))
-
-(defmacro |Clos| (x y) `(let ((xx ,x) (yy #',y)) (cons yy xx)))
-(defmacro |ClosFun| (x) `(car ,x))
-(defmacro |ClosEnv| (x) `(cdr ,x))
-(defmacro |SetClosFun| (x y) `(rplaca ,x ,y))
-(defmacro |SetClosEnv| (x y) `(rplacd ,x ,y))
-
-(defmacro |MakeEnv|     (x y) 
-  `(let ((xx ,x) (yy ,y)) (cons yy (cons xx nil))))
-
-(defmacro |EnvLevel|    (x)   `(car ,x))
-(defmacro |EnvNext|     (x)   `(cadr ,x))
-(defmacro |EnvInfo|     (x)   `(if (and (consp ,x) (consp (cdr ,x)))
-                                   (cddr ,x) nil))
-(defmacro |SetEnvInfo|  (x val)   `(rplacd (cdr  ,x) ,val))
-
-(defmacro |FoamEnvEnsure| (e) 
-  `(if (|EnvInfo| ,e) (|CCall| (|EnvInfo| ,e)) nil))
-
-(defconstant null-char-string (string (code-char 0)))
-(defmacro |MakeLit| (s) `(concatenate 'string ,s null-char-string))
-
-;; functions are represented by symbols, with the symbol-value being some
-;; information, and the symbol-function is the function itself.
-;; 1-valued lisp should represent progs as either a pair or defstruct.
-
-(defmacro |FunProg| (x) x)
-
-(defstruct FoamProgInfoStruct
-  (funcall nil :type function)
-  (hashval 0   :type |SInt|))
-
-(defun |ProgHashCode| (x)
-  (let ((aa (foam-function-info x)))
-    (if (null aa) 0
-      (FoamProgInfoStruct-hashval aa))))
-
-(defun |SetProgHashCode| (x y)
-  (let ((aa (foam-function-info x)))
-    (if (null aa) 0
-      (setf (FoamProgInfoStruct-hashval aa) y))))
-
-;; In a hurry -> O(n) lookup..
-(defvar foam-function-list ())
-
-(defun alloc-prog-info (fun val)
-  (setq foam-function-list (cons (cons fun val) foam-function-list)))
-
-(defun foam-function-info (fun)
-  (let ((xx (assoc fun foam-function-list)))
-    (if (null xx) nil
-      (cdr xx))))
-
-;; Accessors and constructors
-(defmacro |DDecl| (name &rest args)
-  (setf (get name 'struct-args) args)
-  `(defstruct ,name ,@(insert-types args)))
-
-(defun insert-types (slots)
-  (mapcar #'(lambda (slot)
-              `(,(car slot) ,(type2init (cadr slot))
-                :type ,(cadr slot)))
-          slots))
-
-(defmacro |RNew| (name)
-  (let* ((struct-args (get name 'struct-args))
-         (init-args (mapcar #'(lambda (x) (type2init (cadr x)))
-                            struct-args))
-         (count (length struct-args)))
-    (cond ((> count 2) `(vector ,@init-args))
-          ((= count 2) `(cons ,@init-args))
-          (t `(list ,@init-args)))))
-
-(defmacro |RElt| (name field index rec)
-  (let ((count (length (get name 'struct-args))))
-    (cond ((> count 2) `(svref ,rec ,index))
-          ((= count 2)
-           (if (zerop index) `(car ,rec) `(cdr ,rec)))
-          (t `(car ,rec)))))
-
-(defmacro |SetRElt| (name field index rec val)
-  (let ((count (length (get name 'struct-args))))
-    (cond ((> count 2) `(setf (svref ,rec ,index) ,val))
-          ((= count 2)
-           (if (zerop index) `(rplaca ,rec ,val) `(rplacd ,rec ,val)))
-          (t `(rplaca ,rec ,val)))))
-
-(defmacro |AElt| (name index)
-  `(aref ,name ,index))
-
-(defmacro |SetAElt| (name index val)
-  `(setf (aref ,name ,index) ,val))
-
-(defmacro |MakeLevel| (builder struct)
-  (if (get struct 'struct-args)
-      `(,builder)
-    'nil))
-
-
-(defmacro |EElt| (accessor n var)
-  `(,accessor ,var))
-
-(defmacro |SetEElt| (accessor n var val)
-  `(setf (,accessor ,var) ,val))
-
-(defmacro |Lex| (accessor n var)
-  `(,accessor ,var))
-
-(defmacro |SetLex| (accessor n var val)
-  `(progn ;; (print ',accessor)
-          (setf (,accessor ,var) ,val)))
-
-;; Atomic arguments for fun don't need a let to hold the fun.
-;; CCall's with arguments need a let to hold the prog and the env.
-(defmacro |CCall| (fun &rest args)
-  (cond ((and (atom fun) (null args))
-         `(funcall (|FunProg| (|ClosFun| ,fun)) (|ClosEnv| ,fun)))
-        ((null args)
-         `(let ((c ,fun))
-            (funcall (|FunProg| (|ClosFun| c)) (|ClosEnv| c))))
-        ((atom fun)
-         `(let ((fun (|FunProg| (|ClosFun| ,fun)))
-                (env (|ClosEnv| ,fun)))
-            (funcall fun ,@args env)))
-        (t
-         `(let ((c ,fun))
-            (let ((fun (|FunProg| (|ClosFun| c)))
-                  (env (|ClosEnv| c)))
-              (funcall fun ,@args env))))))
-
-(defmacro |FoamFree| (o) '())
-
-;; macros for defining things
-
-(defmacro declare-prog (name-result params)
-  `(proclaim '(function ,(car name-result) ,params ,@(cdr name-result))))
-
-(defmacro declare-type (name type)
-  `(proclaim '(type ,name ,type)))
-
-(defmacro defprog (type temps &rest body)
-  `(progn (defun ,(caar type) ,(mapcar #'car (cadr type))
-            (typed-let ,temps ,@body))
-          (alloc-prog-info #',(caar type) (make-FoamProgInfoStruct))))
-
-(defmacro defspecials (&rest lst)
-  `(proclaim '(special ,@lst)))
-
-(defmacro top-level-define (&rest junk)
-  `(setq ,@junk))
-
-;; Runtime macros
-
-;; control transfer
-(defmacro block-return (obj val)
-  `(return-from ,obj ,val))
-
-(defmacro typed-let (letvars &rest forms)
-  `(let ,(mapcar #'(lambda (var)
-                     (list (car var) (type2init (cadr var))))
-                 letvars )
-     (declare ,@(mapcar #'(lambda (var)
-                            (list 'type (cadr var) (car var)))
-                        letvars))
-     ,@forms))
-
-(defmacro cases (&rest junk)
-  `(case ,@junk))
-
-
-;;; Boot macros
-(defmacro file-exports (lst)
-  `(eval-when (load eval)
-              (when (fboundp 'process-export-entry)
-                    (mapcar #'process-export-entry ,lst))
-        nil))
-
-(defmacro file-imports (lst)
-  `(eval-when (load eval)
-              (when (fboundp 'process-import-entry)
-                    (mapcar #'process-import-entry ,lst))
-        nil))
-
-(defmacro ignore-var (var)
-  `(declare (ignore ,var)))
-
-(defmacro |ANew| (type size)
-  (if (eq type '|Char|)
-      `(make-string ,size)
-      `(make-array ,size
-               :element-type ',type
-               :initial-element ,(type2init type))))
-
-(defun type2init (x)
-  (cond
-   ((eq x '|Char|) '|CharInit|)
-   ((eq x '|Clos|) '|ClosInit|)
-   ((eq x '|Bool|) '|BoolInit|)
-   ((eq x '|Byte|) '|ByteInit|)
-   ((eq x '|HInt|) '|HIntInit|)
-   ((eq x '|SInt|) '|SIntInit|)
-   ((eq x '|BInt|) '|BIntInit|)
-   ((eq x '|DFlo|) '|DFloInit|)
-   ((eq x '|Ptr|) '|PtrInit|)
-   ((eq x '|Word|) '|WordInit|)
-   ((eq x '|Arr|) '|ArrInit|)
-   ((eq x '|Record|) '|RecordInit|)
-   ((eq x '|Arb|) '|ArbInit|)
-   ((eq x '|Env|) '|EnvInit|)
-   ((eq x '|Level|) '|LevelInit|)
-   ((eq x '|Nil|) nil)
-   (t nil)))
-
-;; opsys interface
-(defvar |G-mainArgc| 0)
-(defvar |G-mainArgv| (vector))
-(defmacro |stdinFile| () '*standard-input*)
-(defmacro |stdoutFile| () '*standard-output*)
-(defmacro |stderrFile| () '*error-output*)
-
-;; Format functions
-;needs to stop when it gets a null character
-(defun |strLength| (s)
-  (dotimes (i (length s))
-           (let ((c (schar s i)))
-             (if (char= c |CharCode0|)
-                 (return i))))
-  (length s))
-
-(defun |formatSInt| (n) (format nil "~D" n))
-(defun |formatBInt| (n) (format nil "~D" n))
-(defun |formatDFloat| (x) (format nil "~G" x))
-
-
-;; Printing functions
-(defun |printNewLine| (cs) (terpri cs))
-(defun |printChar|  (cs c) (princ c cs))
-
-;needs to stop when it gets a null character
-(defun |printString| (cs s)
-  (dotimes (i (length s))
-           (let ((c (schar s i)))
-             (if (char= c |CharCode0|)
-                 (return i)
-               (princ c cs)))))
-
-(defun |printSInt| (cs n) (format cs "~D" n))
-(defun |printBInt| (cs n) (format cs "~D" n))
-(defun |printDFloat| (cs x) (format cs "~G" x))
-
-(defun |fputc| (si cs)
-  (|printChar| cs (code-char si))
-  si)
-
-(defun |fputs| (s cs)
-  (|printString| cs s))
-
-;; read a string into s starting at pos i1, ending at i2
-;; we should probably macro-out cases where args are constant
-
-;; fill s[i1..i2] with a null terminated string read from
-;; the given input stream
-(defun |fgetss| (s i1 i2 f)
-  (labels ((aux (n)
-                (if (= n i2)
-                    (progn (setf (schar s n) (code-char 0))
-                           (- n i1))
-                  (let ((c (read-char f)))
-                    (setf (schar s n) c)
-                    (if (equal c #\newline)
-                        (progn (setf (char s (+ n 1)) (code-char 0))
-                               (- n i1))
-                      (aux (+ n 1)))))))
-          (aux i1)))
-                
-;; write s[i1..i2) to the output stream f
-;; stop on any null characters
-
-(defun |fputss| (s i1 i2 f)
-  (labels ((aux (n)
-                (if (= n i2) (- n i1)
-                  (let ((c (schar s n)))
-                    (if  (equal (code-char 0) c)
-                         (- n i1)
-                      (progn (princ c f)        
-                             (aux (+ n 1))))))))
-          (setq i2 (if (minusp i2) (|strLength| s)
-                     (min i2 (|strLength| s))))
-          (aux i1)))
-
-;; function for compiling and loading from lisp
-
-(defun compile-as-file (file &optional (opts nil))
-  (let* ((path (pathname file))
-         (name (pathname-name path))
-         (dir (pathname-directory path))
-         (type (pathname-type path))
-         (lpath (make-pathname :name name :type "l"))
-         (cpath (make-pathname :name name :type "o")))
-    (if (null type)
-        (setq path (make-pathname :directory dir :name name :type "as")))
-    (if opts
-        (system (format nil "axiomxl ~A -Flsp ~A" opts (namestring path)))
-        (system (format nil "axiomxl -Flsp ~A" (namestring path))))
-    (compile-file (namestring lpath))
-    (load (namestring cpath))))
-
-
-;; given the name of a file (a string), return the name of the AXIOM-XL function
-;; that initialises the file.
-(defun axiomxl-file-init-name (filename)
-  (intern (format nil "G-~a" (string-downcase filename)) 'foam-user))
-
-;; given the name of the file, id name, and hashcode, return the
-;; AXIOM-XL identifier for that object
-
-(defun axiomxl-global-name (file id hashcode)
-  (intern (format nil "G-~a_~a_~9,'0d" (string-downcase file) id hashcode) 'foam-user))
-
-;; double float elementary functions
-(defmacro |sqrt| (x) `(sqrt ,x))
-(defmacro |pow| (a b) `(expt ,a ,b))
-(defmacro |log| (a)  `(log ,a))
-(defmacro |exp| (a) `(exp ,a))
-
-(defmacro |sin| (a) `(sin ,a))
-(defmacro |cos| (a) `(cos ,a))
-(defmacro |tan| (a) `(tan ,a))
-
-(defmacro |sinh| (a) `(sinh ,a))
-(defmacro |cosh| (a) `(cosh ,a))
-(defmacro |tanh| (a) `(tanh ,a))
-
-(defmacro |asin| (a) `(asin ,a))
-(defmacro |acos| (a) `(acos ,a))
-(defmacro |atan| (a) `(atan ,a))
-(defmacro |atan2| (a b) `(atan ,a ,b))
-
-(defun |Halt| (n) 
-  (error (cond ((= n 101) "System Error: Unfortunate use of dependant type")
-               ((= n 102) "User error: Reached a 'never'")
-               ((= n 103) "User error: Bad union branch")
-               ((= n 104) "User error: Assertion failed")
-               (t (format nil "Unknown halt condition ~a" n)))))
-;; debuging
-(defvar *foam-debug-var* nil)
-(defun |fiGetDebugVar| () *foam-debug-var*)
-
-(defun |fiSetDebugVar| (x) (setq *foam-debug-var* x))
-(defun |fiSetDebugger| (x y) ())
-(defun |fiGetDebugger| (x) ())
-
-;; Output ports
-(defvar |G-stdoutVar| t)
-(defvar |G-stdinVar| t)
-(defvar |G-stderrVar| t)
-
-;; !! Not portable !!
-;; ??? find a better way to get this work correctly and portably.
-#+:GCL
-(defun |fiStrHash| (x) (boot::|hashString| (subseq x 0 (- (length x) 1))))
-
-;; These three functions check that two cons's contain identical entries.
-;; We use EQL to test numbers and EQ everywhere else.  If the structure 
-;; of the two items is different, or any elements are different, we
-;; return false.
-(defmacro |politicallySound| (u v) 
- `(or (eql ,u ,v) (eq ,u ,v)))
-
-(defun |PtrMagicEQ| (u v) 
-;; I find (as-eg4) that these buggers can be numbers 
- (cond ( (or (NULL u) (NULL v)) nil)
-       ( (and (ATOM u) (ATOM v)) (eql u v))
-       ( (or (ATOM u) (ATOM v)) nil)
-;; removed for Aldor integration
-;;       ( (equal (length u) (length v)) (|magicEq1| u v)) 
-       (t (eq u v) )))
-
-(defun |magicEq1| (u v)
- (cond ((and (atom u) (atom v))
-	(|politicallySound| u v))
-       ((or (atom u) (atom v))
-	nil)
-       ((|politicallySound| (car u) (car v))
-	(|magicEq1| (cdr u) (cdr v)))))
-
-
diff --git a/src/interp/i-syscmd.boot b/src/interp/i-syscmd.boot
index 1e995c05..fd565e94 100644
--- a/src/interp/i-syscmd.boot
+++ b/src/interp/i-syscmd.boot
@@ -40,7 +40,7 @@ namespace BOOT
 $cacheAlist := nil
 $compileRecurrence := true
 $errorReportLevel := 'warning
-$sourceFileTypes := '(INPUT SPAD BOOT LISP LISP370 META)
+$sourceFileTypes := '(INPUT SPAD BOOT LISP)
 
 $existingFiles := hashTable "EQUAL"
 
@@ -437,48 +437,21 @@ compiler args ==
 
     af  := pathname args
     aft := pathnameType af
--- Whats this for? MCD/PAB 21-9-95
---    if haveNew and (null(aft) or (aft = '"")) then
---        af := pathname [af, '"as"]
---        aft = '"as"
---    if haveOld and (null(aft) or (aft = '"")) then
---        af := pathname [af, '"spad"]
---        aft = '"spad"
-
-    haveNew or (aft = '"as")   =>
-        not (af1 := $FINDFILE (af, '(as))) =>
-            throwKeyedMsg("S2IL0003",[NAMESTRING af])
-        compileAsharpCmd [af1]
     haveOld or (aft = '"spad") =>
         not (af1 := $FINDFILE (af, '(spad))) =>
             throwKeyedMsg("S2IL0003",[NAMESTRING af])
         compileSpad2Cmd  [af1]
-    aft = '"lsp"   =>
-        not (af1 := $FINDFILE (af, '(lsp))) =>
-            throwKeyedMsg("S2IL0003",[NAMESTRING af])
-        compileAsharpLispCmd [af1]
     aft = '"NRLIB"  =>
         not (af1 := $FINDFILE (af, '(NRLIB))) =>
             throwKeyedMsg("S2IL0003",[NAMESTRING af])
         compileSpadLispCmd [af1]
-    aft = '"ao"   =>
-        not (af1 := $FINDFILE (af, '(ao))) =>
-            throwKeyedMsg("S2IL0003",[NAMESTRING af])
-        compileAsharpCmd [af1]
-    aft = '"al"   =>    -- archive library of .ao files
-        not (af1 := $FINDFILE (af, '(al))) =>
-            throwKeyedMsg("S2IL0003",[NAMESTRING af])
-        compileAsharpArchiveCmd [af1]
 
     -- see if we something with the appropriate file extension
     -- lying around
 
     af1 := $FINDFILE (af, '(as spad ao asy))
 
-    af1 and pathnameType(af1) = '"as"   => compileAsharpCmd [af1]
-    af1 and pathnameType(af1) = '"ao"  => compileAsharpCmd [af1]
     af1 and pathnameType(af1) = '"spad" => compileSpad2Cmd  [af1]
-    af1 and pathnameType(af1) = '"asy"  => compileAsharpArchiveCmd [af1]
 
     -- maybe /EDITFILE has some stuff that can help us
     ef := pathname _/EDITFILE
@@ -487,226 +460,16 @@ compiler args ==
     ef = af => throwKeyedMsg("S2IZ0039", nil)
     af := ef
 
-    pathnameType(af) = '"as"   => compileAsharpCmd args
-    pathnameType(af) = '"ao"  => compileAsharpCmd args
     pathnameType(af) = '"spad" => compileSpad2Cmd  args
 
     -- see if we something with the appropriate file extension
     -- lying around
-    af1 := $FINDFILE (af, '(as spad ao asy))
+    af1 := $FINDFILE (af, '(spad))
 
-    af1 and pathnameType(af1) = '"as"   => compileAsharpCmd [af1]
-    af1 and pathnameType(af1) = '"ao"  => compileAsharpCmd [af1]
     af1 and pathnameType(af1) = '"spad" => compileSpad2Cmd  [af1]
-    af1 and pathnameType(af1) = '"asy"  => compileAsharpArchiveCmd [af1]
 
     throwKeyedMsg("S2IZ0039", nil)
 
-compileAsharpCmd args ==
-    compileAsharpCmd1 args
-    terminateSystemCommand()
-
-compileAsharpCmd1 args ==
-    -- Assume we entered from the "compiler" function, so args ~= nil
-    -- and is a file with file extension .as or .ao
-
-    path := pathname args
-    pathType := pathnameType path
-    (pathType ~= '"as") and (pathType ~= '"ao") => throwKeyedMsg("S2IZ0083", nil)
-    null PROBE_-FILE path => throwKeyedMsg("S2IL0003",[namestring args])
-
-    SETQ(_/EDITFILE, path)
-    updateSourceFiles path
-
-    optList :=  '( _
-      new _
-      old _
-      translate _
-      onlyargs _
-      moreargs _
-      quiet _
-      nolispcompile _
-      noquiet _
-      library _
-      nolibrary _
-        )
-
-    beQuiet := false         -- be verbose here
-    doLibrary  := true       -- so a )library after compilation
-    doCompileLisp := true    -- do compile generated lisp code
-
-    moreArgs := nil
-    onlyArgs := nil
-
-    for opt in $options repeat
-        [optname,:optargs] := opt
-        fullopt := selectOptionLC(optname,optList,nil)
-
-        fullopt = 'new       => nil
-        fullopt = 'old       => error "Internal error: compileAsharpCmd got )old"
-        fullopt = 'translate => error "Internal error: compileAsharpCmd got )translate"
-
-        fullopt = 'quiet     => beQuiet := true
-        fullopt = 'noquiet   => beQuiet := false
-
-        fullopt = 'nolispcompile   => doCompileLisp := false
-
-        fullopt = 'moreargs  => moreArgs := optargs
-        fullopt = 'onlyargs  => onlyArgs := optargs
-
-        fullopt = 'library   => doLibrary  := true
-        fullopt = 'nolibrary => doLibrary  := false
-
-        throwKeyedMsg("S2IZ0036",[strconc('")",object2String optname)])
-
-    tempArgs :=
-        pathType = '"ao" =>
-            -- want to strip out -Fao
-            (p := STRPOS('"-Fao", $asharpCmdlineFlags, 0, nil)) =>
-                p = 0 => subString($asharpCmdlineFlags, 5)
-                strconc(subString($asharpCmdlineFlags, 0, p), '" ",
-                    subString($asharpCmdlineFlags, p+5))
-            $asharpCmdlineFlags
-        $asharpCmdlineFlags
-
-    asharpArgs :=
-        onlyArgs =>
-            s := ""
-            for a in onlyArgs repeat
-                s := strconc(s, '" ", object2String a)
-            s
-        moreArgs =>
-            s := tempArgs
-            for a in moreArgs repeat
-                s := strconc(s, '" ", object2String a)
-            s
-        tempArgs
-
-    if not beQuiet then sayKeyedMsg("S2IZ0038A",[namestring args, asharpArgs])
-
-    command :=
-     strconc(strconc(getEnv('"ALDORROOT"),'"/bin/"),_
-               "aldor ", asharpArgs, '" ", namestring args)
-    rc := runCommand command
-
-    if (rc = 0) and doCompileLisp then
-        lsp := fnameMake('".", pathnameName args, '"lsp")
-        if fnameReadable?(lsp) then
-            if not beQuiet then sayKeyedMsg("S2IZ0089", [namestring lsp])
-            compileFileQuietly(lsp)
-        else
-            sayKeyedMsg("S2IL0003", [namestring lsp])
-
-    if rc = 0 and doLibrary then
-        -- do we need to worry about where the compilation output went?
-        if not beQuiet then sayKeyedMsg("S2IZ0090", [ pathnameName path ])
-        withAsharpCmd [ pathnameName path ]
-    else if not beQuiet then
-        sayKeyedMsg("S2IZ0084", nil)
-
-    if not $buildingSystemAlgebra then
-      extendLocalLibdb $newConlist
-
-compileAsharpArchiveCmd args ==
-    -- Assume we entered from the "compiler" function, so args ~= nil
-    -- and is a file with file extension .al. We also assume that
-    -- the name is fully qualified.
-
-    path := pathname args
-    null PROBE_-FILE path => throwKeyedMsg("S2IL0003",[namestring args])
-
-    -- here is the plan:
-    --   1. extract the file name and try to make a directory based
-    --      on that name.
-    --   2. cd to that directory and ar x the .al file
-    --   3. for each .ao file that shows up, compile it
-    --   4. delete the generated .ao files
-
-    -- First try to make the directory in the current directory
-
-    dir  := fnameMake('".", pathnameName path, '"axldir")
-    exists := PROBE_-FILE dir
-    isDir := directoryp namestring dir
-    exists and isDir ~= 1=>
-        throwKeyedMsg("S2IL0027",[namestring dir, namestring args])
-
-    if isDir ~= 1 then
-        rc   := mkdir namestring dir
-        rc ~= 0 => throwKeyedMsg("S2IL0027",[namestring dir, namestring args])
-
-    curDir := GET_-CURRENT_-DIRECTORY()
-
-    -- cd to that directory and try to unarchive the .al file
-
-    cd [ object2Identifier namestring dir ]
-
-    cmd := strconc( '"ar x ", namestring path )
-    rc := runCommand cmd
-    rc ~= 0 =>
-        cd [ object2Identifier namestring curDir ]
-        throwKeyedMsg("S2IL0028",[namestring dir, namestring args])
-
-    -- Look for .ao files
-
-    asos := DIRECTORY '"*.ao"
-    null asos =>
-        cd [ object2Identifier namestring curDir ]
-        throwKeyedMsg("S2IL0029",[namestring dir, namestring args])
-
-    -- Compile the .ao files
-
-    for aso in asos repeat
-        compileAsharpCmd1 [ namestring aso ]
-
-    -- Reset the current directory
-
-    cd [ object2Identifier namestring curDir ]
-
-    terminateSystemCommand()
-
-compileAsharpLispCmd args ==
-    -- Assume we entered from the "compiler" function, so args ~= nil
-    -- and is a file with file extension .lsp
-
-    path := pathname args
-    null PROBE_-FILE path => throwKeyedMsg("S2IL0003",[namestring args])
-
-    optList :=  '( _
-      quiet _
-      noquiet _
-      library _
-      nolibrary _
-        )
-
-    beQuiet := false         -- be verbose here
-    doLibrary  := true       -- so a )library after compilation
-
-    for opt in $options repeat
-        [optname,:optargs] := opt
-        fullopt := selectOptionLC(optname,optList,nil)
-
-        fullopt = 'quiet     => beQuiet := true
-        fullopt = 'noquiet   => beQuiet := false
-
-        fullopt = 'library   => doLibrary  := true
-        fullopt = 'nolibrary => doLibrary  := false
-
-        throwKeyedMsg("S2IZ0036",[strconc('")",object2String optname)])
-
-    lsp := fnameMake(pathnameDirectory path, pathnameName path, pathnameType path)
-    if fnameReadable?(lsp) then
-        if not beQuiet then sayKeyedMsg("S2IZ0089", [namestring lsp])
-        compileFileQuietly(lsp)
-    else
-        sayKeyedMsg("S2IL0003", [namestring lsp])
-
-    if doLibrary then
-        -- do we need to worry about where the compilation output went?
-        if not beQuiet then sayKeyedMsg("S2IZ0090", [ pathnameName path ])
-        withAsharpCmd [ pathnameName path ]
-    else if not beQuiet then
-        sayKeyedMsg("S2IZ0084", nil)
-    terminateSystemCommand()
 
 compileSpadLispCmd args ==
     -- Assume we entered from the "compiler" function, so args ~= nil
@@ -870,10 +633,6 @@ compilerDoitWithScreenedLisplib(constructor, fun) ==
     (try compilerDoit(constructor,fun); finally SEQ(UNEMBED 'RWRITE))
 
 
-withAsharpCmd args ==
-    $options: local := nil
-    LOCALDATABASE(args, $options)
-
 --% )copyright -- display copyright notice
 
 summary l ==
diff --git a/src/interp/sys-driver.boot b/src/interp/sys-driver.boot
index efa77eba..13742c4e 100644
--- a/src/interp/sys-driver.boot
+++ b/src/interp/sys-driver.boot
@@ -144,7 +144,6 @@ openDatabases() ==
   OPERATIONOPEN()
   CATEGORYOPEN()
   BROWSEOPEN()
-  CREATE_-INITIALIZERS()
 
 ++
 restart() ==
diff --git a/src/interp/util.lisp b/src/interp/util.lisp
index 906b661b..b05042e9 100644
--- a/src/interp/util.lisp
+++ b/src/interp/util.lisp
@@ -1,6 +1,6 @@
 ;; Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
 ;; All rights reserved.
-;; Copyright (C) 2007-2010, Gabriel Dos Reis.
+;; Copyright (C) 2007-2011, Gabriel Dos Reis.
 ;; All rights reserved.
 ;;
 ;; Redistribution and use in source and binary forms, with or without
@@ -40,10 +40,6 @@
 ;; individual files to whole directories. The most complex functions
 ;; like `makespad' can rebuild the whole algebra tree.
 
-;; A third group of related functions are used to set up the 
-;; `autoload' mechanism. These enable whole subsystems to
-;; be kept out of memory until they are used.
-
 ;; A fourth group of related functions are used to construct and
 ;; search Emacs TAGS files.
 
@@ -243,79 +239,6 @@
 ;; directory from the current {\bf AXIOM} shell variable.
 (defvar $relative-library-directory-list '("/algebra/"))
 
-;; This is part of the {\bf ALDOR subsystem}. These will be loaded
-;; if you compile a {\bf .as} file rather than a {\bf .spad} file.
-;; {\bf ALDOR} is an external compiler that gets automatically called
-;; if the file extension is {\bf .as}.
-(defparameter asauto-functions '(
-        loadas
-;;      |as|                         ;; now in as.boot
-;;      |astran|                     ;; now in as.boot
-        |spad2AxTranslatorAutoloadOnceTrigger|
-        |sourceFilesToAxcliqueAxFile|
-        |sourceFilesToAxFile|
-        |setExtendedDomains|
-        |makeAxFile|
-        |makeAxcliqueAxFile|
-        |nrlibsToAxFile|
-        |attributesToAxFile| ))
-
-;; These are some {\bf debugging} functions that I use. I can't imagine
-;; why you might autoload them but they don't need to be in a running
-;; system.
-(defparameter debug-functions '(
-        loaddebug
-        |showSummary|
-        |showPredicates|
-        |showAttributes|
-        |showFrom|
-        |showImp|))
-
-;; This function is called by {\bf build-interpsys}. It takes two lists.
-;; The first is a list of functions that need to be used as 
-;; ``autoload triggers''. The second is a list of files to load if one
-;; of the trigger functions is called. At system build time each of the
-;; functions in the first list is set up to load every file in the second
-;; list. In this way we will automatically load a whole subsystem if we
-;; touch any function in that subsystem. We call a helper function
-;; called {\bf setBootAutoLoadProperty} to set up the autoload trigger.
-;; This helper function is listed below.
-(defun |setBootAutloadProperties| (fun-list file-list)
-#+:AKCL
-  (mapc #'(lambda (fun) (|setBootAutoLoadProperty| fun file-list)) fun-list)
-)
-
-
-;; This function knows where the {\bf autoload} subdirectory lives.
-;; It is called by {\bf mkBootAutoLoad} above to find the necessary
-;; files.
-(defun boot-load (file)
-  (let ((name (concat (|systemRootDirectory|)
-                      "/autoload/" 
-                      (pathname-name file))))
-    (if |$printLoadMsgs|
-        (format t "   Loading ~A.~%" name))
-    (load name)))
-
-;; This is a helper function to set up the autoload trigger. It sets
-;; the function cell of each symbol to {\bf mkBootAutoLoad} which is
-;; listed below. 
-(defun |setBootAutoLoadProperty| (func file-list)
-  (setf (symbol-function func) (|mkBootAutoLoad| func file-list)) )
-
-;; This is how the autoload magic happens. Every function named in the
-;; autoload lists is actually just another name for this function. When
-;; the named function is called we call {\bf boot-load} on all of the
-;; files in the subsystem. This overwrites all of the autoload triggers.
-;; We then look up the new (real) function definition and call it again
-;; with the real arguments. Thus the subsystem loads and the original
-;; call succeeds.
-(defun |mkBootAutoLoad| (fn file-list)
-   (function (lambda (&rest args)
-                 (mapc #'boot-load file-list)
-                 (unless (string= (subseq (string fn) 0 4) "LOAD")
-                  (apply (symbol-function fn) args)))))
-
 ;############################################################################
 ;# autoload dependencies
 ;#
@@ -332,23 +255,15 @@
 ;#	  (e.g. ${AUTO}/parsing.${O}: ${OUT}/parsing.${O})
 ;#     c) edit util.lisp to add the 'external' function (those that
 ;#	  should trigger the autoload
-;#   case 2:
-;#     build-interpsys (in util.lisp) needs an extra argument for the
-;#     new autoload things and several functions in util.lisp need hacking.
 ;############################################################################
 
-;; The `build-interpsys' function takes a list of files to load
-;; into the image (`load-files'). It also takes several lists of files, 
-;; one for each subsystem which will be autoloaded. Autoloading is explained
-;; below. This function is called in the src/interp/Makefile. 
-
 ;; This function calls `reroot' to set up pathnames we need. Next
 ;; it sets up the lisp system memory (at present only for AKCL/GCL). Next
 ;; it loads all of the named files, resets a few global state variables,
 ;; loads the databases, sets up autoload triggers and clears out hash tables.
 ;; After this function is called the image is clean and can be saved.
 
-(defun build-interpsys (asauto-files)
+(defun build-interpsys ()
   (reroot)
   (|resetWorkspaceVariables|)
   (|AxiomCore|::|%sysInit|)
@@ -357,10 +272,8 @@
   (|initNewWorld|)
   (compressopen)
   (interpopen)
-  (create-initializers)
   (|start| :fin)
   (setq *load-verbose* nil)
-  (|setBootAutloadProperties| asauto-functions asauto-files)
   (|fillDatabasesInCore|) ; the databases into core, then close the streams
   (|closeAllDatabaseStreams|)
  )
author	dos-reis <gdr@axiomatics.org>	2011-06-21 18:51:36 +0000
committer	dos-reis <gdr@axiomatics.org>	2011-06-21 18:51:36 +0000
commit	8b45d02f8f861fe0eab071ccbfcf5ef8bd6593d6 (patch)
tree	8d3c3bb0bdc0ce060e3a622704b6f04709dfcd1c /src
parent	4e5497862c2e37f86114b21f03e443072ec6abf0 (diff)
download	open-axiom-8b45d02f8f861fe0eab071ccbfcf5ef8bd6593d6.tar.gz