From 987aec7a21f7a9a706320badeeaffbbb4b5cb786 Mon Sep 17 00:00:00 2001
From: Gabriel Dos Reis <gdr@axiomatics.org>
Date: Wed, 30 Dec 2015 16:19:06 -0800
Subject: Add more dependencies in the algberas' Makefile.am.

---
 src/interp/c-util.boot   |  6 +++++-
 src/interp/functor.boot  | 20 +++++++++++---------
 src/interp/lisplib.boot  |  3 +++
 src/interp/nruncomp.boot |  2 +-
 4 files changed, 20 insertions(+), 11 deletions(-)

(limited to 'src/interp')

diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot
index 7ecab9d4..84b6df23 100644
--- a/src/interp/c-util.boot
+++ b/src/interp/c-util.boot
@@ -863,9 +863,13 @@ isLiteral(x,e) ==
 registerConstructor(x,e) ==
   put('%compilerData,'%ctor,x,e)
 
+++ Retrieve the most recent defining constructor.
+currentConstructor e ==
+  get('%compilerData,'%ctor,e)
+
 ++ Retrieve the DB of the constructor definition being processed.
 currentDB e ==
-  ctor := get('%compilerData,'%ctor,e) => constructorDB ctor
+  ctor := currentConstructor e => constructorDB ctor
   nil
 
 makeLiteral: (%Symbol,%Env) -> %Thing
diff --git a/src/interp/functor.boot b/src/interp/functor.boot
index 950fb3b1..ca2d3cb8 100644
--- a/src/interp/functor.boot
+++ b/src/interp/functor.boot
@@ -211,15 +211,17 @@ CategoriesFromGDC x ==
     union([[a']],"union"/[CategoriesFromGDC u for u in b])
   x is ['QUOTE,a] and a is [b] => [a]
  
-compCategories(u,e) ==
+compCategories(db,u,e) ==
   u isnt [.,:.] => u
-  cons? u.op =>
+  u.op is [.,:.] =>
     error ['"compCategories: need an atom in operator position", u.op]
   u.op in '(Record Union Mapping) =>
     -- There is no modemap property for these guys so do it by hand.
-    [u.op, :[compCategories1(a,$SetCategory,e) for a in u.args]]
-  u is ['SubDomain,D,.] => compCategories(D,e)
-  v := get(u.op,'modemap,e)
+    [u.op, :[compCategories1(db,a,$SetCategory,e) for a in u.args]]
+  u is ['SubDomain,D,.] => compCategories(db,D,e)
+  v :=
+    u.op = dbConstructor db => dbConstructorModemap db
+    get(u.op,'modemap,e)
   v isnt [.,:.] =>
     error ['"compCategories: could not get proper modemap for operator",u.op]
   if rest v then
@@ -232,13 +234,13 @@ compCategories(u,e) ==
     v := rest v
   v := resolvePatternVars(first(v).mmSource, u.args) -- replaces #n forms
   -- select the modemap part of the first entry, and skip result etc.
-  [u.op,:[compCategories1(a,b,e) for a in u.args for b in v]]
+  [u.op,:[compCategories1(db,a,b,e) for a in u.args for b in v]]
  
-compCategories1(u,v,e) ==
+compCategories1(db,u,v,e) ==
 -- v is the mode of u
   u isnt [.,:.] => u
-  u is [":",x,t] => [u.op,x,compCategories1(t,v,e)]
-  isCategoryForm(v,e) => compCategories(u,e)
+  u is [":",x,t] => [u.op,x,compCategories1(db,t,v,e)]
+  isCategoryForm(v,e) => compCategories(db,u,e)
   [c,:.] := comp(macroExpand(u,e),v,e) => c
   error 'compCategories1
  
diff --git a/src/interp/lisplib.boot b/src/interp/lisplib.boot
index 807f752f..2d02af64 100644
--- a/src/interp/lisplib.boot
+++ b/src/interp/lisplib.boot
@@ -733,6 +733,9 @@ isDomainForm(D,e) ==
   op := opOf D
   not ident? op => false
   op is '%when => and/[isDomainForm(e,c) for [.,c] in D.args]
+  -- In this just an instance of the current constructor?
+  currentConstructor e = op =>
+    dbConstructorKind constructorDB op in '(domain package)
   --db := constructorDB op => dbConstructorKind db in '(domain package)
   symbolMember?(op,$SpecialDomainNames) or isFunctor op or
      ((getmode(op,e) is ['Mapping,target,:.]) and isCategoryForm(target,e)) or
diff --git a/src/interp/nruncomp.boot b/src/interp/nruncomp.boot
index 2b6c7ad4..eb7dfb57 100644
--- a/src/interp/nruncomp.boot
+++ b/src/interp/nruncomp.boot
@@ -463,7 +463,7 @@ buildFunctor(db,sig,code,$locals,$e) ==
   [catsig,:argsig] := sig
   catvecListMaker := removeDuplicates
     [comp(catsig,$EmptyMode,$e).expr,
-      :[compCategories(u,$e) for [u,:.] in categoryAncestors dbDomainShell db]]
+      :[compCategories(db,u,$e) for [u,:.] in categoryAncestors dbDomainShell db]]
   tbl := makeTable function valueEq?
   condCats := InvestigateConditions(db,[catsig,:rest catvecListMaker],tbl,$e)
   -- a list, one %for each element of catvecListMaker
-- 
cgit v1.2.3