diff options
author | dos-reis <gdr@axiomatics.org> | 2008-01-27 17:52:17 +0000 |
---|---|---|
committer | dos-reis <gdr@axiomatics.org> | 2008-01-27 17:52:17 +0000 |
commit | 58cae19381750526539e986ca1de122803ac2293 (patch) | |
tree | 24c77cb7e745a5072eac5dde2503820de3c376f9 /src/interp | |
parent | a388d36abab4b55733a8e2c19b1a8ec882274fa8 (diff) | |
download | open-axiom-58cae19381750526539e986ca1de122803ac2293.tar.gz |
Fix SF/1872551
* interp/c-util.boot (dollarIfRepHack): New.
(RepIfRepHack): Likewise.
(substituteDollarIfRepHack): Likewise.
(isSubset): Dollar is subset of Rep only in old semantics.
* interp/buildom.boot (mkMappingFunList): Substitute dollar for
Rep only when appropriate.
(mkRecordFunList): Likewise.
(mkNewUnionFunList): Likewise.
(mkUnionFunList): Likewise.
* interp/compiler.boot (compNoStacking): Likewise.
(compNoStacking1): Likewise.
(getConstructorFormOfMode): Likewise.
(isUnionMode): Likewise.
(coerce): Likewise.
(coerceSubset): Likewise.
* interp/modemap.boot (addModemap1): Likewise.
(isSuperDomain): Likewise.
* interp/define.boot (maybeInsertViewMorphisms): New.
(compCapsule): Use it.
(compCategoryItem): Don't allow exports of rep and per.
* interp/sys-globals.boot ($useRepresentationHack): New.
Diffstat (limited to 'src/interp')
-rw-r--r-- | src/interp/buildom.boot | 13 | ||||
-rw-r--r-- | src/interp/c-util.boot | 21 | ||||
-rw-r--r-- | src/interp/compiler.boot | 25 | ||||
-rw-r--r-- | src/interp/define.boot | 48 | ||||
-rw-r--r-- | src/interp/modemap.boot | 15 | ||||
-rw-r--r-- | src/interp/pspad2.boot | 2 | ||||
-rw-r--r-- | src/interp/sys-globals.boot | 6 |
7 files changed, 98 insertions, 32 deletions
diff --git a/src/interp/buildom.boot b/src/interp/buildom.boot index 228ef863..cacced1b 100644 --- a/src/interp/buildom.boot +++ b/src/interp/buildom.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007, Gabriel Dos Reis. +-- Copyright (C) 2007-2008, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -270,7 +270,7 @@ mkMappingFunList(nam,mapForm,e) == sigFunAlist:= [["_=",[["Boolean"],nam ,nam],["ELT",dc,6]], ["coerce",[$OutputForm,nam],["ELT",dc,7]]] - [substitute(nam,dc,substitute("$",'Rep,sigFunAlist)),e] + [substitute(nam,dc,substituteDollarIfRepHack sigFunAlist),e] mkRecordFunList(nam,["Record",:Alist],e) == len:= #Alist @@ -294,11 +294,11 @@ mkRecordFunList(nam,["Record",:Alist],e) == for i in 0.. for [.,a,A] in Alist],: [["copy",[nam,nam],["XLAM",["$1"],["RECORDCOPY", "$1",len]]]]] - [substitute(nam,dc,substitute("$","Rep",sigFunAlist)),e] + [substitute(nam,dc,substituteDollarIfRepHack sigFunAlist),e] mkNewUnionFunList(name,form is ["Union",:listOfEntries],e) == dc := name - if name = "Rep" then name := "$" + m := dollarIfRepHack name --2. create coercions from subtypes to subUnion cList:= [["_=",[["Boolean"],name ,name],["ELT",dc,6]], @@ -367,9 +367,6 @@ mkUnionFunList(op,form is ["Union",:listOfEntries],e) == p is ["EQCAR",x,n] => ["XLAM",["#1"],["QEQCAR",x,n]] ["XLAM",["#1"],p] - op:= - op="Rep" => "$" - op - cList:= substitute(op,g,cList) + cList:= substitute(dollarIfRepHack op,g,cList) [cList,e] diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot index 05a65bb7..d0e4f037 100644 --- a/src/interp/c-util.boot +++ b/src/interp/c-util.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007, Gabriel Dos Reis. +-- Copyright (C) 2007-2008, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -35,6 +35,23 @@ import '"g-util" )package "BOOT" +++ If using old `Rep' definition semantics, return `$' when m is `Rep'. +++ Otherwise, return `m'. +dollarIfRepHack m == + m = "Rep" and $useRepresentationHack => "$" + m + +++ The inverse of the above. +RepIfRepHack m == + m = "$" and $useRepresentationHack => "Rep" + m + +++ If using old `Rep' definition semantics, return `$' is m is `Rep'. +-- ??? Eventually this and the above should be merged and/or removed. +substituteDollarIfRepHack m == + $useRepresentationHack => substitute("$","Rep",m) + m + --% Debugging Functions --CONTINUE() == continue() @@ -340,7 +357,7 @@ isSomeDomainVariable s == IDENTP s and #(x:= PNAME s)>2 and x.(0)="#" and x.(1)="#" isSubset(x,y,e) == - x="$" and y="Rep" or x=y or + ($useRepresentationHack and x="$" and y="Rep") or x=y or LASSOC(opOf x,get(opOf y,"Subsets",e) or GETL(opOf y,"Subsets")) or LASSOC(opOf x,get(opOf y,"SubDomain",e)) or opOf(y)='Type or opOf(y)='Object diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot index 1fba5482..ed7554cb 100644 --- a/src/interp/compiler.boot +++ b/src/interp/compiler.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007, Gabriel Dos Reis. +-- Copyright (C) 2007-2008, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -104,14 +104,18 @@ comp(x,m,e) == compNoStacking(x,m,e) == T:= comp2(x,m,e) => - (m=$EmptyMode and T.mode=$Representation => [T.expr,"$",T.env]; T) - --$Representation is bound in compDefineFunctor, set by doIt - --this hack says that when something is undeclared, $ is - --preferred to the underlying representation -- RDJ 9/12/83 + $useRepresentationHack and m=$EmptyMode and T.mode=$Representation => + [T.expr,"$",T.env] + T + --$Representation is bound in compDefineFunctor, set by doIt + --this hack says that when something is undeclared, $ is + --preferred to the underlying representation -- RDJ 9/12/83 + --Now that `per' and `rep' are built in, we do the above + --hack only when `Rep' is defined the old way. -- gdr 2008/01/26 compNoStacking1(x,m,e,$compStack) compNoStacking1(x,m,e,$compStack) == - u:= get(if m="$" then "Rep" else m,"value",e) => + u:= get(RepIfRepHack m,"value",e) => (T:= comp2(x,u.expr,e) => [T.expr,m,T.env]; nil) nil @@ -511,7 +515,7 @@ checkCallingConvention(sigs,nargs) == getConstructorFormOfMode(m,e) == isConstructorForm m => m - if m="$" then m:= "Rep" + m := RepIfRepHack m atom m and get(m,"value",e) is [v,:.] => isConstructorForm v => v @@ -1038,7 +1042,7 @@ getUnionMode(x,e) == isUnionMode(m,e) == m is ["Union",:.] => m (m':= getmode(m,e)) is ["Mapping",["UnionCategory",:.]] => CADR m' - v:= get(if m="$" then "Rep" else m,"value",e) => + v:= get(RepIfRepHack m,"value",e) => (v.expr is ["Union",:.] => v.expr; nil) nil @@ -1180,7 +1184,8 @@ coerce(T,m) == $InteractiveMode => keyedSystemError("S2GE0016",['"coerce", '"function coerce called from the interpreter."]) - rplac(CADR T,substitute("$",$Rep,CADR T)) + if $useRepresentationHack then + rplac(CADR T,substitute("$",$Rep,CADR T)) T':= coerceEasy(T,m) => T' T':= coerceSubset(T,m) => T' T':= coerceHard(T,m) => T' @@ -1204,7 +1209,7 @@ coerceEasy(T,m) == [T.expr,m,T.env] coerceSubset([x,m,e],m') == - isSubset(m,m',e) or m="Rep" and m'="$" => [x,m',e] + isSubset(m,m',e) => [x,m',e] m is ['SubDomain,=m',:.] => [x,m',e] (pred:= LASSOC(opOf m',get(opOf m,'SubDomain,e))) and INTEGERP x and -- obviously this is temporary diff --git a/src/interp/define.boot b/src/interp/define.boot index 945b4cc4..0192427e 100644 --- a/src/interp/define.boot +++ b/src/interp/define.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007, Gabriel Dos Reis. +-- Copyright (C) 2007-2008, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -49,6 +49,46 @@ compDefine(form,m,e) == $packagesUsed: local result:= compDefine1(form,m,e) result + +++ We are about to process the body of a capsule. If the capsule defines +++ `Rep' as a constant, then implicitly insert the view morphisms +++ per: Rep -> % +++ rep: % -> Rep +++ as local functions. Note that we do not declare them as macros. +maybeInsertViewMorphisms body == + domainRep := nil + before := nil + + while null domainRep for [stmt,:after] in tails body repeat + stmt isnt ["DEF",["Rep",:args],sig,nils,domainRep] => + before := [stmt,:before] + if args then + userError [:bright '"Rep",'"cannot take arguments"] + if first sig then + userError [:bright '"Rep", "cannot have type sepcification"] + + null domainRep => body + -- Make sure we don't implicitly convert from `Rep' to `%'. + $useRepresentationHack := false + -- Reject user-defined view morphisms + for stmt in after repeat + stmt is ["DEF",["rep",:.],:.] + or stmt is ["DEF",["per",:.],:.] => + -- ??? We may actually want to stop processing now. + stackSemanticError(['"Cannot define",:bright per],nil) + + -- OK, insert synthetized view morphisms + g := GENSYM() + repMorphism := ["DEF",["rep",g],[domainRep,"$"],[nil,nil], + ["pretend",g,domainRep]] + perMorphism := ["DEF",["per",g],["$",domainRep],[nil,nil], + ["pretend",g,"$"]] + + -- Trick the rest of the compiler into believing that + -- that `Rep' was defined the old way, for the purpose of lookup. + [:reverse before, ["LET","Rep",domainRep], + :[repMorphism,perMorphism],:after] + compDefine1(form,m,e) == $insideExpressionIfTrue: local:= false @@ -1180,7 +1220,8 @@ compCapsule(['CAPSULE,:itemList],m,e) == $bootStrapMode = true => [bootStrapError($functorForm, _/EDITFILE),m,e] $insideExpressionIfTrue: local:= false - compCapsuleInner(itemList,m,addDomain('_$,e)) + $useRepresentationHack := true + compCapsuleInner(maybeInsertViewMorphisms itemList,m,addDomain('_$,e)) compSubDomain(["SubDomain",domainForm,predicate],m,e) == $addFormLhs: local:= domainForm @@ -1503,6 +1544,9 @@ compCategoryItem(x,predl) == ["SIGNATURE",op,:sig]:= x null atom op => for y in op repeat compCategoryItem(["SIGNATURE",y,:sig],predl) + op in '(per rep) => + stackSemanticError(['"cannot export signature for", :bright op],nil) + nil --4. branch on a single type or a signature %with source and target PUSH(MKQ [rest x,pred],$sigList) diff --git a/src/interp/modemap.boot b/src/interp/modemap.boot index 1cdfdd2c..f2ae0fc5 100644 --- a/src/interp/modemap.boot +++ b/src/interp/modemap.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007, Gabriel Dos Reis. +-- Copyright (C) 2007-2008, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -160,11 +160,7 @@ addEltModemap(op,mc,sig,pred,fn,e) == addModemap1(op,mc,sig,pred,fn,e) == --mc is the "mode of computation"; fn the "implementation" - if mc='Rep then --- if fn is [kind,'Rep,.] and - -- save old sig for NRUNTIME --- (kind = 'ELT or kind = 'CONST) then fn:=[kind,'Rep,sig] - sig:= substitute("$",'Rep,sig) + if mc="Rep" then sig := substituteDollarIfRepHack sig currentProplist:= getProplist(op,e) or nil newModemapList:= mkNewModemapList(mc,sig,pred,fn,LASSOC('modemap,currentProplist),e,nil) @@ -220,7 +216,8 @@ mergeModemap(entry is [[mc,:sig],[pred,:.],:.],modemapList,e) == isSuperDomain(domainForm,domainForm',e) == isSubset(domainForm',domainForm,e) => true - domainForm='Rep and domainForm'="$" => true --regard $ as a subdomain of Rep + --regard $ as a subdomain of Rep, only if using old style Rep + domainForm='Rep and domainForm'="$" => $useRepresentationHack LASSOC(opOf domainForm',get(domainForm,"SubDomain",e)) --substituteForRep(entry is [[mc,:sig],:.],curModemapList) == @@ -255,13 +252,13 @@ substituteCategoryArguments(argl,catform) == --operations are not being redefined. augModemapsFromCategoryRep(domainName,repDefn,functorBody,categoryForm,e) == [fnAlist,e]:= evalAndSub(domainName,domainName,domainName,categoryForm,e) - [repFnAlist,e]:= evalAndSub('Rep,'Rep,repDefn,getmode(repDefn,e),e) + [repFnAlist,e]:= evalAndSub("Rep","Rep",repDefn,getmode(repDefn,e),e) catform:= (isCategory categoryForm => categoryForm.(0); categoryForm) compilerMessage ["Adding ",domainName," modemaps"] e:= putDomainsInScope(domainName,e) $base:= 4 for [lhs:=[op,sig,:.],cond,fnsel] in fnAlist repeat - u:=assoc(SUBST('Rep,domainName,lhs),repFnAlist) + u:=assoc(SUBST("Rep",domainName,lhs),repFnAlist) u and not AMFCR_,redefinedList(op,functorBody) => fnsel':=CADDR u e:= addModemap(op,domainName,sig,cond,fnsel',e) diff --git a/src/interp/pspad2.boot b/src/interp/pspad2.boot index fd19e4fd..fc1fba2a 100644 --- a/src/interp/pspad2.boot +++ b/src/interp/pspad2.boot @@ -111,7 +111,7 @@ formatDeftranRepper([op,a],SEQflag) == b := formatDeftran(b,SEQflag) t := formatDeftran(t,SEQflag) a := ["::",b,t] - op = 'per and t = "$" or op = 'rep and t = 'Rep => a + op = "per" and t = "$" or op = "rep" and t = "Rep" => a [op,a] a is ['SEQ,:r] => ['SEQ,:[formatSeqRepper(op,x) for x in r]] a is ['IF,p,b,c] => diff --git a/src/interp/sys-globals.boot b/src/interp/sys-globals.boot index cc7242d2..777b890f 100644 --- a/src/interp/sys-globals.boot +++ b/src/interp/sys-globals.boot @@ -440,3 +440,9 @@ $compilingInputFile := false ++ $minivectorNames := [] + +++ True if the input file uses old semantics of `Rep', +++ e.g. implicit equivalent Rep <-> % with capsules. +++ This semenatics is in effect only when `Rep' is defined +++ through assignment. +$useRepresentationHack := true |