diff options
Diffstat (limited to 'src/interp')
| -rw-r--r-- | src/interp/buildom.boot | 13 | ||||
| -rw-r--r-- | src/interp/compiler.boot | 9 | ||||
| -rw-r--r-- | src/interp/debug.lisp | 2 |
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) |