6 files changed, 41 insertions, 14 deletions
diff --git a/src/interp/buildom.boot b/src/interp/buildom.boot
index 81ad8d1e..ce70aa08 100644
--- a/src/interp/buildom.boot
+++ b/src/interp/buildom.boot
@@ -203,6 +203,20 @@ coerceUn2E(x,source) ==
 --% Mapping
 --  Want to eventually have elt: ($, args) -> target
 
+++ Implementation of the `MappinCategory' as builtin.
+++ A domain that satisfy this predicate provides implementation
+++ to abstraction that map values from some type to values
+++ of another type.
+MappingCategory(:"sig") ==       
+  sig = nil =>
+    error '"MappingCategory requires at least one argument"
+  cat := eval ['Join,$Type,
+                ['mkCategory,quoteForm 'domain,
+                   quoteForm [[['elt,[first sig,'$,:rest sig]],true]],
+                     [], [], nil]]
+  vectorRef(cat,0) := ['MappingCategory,:sig]
+  cat
+
 Mapping(:args) ==
   srcArgs := [devaluate a for a in args]
   nargs := #args
diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot
index b231b3db..3c928a81 100644
--- a/src/interp/compiler.boot
+++ b/src/interp/compiler.boot
@@ -2683,6 +2683,7 @@ for x in [["|", :"compSuchthat"],_
 	  ["SubsetCategory", :"compSubsetCategory"],_
 	  ["Union", :"compCat"],_
 	  ["Mapping", :"compCat"],_
+          ["MappingCategory", :"compConstructorCategory"],_
 	  ["UnionCategory", :"compConstructorCategory"],_
 	  ["where", :"compWhere"],_
           ["per",:"compPer"],_
diff --git a/src/interp/g-cndata.boot b/src/interp/g-cndata.boot
index 819fb583..5f90bc61 100644
--- a/src/interp/g-cndata.boot
+++ b/src/interp/g-cndata.boot
@@ -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
@@ -200,10 +200,11 @@ unabbrev1(u,modeIfTrue) ==
   u
  
 unabbrevSpecialForms(op,arglist,modeIfTrue) ==
-  op = 'Mapping => [op,:[unabbrev1(a,modeIfTrue) for a in arglist]]
-  op = 'Union   =>
+  op in '(Mapping MappingCategory) =>
+    [op,:[unabbrev1(a,modeIfTrue) for a in arglist]]
+  op in '(Union UnionCategory)  =>
     [op,:[unabbrevUnionComponent(a,modeIfTrue) for a in arglist]]
-  op = 'Record =>
+  op in '(Record RecordCategory) =>
     [op,:[unabbrevRecordComponent(a,modeIfTrue) for a in arglist]]
   nil
  
diff --git a/src/interp/g-error.boot b/src/interp/g-error.boot
index e0c0c905..aafefd93 100644
--- a/src/interp/g-error.boot
+++ b/src/interp/g-error.boot
@@ -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
@@ -79,9 +79,9 @@ errorSupervisor(errorType,errorMsg) ==
   errorSupervisor1(errorType,errorMsg,$BreakMode)
 
 needsToSplitMessage msg ==
-  "%b" in msg or '"%b" in msg => false
-  "%d" in msg or '"%d" in msg => false
-  "%l" in msg or '"%l" in msg => false
+  member("%b",msg) or member('"%b",msg) => false
+  member("%d",msg) or member('"%d",msg) => false
+  member("%l",msg) or member('"%l",msg) => false
   true
 
 errorSupervisor1(errorType,errorMsg,$BreakMode) ==
diff --git a/src/interp/nrunfast.boot b/src/interp/nrunfast.boot
index 57afc9a7..2a524414 100644
--- a/src/interp/nrunfast.boot
+++ b/src/interp/nrunfast.boot
@@ -463,14 +463,24 @@ lazyMatchArg2(s,a,dollar,domain,typeFlag) ==
   lazyMatch(s,a,dollar,domain)
   --above line is temporarily necessary until system is compiled 8/15/90
 --s = a
- 
+
+++ Return true if the symbol `s' designates a builtin constructor.
+builtinConstructor? s ==
+  s in $BuiltinConstructorNames
+
+++ Return true if the symbol `s' designates a generalized builtin
+++ constructor, that is a builtin constructor or any operator we
+++ deem as a constructor from the domain slot-filling machinery perspective.
+generalizedBuiltinConstructor? s ==
+  builtinConstructor? s or s is "QUOTE" or s is "[||]"
+
 lazyMatch(source,lazyt,dollar,domain) ==
   lazyt is [op,:argl] and cons? source and op=first source
     and #(sargl := rest source) = #argl =>
-      op in '(Record Union) and first argl is [":",:.] =>
+      builtinConstructor? op and first argl is [":",:.] =>
         and/[stag = atag and lazyMatchArg(s,a,dollar,domain)
               for [.,stag,s] in sargl for [.,atag,a] in argl]
-      op in '(Union Mapping _[_|_|_] QUOTE Enumeration) =>
+      generalizedBuiltinConstructor? op =>
          and/[lazyMatchArg(s,a,dollar,domain) for s in sargl for a in argl]
       coSig := getDualSignatureFromDB op
       null coSig => error ["bad Constructor op", op]
@@ -644,7 +654,7 @@ newHasTest(domform,catOrAtt) ==
 -- we will refuse to say yes for 'Cat has Cat'
 --getConstructorKindFromDB opOf domform = "category" => throwKeyedMsg("S2IS0025",NIL)
 -- on second thoughts we won't!
-  getConstructorKindFromDB opOf domform = "category" =>
+  categoryForm? domform =>
       domform = catOrAtt => 'T
       for [aCat,:cond] in [:ancestorsOf(domform,NIL),:SUBLISLIS (rest domform,$FormalMapVariableList,getConstructorAttributesFromDB(opOf domform))] |  aCat = catOrAtt  repeat
          return evalCond cond where
@@ -658,7 +668,7 @@ newHasTest(domform,catOrAtt) ==
              pred in '(OR or %or) => or/[evalCond i for i in l]
              pred in '(AND and %and) => and/[evalCond i for i in l]
              x  
-  not isAtom and constructor? op  =>
+  not isAtom and categoryForm? catOrAtt  =>
     domain := eval mkEvalable domform
     newHasCategory(domain,catOrAtt)
   catOrAtt is [":",op,type] =>
diff --git a/src/interp/sys-constants.boot b/src/interp/sys-constants.boot
index 45f747d5..9a1fbcff 100644
--- a/src/interp/sys-constants.boot
+++ b/src/interp/sys-constants.boot
@@ -533,7 +533,8 @@ $CategoryNames ==
     Join _
     EnumerationCategory _
     SubsetCategory _
-    UnionCategory)
+    UnionCategory _
+    MappingCategory)
 
 ++ List of domain constructors that do not have entries in the constructor
 ++ database. So, they are mostly recognized by their names.