Esempio n. 1
0
        /** Reduce a cond expression to some code which, when evaluated,
         * gives the value of the cond expression.  We do it that way to
         * maintain tail recursion. **/
        Object reduceCond(Object clauses, Environment env)
        {
            Object result = null;

            for (; ;)
            {
                if (clauses == null)
                {
                    return(FALSE);
                }
                Object clause = first(clauses); clauses = rest(clauses);
                if (string.Equals(SchemeUtils.first(clause), "else") ||
                    truth(result = eval(first(clause), env)))
                {
                    if (rest(clause) == null)
                    {
                        return(list("quote", result));
                    }
                    else if (string.Equals(SchemeUtils.second(clause), "=>"))
                    {
                        return(list(third(clause), list("quote", result)));
                    }
                    else
                    {
                        return(cons("begin", rest(clause)));
                    }
                }
            }
        }
Esempio n. 2
0
        /** Apply a primitive to a list of arguments. **/
        public override object apply(Scheme interp, object args)
        {
            //First make sure there are the right number of arguments.
            int nArgs = length(args);

            if (nArgs < minArgs)
            {
                return(error("too few args, " + nArgs +
                             ", for " + this.name + ": " + args));
            }
            else if (nArgs > maxArgs)
            {
                return(error("too many args, " + nArgs +
                             ", for " + this.name + ": " + args));
            }

            Object x = first(args);
            Object y = second(args);

            switch (idNumber)
            {
            ////////////////  SECTION 6.1 BOOLEANS
            case NOT:           return(truth((Boolean)x == FALSE));

            case BOOLEANQ: return(truth((Boolean)x == TRUE || (Boolean)x == FALSE));

            ////////////////  SECTION 6.2 EQUIVALENCE PREDICATES
            case EQVQ:          return(truth(eqv(x, y)));

            case EQQ:           return(truth(x == y));

            case EQUALQ:        return(truth(equal(x, y)));

            ////////////////  SECTION 6.3 LISTS AND PAIRS
            case PAIRQ:         return(truth(x is Pair));

            case LISTQ:         return(truth(isList(x)));

            case CXR:           for (int i = name.Length - 2; i >= 1; i--)
                {
                    x = (name[i] == 'a') ? first(x) : rest(x);
                }
                return(x);

            case CONS:          return(cons(x, y));

            case CAR:           return(first(x));

            case CDR:           return(rest(x));

            case SETCAR:        return(setFirst(x, y));

            case SETCDR:        return(setRest(x, y));

            case SECOND:        return(second(x));

            case THIRD:         return(third(x));

            case NULLQ:         return(truth(x == null));

            case LIST:          return(args);

            case LENGTH:        return(num(length(x)));

            case APPEND:        return((args == null) ? null : append(args));

            case REVERSE:       return(reverse(x));

            case LISTTAIL:      for (int k = (int)num(y); k > 0; k--)
                {
                    x = rest(x);
                }
                return(x);

            case LISTREF:       for (int k = (int)num(y); k > 0; k--)
                {
                    x = rest(x);
                }
                return(first(x));

            case MEMQ:          return(memberAssoc(x, y, 'm', 'q'));

            case MEMV:          return(memberAssoc(x, y, 'm', 'v'));

            case MEMBER:        return(memberAssoc(x, y, 'm', ' '));

            case ASSQ:          return(memberAssoc(x, y, 'a', 'q'));

            case ASSV:          return(memberAssoc(x, y, 'a', 'v'));

            case ASSOC:         return(memberAssoc(x, y, 'a', ' '));

            ////////////////  SECTION 6.4 SYMBOLS
            case SYMBOLQ:       return(truth(x is String));

            case SYMBOLTOSTRING: return(sym(x).ToCharArray());

            case STRINGTOSYMBOL: return(new String(SchemeUtils.str(x)));

            ////////////////  SECTION 6.5 NUMBERS
            case NUMBERQ:       return(truth(x is Double));

            case ODDQ:          return(truth(Math.Abs(num(x)) % 2 != 0));

            case EVENQ:         return(truth(Math.Abs(num(x)) % 2 == 0));

            case ZEROQ:         return(truth(num(x) == 0));

            case POSITIVEQ:     return(truth(num(x) > 0));

            case NEGATIVEQ:     return(truth(num(x) < 0));

            case INTEGERQ:      return(truth(isExact(x)));

            case INEXACTQ:      return(truth(!isExact(x)));

            case LT:            return(numCompare(args, '<'));

            case GT:            return(numCompare(args, '>'));

            case EQ:            return(numCompare(args, '='));

            case LE:            return(numCompare(args, 'L'));

            case GE:            return(numCompare(args, 'G'));

            case MAX:           return(numCompute(args, 'X', num(x)));

            case MIN:           return(numCompute(args, 'N', num(x)));

            case PLUS:          return(numCompute(args, '+', 0.0));

            case MINUS:         return(numCompute(rest(args), '-', num(x)));

            case TIMES:         return(numCompute(args, '*', 1.0));

            case DIVIDE:        return(numCompute(rest(args), '/', num(x)));

            case QUOTIENT:      double d = num(x) / num(y);
                return(num(d > 0 ? Math.Floor(d) : Math.Ceiling(d)));

            case REMAINDER:     return(num((long)num(x) % (long)num(y)));

            case MODULO:        long xi = (long)num(x), yi = (long)num(y), m = xi % yi;
                return(num((xi * yi > 0 || m == 0) ? m : m + yi));

            case ABS:           return(num(Math.Abs(num(x))));

            case FLOOR:         return(num(Math.Floor(num(x))));

            case CEILING:       return(num(Math.Ceiling(num(x))));

            case TRUNCATE:      d = num(x);
                return(num((d < 0.0) ? Math.Ceiling(d) : Math.Floor(d)));

            case ROUND:         return(num(Math.Round(num(x))));

            case EXP:           return(num(Math.Exp(num(x))));

            case LOG:           return(num(Math.Log(num(x))));

            case SIN:           return(num(Math.Sin(num(x))));

            case COS:           return(num(Math.Cos(num(x))));

            case TAN:           return(num(Math.Tan(num(x))));

            case ASIN:          return(num(Math.Asin(num(x))));

            case ACOS:          return(num(Math.Acos(num(x))));

            case ATAN:          return(num(Math.Atan(num(x))));

            case SQRT:          return(num(Math.Sqrt(num(x))));

            case EXPT:          return(num(Math.Pow(num(x), num(y))));

            case NUMBERTOSTRING: return(numberToString(x, y));

            case STRINGTONUMBER: return(stringToNumber(x, y));

            case GCD:           return((args == null) ? ZERO : gcd(args));

            case LCM:           return((args == null) ? ONE  : lcm(args));

            ////////////////  SECTION 6.6 CHARACTERS
            case CHARQ:           return(truth(x is Char));

            case CHARALPHABETICQ: return(truth(Char.IsLetter(chr(x))));

            case CHARNUMERICQ:    return(truth(Char.IsDigit(chr(x))));

            case CHARWHITESPACEQ: return(truth(Char.IsWhiteSpace(chr(x))));

            case CHARUPPERCASEQ:  return(truth(Char.IsUpper(chr(x))));

            case CHARLOWERCASEQ:  return(truth(Char.IsLower(chr(x))));

            case CHARTOINTEGER:   return((double)chr(x));

            case INTEGERTOCHAR:   return(chr((char)(int)num(x)));

            case CHARUPCASE:      return(chr(Char.ToUpper(chr(x))));

            case CHARDOWNCASE:    return(chr(Char.ToLower(chr(x))));

            case CHARCMP + EQ:      return(truth(charCompare(x, y, false) == 0));

            case CHARCMP + LT:      return(truth(charCompare(x, y, false) < 0));

            case CHARCMP + GT:      return(truth(charCompare(x, y, false) > 0));

            case CHARCMP + GE:      return(truth(charCompare(x, y, false) >= 0));

            case CHARCMP + LE:      return(truth(charCompare(x, y, false) <= 0));

            case CHARCICMP + EQ:    return(truth(charCompare(x, y, true) == 0));

            case CHARCICMP + LT:    return(truth(charCompare(x, y, true) < 0));

            case CHARCICMP + GT:    return(truth(charCompare(x, y, true) > 0));

            case CHARCICMP + GE:    return(truth(charCompare(x, y, true) >= 0));

            case CHARCICMP + LE:    return(truth(charCompare(x, y, true) <= 0));

            case ERROR:         return(error(stringify(args)));

            ////////////////  SECTION 6.7 STRINGS
            case STRINGQ:       return(truth(x is char[]));

            case MAKESTRING: char[] str = new char[(int)num(x)];
                if (y != null)
                {
                    char c = chr(y);
                    for (int i = str.Length - 1; i >= 0; i--)
                    {
                        str[i] = c;
                    }
                }
                return(str);

            case STRING:        return(listToString(args));

            case STRINGLENGTH:  return(num(SchemeUtils.str(x).Length));

            case STRINGREF: return(chr(SchemeUtils.str(x)[(int)num(y)]));

            case STRINGSET: Object z = third(args); SchemeUtils.str(x)[(int)num(y)] = chr(z);
                return(z);

            case SUBSTRING:     int start = (int)num(y), end = (int)num(third(args));
                return(new String(SchemeUtils.str(x), start, end - start).ToCharArray());

            case STRINGAPPEND:  return(stringAppend(args));

            case STRINGTOLIST:  Pair result = null;
                char[] str2 = SchemeUtils.str(x);
                for (int i = str2.Length - 1; i >= 0; i--)
                {
                    result = cons(chr(str2[i]), result);
                }
                return(result);

            case LISTTOSTRING:  return(listToString(x));

            case STRINGCMP + EQ:  return(truth(stringCompare(x, y, false) == 0));

            case STRINGCMP + LT:  return(truth(stringCompare(x, y, false) < 0));

            case STRINGCMP + GT:  return(truth(stringCompare(x, y, false) > 0));

            case STRINGCMP + GE:  return(truth(stringCompare(x, y, false) >= 0));

            case STRINGCMP + LE:  return(truth(stringCompare(x, y, false) <= 0));

            case STRINGCICMP + EQ: return(truth(stringCompare(x, y, true) == 0));

            case STRINGCICMP + LT: return(truth(stringCompare(x, y, true) < 0));

            case STRINGCICMP + GT: return(truth(stringCompare(x, y, true) > 0));

            case STRINGCICMP + GE: return(truth(stringCompare(x, y, true) >= 0));

            case STRINGCICMP + LE: return(truth(stringCompare(x, y, true) <= 0));

            ////////////////  SECTION 6.8 VECTORS
            case VECTORQ:       return(truth(x is Object[]));

            case MAKEVECTOR:    Object[] vec = new Object[(int)num(x)];
                if (y != null)
                {
                    for (int i = 0; i < vec.Length; i++)
                    {
                        vec[i] = y;
                    }
                }
                return(vec);

            case VECTOR:        return(listToVector(args));

            case VECTORLENGTH: return(num(SchemeUtils.vec(x).Length));

            case VECTORREF: return(SchemeUtils.vec(x)[(int)num(y)]);

            case VECTORSET: return(SchemeUtils.vec(x)[(int)num(y)] = third(args));

            case VECTORTOLIST:  return(vectorToList(x));

            case LISTTOVECTOR:  return(listToVector(x));

            ////////////////  SECTION 6.9 CONTROL FEATURES
            case EVAL:          return(interp.eval(x));

            case FORCE:         return((!(x is Procedure)) ? x
              : Procedure.proc(x).apply(interp, null));

            case MACROEXPAND:   return(Macro.macroExpand(interp, x));

            case PROCEDUREQ:    return(truth(x is Procedure));

            case APPLY: return(Procedure.proc(x).apply(interp, listStar(rest(args))));

            case MAP: return(map(Procedure.proc(x), rest(args), interp, list(null)));

            case FOREACH: return(map(Procedure.proc(x), rest(args), interp, null));

            case CALLCC: Exception cc   = new Exception();
                Continuation       proc = new Continuation(cc);
                try { return(Procedure.proc(x).apply(interp, list(proc))); }
                catch (Exception e)
                {
                    if (e == cc)
                    {
                        return(proc.value);
                    }
                    else
                    {
                        throw e;
                    }
                }

            ////////////////  SECTION 6.10 INPUT AND OUPUT
            case EOFOBJECTQ:         return(truth(string.Equals(x, InputPort.EOF)));

            case INPUTPORTQ:         return(truth(x is InputPort));

            case CURRENTINPUTPORT:   return(interp.input);

            case OPENINPUTFILE:      return(openInputFile(x));

            case CLOSEINPUTPORT:     return(inPort(x, interp).close());

            case OUTPUTPORTQ: return(truth(x is TextWriter));

            case CURRENTOUTPUTPORT:  return(interp.output);

            case OPENOUTPUTFILE:     return(openOutputFile(x));

            case CALLWITHOUTPUTFILE: TextWriter p = null;
                try { p = openOutputFile(x);
                      z = Procedure.proc(y).apply(interp, list(p)); } finally { if (p != null)
                                                                                {
                                                                                    p.Close();
                                                                                }
                }
                return(z);

            case CALLWITHINPUTFILE:  InputPort p2 = null;
                try { p2 = openInputFile(x);
                      z  = Procedure.proc(y).apply(interp, list(p2)); }
                finally { if (p2 != null)
                          {
                              p2.close();
                          }
                }
                return(z);

            case CLOSEOUTPUTPORT:    outPort(x, interp).Close(); return(TRUE);

            case READCHAR:      return(inPort(x, interp).readChar());

            case PEEKCHAR:      return(inPort(x, interp).peekChar());

            case LOAD:          return(interp.load(x));

            case READ:          return(inPort(x, interp).read());

            case EOF_OBJECT:    return(truth(InputPort.isEOF(x)));

            case WRITE:         return(write(x, outPort(y, interp), true));

            case DISPLAY:       return(write(x, outPort(y, interp), false));

            case NEWLINE:       outPort(x, interp).WriteLine();
                outPort(x, interp).Flush(); return(TRUE);

            ////////////////  EXTENSIONS
            case CLASS:         try { return(Type.GetType(stringify(x, false))); }
                catch (Exception e) { return(FALSE); }

            case NEW:           try { return(Type.GetType(x.ToString()).Assembly.CreateInstance(x.ToString())); }
                catch (Exception e) { return(FALSE); }

            case EXIT: System.Environment.Exit((x == null) ? 0 : (int)num(x)); return(0);

            case LISTSTAR:      return(listStar(args));

            default:            return(error("internal error: unknown primitive: "
                                             + this + " applied to " + args));
            }
        }