aboutsummaryrefslogtreecommitdiff
path: root/src/interp
diff options
context:
space:
mode:
Diffstat (limited to 'src/interp')
-rw-r--r--src/interp/buildom.boot13
-rw-r--r--src/interp/compiler.boot9
-rw-r--r--src/interp/debug.lisp2
3 files changed, 19 insertions, 5 deletions
diff --git a/src/interp/buildom.boot b/src/interp/buildom.boot
index 508c325c..a7765057 100644
--- a/src/interp/buildom.boot
+++ b/src/interp/buildom.boot
@@ -481,6 +481,14 @@ coerceMap2E(x) ==
--% Enumeration
+EnumerationCategory(:"args") ==
+ cat := eval ['Join,$SetCategory,
+ ['mkCategory,quoteForm 'domain,
+ quoteForm [[[arg,['$],'constant],'T] for arg in args],
+ [], [], nil]]
+ canonicalForm(cat) := ['EnumerationCategory,:args]
+ cat
+
Enumeration(:"args") ==
nargs := #args
dom := newShell(nargs + 9)
@@ -498,7 +506,8 @@ Enumeration(:"args") ==
vectorRef(dom,3) := ["EnumerationCategory",:instantiationArgs dom]
vectorRef(dom,4) := [$commonCategoryDefaults, $commonCategoryAncestors]
vectorRef(dom,5) := nil
- for i in $FirstParamSlot.. for a in args repeat dom.i := a
+ for i in $FirstParamSlot.. for a in args repeat
+ dom.i := a
dom.($FirstParamSlot + nargs) := [function EnumEqual, :dom]
dom.($FirstParamSlot + nargs + 1) := [function EnumPrint, :dom]
dom.($FirstParamSlot + nargs + 2) := [function createEnum, :dom]
@@ -522,8 +531,6 @@ createEnum(sym, dom) ==
RecordCategory(:"x") == constructorCategory ["Record",:x]
-EnumerationCategory(:"x") == constructorCategory ["Enumeration",:x]
-
UnionCategory(:"x") == constructorCategory ["Union",:x]
constructorCategory (title is [op,:.]) ==
diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot
index e165751e..df460c2c 100644
--- a/src/interp/compiler.boot
+++ b/src/interp/compiler.boot
@@ -735,6 +735,12 @@ substituteIntoFunctorModemap(argl,modemap is [[dc,:sig],:.],e) ==
compConstructorCategory(x,m,e) == [x,resolve($Category,m),e]
+compEnumCat(x,m,e) ==
+ for arg in x.args repeat
+ IDENTP arg => nil -- OK
+ stackAndThrow('"all arguments to %1b must be identifiers",[x.op])
+ [x,resolve($Category,m),e]
+
--% SUBSET CATEGORY
compSubsetCategory: (%Form,%Mode,%Env) -> %Maybe %Triple
@@ -2639,6 +2645,7 @@ for x in [["|", :"compSuchthat"],_
["DEF", :"compDefine"],_
["elt", :"compElt"],_
["Enumeration", :"compCat"],_
+ ["EnumerationCategory", :"compEnumCat"],_
["exit", :"compExit"],_
["has", :"compHas"],_
["IF", : "compIf"],_
@@ -2659,9 +2666,9 @@ for x in [["|", :"compSuchthat"],_
["SEQ", :"compSeq"],_
["SubDomain", :"compSubDomain"],_
["SubsetCategory", :"compSubsetCategory"],_
- ["Union", :"compCat"],_
["Mapping", :"compCat"],_
["MappingCategory", :"compConstructorCategory"],_
+ ["Union", :"compCat"],_
["UnionCategory", :"compConstructorCategory"],_
["where", :"compWhere"],_
["per",:"compPer"],_
diff --git a/src/interp/debug.lisp b/src/interp/debug.lisp
index a9ca2349..7e409ff3 100644
--- a/src/interp/debug.lisp
+++ b/src/interp/debug.lisp
@@ -720,7 +720,7 @@ EXAMINE (SETQ RECNO (NOTE |$InputStream|))
(T (COND (|$mathTrace| (TERPRI)))
(PRINMATHOR0 VAL CURSTRM)))))))
-(DEFUN MONITOR-BLANKS (N) (PRINC (MAKE-FULL-CVEC N " ") CURSTRM))
+(DEFUN MONITOR-BLANKS (N) (PRINC (|makeString| N (|char| " ")) CURSTRM))
(DEFUN MONITOR-EVALBEFORE (X) (EVAL (MONITOR-EVALTRAN X NIL)) X)