From dcbef497500af46167cafb3ca70c24c873cafbbc Mon Sep 17 00:00:00 2001 From: Ian Piumarta Date: Sun, 26 May 2024 17:58:27 +0900 Subject: [PATCH] Exceptions are supported with syntax "try {} catch (e) {}", "try {} ensure {}", and "raise e". Add catch to the list of words that can end an expression statement. Most runtime errors are reported using exceptions when EXCEPTIONS=1. Add String_repeat() supporting multiplying a string and an integer. Illegal escape sequence in a string is a warning not an error. Break and continue work properly in while(). ForFromTo evaluates its start and end arguments. Rename primitive fatal() to error(). --- minproto.leg | 545 +++++++++++++++++++++++++++++++++++++++------------ 1 file changed, 416 insertions(+), 129 deletions(-) diff --git a/minproto.leg b/minproto.leg index 81d3f33..6a685be 100644 --- a/minproto.leg +++ b/minproto.leg @@ -1,6 +1,6 @@ # minproto.leg -- minimal prototype langauge for semantic experiments # -# last edited: 2024-05-26 10:21:16 by piumarta on xubuntu +# last edited: 2024-05-26 17:45:40 by piumarta on zora %{ ; @@ -34,6 +34,10 @@ # define NONLOCAL 1 // (approx. 5% [loop] to 55% [call] performance decrease, because of jmp_buf initialisations) #endif +#ifndef EXCEPTIONS // report errors by raising an exception +# define EXCEPTIONS 1 +#endif + #include #include #include @@ -59,6 +63,7 @@ #define indexableSize(A) (sizeof(A) / sizeof(*(A))) +void warning(char *fmt, ...); void fatal(char *fmt, ...); int opt_O = 0; @@ -99,9 +104,9 @@ oop printOn(oop buf, oop obj, int indent); #endif #if PRIMCLOSURE -#define doProtos(_) _(Object) _(RefVar) _(GetVar) _(SetVar) _(RefProp) _(GetProp) _(SetProp) _(RefArray) _(GetArray) _(SetArray) _(Call) _(Invoke) _(Continue) _(Break) _(Return) _(Binop) _(Unyop) _(Let) _(If) _(While) _(Block) _(For) _(ForIn) _(ForFromTo) _(Literal) +#define doProtos(_) _(Object) _(RefVar) _(GetVar) _(SetVar) _(RefProp) _(GetProp) _(SetProp) _(RefArray) _(GetArray) _(SetArray) _(Call) _(Invoke) _(Continue) _(Break) _(Return) _(TryCatch) _(TryEnsure)_(Raise)_(Binop) _(Unyop) _(Let) _(If) _(While) _(Block) _(For) _(ForIn) _(ForFromTo) _(Literal) #else -#define doProtos(_) _(Object) _(RefVar) _(GetVar) _(SetVar) _(RefProp) _(GetProp) _(SetProp) _(RefArray) _(GetArray) _(SetArray) _(Call) _(Invoke) _(Continue) _(Break) _(Return) _(Binop) _(Unyop) _(Let) _(If) _(While) _(Block) _(For) _(ForIn) _(ForFromTo) _(Literal) _(Lambda) _(Closure) +#define doProtos(_) _(Object) _(RefVar) _(GetVar) _(SetVar) _(RefProp) _(GetProp) _(SetProp) _(RefArray) _(GetArray) _(SetArray) _(Call) _(Invoke) _(Continue) _(Break) _(Return) _(TryCatch) _(TryEnsure) _(Raise) _(Binop) _(Unyop) _(Let) _(If) _(While) _(Block) _(For) _(ForIn) _(ForFromTo) _(Literal) _(Lambda) _(Closure) #endif #define declareProto(NAME) oop p##NAME = 0; @@ -119,13 +124,13 @@ enum typecode { doTypes(makeProto); #undef makeProto -#define doProperties(_) _(name) _(eval) _(delegate) _(codeon) _(function) +#define doProperties(_) _(name) _(eval) _(delegate) _(codeon) _(function) _(message) _(kind) #define declareProp(NAME) oop prop_##NAME = 0; doProperties(declareProp); #undef declareProp -#define doSymbols(_) _(t) _(name) _(expr) _(function) _(arguments) _(object) _(index) _(key) _(value) _(self) _(method) _(parameters) _(body) _(lambda) _(environment) _(operation) _(full) _(condition) _(consequent) _(alternate) _(expression) _(identifier) _(initialise) _(update) _(first) _(last) _(fixed) _(keyvals) _(__namespaces__) _(O) _(d) _(v) +#define doSymbols(_) _(t) _(name) _(expr) _(function) _(arguments) _(object) _(index) _(key) _(value) _(self) _(method) _(parameters) _(body) _(lambda) _(environment) _(operation) _(full) _(condition) _(consequent) _(alternate) _(expression) _(identifier) _(initialise) _(update) _(first) _(last) _(fixed) _(keyvals) _(__namespaces__) _(O) _(d) _(v) _(statement) _(handler) _(kind) _(message) _(operand1) _(operand2) #define declareSym(NAME) oop sym_##NAME = 0; doSymbols(declareSym); @@ -136,11 +141,12 @@ doSymbols(declareSym); #include enum { - NLR_RESULT = 0, // initialisation, no non-local flow + NLR_INIT = 0, // initialisation, no non-local flow NLR_CONTINUE, // non-local jump back to the start of active loop NLR_BREAK, // non-local jump out of the active loop NLR_RETURN, // non-local return from the active function -}; // passed to longjmp, returned from setjmp + NLR_RAISE, // exception +}; struct NLR { int ntrace; @@ -212,6 +218,18 @@ oop namespaces = nil; #define UNDEFINED 0 + +void typeError(char *who, char *msg, oop value); +void typeError2(char *who, char *msg, oop lhs, oop rhs); +void rangeError(char *who, char *msg, oop object, int index); +void valueError(char *who, char *msg, oop value); +void keyError(char *who, char *msg, oop object, oop key); +void undefinedError(oop name); +void syntaxError(char *message); +void unknownError(char *message); +void keyboardInterrupt(void); + + enum type getType(oop obj) { # if TAGS @@ -278,7 +296,7 @@ long _integerValue(oop obj) long integerValue(oop obj, char *op) { - if (!isInteger(obj)) fatal("%s: non-integer operand", op); + if (!isInteger(obj)) typeError(op, "non-integer operand", obj); return _integerValue(obj); } @@ -309,7 +327,7 @@ double floatValue(oop obj, char *op) switch (getType(obj)) { case Integer: return (double)_integerValue(obj); case Float: return (double)_floatValue(obj); - default: fatal("%s: non-numeric operand", op); + default: typeError(op, "non-numeric operand", obj); } return 0; } @@ -425,6 +443,15 @@ oop String_concat(oop a, oop b) return result; } +oop String_repeat(oop s, int n) +{ assert(is(String, s)); + char *chars = _get(s, String,value); + int length = _get(s, String,length); + oop result = newStringLen(0, 0); + while (n-- > 0) String_appendAllLen(result, chars, length); + return result; +} + oop newStringUnescaped(char *string) { oop buf = newStringLen(0, 0); @@ -444,9 +471,9 @@ oop newStringUnescaped(char *string) case 't' : c = '\t'; break; case 'v' : c = '\v'; break; case 'X' : - case 'x' : c = readCharValue(&string, 16, -1); break; - case '0' : c = readCharValue(&string, 8, 3); break; - default : fatal("illegal character escape sequence"); break; + case 'x' : c = readCharValue(&string, 16, -1); break; + case '0' : c = readCharValue(&string, 8, 3); break; + default : warning("illegal character escape sequence: \\%c", c); break; } } String_append(buf, c); @@ -485,13 +512,14 @@ oop String_escaped(oop obj) } char *codeString(oop obj, int indent); +char *printString(oop obj, int indent); oop String_push(oop obj, oop val) // val is String OR Integer { if (isInteger(val)) String_append(obj, _integerValue(val)); else if (is(String, val)) String_appendAllLen(obj, _get(val, String,value), _get(val, String,length)); else if (is(Symbol, val)) String_appendAllLen(obj, _get(val, Symbol,name), strlen(_get(val, Symbol,name))); - else fatal("String.push: value is not integer, string, or symbol: %s", codeString(val, 0)); + else typeError("String.push", "value is not integer, string, or symbol", val); return val; } @@ -511,7 +539,7 @@ char *stringValue(oop obj, char *who) int type = getType(obj); if (type == String) return _get(obj, String,value); if (type == Symbol) return _get(obj, Symbol,name); - fatal("%s: non-string operand", who); + typeError(who, "non-string operand", obj); return 0; } @@ -520,7 +548,7 @@ int stringLength(oop obj, char *who) int type = getType(obj); if (type == String) return _get(obj, String,length); if (type == Symbol) return strlen(_get(obj, Symbol,name)); - fatal("%s: non-string operand", who); + typeError(who, "non-string operand", obj); return 0; } @@ -585,14 +613,14 @@ oop intern(char *name) oop Object_at(oop obj, size_t index) { size_t size = get(obj, Object,isize); - if (index >= size) fatal("index %zd out of range (%zd)", index, size); + if (index >= size) rangeError("Object[]", "index out of bounds", obj, index); return _get(obj, Object,indexed)[index]; } oop Object_atPut(oop obj, size_t index, oop val) { size_t size = get(obj, Object,isize); - if (index >= size) fatal("index %zd out of range (%zd)", index, size); + if (index >= size) rangeError("Object.[]=", "index out of bounds", obj, index); return _get(obj, Object,indexed)[index] = val; } @@ -615,7 +643,7 @@ oop Object_push(oop obj, oop val) oop Object_pop(oop obj) { size_t size = get(obj, Object,isize); - if (!size) fatal("pop: object is empty"); + if (!size) rangeError("Object.pop", "object is empty", obj, 0); oop *indexed = _get(obj, Object,indexed); oop result = indexed[--size]; _set(obj, Object,isize, size); @@ -695,13 +723,13 @@ oop *Object_ref(oop obj, oop key) break; } } - if (key == prop_delegate) fatal("__delegate__ is inaccessible"); + if (key == prop_delegate) keyError("Object.", "__delegate__ is inaccessible", obj, prop_delegate); while (is(Object, o)) { ssize_t ind = Object_find(o, key); if (ind >= 0) return &_get(o, Object,properties)[ind].val; o = _getDelegate(o); } - fatal("undefined property: %s.%s", storeString(obj, 0), storeString(key, 0)); + keyError("Object.", "undefined property", obj, key); return 0; } @@ -742,7 +770,7 @@ oop Object_get(oop obj, oop key) if (ind >= 0) return _get(o, Object,properties)[ind].val; o = _getDelegate(o); } - fatal("undefined property: %s.%s", storeString(obj, 0), storeString(key, 0)); + keyError("Object.", "undefined property", obj, key); return nil; } @@ -772,7 +800,7 @@ oop *_refvar(oop obj, oop key) oop *refvar(oop obj, oop key) { oop *ref = _refvar(obj, key); - if (UNDEFINED == *ref) fatal("undefined variable: %s", storeString(key, 0)); + if (UNDEFINED == *ref) undefinedError(key); return ref; } @@ -864,6 +892,50 @@ oop newObjectWith(int isize, oop *indexed, int psize, struct property *propertie return obj; } + +#if EXCEPTIONS + +void genericError(char *who, char *message, char *kind, ...); + +void typeError(char *who, char *msg, oop value) { genericError(who, msg, "type error", + sym_value, value, 0); } + +void typeError2(char *who, char *msg, oop lhs, oop rhs) { genericError(who, msg, "type error", + sym_operand1, lhs, sym_operand2, rhs, 0); } + +void rangeError(char *who, char *msg, oop obj, int index) { genericError(who, msg, "index error", + sym_object, obj, sym_index, newInteger(index), 0); } + +void valueError(char *who, char *msg, oop value) { genericError(who, msg, "value error", + sym_value, value, 0); } + +void keyError(char *who, char *msg, oop object, oop key) { genericError(who, msg, "key error", + sym_object, object, sym_key, key, 0); } + +void undefinedError(oop name) { genericError( 0, 0, "undefined name", + sym_name, name, 0); } + +void syntaxError(char *msg) { genericError( 0, msg, "syntax error", 0); } + +void unknownError(char *msg) { genericError( 0, msg, "error", 0); } + +void keyboardInterrupt(void) { genericError( 0, 0, "keyboard interrupt", 0); } + +#else + +void typeError(char *who, char *msg, oop value) { fatal("%s: %s: %s", who, msg, getTypeName(value)); } +void typeError2(char *who, char *msg, oop lhs, oop rhs) { fatal("%s: %s: %s and %s", who, msg, getTypeName(lhs), getTypeName(rhs)); } +void rangeError(char *who, char *msg, oop obj, int index) { fatal("%s: %s: %s[%d]", who, msg, codeString(obj, 0), index); } +void valueError(char *who, char *msg, oop value) { fatal("%s: %s: %s", who, msg, codeString(value, 0)); } +void keyError(char *who, char *msg, oop object, oop key) { fatal("%s: %s: %s.%s", who, msg, codeString(object, 0), printString(key, 0)); } +void undefinedError(oop name) { fatal("undefined: %s", printString(name, 0)); } +void syntaxError(char *msg) { fatal("syntax error: %s", msg); } +void unknownError(char *msg) { fatal("%s", msg); } +void keyboardInterrupt(void) { fatal("keyboard interrupt"); } + +#endif + + int isSpecial(oop key) { return is(Symbol, key) && !strncmp("__", _get(key, Symbol,name), 2); @@ -973,7 +1045,7 @@ oop sorted(oop obj, char *who) case Object: return sortObject(clone(obj), who); default: break; } - fatal("sort: cannot sort %s", getTypeName(obj)); + typeError("sort", "unsortable type", obj); return 0; } @@ -1010,7 +1082,7 @@ oop reversed(oop obj, char *who) case Object: return reverseObject(clone(obj), who); default: break; } - fatal("sort: cannot reverse %s", getTypeName(obj)); + typeError("reverse", "unreversible type", obj); return 0; } @@ -1260,7 +1332,7 @@ oop storeOn(oop buf, oop obj, int indent) size = _get(names, Object,isize); elts = _get(names, Object,indexed); for (int j = 0; j < size; ++j) { - oop key = elts[i]; + oop key = elts[j]; oop val = Object_getLocal(obj, key); if (key == prop_delegate && val == pObject) continue; if (i++) String_appendAll(buf, ", "); @@ -1335,14 +1407,27 @@ int lineno = 1; oop trace = nil; -void fatal(char *fmt, ...) +void vwarning(char *fmt, va_list ap) { fflush(stdout); - va_list ap; - va_start(ap, fmt); fprintf(stderr, "\n%s:%d: ", filename, lineno); vfprintf(stderr, fmt, ap); fprintf(stderr, "\n"); +} + +void warning(char *fmt, ...) +{ + va_list ap; + va_start(ap, fmt); + vwarning(fmt, ap); + va_end(ap); +} + +void fatal(char *fmt, ...) +{ + va_list ap; + va_start(ap, fmt); + vwarning(fmt, ap); va_end(ap); if (is(Object, trace)) { int w = 1 + log10(_get(trace, Object,isize)); @@ -1354,11 +1439,39 @@ void fatal(char *fmt, ...) exit(1); } + +#if EXCEPTIONS + +void genericError(char *who, char *message, char *kind, ...) +{ assert(kind); + oop err = new(pObject); + if (who) Object_put(err, prop_function, newString(who)); + if (message) Object_put(err, prop_message, newString(message)); + Object_put(err, prop_kind, newString(kind)); + va_list ap; + va_start(ap, kind); + oop sym = 0; + while ((sym = va_arg(ap, oop))) { assert(is(Symbol, sym)); + oop arg = va_arg(ap, oop); assert(arg); + Object_put(err, sym, arg); + } + va_end(ap); + if (is(Object, trace)) { + int size = _get(trace, Object,isize); + oop *elts = _get(trace, Object,indexed); + for (int i = 0; i < size; ++i) Object_push(err, elts[i]); + } + nlrReturn(err, NLR_RAISE); +} + +#endif + + #include void sigint(int sig) { - fatal("keyboard interrupt"); + keyboardInterrupt(); } typedef struct Input { @@ -1542,7 +1655,7 @@ void SetProp_codeOn(oop exp, oop str, oop env) void oob(oop obj, int index) { - fatal("[]: index %d out of bounds in %s", index, storeString(obj, 0)); + rangeError("[]", "index out of bounds", obj, index); } char *String_aref(oop obj, int index) @@ -1589,7 +1702,7 @@ oop RefArray_eval(oop exp, oop env) if (ref) return mkptr(ref); } error: - fatal("[]: %s is not an object", storeString(obj, 0)); + typeError("[]", "not an object", obj); return 0; } @@ -1619,10 +1732,10 @@ oop GetArray_eval(oop exp, oop env) case String: return newInteger(*String_aref(obj, index)); case Symbol: return newInteger(*Symbol_aref(obj, index)); case Object: return *Object_aref(obj, index); - default: fatal("[]: %s is not indexable", storeString(obj, 0)); + default: typeError("[]", "non-indexable object", obj); } } - if (!is(Object, obj)) fatal("[]: %s is not an object", storeString(obj, 0)); + if (!is(Object, obj)) typeError("[]", "non-indexable object", obj); return Object_getLocal(obj, ind); } @@ -1654,11 +1767,11 @@ oop SetArray_eval(oop exp, oop env) case String: *String_aref(obj, index) = integerValue(val, "[]="); break; case Symbol: *Symbol_aref(obj, index) = integerValue(val, "[]="); break; case Object: *Object_aref(obj, index) = val; break; - default: fatal("[]=: %s is not indexable", storeString(obj, 0)); + default: typeError("[]=", "non-indexable object", obj); } return val; } - if (!is(Object, obj)) fatal("[]=: %s is not an object", storeString(obj, 0)); + if (!is(Object, obj)) typeError("[]=", "non-indexable object", obj); return Object_put(obj, ind, val); } @@ -1830,6 +1943,111 @@ void Return_codeOn(oop exp, oop str, oop env) codeOn(str, Object_get(exp, sym_value), 0); } +oop newTryCatch(oop statement, oop identifier, oop handler) +{ + oop o = new(pTryCatch); + Object_put(o, sym_statement, statement); + Object_put(o, sym_identifier, identifier); + Object_put(o, sym_handler, handler); + return o; +} + +oop TryCatch_eval(oop exp, oop env) +{ + oop statement = Object_get(exp, sym_statement); +# if NONLOCAL + switch (nlrPush()) { + case NLR_CONTINUE: nlrReturn(nlrPop(), NLR_CONTINUE); + case NLR_BREAK: nlrReturn(nlrPop(), NLR_BREAK); + case NLR_RETURN: nlrReturn(nlrPop(), NLR_RETURN); + case NLR_RAISE: { + oop exception = nlrPop(); + oop env2 = new(pObject); + _setDelegate(env2, env); + Object_put(env2, Object_get(exp, sym_identifier), exception); + return eval(Object_get(exp, sym_handler), env2); + } + } +# endif + oop result = eval(Object_get(exp, sym_statement), env); +# if NONLOCAL + nlrPop(); +# endif + return result; +} + +void TryCatch_codeOn(oop exp, oop str, oop env) +{ + String_appendAll(str, "try "); + codeOn(str, Object_get(exp, sym_statement), 0); + String_appendAll(str, " catch ("); + printOn(str, Object_get(exp, sym_identifier), 0); + String_appendAll(str, ") "); + codeOn(str, Object_get(exp, sym_handler), 0); +} + +oop newTryEnsure(oop statement, oop handler) +{ + oop o = new(pTryEnsure); + Object_put(o, sym_statement, statement); + Object_put(o, sym_handler, handler); + return o; +} + +oop TryEnsure_eval(oop exp, oop env) +{ + oop statement = Object_get(exp, sym_statement); + oop handler = Object_get(exp, sym_handler); + oop result = nil; + int nlreason = 0; +# if NONLOCAL + if (NLR_INIT != (nlreason = nlrPush())) { + result = nlrPop(); + eval(handler, env); + nlrReturn(result, nlreason); + } +# endif + result = eval(Object_get(exp, sym_statement), env); +# if NONLOCAL + nlrPop(); +# endif + eval(handler, env); + return result; +} + +void TryEnsure_codeOn(oop exp, oop str, oop env) +{ + String_appendAll(str, "try "); + codeOn(str, Object_get(exp, sym_statement), 0); + String_appendAll(str, " catch ("); + printOn(str, Object_get(exp, sym_identifier), 0); + String_appendAll(str, ") "); + codeOn(str, Object_get(exp, sym_handler), 0); +} + +oop newRaise(oop value) +{ + oop o = new(pRaise); + Object_put(o, sym_value, value); + return o; +} + +oop Raise_eval(oop exp, oop env) +{ + oop value = eval(Object_get(exp, sym_value), env); +# if NONLOCAL + nlrReturn(value, NLR_RAISE); + assert(!"this cannot happen"); +# endif + return value; +} + +void Raise_codeOn(oop exp, oop str, oop env) +{ + String_appendAll(str, "raise "); + codeOn(str, Object_get(exp, sym_value), 0); +} + #if !PRIMCLOSURE oop newLambda(oop parameters, oop body) @@ -1974,7 +2192,7 @@ oop binPostAdd(oop lhs, oop rhs) switch (getType(value)) { case Integer: *ref = newInteger(_integerValue(value) + amount); break; case Float: *ref = newFloat (_floatValue (value) + amount); break; - default: fatal("++: non-numeric argument"); + default: typeError("++", "non-numeric value", value); } return value; } @@ -1987,7 +2205,7 @@ oop binPostDec(oop lhs, oop rhs) switch (getType(value)) { case Integer: *ref = newInteger(_integerValue(value) - amount); break; case Float: *ref = newFloat (_floatValue (value) - amount); break; - default: fatal("++: non-numeric argument"); + default: typeError("++", "non-numeric value", value); } return value; } @@ -2026,13 +2244,13 @@ oop binPreDiv(oop lhs, oop rhs) oop val = *ref; if (isInteger(val) && isInteger(rhs)) { long l = _integerValue(val), r = _integerValue(rhs); - if (!r) fatal("/=: division by zero"); + if (!r) valueError("/=", "division by zero", rhs); l /= r; return *ref = newInteger(l); } double l = floatValue(val, "/="); double r = floatValue(rhs, "/="); - if (!r) fatal("/=: division by zero"); + if (!r) valueError("/=", "division by zero", rhs); l /= r; return *ref = newFloat(l); } @@ -2043,13 +2261,13 @@ oop binPreMod(oop lhs, oop rhs) oop val = *ref; if (isInteger(val) && isInteger(rhs)) { long l = _integerValue(val), r = _integerValue(rhs); - if (!r) fatal("%%=: division by zero"); + if (!r) valueError("%%=", "division by zero", rhs); l /= r; return *ref = newInteger(l); } double l = floatValue(val, "%="); double r = floatValue(rhs, "%="); - if (!r) fatal("%%=: division by zero"); + if (!r) valueError("%%=", "division by zero", rhs); return *ref = newFloat(fmod(l, r)); } @@ -2077,7 +2295,7 @@ oop binShl(oop l, oop r) int tl = getType(l), tr = getType(r); if (Integer == tl && Integer == tr) return newInteger(_integerValue(l) << _integerValue(r)); - fatal("<<: illegal operand types %s and %s", getTypeName(l), getTypeName(r)); + typeError2("<<", "non-integer operand", l, r); return 0; } @@ -2086,7 +2304,7 @@ oop binShr(oop l, oop r) int tl = getType(l), tr = getType(r); if (Integer == tl && Integer == tr) return newInteger(_integerValue(l) >> _integerValue(r)); - fatal(">>: illegal operand types %s and %s", getTypeName(l), getTypeName(r)); + typeError2(">>", "non-integer operand", l, r); return 0; } @@ -2096,7 +2314,7 @@ oop binAdd(oop l, oop r) if (Integer == tl && Integer == tr) return newInteger(_integerValue(l ) + _integerValue(r )); if (Float == tl || Float == tr) return newFloat ( floatValue (l, "+") + floatValue (r, "+")); if (String == tl && String == tr) return String_concat(l, r); - fatal("+: illegal operand types %s and %s", getTypeName(l), getTypeName(r)); + typeError2("+", "illegal operand types", l, r); return 0; } @@ -2106,15 +2324,25 @@ oop NAME(oop l, oop r) int tl = getType(l), tr = getType(r); \ if (Integer == tl && Integer == tr) return newInteger(_integerValue(l ) OP _integerValue(r )); \ if (Float == tl || Float == tr) return newFloat ( floatValue(l, #OP) OP floatValue(r, #OP)); \ - fatal(#OP": illegal operand types %s and %s", getTypeName(l), getTypeName(r)); \ + typeError2(#OP, "illegal operand types", l, r); \ return 0; \ } binop(binSub, -); -binop(binMul, *); #undef binop +oop binMul(oop l, oop r) +{ + int tl = getType(l), tr = getType(r); + if (Integer == tl && Integer == tr) return newInteger(_integerValue(l ) * _integerValue(r )); + if (Float == tl || Float == tr) return newFloat ( floatValue (l, "*") * floatValue (r, "*")); + if (String == tl && Integer == tr) return String_repeat(l, _integerValue(r)); + if (Integer == tl && String == tr) return String_repeat(r, _integerValue(l)); + typeError2("*", "illegal operand types", l, r); + return 0; +} + oop binDiv(oop l, oop r) { int tl = getType(l), tr = getType(r); @@ -2125,7 +2353,7 @@ oop binDiv(oop l, oop r) return newFloat((double)vl / (double)vr); } if (Float == tl || Float == tr) return newFloat (floatValue(l, "/") / floatValue(r, "/")); - fatal("/: illegal operand types %s and %s", getTypeName(l), getTypeName(r)); + typeError2("/", "illegal operand type", l, r); return 0; } @@ -2134,7 +2362,7 @@ oop binMod(oop l, oop r) int tl = getType(l), tr = getType(r); if (Integer == tl && Integer == tr) return newInteger( _integerValue(l) % _integerValue(r ) ); if (Float == tl || Float == tr) return newFloat (fmod(floatValue(l, "%"), floatValue(r, "%"))); - fatal("/: illegal operand types %s and %s", getTypeName(l), getTypeName(r)); + typeError2("/", "illegal operand types", l, r); return 0; } @@ -2182,7 +2410,7 @@ oop Binop_eval(oop exp, oop env) switch (getType(value)) { case Integer: *ref = newInteger(_integerValue(value) + amount); break; case Float: *ref = newFloat (_floatValue (value) + amount); break; - default: fatal("++/--: non-numeric argument"); + default: typeError("++", "non-numeric value", value); } return value; } @@ -2215,11 +2443,11 @@ oop Binop_eval(oop exp, oop env) case opPreSub: l -= r; break; case opPreMul: l *= r; break; case opPreDiv: - if (!r) fatal("division by zero"); + if (!r) valueError("/=", "division by zero", rhs); l /= r; break; case opPreMod: - if (!r) fatal("division by zero"); + if (!r) valueError("%=", "division by zero", rhs); l %= r; break; default: assert(!"this cannot happen"); @@ -2233,11 +2461,11 @@ oop Binop_eval(oop exp, oop env) case opPreSub: l -= r; break; case opPreMul: l *= r; break; case opPreDiv: - if (!r) fatal("division by zero"); + if (!r) valueError("/=", "division by zero", rhs); l /= r; break; case opPreMod: - if (!r) fatal("division by zero"); + if (!r) valueError("%=", "division by zero", rhs); l = fmod(l, r); break; default: assert(!"this cannot happen"); @@ -2332,7 +2560,7 @@ oop neg(oop n) case Float: return newFloat (-_floatValue (n)); default: break; } - fatal("-: illegal operand type %s", getTypeName(n)); + typeError("-", "non-numeric operand", n); return 0; } @@ -2343,7 +2571,7 @@ oop com(oop n) case Integer: return newInteger(~_integerValue(n)); default: break; } - fatal("~: illegal operand type %s", getTypeName(n)); + typeError("~", "non-numeric operand", n); return 0; } @@ -2353,7 +2581,7 @@ oop Unyop_eval(oop exp, oop env) oop value = _get(exp, Object,indexed)[0]; enum unyop code = integerValue(op, "Unyop.operation"); if (code == opQuasiquote) return quasiclone(value, env); - if (code == opUnquote ) fatal("@ outside quasiquotation"); + if (code == opUnquote ) syntaxError("@ outside quasiquotation"); value = eval(value, env); switch (code) { case opNot: return newBoolean(value == nil); @@ -2447,6 +2675,26 @@ void If_codeOn(oop exp, oop str, oop env) } } +#define _PASTE(A, B) A##B +#define PASTE(A, B) _PASTE(A,B) + +#if NONLOCAL + +# define LOOP() \ + PASTE(continue,__LINE__): \ + switch (nlrPush()) { \ + case NLR_CONTINUE: nlrPop(); goto PASTE(continue, __LINE__); \ + case NLR_BREAK: return nlrPop(); \ + case NLR_RETURN: nlrReturn(nlrPop(), NLR_RETURN); \ + case NLR_RAISE: nlrReturn(nlrPop(), NLR_RAISE ); \ + } + +# define DONE() nlrPop() +#else +# define LOOP() +# define DONE() +#endif + oop newWhile(oop condition, oop body) { oop o = new(pWhile); @@ -2460,7 +2708,9 @@ oop While_eval(oop exp, oop env) oop condition = Object_get(exp, sym_condition); oop body = Object_get(exp, sym_body ); oop result = nil; + LOOP(); while (nil != eval(condition, env)) result = eval(body, env); + DONE(); return result; } @@ -2509,25 +2759,6 @@ oop newFor(oop initialise, oop condition, oop update, oop body) return o; } -#define _PASTE(A, B) A##B -#define PASTE(A, B) _PASTE(A,B) - -#if NONLOCAL - -# define LOOP() \ - PASTE(continue,__LINE__): \ - switch (nlrPush()) { \ - case NLR_CONTINUE: nlrPop(); goto PASTE(continue, __LINE__); \ - case NLR_BREAK: return nlrPop(); \ - case NLR_RETURN: nlrReturn(nlrPop(), NLR_RETURN); \ - } - -# define DONE() nlrPop() -#else -# define LOOP() -# define DONE() -#endif - oop For_eval(oop exp, oop env) { oop initialise = Object_get(exp, sym_initialise); @@ -2606,7 +2837,7 @@ oop ForIn_eval(oop exp, oop env) DONE(); return result; } - if (!is(Object, vals)) fatal("for: non-object sequence %s", storeString(vals, 0)); + if (!is(Object, vals)) typeError("for", "non-iterable value", vals); oop *indexed = _get(vals, Object,indexed); int size = _get(vals, Object,isize); int i = -1; @@ -2645,8 +2876,8 @@ oop newForFromTo(oop identifier, oop first, oop last, oop body) oop ForFromTo_eval(oop exp, oop env) { oop identifier = Object_get(exp, sym_identifier); - oop first = Object_get(exp, sym_first); - oop last = Object_get(exp, sym_last); + oop first = eval(Object_get(exp, sym_first), env); + oop last = eval(Object_get(exp, sym_last ), env); oop body = Object_get(exp, sym_body); oop env2 = new(pObject); _setDelegate(env2, env); @@ -2756,24 +2987,24 @@ void Literal_codeOn(oop exp, oop str, oop env) oop lvalue(oop rval) { - if (!is(Object,rval)) fatal("cannot assign to: %s", codeString(rval, 0)); + if (!is(Object,rval)) valueError("=", "non-assignable value", rval); oop kind = _getDelegate(rval); if (kind == pGetVar ) kind = pRefVar; else if (kind == pGetProp ) kind = pRefProp; else if (kind == pGetArray) kind = pRefArray; - else fatal("cannot assign to: %s", codeString(rval, 0)); + else valueError("=", "non-assignable value", rval); _setDelegate(rval, kind); return rval; } oop assign(oop rval, oop value) { - if (!is(Object,rval)) fatal("cannot assign to: %s", codeString(rval, 0)); + if (!is(Object,rval)) valueError("=", "non-assignable value", rval); oop kind = _getDelegate(rval); if (kind == pGetVar ) kind = pSetVar; else if (kind == pGetProp ) kind = pSetProp; else if (kind == pGetArray) kind = pSetArray; - else fatal("cannot assign to: %s", codeString(rval, 0)); + else valueError("=", "non-assignable value", rval); _setDelegate(rval, kind); Object_put(rval, sym_value, value); return rval; @@ -2783,7 +3014,7 @@ oop assign(oop rval, oop value) start = - ( s:stmt { yysval = s } | !. { yysval = 0 } - | < (!EOL .)* > { fatal("syntax error near: %s", yytext) } + | < (!EOL .)* > { syntaxError(yytext) } ) stmt = LET l:mklet k:id ASSIGN v:expr { Let_append(l, k, v) } @@ -2806,6 +3037,11 @@ stmt = LET l:mklet k:id ASSIGN v:expr { Let_append(l, k, v) } | FOR LPAREN i:expr SEMI c:expr SEMI u:expr RPAREN s:stmt { $$ = newFor(i, c, u, s) } | i:id p:params b:block { $$ = newSetVar(i, newLambda(p, b)) } + | TRY t:stmt + ( CATCH LPAREN i:id RPAREN c:stmt { $$ = newTryCatch(t, i, c) } + | ENSURE e:stmt { $$ = newTryEnsure(t, e) } + ) + | RAISE e:expr EOS { $$ = newRaise(e) } | v:proto DOT i:id p:params b:block { $$ = newSetProp(v, i, newLambda(p, b)) } | v:proto CCOLON i:id p:params b:block { $$ = newSetProp(v, i, newLambda(p, b)) } | b:block { $$ = newBlock(b) } @@ -2816,7 +3052,7 @@ mklet = { $$ = newLet() } proto = v:var ( DOT j:id !LPAREN { v = newGetProp(v, j) } )* { $$ = v } -EOS = SEMI+ | &RBRACE | &ELSE +EOS = SEMI+ | &RBRACE | &ELSE | &CATCH expr = i:id ASSIGN e:expr { $$ = newSetVar(i, e) } | l:logor ( ASSIGN r:expr { l = assign(l, r) } @@ -2893,12 +3129,12 @@ postfix = p:primary args = LPAREN a:mkobj ( RPAREN - | ( k:id COLON e:expr { Object_put(a, k, e) } - | e:expr { Object_push(a, e) } + | ( k:id COLON e:expr { Object_put(a, k, e) } + | e:expr { Object_push(a, e) } ) - ( COMMA ( k:id COLON e:expr { Object_put(a, k, e) } - | e:expr { Object_push(a, e) } - ) )* RPAREN ) { $$ = a } + ( COMMA ( k:id COLON e:expr { Object_put(a, k, e) } + | e:expr { Object_push(a, e) } + ) )* RPAREN ) { $$ = a } params = LPAREN p:mkobj ( RPAREN @@ -2987,6 +3223,10 @@ LET = "let" !ALNUM - CONT = "continue" !ALNUM - BREAK = "break" !ALNUM - RETURN = "return" !ALNUM - +TRY = "try" !ALNUM - +CATCH = "catch" !ALNUM - +ENSURE = "ensure" !ALNUM - +RAISE = "raise" !ALNUM - BQUOTE = "`" - COMMAT = "@" - @@ -3061,14 +3301,14 @@ oop apply(oop func, oop self, oop args, oop env) return _get(func, Primitive,function)(func, self, args, env); #if PRIMCLOSURE if (Closure != functype) - fatal("cannot %s %s", (nil == self ? "call" : "invoke"), storeString(func, 0)); + valueError(nil == self ? "()" : ".()", "cannot apply", func); oop lambda = _get(func, Closure,function); oop environment = _get(func, Closure,environment); oop parameters = _get(lambda, Lambda,parameters); oop body = _get(lambda, Lambda,body); #else if (Object != functype || pClosure != _getDelegate(func)) - fatal("cannot %s %s", (nil == self ? "call" : "invoke"), storeString(func, 0)); + valueError(nil == self ? "()" : ".()", "cannot apply", func); oop lambda = Object_get(func, sym_function); oop environment = Object_get(func, sym_environment); oop parameters = Object_get(lambda, sym_parameters); @@ -3087,9 +3327,10 @@ oop apply(oop func, oop self, oop args, oop env) oop *pargs = _get(args, Object,indexed); # if NONLOCAL switch (nlrPush()) { - case NLR_CONTINUE: fatal("continue outside loop"); - case NLR_BREAK: fatal("break outside loop"); + case NLR_CONTINUE: syntaxError("continue outside loop"); + case NLR_BREAK: syntaxError("break outside loop"); case NLR_RETURN: return nlrPop(); + case NLR_RAISE: nlrReturn(nlrPop(), NLR_RAISE); } # endif // positional args -> named parameters @@ -3111,14 +3352,14 @@ oop apply(oop func, oop self, oop args, oop env) oop getArg(oop args, int index, char *who) { assert(is(Object, args)); - if (index >= _get(args, Object,isize)) fatal("%s: too few arguments", who); + if (index >= _get(args, Object,isize)) valueError("%s", "too few arguments", args); return _get(args, Object,indexed)[index]; } oop getArgType(oop args, int index, int type, char *who) { assert(is(Object, args)); oop arg = getArg(args, index, who); - if (type != getType(arg)) fatal("%s: non-%s arg: ", who, typeNames[type], storeString(arg, 0)); + if (type != getType(arg)) typeError(who, "illegal argument type", arg); return arg; } @@ -3225,7 +3466,7 @@ oop prim_Object_push(oop func, oop self, oop args, oop env) oop prim_Object_pop(oop func, oop self, oop args, oop env) { assert(is(Object, self)); int size = _get(self, Object,isize); - if (size < 1) fatal("pop: object is empty\n"); + if (size < 1) rangeError("Object.pop", "object is empty", self, 0); --size; _set(self, Object,isize, size); return _get(self, Object,indexed)[size]; @@ -3257,7 +3498,7 @@ oop prim_String_push(oop func, oop self, oop args, oop env) oop prim_String_pop(oop func, oop self, oop args, oop env) { assert(is(String, self)); int size = _get(self, String,length); - if (size < 1) fatal("pop: string is empty\n"); + if (size < 1) rangeError("String.pop", "string is empty", self, 0); --size; _set(self, String,length, size); return newInteger(_get(self, String,value)[size]); @@ -3340,7 +3581,7 @@ oop prim_String_includes(oop func, oop self, oop args, oop env) if (!strnstr(value, String_content(arg), length)) return nil; continue; default: - fatal("String.includes: argument not string or integer: %s", codeString(arg, 0)); + typeError("String.includes", "non-string/integer argument", arg); break; } } @@ -3350,16 +3591,16 @@ oop prim_String_includes(oop func, oop self, oop args, oop env) oop prim_String_sliced(oop func, oop self, oop args, oop env) { assert(is(Object, args)); int argc = _get(args, Object,isize); assert(is(String, self)); - if (argc != 2) fatal("String.sliced: two arguments expected"); + if (argc != 2) valueError("String.sliced", "two arguments expected", args); oop *argv = _get(args, Object,indexed); char *value = _get(self, String,value); int length = _get(self, String,length); int start = integerValue(argv[0], "String.sliced"); int end = integerValue(argv[1], "String.sliced"); if (start < 0) start += length; - if (start < 0 || start >= length) fatal("String.sliced: start index %d out of bounds", start); + if (start < 0 || start >= length) rangeError("String.sliced", "start index out of bounds", self, start); if (end < 0) end += length; - if (end < 0 || end >= length) fatal("String.sliced: end index %d out of bounds", end); + if (end < 0 || end >= length) rangeError("String.sliced", "end index out of bounds", self, end); oop result = newStringLen(0, 0); String_appendAllLen(result, value + start, end - start + 1); return result; @@ -3372,7 +3613,7 @@ oop prim_Symbol_asString(oop func, oop self, oop args, oop env) oop prim_length(oop func, oop self, oop args, oop env) { assert(is(Object, args)); - if (!is(Object, self)) fatal("length: not an object"); + if (!is(Object, self)) valueError("length", "not an object", self); return newInteger(_get(self, Object,isize)); } @@ -3389,7 +3630,7 @@ oop prim_allKeys(oop func, oop self, oop args, oop env) oop prim_findKey(oop func, oop self, oop args, oop env) { if (is(Object, self)) { - if (_get(args, Object,isize) != 1) fatal("Object.findKey: one argument expected"); + if (_get(args, Object,isize) != 1) valueError("Object.findKey", "one argument expected", args); oop key = _get(args, Object,indexed)[0]; int index = Object_find(self, key); return newInteger(index); @@ -3400,7 +3641,7 @@ oop prim_findKey(oop func, oop self, oop args, oop env) oop prim_sorted(oop func, oop self, oop args, oop env) { assert(is(Object, args)); if (self == nil) { - if (_get(args, Object,isize) != 1) fatal("sorted: one argument expected"); + if (_get(args, Object,isize) != 1) valueError("sorted", "one argument expected", args); self = _get(args, Object,indexed)[0]; } return sorted(self, "sorted"); @@ -3409,7 +3650,7 @@ oop prim_sorted(oop func, oop self, oop args, oop env) oop prim_reversed(oop func, oop self, oop args, oop env) { assert(is(Object, args)); if (self == nil) { - if (_get(args, Object,isize) != 1) fatal("reversed: one argument expected"); + if (_get(args, Object,isize) != 1) valueError("reversed", "one argument expected", args); self = _get(args, Object,indexed)[0]; } return reversed(self, "reversed"); @@ -3460,21 +3701,21 @@ oop prim_codeString(oop func, oop self, oop args, oop env) oop prim_sqrt(oop func, oop self, oop args, oop env) { int argc = _get(args, Object,isize); - if (1 != argc) fatal("sqrt: 1 argument expected"); + if (1 != argc) valueError("sqrt", "one argument expected", args); return newFloat(sqrt(floatValue(_get(args, Object,indexed)[0], "sqrt"))); } oop prim_round(oop func, oop self, oop args, oop env) { int argc = _get(args, Object,isize); - if (1 != argc) fatal("round: 1 argument expected"); + if (1 != argc) valueError("round", "one argument expected", args); return newInteger(round(floatValue(_get(args, Object,indexed)[0], "round"))); } oop prim_truncate(oop func, oop self, oop args, oop env) { int argc = _get(args, Object,isize); - if (1 != argc) fatal("truncate: 1 argument expected"); + if (1 != argc) valueError("truncate", "one argument expected", args); return newInteger(floatValue(_get(args, Object,indexed)[0], "truncate")); } @@ -3493,7 +3734,7 @@ oop prim_evaluations(oop func, oop self, oop args, oop env) oop prim_len(oop func, oop self, oop args, oop env) { int argc = _get(args, Object,isize); - if (1 != argc) fatal("len: 1 argument expected"); + if (1 != argc) valueError("len", "one argument expected", args); oop arg = _get(args, Object,indexed)[0]; switch (getType(arg)) { case String: return newInteger(_get(arg, String,length)); @@ -3507,10 +3748,10 @@ oop prim_len(oop func, oop self, oop args, oop env) oop prim_ord(oop func, oop self, oop args, oop env) { int argc = _get(args, Object,isize); - if (1 != argc) fatal("ord: 1 argument expected"); + if (1 != argc) valueError("ord", "one argument expected", args); oop arg = _get(args, Object,indexed)[0]; - if (!is(String, arg)) fatal("ord: string argument expected"); - if (1 != _get(arg, String,length)) fatal("ord: string of length 1 expected"); + if (!is(String, arg)) typeError("ord", "non-string argument", arg); + if (1 != _get(arg, String,length)) valueError("ord", "string of length one expected", arg); return newInteger(_get(arg, String,value)[0]); } @@ -3544,9 +3785,9 @@ oop prim_readfile(oop func, oop self, oop args, oop env) int argc = _get(args, Object,isize); for (int i = 0; i < argc; ++i) { oop name = _get(args, Object,indexed)[i]; - if (!is(String, name)) fatal("readfile: non-string argument: %s", storeString(name, 0)); + if (!is(String, name)) typeError("readfile", "non-string argument", name); FILE *file = fopen(_get(name, String,value), "r"); - if (!file) fatal("%s: %s", _get(name, String,value), strerror(errno)); + if (!file) valueError("readfile", strerror(errno), name); char *text = 0; int tlen = 0; readFile(file, &text, &tlen); @@ -3560,7 +3801,7 @@ oop prim_exit(oop func, oop self, oop args, oop env) { int argc = _get(args, Object,isize); int status = 0; - if (argc > 1) fatal("exit: too many arguments"); + if (argc > 1) valueError("exit", "too many arguments", args); if (argc == 1) status = integerValue(_get(args, Object,indexed)[0], "exit"); exit(status); return nil; @@ -3569,24 +3810,24 @@ oop prim_exit(oop func, oop self, oop args, oop env) oop prim_error(oop func, oop self, oop args, oop env) { int argc = _get(args, Object,isize); - if (argc != 1) fatal("error: one argument expected"); + if (argc != 1) valueError("error", "one argument expected", args); oop arg = _get(args, Object,indexed)[0]; - if (!is(String, arg)) fatal("error: non-string argument"); - fatal("%.*s", _get(arg, String,length), _get(arg, String,value)); + if (!is(String, arg)) typeError("error", "non-string argument", arg); + unknownError(String_content(arg)); return 0; } oop prim_Symbol_setopt(oop func, oop self, oop args, oop env) { assert(is(Symbol, self)); int argc = _get(args, Object,isize); - if (argc != 1) fatal("setopt: one argument expected"); + if (argc != 1) valueError("Symbol.setopt", "one argument expected", args); oop val = _get(args, Object,indexed)[0]; - if (!isInteger(val)) fatal("setopt: non-integer option value: %s", storeString(val, 0)); + if (!isInteger(val)) typeError("Symbol.setopt", "non-integer agument", val); int optval = _integerValue(val); if (sym_O == self) opt_O = optval; else if (sym_d == self) opt_d = optval; else if (sym_v == self) opt_v = optval; - else fatal("setopt: unknown option: %s", storeString(self, 0)); + else valueError("Symbol.setopt", "unknown option", val); return val; } @@ -3595,13 +3836,13 @@ oop prim_Symbol_getopt(oop func, oop self, oop args, oop env) if (sym_O == self) return newInteger(opt_O); else if (sym_d == self) return newInteger(opt_d); else if (sym_v == self) return newInteger(opt_v); - else fatal("getopt: unknown option: %s", storeString(self, 0)); + else valueError("Symbol.getopt", "unknown option", self); return 0; } oop prim_defined(oop func, oop self, oop args, oop env) { assert(is(Object, args)); - if (1 != _get(args, Object,isize)) fatal("defined: one argument expected"); + if (1 != _get(args, Object,isize)) valueError("defined", "one argument expected", args); oop arg = _get(args, Object,indexed)[0]; return UNDEFINED == *_refvar(env, arg) ? nil : sym_t; // looks in locals too } @@ -3614,7 +3855,7 @@ oop prim_Symbol_defined(oop func, oop self, oop args, oop env) oop prim_Symbol_define(oop func, oop self, oop args, oop env) { assert(is(Object, args)); int argc = _get(args, Object,isize); assert(is(Symbol, self)); - if (argc != 1) fatal("Symbol.define: one argument expected"); + if (argc != 1) valueError("Symbol.define", "one argument expected", args); _set(self, Symbol,value, _get(args, Object,indexed)[0]); return self; } @@ -3641,9 +3882,55 @@ oop replFile(FILE *in) oop result = nil; # if NONLOCAL switch (nlrPush()) { - case NLR_CONTINUE: fatal("continue outside loop"); - case NLR_BREAK: fatal("break outside loop"); - case NLR_RETURN: fatal("return outside function"); + case NLR_CONTINUE: syntaxError("continue outside loop"); + case NLR_BREAK: syntaxError("break outside loop"); + case NLR_RETURN: syntaxError("return outside function"); + case NLR_RAISE: { + if (!is(Object, valnlr)) fatal("%s%s", + is(String, valnlr) ? "" : "unhandled exception: ", + printString(valnlr, 1)); + oop msg = newStringLen(0, 0); + if (Object_find(valnlr, prop_function) >= 0) { + String_push(msg, Object_get(valnlr, prop_function)); + String_appendAll(msg, ": "); + } + if (Object_find(valnlr, prop_kind) >= 0) + String_push(msg, Object_get(valnlr, prop_kind)); + else + String_appendAll(msg, "unhandled exception"); + if (Object_find(valnlr, prop_message) >= 0) { + String_appendAll(msg, ": "); + String_push(msg, Object_get(valnlr, prop_message)); + } + int size = _get(valnlr, Object,psize); + struct property *kvs = _get(valnlr, Object,properties); + if (size) String_appendAll(msg, ": "); + int n = 0; + printf("MESSAGE "); println(msg, 0); + for (int i = 0; i < size; ++i) { + if (isSpecial(kvs[i].key)) continue; + if (n++) String_appendAll(msg, ", "); + String_push(msg, kvs[i].key); + printf("KEY "); println(kvs[i].key, 0); + printf("VAL %p ", kvs[i].val); println(kvs[i].val, 0); + String_appendAll(msg, " = "); + storeOn(msg, kvs[i].val, 0); + } + String_appendAll(msg, ":"); + if (Object_find(valnlr, sym_message) >= 0) { + String_append(msg, ' '); + String_push(msg, Object_get(valnlr, sym_message)); + } + size = _get(valnlr, Object,isize); + oop *elts = _get(valnlr, Object,indexed); + int w = 1 + log10(size); + for (int i = size; i--;) { + String_format(msg, "\n%*d:", w, i); + codeOn(msg, elts[i], 0); + } + trace = nil; + fatal(String_content(msg)); + } } # endif while (yyparse() && yysval) { @@ -3668,7 +3955,7 @@ oop replFile(FILE *in) oop replPath(char *path) { FILE *in = fopen(path, "r"); - if (!in) fatal("%s: %s", path, strerror(errno)); + if (!in) valueError("REPL", strerror(errno), newString(path)); char *oldname = filename; filename = path; oop result = replFile(in); @@ -3750,7 +4037,7 @@ int main(int argc, char **argv) prim(chr , prim_chr); prim(readfile , prim_readfile); prim(exit , prim_exit); - prim(fatal , prim_error); + prim(error , prim_error); prim(defined , prim_defined); # undef prim