001: package gnu.kawa.functions;
002:
003: import gnu.bytecode.*;
004: import gnu.mapping.*;
005: import gnu.expr.*;
006: import gnu.mapping.Procedure;
007: import gnu.kawa.reflect.Invoke;
008: import gnu.kawa.reflect.ArraySet;
009:
010: /** Implements Kawa extension function "setter", as in SRFI-17. */
011:
012: public class Setter extends Procedure1 implements CanInline, HasSetter {
013: public static final Setter setter = new Setter();
014: static {
015: setter.setName("setter");
016: }
017:
018: public static Object setter(Procedure arg) {
019: return arg.getSetter();
020: }
021:
022: public Object apply1(Object arg) {
023: if (!(arg instanceof Procedure)) {
024: /* #ifdef JAVA2 */
025: if (arg instanceof java.util.List)
026: return new SetList((java.util.List) arg);
027: /* #else */
028: // if (arg instanceof gnu.lists.Sequence)
029: // return new SetList((gnu.lists.Sequence) arg);
030: /* #endif */
031: Class cl = arg.getClass();
032: if (cl.isArray())
033: return new SetArray(arg, Language.getDefaultLanguage()/*FIXME*/);
034: }
035: return ((Procedure) arg).getSetter();
036: }
037:
038: public Expression inline(ApplyExp exp, ExpWalker walker) {
039: Expression[] args = exp.getArgs();
040: if (args.length == 1) {
041: Expression arg = args[0];
042: Type argType = arg.getType();
043: ClassType ctype;
044: if (argType instanceof ArrayType) {
045: return new SetArrayExp(arg, (ArrayType) argType);
046: }
047: if (argType instanceof ClassType
048: && (ctype = (ClassType) argType)
049: .isSubclass(ApplyToArgs.typeList)) {
050: if (exp instanceof SetListExp)
051: return exp;
052: else
053: return new SetListExp(exp.getFunction(), args);
054: }
055: if (arg instanceof ReferenceExp) {
056: Declaration decl = ((ReferenceExp) arg).getBinding();
057: if (decl != null)
058: arg = decl.getValue();
059: }
060: if (arg instanceof QuoteExp) {
061: Object value = ((QuoteExp) arg).getValue();
062: if (value instanceof Procedure) {
063: Object setter = ((Procedure) value).getSetter();
064: if (setter instanceof Procedure) {
065: if (setter instanceof java.io.Externalizable)
066: return new QuoteExp(setter);
067: Declaration decl = Declaration
068: .getDeclaration((Procedure) setter);
069: if (decl != null)
070: return new ReferenceExp(decl);
071: }
072: }
073: }
074: }
075: return exp;
076: }
077:
078: public void set1(Object arg1, Object value) throws Throwable {
079: ((Procedure) arg1).setSetter((Procedure) value);
080: }
081:
082: static final ClassType setterType = ClassType
083: .make("gnu.kawa.functions.Setter");
084: static final Field setterField = setterType
085: .getDeclaredField("setter");
086: public static final Declaration setterDecl = new Declaration(
087: "setter", setterField);
088: static {
089: setterDecl.noteValue(new QuoteExp(Setter.setter));
090: }
091:
092: }
093:
094: class SetArray extends Procedure2 {
095: Object array;
096: Type elementType;
097:
098: public SetArray(Object array, Language language) {
099: Class elementClass = array.getClass().getComponentType();
100: elementType = language.getTypeFor(elementClass);
101: this .array = array;
102: }
103:
104: public Object apply2(Object index, Object value) {
105: value = elementType.coerceFromObject(value);
106: java.lang.reflect.Array.set(array, ((Number) index).intValue(),
107: value);
108: return Values.empty;
109: }
110: }
111:
112: class SetList extends Procedure2 {
113: /* #ifdef JAVA2 */
114: java.util.List list;
115:
116: public SetList(java.util.List list) {
117: this .list = list;
118: }
119:
120: /* #else */
121: // gnu.lists.Sequence list;
122: // public SetList (gnu.lists.Sequence list)
123: // {
124: // this.list = list;
125: // }
126: /* #endif */
127: Type elementType;
128:
129: public Object apply2(Object index, Object value) {
130: list.set(((Number) index).intValue(), value);
131: return Values.empty;
132: }
133: }
134:
135: class SetArrayExp extends ApplyExp {
136: public static final ClassType typeSetArray = ClassType
137: .make("gnu.kawa.functions.SetArray");
138:
139: Type elementType;
140:
141: public SetArrayExp(Expression array, ArrayType arrayType) {
142: super (Invoke.make, new Expression[] {
143: new QuoteExp(typeSetArray), array });
144: elementType = arrayType.getComponentType();
145: }
146:
147: public Expression inline(ApplyExp exp, InlineCalls walker,
148: Declaration decl) {
149: Expression[] args = exp.getArgs();
150: if (args.length == 2) {
151: Expression array = this .getArgs()[1];
152: Expression[] xargs = new Expression[3];
153: xargs[0] = array;
154: xargs[1] = args[0];
155: xargs[2] = args[1];
156: ArraySet arrSetter = new ArraySet(elementType);
157: return walker.walkApplyOnly(new ApplyExp(arrSetter, xargs));
158: }
159: return exp;
160: }
161: }
162:
163: class SetListExp extends ApplyExp {
164: public SetListExp(Expression func, Expression[] args) {
165: super (func, args);
166: }
167:
168: public Expression inline(ApplyExp exp, InlineCalls walker,
169: Declaration decl) {
170: Expression[] args = exp.getArgs();
171: if (args.length == 2) {
172: Expression[] xargs = new Expression[4];
173: xargs[0] = this .getArgs()[0];
174: xargs[1] = QuoteExp.getInstance("set");
175: xargs[2] = Convert.makeCoercion(args[0], Type.int_type);
176: xargs[3] = args[1];
177: Expression set = walker.walkApplyOnly(new ApplyExp(
178: Invoke.invoke, xargs));
179: return Convert.makeCoercion(set, Type.void_type);
180: }
181: return exp;
182: }
183: }
|