* interp/parse.boot (parseHas): Constants are not attributes.

	* interp/compiler.boot (compHasFormat): Handle signature for
	constants too.
	* interp/info.boot (actOnInfo): Likewise.
	* algebra/data.spad.pamphlet (sample$Byte): Make a constant.
	(SystemInteger): Export constant 'sample'.
	(SystemNonNegativeInteger): Likewise.
	* algebra/aggcat2.spad.pamphlet (FiniteLinearAggregateFunctions2):
	Use 'sample' or 'random' elements when allocating new aggregates.

6 files changed, 46 insertions, 23 deletions

diff --git a/src/ChangeLog b/src/ChangeLog
index 01ad0fac..0319eb6b 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,15 @@
+2009-02-18  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* interp/parse.boot (parseHas): Constants are not attributes.
+	* interp/compiler.boot (compHasFormat): Handle signature for
+	constants too.
+	* interp/info.boot (actOnInfo): Likewise.
+	* algebra/data.spad.pamphlet (sample$Byte): Make a constant.
+	(SystemInteger): Export constant 'sample'.
+	(SystemNonNegativeInteger): Likewise.
+	* algebra/aggcat2.spad.pamphlet (FiniteLinearAggregateFunctions2):
+	Use 'sample' or 'random' elements when allocating new aggregates.
+
 2009-02-15  Gabriel Dos Reis  <gdr@cs.tamu.edu>
 
 	* algebra/data.spad.pamphlet (ByteBuffer): Tidy.  Manage size
diff --git a/src/algebra/aggcat2.spad.pamphlet b/src/algebra/aggcat2.spad.pamphlet
index a49e955d..7fea65b4 100644
--- a/src/algebra/aggcat2.spad.pamphlet
+++ b/src/algebra/aggcat2.spad.pamphlet
@@ -56,6 +56,11 @@ FiniteLinearAggregateFunctions2(S, A, R, B):
                                        ++ \spad{[reduce(f,[a1],r),reduce(f,[a1,a2],r),...]}.
 
   Implementation ==> add
+    getRSample(): R ==
+      R has sample: R => sample()$R
+      R has random: () -> R => random()$R
+      NIL$Lisp         -- R got to be non-trivial.
+
     if A has ListAggregate(S) then         -- A is a list-oid
       reduce(fn, l, ident) ==
         empty? l => ident
@@ -72,12 +77,12 @@ FiniteLinearAggregateFunctions2(S, A, R, B):
 
       else                      -- A is a list-oid, B a mutable array-oid
         map(f, l) ==
-          i := minIndex(w := new(#l,NIL$Lisp)$B)
+          i := minIndex(w := new(#l,getRSample())$B)
           for a in entries l repeat (qsetelt_!(w, i, f a); i := inc i)
           w
 
         scan(fn, l, ident) ==
-          i := minIndex(w := new(#l,NIL$Lisp)$B)
+          i := minIndex(w := new(#l,getRSample())$B)
           vl := ident
           for a in entries l repeat
             vl := qsetelt_!(w, i, fn(a, vl))
@@ -105,13 +110,13 @@ FiniteLinearAggregateFunctions2(S, A, R, B):
       else                             -- A and B are array-oid's
         if B has shallowlyMutable then -- B is also mutable
           map(f, v) ==
-            w := new(#v,NIL$Lisp)$B
+            w := new(#v,getRSample())$B
             for i in minIndex w .. maxIndex w repeat
               qsetelt_!(w, i, f qelt(v, i))
             w
 
           scan(fn, v, ident) ==
-            w   := new(#v,NIL$Lisp)$B
+            w   := new(#v,getRSample())$B
             vl := ident
             for i in minIndex v .. maxIndex v repeat
               vl := qsetelt_!(w, i, fn(qelt(v, i), vl))
@@ -188,6 +193,8 @@ FiniteSetAggregateFunctions2(S, A, R, B): Exports == Implementation where
 <<license>>=
 --Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
 --All rights reserved.
+--Copyright (C) 2007-2009, Gabriel Dos Reis.
+--All rights reserved.
 --
 --Redistribution and use in source and binary forms, with or without
 --modification, are permitted provided that the following conditions are
diff --git a/src/algebra/data.spad.pamphlet b/src/algebra/data.spad.pamphlet
index 43a3b07d..eb69372a 100644
--- a/src/algebra/data.spad.pamphlet
+++ b/src/algebra/data.spad.pamphlet
@@ -33,11 +33,11 @@ Byte(): Public == Private where
       ++ bitand(x,y) returns the bitwise `and' of `x' and `y'.
     bitior: (%,%) -> %
       ++ bitor(x,y) returns the bitwise `inclusive or' of `x' and `y'.
-    sample: () -> %
-      ++ sample() returns a sample datum of type Byte.
+    sample: %
+      ++ \spad{sample} gives a sample datum of type Byte.
   Private == SubDomain(NonNegativeInteger, #1 < 256) add
     byte(x: NonNegativeInteger): % == per x
-    sample() = 0$Lisp
+    sample = 0$Lisp
     coerce(c: Character) == per ord c
     coerce(x: %): Character == char rep x
     x = y == byteEqual(x,y)$Lisp
@@ -91,8 +91,10 @@ ByteOrder(): Public == Private where
 ++   for system programming tasks, i.e. interfacting with the hosting
 ++   operating system, reading/writing external binary format files.
 SystemInteger(N: PositiveInteger): Public == Private where
-  Public == OrderedFinite
+  Public == OrderedFinite with
+    sample: % ++ \spad{sample} gives a sample datum of this type.
   Private == SubDomain(Integer, length #1 <= N) add
+    sample == per(0@Integer)
     min == per(-shift(1,N-1))
     max == per(shift(1,N-1)-1)
     size() == (rep max - rep min + 1)::NonNegativeInteger
@@ -159,12 +161,12 @@ SystemNonNegativeInteger(N: PositiveInteger): Public == Private where
       ++ bitand(x,y) returns the bitwise `and' of `x' and `y'.
     bitior: (%,%) -> %
       ++ bitor(x,y) returns the bitwise `inclusive or' of `x' and `y'.
-    sample: () -> %
-      ++ sample() returns a sample datum of type Byte.
+    sample: %
+      ++ \spad{sample} gives a sample datum of type Byte.
   Private == SubDomain(NonNegativeInteger, length #1 <= N) add
     min == per 0
     max == per((shift(1,N)-1)::NonNegativeInteger)
-    sample() == min
+    sample == min
     bitand(x,y) == BOOLE(BOOLE_-AND$Lisp,x,y)$Lisp
     bitior(x,y) == BOOLE(BOOLE_-IOR$Lisp,x,y)$Lisp
 
diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot
index aa09ea1f..b5faa805 100644
--- a/src/interp/compiler.boot
+++ b/src/interp/compiler.boot
@@ -1101,6 +1101,7 @@ compElt(form,m,E) ==
     E:= addDomain(aDomain,E)
     mmList:= getModemapListFromDomain(anOp,0,aDomain,E)
     modemap:=
+      -- FIXME: do this only for constants.
       n:=#mmList
       1=n => mmList.(0)
       0=n =>
@@ -1112,7 +1113,6 @@ compElt(form,m,E) ==
       mmList.(0)
     [sig,[pred,val]]:= modemap
     #sig^=2 and ^val is ["elt",:.] => nil --what does the second clause do ????
---+
     val := genDeltaEntry [opOf anOp,:modemap]
     convert([["call",val],first rest sig,E], m) --implies fn calls used to access constants
   compForm(form,m,E)
@@ -1121,9 +1121,7 @@ compElt(form,m,E) ==
 
 compHas: (%Form,%Mode,%Env) -> %Maybe %Triple
 compHas(pred is ["has",a,b],m,$e) ==
-  --b is (":",:.) => (.,.,E):= comp(b,$EmptyMode,E)
   $e:= chaseInferences(pred,$e)
-  --pred':= ("has",a',b') := formatHas(pred)
   predCode:= compHasFormat pred
   coerce([predCode,$Boolean,$e],m)
 
@@ -1136,7 +1134,7 @@ compHasFormat (pred is ["has",olda,b]) ==
   [a,:.] := comp(a,$EmptyMode,$e) or return nil
   a := SUBLISLIS(formals,argl,a)
   b is ["ATTRIBUTE",c] => ["HasAttribute",a,["QUOTE",c]]
-  b is ["SIGNATURE",op,sig] =>
+  b is ["SIGNATURE",op,sig,:.] =>
      ["HasSignature",a,
        mkList [MKQ op,mkList [mkTypeForm type for type in sig]]]
   isCategoryForm(b,$e) => ["HasCategory",a,mkTypeForm b]
diff --git a/src/interp/info.boot b/src/interp/info.boot
index 36daa11c..878b78b0 100644
--- a/src/interp/info.boot
+++ b/src/interp/info.boot
@@ -97,7 +97,7 @@ formatInfo u ==
     b="%noBranch" => ["COND",:liftCond [["not",formatPred a],formatInfo c]]
     ["COND",:liftCond [formatPred a,formatInfo b],:
       liftCond [["not",formatPred a],formatInfo c]]
-  systemError '"formatInfo"
+  systemError ['"formatInfo",u]
  
 liftCond (clause is [ante,conseq]) ==
   conseq is ["COND",:l] =>
@@ -118,7 +118,7 @@ formatPred u ==
     ["has",a,["ATTRIBUTE",b]]
   atom u => u
   u is ["and",:v] => ["and",:[formatPred w for w in v]]
-  systemError '"formatPred"
+  systemError ['"formatPred",u]
  
 chaseInferences(pred,$e) ==
   foo hasToInfo pred where
@@ -220,18 +220,21 @@ actOnInfo(u,$e) ==
     cat:= ["CATEGORY",key,["ATTRIBUTE",att]]
     $e:= put(name,"value",[vval,mkJoin(cat,vmode),venv],$e)
       --there is nowhere %else that this sort of thing exists
-  u is ["SIGNATURE",name,operator,modemap] =>
+  u is ["SIGNATURE",name,operator,modemap,:q] =>
+    kind := 
+      q is ["constant"] => "CONST" 
+      "ELT"
     implem:=
       (implem:=ASSOC([name,:modemap],get(operator,'modemap,$e))) =>
           CADADR implem
-      name = "$" => ['ELT,name,-1]
-      ['ELT,name,substitute('$,name,modemap)]
+      name = "$" => [kind,name,-1]
+      [kind,name,substitute('$,name,modemap)]
     $e:= addModemap(operator,name,modemap,true,implem,$e)
     [vval,vmode,venv]:= GetValue name
     compilerMessage('"augmenting %1: %2p", 
-      [name,["SIGNATURE",operator,modemap]])
+       [name,["SIGNATURE",operator,modemap,:q]])
     key:= if CONTAINED("$",vmode) then "domain" else name
-    cat:= ["CATEGORY",key,["SIGNATURE",operator,modemap]]
+    cat:= ["CATEGORY",key,["SIGNATURE",operator,modemap,:q]]
     $e:= put(name,"value",[vval,mkJoin(cat,vmode),venv],$e)
   u is ["has",name,cat] =>
     [vval,vmode,venv]:= GetValue name
@@ -255,7 +258,7 @@ actOnInfo(u,$e) ==
       $e:= put(name,"value",[vval,mkJoin(cat,vmode),venv],$e)
     SAY("extension of ",vval," to ",cat," ignored")
     $e
-  systemError '"knownInfo"
+  systemError ['"actOnInfo",u]
  
 mkJoin(cat,mode) ==
   mode is ['Join,:cats] => ['Join,cat,:cats]
diff --git a/src/interp/parse.boot b/src/interp/parse.boot
index cff6ef7c..92c040bd 100644
--- a/src/interp/parse.boot
+++ b/src/interp/parse.boot
@@ -211,6 +211,7 @@ parseHas t ==
       kk = "domain" or kk = "category" => [makeNonAtomic y]
       y is ["ATTRIBUTE",:.] => [y]
       y is ["SIGNATURE",:.] => [y]
+      y is [":",op,type] => [["SIGNATURE",op,[type],"constant"]]
       [["ATTRIBUTE",y]]
  
 parseDEF: %ParseForm -> %Form