Changeset 4091
- Timestamp:
- 09/28/03 01:14:59 (20 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/j/src/org/armedbear/lisp/Primitives.java
r4090 r4091 3 3 * 4 4 * Copyright (C) 2002-2003 Peter Graves 5 * $Id: Primitives.java,v 1.44 6 2003-09-28 00:47:10piso Exp $5 * $Id: Primitives.java,v 1.447 2003-09-28 01:14:59 piso Exp $ 6 6 * 7 7 * This program is free software; you can redistribute it and/or … … 30 30 public final class Primitives extends Module 31 31 { 32 // SpecialOperator33 private static final int FLET = 1;34 private static final int LABELS = 2;35 private static final int PROGN = 3;36 37 32 // Primitive 38 private static final int DIVIDE = 4;39 private static final int EXIT = 5;40 private static final int MAX = 6;41 private static final int MIN = 7;42 private static final int MULTIPLY = 8;43 private static final int VALUES = 9;33 private static final int DIVIDE = 1; 34 private static final int EXIT = 2; 35 private static final int MAX = 3; 36 private static final int MIN = 4; 37 private static final int MULTIPLY = 5; 38 private static final int VALUES = 6; 44 39 45 40 // Primitive1 46 private static final int ABS = 10;47 private static final int ARRAYP = 11;48 private static final int ARRAY_HAS_FILL_POINTER_P = 12;49 private static final int BIT_VECTOR_P = 1 3;50 private static final int BOTH_CASE_P = 1 4;51 private static final int CHARACTERP = 1 5;52 private static final int CHAR_CODE = 1 6;53 private static final int CHAR_DOWNCASE = 1 7;54 private static final int CHAR_INT = 1 8;55 private static final int CHAR_UPCASE = 1 9;56 private static final int CODE_CHAR = 20;57 private static final int COMPILED_FUNCTION_P = 21;58 private static final int CONSP = 22;59 private static final int EVAL = 2 3;60 private static final int EVENP = 2 4;61 private static final int FBOUNDP = 2 5;62 private static final int FMAKUNBOUND = 2 6;63 private static final int FOURTH = 2 7;64 private static final int FUNCTIONP = 2 8;65 private static final int IDENTITY = 2 9;66 private static final int KEYWORDP = 30;67 private static final int LENGTH = 31;68 private static final int LISTP = 32;69 private static final int LOWER_CASE_P = 3 3;70 private static final int MAKE_SYMBOL = 3 4;71 private static final int MAKUNBOUND = 3 5;72 private static final int NUMBERP = 3 6;73 private static final int ODDP = 3 7;74 private static final int PREDECESSOR = 3 8;75 private static final int SECOND = 3 9;76 private static final int SIMPLE_BIT_VECTOR_P = 40;77 private static final int SIMPLE_STRING_P = 41;78 private static final int SIMPLE_VECTOR_P = 42;79 private static final int SPECIAL_OPERATOR_P = 4 3;80 private static final int STRINGP = 4 4;81 private static final int SUCCESSOR = 4 5;82 private static final int SYMBOL_FUNCTION = 4 6;83 private static final int SYMBOL_NAME = 4 7;84 private static final int SYMBOL_PACKAGE = 4 8;85 private static final int SYMBOL_PLIST = 4 9;86 private static final int SYMBOL_VALUE = 50;87 private static final int THIRD = 51;88 private static final int UPPER_CASE_P = 52;89 private static final int VALUES_LIST = 5 3;90 private static final int VECTORP = 5 4;41 private static final int ABS = 7; 42 private static final int ARRAYP = 8; 43 private static final int ARRAY_HAS_FILL_POINTER_P = 9; 44 private static final int BIT_VECTOR_P = 10; 45 private static final int BOTH_CASE_P = 11; 46 private static final int CHARACTERP = 12; 47 private static final int CHAR_CODE = 13; 48 private static final int CHAR_DOWNCASE = 14; 49 private static final int CHAR_INT = 15; 50 private static final int CHAR_UPCASE = 16; 51 private static final int CODE_CHAR = 17; 52 private static final int COMPILED_FUNCTION_P = 18; 53 private static final int CONSP = 19; 54 private static final int EVAL = 20; 55 private static final int EVENP = 21; 56 private static final int FBOUNDP = 22; 57 private static final int FMAKUNBOUND = 23; 58 private static final int FOURTH = 24; 59 private static final int FUNCTIONP = 25; 60 private static final int IDENTITY = 26; 61 private static final int KEYWORDP = 27; 62 private static final int LENGTH = 28; 63 private static final int LISTP = 29; 64 private static final int LOWER_CASE_P = 30; 65 private static final int MAKE_SYMBOL = 31; 66 private static final int MAKUNBOUND = 32; 67 private static final int NUMBERP = 33; 68 private static final int ODDP = 34; 69 private static final int PREDECESSOR = 35; 70 private static final int SECOND = 36; 71 private static final int SIMPLE_BIT_VECTOR_P = 37; 72 private static final int SIMPLE_STRING_P = 38; 73 private static final int SIMPLE_VECTOR_P = 39; 74 private static final int SPECIAL_OPERATOR_P = 40; 75 private static final int STRINGP = 41; 76 private static final int SUCCESSOR = 42; 77 private static final int SYMBOL_FUNCTION = 43; 78 private static final int SYMBOL_NAME = 44; 79 private static final int SYMBOL_PACKAGE = 45; 80 private static final int SYMBOL_PLIST = 46; 81 private static final int SYMBOL_VALUE = 47; 82 private static final int THIRD = 48; 83 private static final int UPPER_CASE_P = 49; 84 private static final int VALUES_LIST = 50; 85 private static final int VECTORP = 51; 91 86 92 87 // Primitive2 93 private static final int MEMBER = 5 5;94 private static final int RPLACA = 5 6;95 private static final int RPLACD = 5 7;96 private static final int SET = 5 8;88 private static final int MEMBER = 52; 89 private static final int RPLACA = 53; 90 private static final int RPLACD = 54; 91 private static final int SET = 55; 97 92 98 93 private Primitives() 99 94 { 100 defineSpecialOperator("flet", FLET);101 defineSpecialOperator("labels", LABELS);102 defineSpecialOperator("progn", PROGN);103 104 95 definePrimitive("*", MULTIPLY); 105 96 definePrimitive("/", DIVIDE); … … 159 150 definePrimitive2("rplacd", RPLACD); 160 151 definePrimitive2("set", SET); 161 }162 163 // SpecialOperator164 public LispObject dispatch(LispObject args, Environment env, int index)165 throws ConditionThrowable166 {167 switch (index) {168 case FLET: // ### flet169 return _flet(args, env, false);170 case LABELS: // ### labels171 return _flet(args, env, true);172 case PROGN: // ### progn173 return progn(args, env, LispThread.currentThread());174 default:175 Debug.trace("bad index " + index);176 Debug.assertTrue(false);177 return NIL;178 }179 152 } 180 153 … … 2754 2727 }; 2755 2728 2756 private static final LispObject _flet(LispObject args, Environment env,2757 boolean recursive) throws ConditionThrowable2758 {2759 // First argument is a list of local function definitions.2760 LispObject defs = checkList(args.car());2761 final LispThread thread = LispThread.currentThread();2762 LispObject result;2763 if (defs != NIL) {2764 Environment oldDynEnv = thread.getDynamicEnvironment();2765 Environment ext = new Environment(env);2766 while (defs != NIL) {2767 LispObject def = checkList(defs.car());2768 Symbol symbol = checkSymbol(def.car());2769 LispObject rest = def.cdr();2770 LispObject parameters = rest.car();2771 LispObject body = rest.cdr();2772 body = new Cons(symbol, body);2773 body = new Cons(Symbol.BLOCK, body);2774 body = new Cons(body, NIL);2775 Closure closure;2776 if (recursive)2777 closure = new Closure(parameters, body, ext);2778 else2779 closure = new Closure(parameters, body, env);2780 closure.setLambdaName(list2(Symbol.FLET, symbol));2781 ext.bindFunctional(symbol, closure);2782 defs = defs.cdr();2783 }2784 result = progn(args.cdr(), ext, thread);2785 thread.setDynamicEnvironment(oldDynEnv);2786 } else2787 result = progn(args.cdr(), env, thread);2788 return result;2789 }2790 2791 2729 // ### macrolet 2792 2730 private static final SpecialOperator MACROLET =
Note: See TracChangeset
for help on using the changeset viewer.