diff options
| -rw-r--r-- | src/ChangeLog | 12 | ||||
| -rw-r--r-- | src/algebra/aggcat2.spad.pamphlet | 15 | ||||
| -rw-r--r-- | src/algebra/data.spad.pamphlet | 16 | ||||
| -rw-r--r-- | src/interp/compiler.boot | 6 | ||||
| -rw-r--r-- | src/interp/info.boot | 19 | ||||
| -rw-r--r-- | src/interp/parse.boot | 1 |
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 |