瀏覽代碼

Primitives have a unique integer index to identify them. Add String_appendString(base, ext) with the obvious behaviour. Rename newStringEscaped -> newStringUnescaped to describe its operation not its input. Add String_escaped() to replace non-graphic characters. Add String_push() to append characters or strings. Add __primitives__ containing an array of all primitives. Add reverseString() that reverse a string in-place. Add reverseObject() that reverses an object in-place. Add reversed() that returns a reversed copy of an object or string. Fix Let_codeOn() to avoid the # in front of the variable name. Add /* ... */ syntax for multi-line, nesting comments. Add method String.new() to make a new, empty string. Add methods String.escaped(), String.unescaped(). Add method String.push() to append a character or another string. Add method String.pop() to remove and return the last character. Add methods String.asInteger(), String.asFloat(), String.asSymbol(). Provide an implementation of strnstr() for C libraries that lack it. Add method Object.includes() that searches indexable part of an object. Add method String.includes() that searches for characters or strings. Add String.sliced(start, stop) that returns a sub-string. Add method Symbol.asString(). Add method Object.findKey(). Add primitive reversed(). Add methods Symbol.getopt() and Symbol.setopt(). Add method Symbol.defined() that checks the global value, whereas the defined() primitive checks all visible bindings. Add method Symbol.define() to set the global value. Add method Symbol.value() to retrieve the global value. Add method Symbol.allInstances().

master
Ian Piumarta 1 年之前
父節點
當前提交
2fcfaa962b
共有 1 個檔案被更改,包括 345 行新增50 行删除
  1. +345
    -50
      minproto.leg

+ 345
- 50
minproto.leg 查看文件

@ -1,6 +1,6 @@
# minproto.leg -- minimal prototype langauge for semantic experiments
#
# last edited: 2024-05-21 08:45:20 by piumarta on zora
# last edited: 2024-05-23 15:37:35 by piumarta on zora-1034.local
%{
;
@ -178,7 +178,7 @@ struct Symbol { enum type type; char *name; oop value; enum typecode typec
#else // !TYPECODES
struct Symbol { enum type type; char *name; oop value; };
#endif
struct Primitive { enum type type; oop name; prim_t function; };
struct Primitive { enum type type; oop name; prim_t function; int index; };
#if PRIMCLOSURE
struct Lambda { enum type type; oop parameters, body; };
struct Closure { enum type type; oop fixed, function, environment; };
@ -372,6 +372,7 @@ oop String_append(oop str, int c)
oop String_appendAllLen(oop str, char *s, int len)
{
if (len < 1) return str;
int length = get(str, String,length);
char *value = get(str, String,value);
value = xrealloc(value, length + len);
@ -386,6 +387,11 @@ oop String_appendAll(oop str, char *s)
return String_appendAllLen(str, s, strlen(s));
}
oop String_appendString(oop str, oop val)
{
return String_appendAllLen(str, _get(val, String,value), _get(val, String,length));
}
oop String_format(oop str, char *fmt, ...)
{
size_t len = 0, cap = 16;
@ -419,7 +425,7 @@ oop String_concat(oop a, oop b)
return result;
}
oop newStringEscaped(char *string)
oop newStringUnescaped(char *string)
{
oop buf = newStringLen(0, 0);
while (*string) {
@ -448,6 +454,47 @@ oop newStringEscaped(char *string)
return buf;
}
oop String_escaped(oop obj)
{ assert(is(String, obj));
oop buf = newStringLen(0, 0);
char *str = _get(obj, String,value);
int len = _get(obj, String,length);
while (len--) {
int c = *str++;
if (c == '"') String_appendAll(buf, "\\\"");
else if (c == '\\') String_appendAll(buf, "\\\\");
else if (c >= ' ' && c <= '~') String_append(buf, c);
else {
switch (c) {
case '\a': c = 'a'; break;
case '\b': c = 'b'; break;
case '\f': c = 'f'; break;
case '\n': c = 'n'; break;
case '\r': c = 'r'; break;
case '\t': c = 't'; break;
case '\v': c = 'v'; break;
default:
String_format(buf, "\\%03o", c);
continue;
}
String_format(buf, "\\%c", c);
}
}
return buf;
}
char *codeString(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));
return val;
}
oop newSymbol(char *name)
{
oop obj = make(Symbol);
@ -477,11 +524,19 @@ int stringLength(oop obj, char *who)
return 0;
}
oop Object_put(oop obj, oop key, oop val);
oop Object_push(oop obj, oop val);
oop primitives = 0;
oop newPrimitive(prim_t function, oop name)
{
oop obj = make(Primitive);
_set(obj, Primitive,name, name);
_set(obj, Primitive,function, function);
_set(obj, Primitive,index, _get(primitives, Object,isize));
Object_put(primitives, obj, newInteger(_get(primitives, Object,isize)));
Object_push(primitives, obj);
return obj;
}
@ -922,6 +977,43 @@ oop sorted(oop obj, char *who)
return 0;
}
oop reverseString(oop obj, char *who)
{ assert(is(String, obj));
char *elts = _get(obj, String,value);
int size = _get(obj, String,length), middle = size / 2;
int left = 0, right = size;
while (left <= middle) {
int tmp = elts[left];
elts[left++] = elts[--right];
elts[right] = tmp;
}
return obj;
}
oop reverseObject(oop obj, char *who)
{ assert(is(Object, obj));
oop *elts = _get(obj, Object,indexed);
int size = _get(obj, Object,isize), middle = size / 2;
int left = 0, right = size;
while (left <= middle) {
oop tmp = elts[left];
elts[left++] = elts[--right];
elts[right] = tmp;
}
return obj;
}
oop reversed(oop obj, char *who)
{
switch (getType(obj)) {
case String: return reverseString(clone(obj), who);
case Object: return reverseObject(clone(obj), who);
default: break;
}
fatal("sort: cannot reverse %s", getTypeName(obj));
return 0;
}
oop apply(oop func, oop self, oop args, oop env);
void codeParametersOn(oop str, oop object, char *begin, char *end)
@ -1049,25 +1141,7 @@ oop printOn(oop buf, oop obj, int indent)
int len = _get(obj, String,length);
if (indent && indent != 1) {
String_append(buf, '"');
while (len--) {
int c = *str++;
if (c >= ' ' && c <= '~') String_append(buf, c);
else if (c == '"') String_appendAll(buf, "\\\"");
else if (c == '\\') String_appendAll(buf, "\\\\");
else {
switch (c) {
case '\a': c = 'a'; break;
case '\b': c = 'b'; break;
case '\f': c = 'f'; break;
case '\n': c = 'n'; break;
case '\r': c = 'r'; break;
case '\t': c = 't'; break;
case '\v': c = 'v'; break;
defalt: String_format(buf, "\\%03o", c); continue;
}
String_format(buf, "\\%c", c);
}
}
String_appendString(buf, String_escaped(obj));
String_append(buf, '"');
return buf;
}
@ -1114,7 +1188,6 @@ oop printOn(oop buf, oop obj, int indent)
String_appendAll(buf, " function: ");
printOn(buf, _get(obj, Closure,function), indent + 1);
break;
break;
}
#endif
case Object: {
@ -2336,7 +2409,7 @@ void Let_codeOn(oop exp, oop str, oop env)
String_appendAll(str, "let ");
for (int i = 0; i < isize - 1; i += 2) {
if (i) String_appendAll(str, ", ");
codeOn(str, indexed[i], 0);
printOn(str, indexed[i], 0);
String_appendAll(str, " = ");
codeOn(str, indexed[i+1], 0);
}
@ -2624,6 +2697,7 @@ oop newLiteral(oop object)
oop Literal_eval(oop exp, oop env)
{
oop object = Object_get(exp, sym_object);
// if (is(String, object)) return newStringLen(_get(object, String,value), _get(object, String,length));
oop clone = new(pObject);
oop *indexed = _get(object, Object,indexed);
int isize = _get(object, Object,isize);
@ -2633,11 +2707,6 @@ oop Literal_eval(oop exp, oop env)
int psize = _get(object, Object,psize);
for (int i = 0; i < psize; ++i)
Object_put(clone, kvs[i].key, eval(kvs[i].val, env));
# if 0
oop delegate = _getDelegate(object);
if (nil != delegate)
Object_put(clone, prop_delegate, eval(delegate, env));
# endif
return clone;
}
@ -2712,7 +2781,6 @@ oop assign(oop rval, oop value)
%}
start = - ( s:stmt { yysval = s }
| !. { yysval = 0 }
| < (!EOL .)* > { fatal("syntax error near: %s", yytext) }
@ -2875,9 +2943,9 @@ unsign = < DIGIT+ '.' DIGIT* EXP? > - { $$ = newFloat(strtod(yytext, 0
| "0" [xX] < HIGIT+ > - { $$ = newInteger(strtol(yytext, 0, 16)) }
| "0" < OIGIT* > - { $$ = newInteger(strtol(yytext, 0, 8)) }
| < DIGIT+ > - { $$ = newInteger(strtol(yytext, 0, 10)) }
| "'" < char > "'" - { $$ = newInteger(_get(newStringUnescaped(yytext), String,value)[0]) }
string = '"' < ( !'"' char )* > '"' - { $$ = newStringEscaped(yytext) }
| "'" < ( !"'" char )* > "'" - { $$ = newStringEscaped(yytext) }
string = '"' < ( !'"' char )* > '"' - { $$ = newStringUnescaped(yytext) }
char = "\\" ( ["'\\abfnrtv]
| [xX] HIGIT*
@ -2902,8 +2970,10 @@ EXP = [eE] SIGN DIGIT+
- = SPACE*
SPACE = [ \t] | EOL | '//' (!EOL .)*
SPACE = [ \t] | EOL | SLC | MLC
EOL = [\n\r] { ++lineno }
SLC = "//" (!EOL .)*
MLC = "/*" ( MLC | !"*/" (EOL | .))* "*/" -
NIL = "nil" !ALNUM -
WHILE = "while" !ALNUM -
@ -3108,7 +3178,13 @@ oop eval(oop exp, oop env)
if (Lambda == type) return newClosure(exp, env);
# endif
if (Object != type) return exp;
if (!opt_O) Object_push(trace, exp);
if (!opt_O) {
Object_push(trace, exp);
if (opt_d && opt_v) {
printf("@@@ ");
codeln(exp, 0);
}
}
oop result = evalobj(exp, env);
if (!opt_O) Object_pop(trace);
return result;
@ -3138,18 +3214,16 @@ oop prim_new(oop func, oop self, oop args, oop env)
return args;
}
oop prim_push(oop func, oop self, oop args, oop env)
oop prim_Object_push(oop func, oop self, oop args, oop env)
{ assert(is(Object, args));
if (!is(Object, self)) fatal("push: not an object");
int argc = _get(args, Object,isize);
int argc = _get(args, Object,isize); assert(is(Object, self));
oop *indexed = _get(args, Object,indexed);
for (int i = 0; i < argc; ++i) Object_push(self, indexed[i]);
return self;
}
oop prim_pop(oop func, oop self, oop args, oop env)
{ assert(is(Object, args));
if (!is(Object, self)) fatal("pop: not an object");
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");
--size;
@ -3157,6 +3231,145 @@ oop prim_pop(oop func, oop self, oop args, oop env)
return _get(self, Object,indexed)[size];
}
oop prim_String_new(oop func, oop self, oop args, oop env)
{
return newStringLen(0, 0);
}
oop prim_String_escaped(oop func, oop self, oop args, oop env)
{
return String_escaped(self);
}
oop prim_String_unescaped(oop func, oop self, oop args, oop env)
{
return newStringUnescaped(String_content(self));
}
oop prim_String_push(oop func, oop self, oop args, oop env)
{ assert(is(Object, args));
int argc = _get(args, Object,isize); assert(is(String, self));
oop *indexed = _get(args, Object,indexed);
for (int i = 0; i < argc; ++i) String_push(self, indexed[i]);
return self;
}
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");
--size;
_set(self, String,length, size);
return newInteger(_get(self, String,value)[size]);
}
oop prim_String_asInteger(oop func, oop self, oop args, oop env)
{ assert(is(String, self));
char *str = String_content(self); // ensure nul terminator
char *end = 0;
long value = strtol(str, &end, 0);
if (*end) return nil;
return newInteger(value);
}
oop prim_String_asFloat(oop func, oop self, oop args, oop env)
{ assert(is(String, self));
char *str = String_content(self); // ensure nul terminator
char *end = 0;
double value = strtod(str, &end);
if (*end) return nil;
return newFloat(value);
}
oop prim_String_asSymbol(oop func, oop self, oop args, oop env)
{ assert(is(String, self));
return intern(String_content(self));
}
char *strnchr(char *s, int len, int c)
{
while (len--) if (c == *s++) return s-1;
return 0;
}
#if !defined(__MACH__) // BSD has this in libc
char *strnstr(char *s, char *t, int slen)
{
int tlen = strlen(t);
int limit = slen - tlen;
for (int i = 0; i <= limit; ++i)
if (!strncmp(s + i, t, tlen))
return s+i;
return 0;
}
#endif
oop prim_Object_includes(oop func, oop self, oop args, oop env)
{ assert(is(Object, args));
if (!is(Object, self)) return nil;
int argc = _get(args, Object,isize);
oop *argv = _get(args, Object,indexed);
int size = _get(self, Object,isize);
oop *elts = _get(self, Object,indexed);
for (int i = 0; i < argc; ++i) {
oop arg = argv[i];
int found = 0;
for (int j = 0; j < size; ++j)
if ((found = (elts[j] == arg)))
break;
if (!found) return nil;
}
return sym_t;
}
oop prim_String_includes(oop func, oop self, oop args, oop env)
{ assert(is(Object, args));
int size = _get(args, Object,isize); assert(is(String, self));
oop *elts = _get(args, Object,indexed);
char *value = _get(self, String,value);
int length = _get(self, String,length);
for (int i = 0; i < size; ++i) {
oop arg = elts[i];
switch (getType(arg)) {
case Integer:
if (!strnchr(value, length, _integerValue(arg))) return nil;
continue;
case String:
if (!strnstr(value, String_content(arg), length)) return nil;
continue;
default:
fatal("String.includes: argument not string or integer: %s", codeString(arg, 0));
break;
}
}
return sym_t;
}
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");
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 (end < 0) end += length;
if (end < 0 || end >= length) fatal("String.sliced: end index %d out of bounds", end);
oop result = newStringLen(0, 0);
String_appendAllLen(result, value + start, end - start + 1);
return result;
}
oop prim_Symbol_asString(oop func, oop self, oop args, oop env)
{ assert(is(Symbol, self));
return newString(_get(self, Symbol,name));
}
oop prim_length(oop func, oop self, oop args, oop env)
{ assert(is(Object, args));
if (!is(Object, self)) fatal("length: not an object");
@ -3173,6 +3386,17 @@ oop prim_allKeys(oop func, oop self, oop args, oop env)
return keys(self, 1);
}
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");
oop key = _get(args, Object,indexed)[0];
int index = Object_find(self, key);
return newInteger(index);
}
return nil;
}
oop prim_sorted(oop func, oop self, oop args, oop env)
{ assert(is(Object, args));
if (self == nil) {
@ -3182,6 +3406,15 @@ oop prim_sorted(oop func, oop self, oop args, oop env)
return sorted(self, "sorted");
}
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");
self = _get(args, Object,indexed)[0];
}
return reversed(self, "reversed");
}
oop prim_env(oop func, oop self, oop args, oop env)
{
return env;
@ -3357,9 +3590,46 @@ oop prim_Symbol_setopt(oop func, oop self, oop args, oop env)
return val;
}
oop prim_Symbol_getopt(oop func, oop self, oop args, oop env)
{ assert(is(Symbol, self));
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));
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");
oop arg = _get(args, Object,indexed)[0];
return UNDEFINED == *_refvar(env, arg) ? nil : sym_t; // looks in locals too
}
oop prim_Symbol_defined(oop func, oop self, oop args, oop env)
{ assert(is(Symbol, self));
return UNDEFINED == _get(self, Symbol,value) ? nil : sym_t; // looks only at global
}
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");
_set(self, Symbol,value, _get(args, Object,indexed)[0]);
return self;
}
oop prim_Symbol_value(oop func, oop self, oop args, oop env)
{ assert(is(Symbol, self));
oop value = _get(self, Symbol,value);
return value ? value : nil;
}
oop prim_Symbol_allInstances(oop func, oop self, oop args, oop env)
{
return *_refvar(env, self) ? sym_t : nil;
oop result = new(pObject);
for (int i = 0; i < nsymbols; ++i) Object_push(result, symbols[i]);
return result;
}
oop replFile(FILE *in)
@ -3407,6 +3677,8 @@ oop replPath(char *path)
return result;
}
int main(int argc, char **argv)
{
GC_INIT();
@ -3431,6 +3703,10 @@ int main(int argc, char **argv)
# undef defineProto
primitives = new(pObject);
_set(intern("__primitives__"), Symbol,value, primitives);
Object_put(pObject, prop_eval, newPrimitive(prim___eval__, newString("Object.__eval__"))); // inherited by all objects
#if TYPECODES
@ -3475,20 +3751,39 @@ int main(int argc, char **argv)
prim(readfile , prim_readfile);
prim(exit , prim_exit);
prim(fatal , prim_error);
prim(defined , prim_defined);
# undef prim
# define method(CLASS, NAME, FUNC) Object_put(p##CLASS, intern(#NAME), newPrimitive(FUNC, newString(#CLASS"."#NAME)))
method(Object,new, prim_new );
method(Object,push, prim_push );
method(Object,pop, prim_pop );
method(Object,length, prim_length );
method(Object,keys, prim_keys );
method(Object,allKeys, prim_allKeys);
method(Object,sorted, prim_sorted );
method(Symbol,defined, prim_Symbol_defined);
method(Symbol,setopt, prim_Symbol_setopt);
method(Object,new, prim_new );
method(Object,push, prim_Object_push );
method(Object,pop, prim_Object_pop );
method(Object,length, prim_length );
method(Object,keys, prim_keys );
method(Object,allKeys, prim_allKeys );
method(Object,findKey, prim_findKey );
method(Object,sorted, prim_sorted );
method(Object,reversed, prim_reversed );
method(Object,includes, prim_Object_includes );
method(String,new, prim_String_new );
method(String,escaped, prim_String_escaped );
method(String,unescaped, prim_String_unescaped);
method(String,push, prim_String_push );
method(String,pop, prim_String_pop );
method(String,asInteger, prim_String_asInteger);
method(String,asFloat, prim_String_asFloat );
method(String,asSymbol, prim_String_asSymbol );
method(String,includes, prim_String_includes );
method(String,sliced, prim_String_sliced );
method(Symbol,asString, prim_Symbol_asString );
method(Symbol,setopt, prim_Symbol_setopt );
method(Symbol,getopt, prim_Symbol_getopt );
method(Symbol,defined, prim_Symbol_defined );
method(Symbol,define, prim_Symbol_define );
method(Symbol,value, prim_Symbol_value );
method(Symbol,allInstances, prim_Symbol_allInstances);
# undef method

Loading…
取消
儲存