diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/ChangeLog | 15 | ||||
| -rw-r--r-- | src/interp/buildom.boot | 14 | ||||
| -rw-r--r-- | src/interp/compiler.boot | 1 | ||||
| -rw-r--r-- | src/interp/g-cndata.boot | 9 | ||||
| -rw-r--r-- | src/interp/g-error.boot | 8 | ||||
| -rw-r--r-- | src/interp/nrunfast.boot | 20 | ||||
| -rw-r--r-- | src/interp/sys-constants.boot | 3 |
7 files changed, 56 insertions, 14 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index f506aadf..e3908535 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,18 @@ +2011-02-09 Gabriel Dos Reis <gdr@cs.tamu.edu> + + Add MappingCategory as a (builtin) category. + * interp/sys-constants.boot ($CategoryNames): Include MappingCategory. + * interp/g-cndata.boot (unabbrevSpecialForms): Handle + MappingCategory, RecordCategory, and UnionCategory. + * interp/buildom.boot (MappingCategory): New. + * interp/compiler.boot: Elaboration MappingCategory forms. + * interp/g-error.boot (needsToSplitMessage): Fix thinko from + type-based dispatch done by the Boot translator. + * interp/nrunfast.boot (builtinConstructor?): New. + (generalizedBuiltinConstructor?): Likewise. + (lazyMatch): Use them. + (newHasTest): Properly recognize all flavours of category forms. + 2011-02-08 Gabriel Dos Reis <gdr@cs.tamu.edu> * interp/sys-constants.boot ($PrimitiveDomainNames): Remove. 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. |