From 58cae19381750526539e986ca1de122803ac2293 Mon Sep 17 00:00:00 2001
From: dos-reis <gdr@axiomatics.org>
Date: Sun, 27 Jan 2008 17:52:17 +0000
Subject: 	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.

---
 src/interp/buildom.boot     | 13 +++++-------
 src/interp/c-util.boot      | 21 ++++++++++++++++++--
 src/interp/compiler.boot    | 25 +++++++++++++----------
 src/interp/define.boot      | 48 +++++++++++++++++++++++++++++++++++++++++++--
 src/interp/modemap.boot     | 15 ++++++--------
 src/interp/pspad2.boot      |  2 +-
 src/interp/sys-globals.boot |  6 ++++++
 7 files changed, 98 insertions(+), 32 deletions(-)

(limited to 'src/interp')

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
-- 
cgit v1.2.3