[open-axiom-devel] functions returning types, was: Axiom interface

[Martin R. <mar...@un...>]

Dear all,

I now have managed to do a proper patch, no regressions.

If there is no complaint, I'll commit, although I must say that the code in
open-axiom looks much cleaner.

Since I do not understand what I'm doing here, help and comments would be
greatly appreciated.  (The comments in the patch are taken, as everything else,
too, from open-axiom)

Oh: one important thing: I had to define isCategoryForm *additionally* in
src/interp/i-analy.boot, for some reason it wouldn't find the definition in
category.boot.  This *has* to be fixed...

Martin

new file:

bugs2008-ExportType.spad:
)abbrev package EXPORT ExportType
ExportType(x: Ring): with
    baseRing: () -> Ring
  == add
    baseRing() == x


Index: src/input/bugs2008.input.pamphlet
===================================================================
--- src/input/bugs2008.input.pamphlet	(Revision 364)
+++ src/input/bugs2008.input.pamphlet	(Arbeitskopie)
@@ -11,6 +11,9 @@
 \eject
 @
 <<*>>=
+-- )compile files needed for testing here
+)co bugs2008-ExportType.spad
+
 )set break resume
 )expose UnittestCount UnittestAux Unittest
 
@@ -97,6 +100,12 @@
 testEquals("M**2", "M*M")
 testEquals("M^3", "M*M*M")
 
+testcase "Functions returning type"
+-- warning: the file must not be )compiled, nor )lib'd here, because this would
+-- make UNITCNT forget all counters.
+I := baseRing()$ExportType(Integer)
+testEquals("1$I", "1")
+
 )set output algebra on
 statistics()
 @
Index: src/interp/i-analy.boot
===================================================================
--- src/interp/i-analy.boot	(Revision 364)
+++ src/interp/i-analy.boot	(Arbeitskopie)
@@ -208,6 +208,11 @@
 -- Also see I-SPEC BOOT for special handlers and I-MAP BOOT for
 -- user function processing.
 
+isCategoryForm(x,e) ==
+  x is [name,:.] => categoryForm? name
+  atom x => u:= get(x,"macro",e) => isCategoryForm(u,e)
+
+
 bottomUp t ==
   -- bottomUp takes an attributed tree, and returns the modeSet for it.
   -- As a side-effect it also evaluates the tree.
@@ -258,6 +263,11 @@
             argModeSetList:= [bottomUp x for x in argl]
 
     ms := bottomUpForm(t,op,opName,argl,argModeSetList)
+    -- If this is a type producing form, then we don't want
+    -- to store the representation object in the environment.
+    -- Rather, we want to record the reified canonical form.
+    if ms is [m] and (m in '((Mode) (Domain) (SubDomain (Domain))) or isCategoryForm(m,$e))
+    then putValue(t,objNew(devaluate objValUnwrap getValue t, m))
 
     -- given no target or package calling, force integer constants to
     -- belong to tightest possible subdomain
 
Index: src/interp/i-eval.boot
===================================================================
--- src/interp/i-eval.boot	(Revision 364)
+++ src/interp/i-eval.boot	(Arbeitskopie)
@@ -145,10 +145,22 @@
     op='Record =>
       [op,:[['_:,sel,evaluateType type] for ['_:,sel,type] in argl]]
     op='Enumeration => form
-    evaluateType1 form
+    evaluateFormAsType form
   constructor? form =>
     ATOM form => evaluateType [form]
     throwEvalTypeMsg("S2IE0003",[form,form])
+  evaluateFormAsType form
+
+++ `form' used in a context where a type (domain or category) is
+++ expected.  Attempt to fully evaluate it.  Error if the resulting
+++ value is not a type.  When successful, the result is the reified
+++ canonical form of the type.
+evaluateFormAsType form ==
+  form is [op,:args] and constructor? op => evaluateType1 form
+  t := mkAtree form
+  -- ??? Maybe we should be more careful about generalized types.
+  bottomUp t is [m] and (m in '((Mode) (Domain) (SubDomain (Domain))) or isCategoryForm(m,$e)) =>
+    objVal getValue t
   throwEvalTypeMsg("S2IE0004",[form])
 
 evaluateType1 form ==
Index: src/interp/i-spec1.boot
===================================================================
--- src/interp/i-spec1.boot	(Revision 364)
+++ src/interp/i-spec1.boot	(Arbeitskopie)
@@ -1216,7 +1216,8 @@
     get(form,'value,$InteractiveFrame) or _
     (PAIRP($env) and get(form,'value,$env)) or _
     (PAIRP($e) and get(form,'value,$e)))) and
-      objMode(val) in '((Domain) (SubDomain (Domain))) =>
+      ((m := objMode(val)) in '((Domain) (SubDomain (Domain)))
+          or categoryForm? m) =>
         objValUnwrap(val)
   nil