8 Commits

Se han modificado 6 ficheros con 646 adiciones y 135 borrados
Dividir vista
  1. +7
    -0
      .gitignore
  2. +2
    -2
      Makefile
  3. +357
    -0
      grammar_parser.meta
  4. +223
    -128
      minproto.leg
  5. +53
    -3
      test.ref
  6. +4
    -2
      test.txt

+ 7
- 0
.gitignore Ver fichero

@ -0,0 +1,7 @@
.DS_Store
*.dSYM
*~
minproto.c
minproto
minproto-opt
minproto-prof

+ 2
- 2
Makefile Ver fichero

@ -22,11 +22,11 @@ all : $(MAIN)
leg -o $@ $<
test : $(MAIN)
./$(MAIN) < test.txt | tee test.out
./$(MAIN) test.txt 2>&1 | tee test.out
@diff test.ref test.out && echo '\012--- PASSED ---'
testref : $(MAIN)
./$(MAIN) < test.txt | tee test.ref
./$(MAIN) test.txt 2>&1 | tee test.ref
bench : $(MAIN)-opt
time ./$(MAIN)-opt -O bench.txt

+ 357
- 0
grammar_parser.meta Ver fichero

@ -0,0 +1,357 @@
// Utils
println = (x) {
if (!x) {
print("\n");
} else {
print(x, "\n", full: 1);
}
};
Object.subtype(name) { self.new(__name__: name) }
// Input stream
Stream = Object.subtype(#Stream);
newStream(string) {
self = Stream.new(
content: string,
position: 0,
limit: len(string)
);
print("Created new stream object: { position: ", self.position, ", limit: ", self.limit, ", !atEnd(): ", !self.atEnd(), " }\n");
self;
}
Stream.atEnd() { self.position >= self.limit }
Stream.peek() { !self.atEnd() && self.content[self.position] }
Stream.inc() { !self.atEnd() && { self.position = self.position + 1; } }
Stream.next() {
!self.atEnd() && {
c = self.content[self.position];
self.position = self.position + 1;
c;
}
}
Stream.setLastBegin = () { self.lastBegin = self.position; };
// Context
Context = Object.subtype(#Context);
Context.init() { self.variables = []; self; }
Context.declareVariable(var) { self.variables[var] = nil }
// String Literal
StringLiteral = Object.subtype(#StringLiteral);
StringLiteral.match(stream, context, actions) {
n = len(self.string);
i = 0;
success = 1;
startCursor = stream.cursor;
while(i < n && success == 1) {
if (self.string[i] != stream.peek()) {
success = 0;
stream.cursor = startCursor;
} else {
i = i + 1;
stream.inc();
}
}
success;
}
// Character Class
CharacterClass = Object.subtype(#CharacterClass);
CharacterClass.match(stream, context, actions) {
classLength = len(self.value);
i = 0;
prevChar = nil;
success = 0;
while (i < classLength && success == 0) {
// [a] case
if (prevChar == nil) {
// println("[a] case");
prevChar = self.value[i];
if (stream.peek() == self.value[i]) {
success = 1;
}
} else if (prevChar != nil && self.value[i] == ord('-')) {
// [a-z] case
if (i+1 < classLength) {
// println("[a-z] case");
rangeStart = charValue(prevChar);
rangeEnd = charValue(self.value[i+1]);
// print("Range Start: ", rangeStart, " | ");
// print("Range End: ", rangeEnd, "\n");
if (charValue(stream.peek()) >= rangeStart
&& charValue(stream.peek()) <= rangeEnd
) {
success = 1;
}
prevChar = nil;
i = i + 1;
// [a-] case
} else {
// println("[a-] case");
if (stream.peek() == ord('-')) {
success = 1;
}
}
// [ab] case
} else if (prevChar != nil && self.value[i] != ord('-')) {
// println("[ab] case");
prevChar = self.value[i];
if (stream.peek() == self.value[i]) {
success = 1;
}
}
// print("prevChar: ", prevChar, "\n");
i = i + 1;
}
if (success == 1) {
stream.inc();
}
success;
}
// Dot
Dot = Object.subtype(#Dot);
Dot.match(stream, context, actions) {
if (stream.peek() != nil) {
stream.inc();
1;
} else {
0;
}
}
// Begin
Begin = Object.subtype(#Begin);
Begin.match(stream, context, actions) {
stream.setLastBegin();
1;
}
// End
End = Object.subtype(#End);
End.match(stream, context, actions) {
context.input = stream.string[stream.lastBegin..stream.cursor];
1;
}
// Optional (? postfix operator)
Optional = Object.subtype(#Optional);
Optional.match(stream, context) {
self.innerExpression.match(stream, context);
1;
}
// Star
Star = Object.subtype(#Star);
Star.match(stream, context, actions) {
while (self.innerExpression.match(stream, context) == 1) {}
1;
}
// Plus
Plus = Object.subtype(#Plus);
Plus.match(stream, context, actions) {
if (self.innerExpression.match(stream, context) == 1) {
while (self.innerExpression.match(stream, context) == 1) {}
1;
} else {
0;
}
}
// And
And = Object.subtype(#And);
And.match(stream, context, actions) {
position = stream.position;
if (self.innerExpression.match(stream, context) == 1) {
stream.position = position;
1;
} else {
0;
}
}
// Not
Not = Object.subtype(#Not);
Not.match(stream, context, actions) {
position = stream.position;
if (self.innerExpression.match(stream, context) == 1) {
stream.position = position;
0;
} else {
1;
}
}
// Sequence
Sequence = Object.subtype(#Sequence);
Sequence.match(stream, context, actions) {
i = 0;
match = 1;
while (i < self.length() && match == 1) {
match = self[i].match(stream, context, actions);
}
match;
}
// Alternation
Alternation = Object.subtype(#Alternation);
Alternation.match(stream, context, actions) {
i = 0;
match = 0;
while(i < self.length() && match == 0){
initialActionCount = actions.length();
match = self[i].match(stream, context, actions);
if (match == 0) {
while (actions.length() > initialActionCount) {
actions.pop();
}
}
}
}
// Action
Action = Object.subtype(#Action);
Action.match(stream, context, actions) {
actions.push(self);
self.context = context;
1;
}
Action.execute() {
// Declare all variables that a value is set to in the context
for (statement in self.parseTree.body) {
if (statement.__name__ == "SetVar") {
self.context.declareVariable(statement.name);
}
}
// Evaluate the parse tree and return to outer context if needed
returnValue = eval(self.parseTree, env: self.context.variables);
if (self.context.outerContext != nil) {
self.context.outerContext.variables[self.context.returnValueName] = returnValue;
}
}
// Assignment
Assignment = Object.subtype(#Assignment);
Assignment.match(stream, context, actions) {
context.declareVariable(self.variableName);
innerContext = Context.new(outerContext: context, returnValueName: self.variableName).init();
self.rule.match(stream, innerContext, actions);
}
// Main
// stream = newStream(readfile("input.txt"));
stream = newStream("asdf1234");
context = Context.new(outerContext: nil).init();
actions = [];
// s = StringLiteral.new(string: "ab");
// print("Success : ", s.match(stream), "\n");
// c = CharacterClass.new(value: " \n\t");
// print("Parsing Character: ", stream.peek(), " | CharacterClass [", c.value,"] : ", c.match(stream), "\n");
// d = Dot.new();
// print("Parsing Character: ", stream.peek(), " | Dot : ", d.match(stream, context), "\n");
println("\n--- Action Test ---\n");
actionParseTree = `{
innerVar = 151;
};
act = Action.new(parseTree: actionParseTree);
assign = Assignment.new(variableName: #outerVar, rule: act);
assign.match(stream, context, actions);
actionParseTree2 = `{
x = 69;
};
act2 = Action.new(parseTree: actionParseTree2);
act2.match(stream, context, actions);
for (action in actions) {
action.execute();
}
print("global variable named innerVar => ", innerVar, " should be nil\n");
print("global variable named x => ", x, " should be nil\n");
print(context, "\n", full: 1);
// c = CharacterClass.new(value: "a");
// u = Not.new(innerExpression: c);
// println(u.match(stream, context));
// println(stream);
//
// println();
// println();
// println();
//
// gensokyo = [buses: 0, inhabitants: 1337];
//
// reimu = [location: gensokyo];
// marisa = [location: gensokyo];
//
// println(marisa.location);
// reimu.location.inhabitants = 42;
// println(marisa.location);

+ 223
- 128
minproto.leg Ver fichero

@ -1,27 +1,27 @@
# minproto.leg -- minimal prototype langauge for semantic experiments
#
# last edited: 2024-05-07 23:23:22 by piumarta on m1mbp
# last edited: 2024-05-09 10:17:11 by piumarta on zora-1034.local
%{
;
#ifndef GC
# define GC 1
# define GC 1 // do not fill memory with unreachable junk
#endif
#ifndef TAGS
# define TAGS 1
# define TAGS 1 // Integer and Float are immediate values encoded in their object "pointer"
#endif
#ifndef TYPECODES
# define TYPECODES 0
#ifndef TYPECODES // <ast>.eval() dispatches using switch(), instead of invoking a method
# define TYPECODES 0 // (approx. 210% performance increase, because no dynamic dispatch in eval())
#endif
#ifndef PRIMCLOSURE
# define PRIMCLOSURE 1
#ifndef PRIMCLOSURE // Lambda and Closure are primitive types, not subtypes of Object
# define PRIMCLOSURE 0 // (approx. 6% performance decrease, because every Object_get() is slower)
#endif
#ifndef DELOPT
# define DELOPT 0
#ifndef DELOPT // delegate is a member of Object structure, not a normal property
# define DELOPT 0 // (approx. 60% performance increase, becase no associative lookup of __delegate__)
#endif
#include <math.h>
@ -85,9 +85,9 @@ typedef oop (*prim_t)(oop func, oop self, oop args, oop env);
#endif
#if PRIMCLOSURE
#define doProtos(_) _(Object) _(GetVar) _(SetVar) _(GetProp) _(SetProp) _(GetArray) _(SetArray) _(Call) _(Invoke) _(Binop) _(Unyop) _(If) _(While) _(Block) _(For) _(ForIn) _(ForFromTo) _(Literal)
#define doProtos(_) _(Object) _(GetVar) _(SetVar) _(GetProp) _(SetProp) _(GetArray) _(SetArray) _(Call) _(Invoke) _(Binop) _(Unyop) _(If) _(While) _(Block) _(For) _(ForIn) _(ForFromTo) _(Literal) _(Range)
#else
#define doProtos(_) _(Object) _(GetVar) _(SetVar) _(GetProp) _(SetProp) _(GetArray) _(SetArray) _(Call) _(Invoke) _(Binop) _(Unyop) _(If) _(While) _(Block) _(For) _(ForIn) _(ForFromTo) _(Literal) _(Lambda) _(Closure)
#define doProtos(_) _(Object) _(GetVar) _(SetVar) _(GetProp) _(SetProp) _(GetArray) _(SetArray) _(Call) _(Invoke) _(Binop) _(Unyop) _(If) _(While) _(Block) _(For) _(ForIn) _(ForFromTo) _(Literal) _(Lambda) _(Closure) _(Range)
#endif
#define declareProto(NAME) oop p##NAME = 0;
@ -114,7 +114,7 @@ doTypes(makeProto);
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)
#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) _(start) _(end) _(env)
#define declareSym(NAME) oop sym_##NAME = 0;
doSymbols(declareSym);
@ -133,7 +133,7 @@ struct Symbol { enum type type; char *name; oop value; };
struct Primitive { enum type type; oop name; prim_t function; };
#if PRIMCLOSURE
struct Lambda { enum type type; oop parameters, body; };
struct Closure { enum type type; int fixed; oop lambda, environment; };
struct Closure { enum type type; int fixed; oop function, environment; };
#endif
struct Object { enum type type; int isize, icap, psize;
# if DELOPT
@ -424,14 +424,16 @@ oop newLambda(oop parameters, oop body)
return obj;
}
oop newClosure(oop lambda, oop environment)
oop newClosure(oop function, oop environment)
{
oop obj = make(Closure);
_set(obj, Closure,lambda, lambda);
_set(obj, Closure,function, function);
_set(obj, Closure,environment, environment);
return obj;
}
int isClosure(oop obj) { return is(Closure, obj); }
#endif
oop macros = 0;
@ -530,36 +532,40 @@ char *storeString(oop obj, int indent);
oop Object_get(oop obj, oop key)
{
oop o = obj;
while (is(Object, o)) {
ssize_t ind = Object_find(o, key);
if (ind >= 0) return _get(o, Object,properties)[ind].val;
o = _getDelegate(o);
}
# define makeCase(NAME) case NAME: o = p##NAME; break;
oop o;
switch (getType(obj)) {
doTypes(makeCase);
case Object: break;
case Undefined: o = pUndefined; break;
case Integer: o = pInteger; break;
case Float: o = pFloat; break;
case String: o = pString; break;
case Symbol: o = pSymbol; break;
case Primitive: o = pPrimitive; break;
# if PRIMCLOSURE
case Lambda:
if (key == sym_parameters) return _get(obj, Lambda,parameters);
if (key == sym_body ) return _get(obj, Lambda,body );
o = pLambda;
break;
case Closure:
if (key == sym_function ) return _get(obj, Closure,function );
if (key == sym_environment) return _get(obj, Closure,environment);
if (key == sym_fixed ) return _get(obj, Closure,fixed) ? sym_t : nil;
o = pClosure;
break;
# endif
case Object: {
ssize_t ind = Object_find(obj, key);
if (ind >= 0) return _get(obj, Object,properties)[ind].val;
o = _getDelegate(obj);
break;
}
}
# undef makeCase
# if !DELOPT
if (key == prop_delegate) return o; // implicit delegate of atomic object
# endif
if (key == prop_delegate) return o;
while (is(Object, o)) {
ssize_t ind = Object_find(o, key);
if (ind >= 0) return _get(o, Object,properties)[ind].val;
o = _getDelegate(o);
}
# if DELOPT
if (key == prop_delegate) {
# define makeCase(NAME) case NAME: return p##NAME;
switch (getType(obj)) {
doTypes(makeCase);
case Object: return _getDelegate(obj);
}
# undef makeCase
}
# endif
fatal("%s.%s is undefined", storeString(obj, 0), storeString(key, 0));
return nil;
}
@ -586,6 +592,20 @@ oop setvar(oop obj, oop key, oop val)
oop Object_put(oop obj, oop key, oop val)
{
# if PRIMCLOSURE
switch (getType(obj)) {
case Lambda:
if (key == sym_parameters ) { _set(obj, Lambda,parameters, val); return val; }
if (key == sym_body ) { _set(obj, Lambda,body, val); return val; }
break;
case Closure:
if (key == sym_fixed ) { _set(obj, Closure,fixed, nil != val); return val; }
if (key == sym_function ) { _set(obj, Closure,function, val); return val; }
if (key == sym_environment) { _set(obj, Closure,environment, val); return val; }
default:
break;
}
# endif
ssize_t ind = Object_find(obj, key);
struct property *kvs = _get(obj, Object,properties);
if (ind < 0) {
@ -723,8 +743,37 @@ oop printOn(oop buf, oop obj, int indent)
break;
}
#if PRIMCLOSURE
case Lambda: String_appendAll(buf, "<lambda>"); break;
case Closure: String_appendAll(buf, "<closure>"); break;
case Lambda: {
String_appendAll(buf, "<<Lambda>>");
if (!indent) break;
String_append(buf, '\n');
for (int j = indent; j--;) String_appendAll(buf, " | ");
String_appendAll(buf, " body: ");
printOn(buf, _get(obj, Lambda,body), indent+1);
String_append(buf, '\n');
for (int j = indent; j--;) String_appendAll(buf, " | ");
String_appendAll(buf, " parameters: ");
printOn(buf, _get(obj, Lambda,parameters), indent+1);
break;
}
case Closure: {
String_appendAll(buf, "<<Closure>>");
if (!indent) break;
String_append(buf, '\n');
for (int j = indent; j--;) String_appendAll(buf, " | ");
String_appendAll(buf, " environment: ");
printOn(buf, _get(obj, Closure,environment), indent+1);
String_append(buf, '\n');
for (int j = indent; j--;) String_appendAll(buf, " | ");
String_appendAll(buf, " function: ");
printOn(buf, _get(obj, Closure,function), indent+1);
break;
break;
}
#endif
case Object: {
int level = 0;
@ -1074,6 +1123,17 @@ oop GetArray_eval(oop exp, oop env)
default: fatal("[]: %s is not indexable", storeString(obj, 0));
}
}
if (getType(ind) == Object) {
switch (getType(obj)) {
case String: {
int start = integerValue(eval(Object_get(ind, sym_start), env), "[..]");
int end = integerValue(eval(Object_get(ind, sym_end ), env), "[..]");
oop slice = newStringLen(String_aref(obj, start), end - start);
return slice;
}
default: fatal("[]: %s is not range - indexable", storeString(obj, 0));
}
}
if (!is(Object, obj)) fatal("[]: %s is not an object", storeString(obj, 0));
return Object_getLocal(obj, ind);
}
@ -1123,6 +1183,25 @@ void SetArray_codeOn(oop exp, oop str, oop env)
codeOn(str, Object_get(exp, sym_value), 0);
}
oop newRange(oop start, oop end) {
oop o = new(pRange);
Object_put(o, sym_start, start);
Object_put(o, sym_end, end);
return o;
}
oop Range_eval(oop exp, oop env)
{
return exp;
}
void Range_codeOn(oop exp, oop str, oop env)
{
codeOn(str, Object_get(exp, sym_start), 0);
String_appendAll(str, "..");
codeOn(str, Object_get(exp, sym_end), 0);
}
oop newCall(oop function, oop arguments)
{
oop o = new(pCall);
@ -1144,7 +1223,11 @@ oop newApply(oop function, oop arguments)
int isFixed(oop func)
{
# if PRIMCLOSURE
return is(Closure, func) && _get(func, Closure,fixed);
# else
return Object_getLocal(func, sym_fixed) != nil;
# endif
}
oop Call_eval(oop exp, oop env)
@ -1220,6 +1303,19 @@ oop newLambda(oop parameters, oop body)
return o;
}
oop newClosure(oop function, oop environment)
{
oop o = new(pClosure);
Object_put(o, sym_function , function );
Object_put(o, sym_environment, environment);
return o;
}
int isClosure(oop obj)
{
return is(Object, obj) && pClosure == _getDelegate(obj);
}
oop Lambda_eval(oop exp, oop env)
{
return newClosure(exp, env);
@ -1231,14 +1327,6 @@ void Lambda_codeOn(oop exp, oop str, oop env)
codeBlockOn(str, Object_get(exp, sym_body));
}
oop newClosure(oop lambda, oop environment)
{
oop o = new(pClosure);
Object_put(o, sym_lambda , lambda );
Object_put(o, sym_environment, environment);
return o;
}
oop Closure_eval(oop exp, oop env)
{
return exp;
@ -1445,9 +1533,10 @@ oop quasiclone(oop exp, oop env)
struct property *kvs = _get(exp, Object,properties);
int psize = _get(exp, Object,psize);
for (int i = 0; i < psize; ++i)
Object_put(clone, kvs[i].key, quasiclone(kvs[i].val, env));
if (kvs[i].key != prop_delegate)
Object_put(clone, kvs[i].key, quasiclone(kvs[i].val, env));
oop delegate = _getDelegate(exp);
if (nil != delegate)
if (nil != delegate) // always shallow copied
Object_put(clone, prop_delegate, delegate);
return clone;
}
@ -1873,10 +1962,13 @@ sum = l:prod ( PLUS r:prod { l = newBinop(opAdd, l, r) }
| MINUS r:prod { l = newBinop(opSub, l, r) }
)* { $$ = l }
prod = l:prefix ( STAR r:prefix { l = newBinop(opMul, l, r) }
| SLASH r:prefix { l = newBinop(opDiv, l, r) }
| PCENT r:prefix { l = newBinop(opMod, l, r) }
)* { $$ = l }
prod = l:range ( STAR r:range { l = newBinop(opMul, l, r) }
| SLASH r:range { l = newBinop(opDiv, l, r) }
| PCENT r:range { l = newBinop(opMod, l, r) }
) * { $$ = l }
range = i1:prefix ( DOTDOT i2:prefix { i1 = newRange(i1, i2) }
) ? { $$ = i1 }
prefix = PLING p:prefix { $$ = newUnyop(opNot, p) }
| MINUS p:prefix { $$ = newUnyop(opNeg, p) }
@ -1931,8 +2023,7 @@ number = "-" u:unsign { $$ = neg(u) }
| "+" n:number { $$ = u }
| u:unsign { $$ = u }
unsign = < DIGIT+ '.' DIGIT* EXP? > - { $$ = newFloat(strtod(yytext, 0)) }
| < DIGIT* '.' DIGIT+ EXP? > - { $$ = newFloat(strtod(yytext, 0)) }
unsign = < DIGIT* '.' DIGIT+ EXP? > - { $$ = newFloat(strtod(yytext, 0)) }
| "0" [bB] < BIGIT+ > - { $$ = newInteger(strtol(yytext, 0, 2)) }
| "0" [xX] < HIGIT+ > - { $$ = newInteger(strtol(yytext, 0, 16)) }
| "0" < OIGIT* > - { $$ = newInteger(strtol(yytext, 0, 8)) }
@ -1970,40 +2061,41 @@ IN = "in" !ALNUM -
FROM = "from" !ALNUM -
TO = "to" !ALNUM -
BQUOTE = "`" -
COMMAT = "@" -
HASH = "#" -
SEMI = ";" -
ASSIGN = "=" ![=] -
COMMA = "," -
COLON = ":" -
LPAREN = "(" -
RPAREN = ")" -
LBRAK = "[" -
RBRAK = "]" -
LBRACE = "{" -
RBRACE = "}" -
BARBAR = "||" ![=] -
ANDAND = "&&" ![=] -
OR = "|" ![|=] -
XOR = "^" ![=] -
AND = "&" ![&=] -
EQ = "==" -
NOTEQ = "!=" -
LESS = "<" ![<=] -
LESSEQ = "<=" -
GRTREQ = ">=" -
GRTR = ">" ![=] -
SHL = "<<" ![=] -
SHR = ">>" ![=] -
PLUS = "+" ![+=] -
MINUS = "-" ![-=] -
STAR = "*" ![=] -
SLASH = "/" ![/=] -
PCENT = "%" ![*=] -
DOT = "." -
PLING = "!" ![=] -
TILDE = "~" -
BQUOTE = "`" -
COMMAT = "@" -
HASH = "#" -
SEMI = ";" -
ASSIGN = "=" ![=] -
COMMA = "," -
COLON = ":" -
LPAREN = "(" -
RPAREN = ")" -
LBRAK = "[" -
RBRAK = "]" -
LBRACE = "{" -
RBRACE = "}" -
BARBAR = "||" ![=] -
ANDAND = "&&" ![=] -
OR = "|" ![|=] -
XOR = "^" ![=] -
AND = "&" ![&=] -
EQ = "==" -
NOTEQ = "!=" -
LESS = "<" ![<=] -
LESSEQ = "<=" -
GRTREQ = ">=" -
GRTR = ">" ![=] -
SHL = "<<" ![=] -
SHR = ">>" ![=] -
PLUS = "+" ![+=] -
MINUS = "-" ![-=] -
STAR = "*" ![=] -
SLASH = "/" ![/=] -
PCENT = "%" ![*=] -
DOT = "." ![.] -
DOTDOT = ".." -
PLING = "!" ![=] -
TILDE = "~" -
%%;
@ -2031,14 +2123,14 @@ oop apply(oop func, oop self, oop args, oop env)
#if PRIMCLOSURE
if (Closure != functype)
fatal("cannot %s %s", (nil == self ? "call" : "invoke"), storeString(func, 0));
oop lambda = _get(func, Closure,lambda);
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));
oop lambda = Object_get(func, sym_lambda);
oop lambda = Object_get(func, sym_function);
oop environment = Object_get(func, sym_environment);
oop parameters = Object_get(lambda, sym_parameters);
oop body = Object_get(lambda, sym_body);
@ -2091,20 +2183,22 @@ enum typecode getTypecode(oop exp)
return NAME##_eval(exp, env); \
}
doProtos(defineEval)
#undef defineEval
#endif // !TYPECODES
#define defineCodeOn(NAME) \
static inline oop prim_##NAME##_codeOn(oop func, oop exp, oop args, oop env) { \
NAME##_codeOn(exp, getArgType(args, 0, String, #NAME".codeOn"), env); \
return exp; \
} \
doProtos(defineEval)
doProtos(defineCodeOn)
#undef defineEval
#undef defineCodeOn
#endif // !TYPECODES
static inline oop evalobj(oop exp, oop env)
{
# if !TYPECODES
@ -2117,7 +2211,7 @@ static inline oop evalobj(oop exp, oop env)
enum typecode type = getTypecode(exp);
# define defineEval(NAME) case t##NAME: NAME##_eval(exp, env); break;
# define defineEval(NAME) case t##NAME: return NAME##_eval(exp, env);
switch (type) {
doProtos(defineEval);
}
@ -2196,13 +2290,31 @@ oop prim_length(oop func, oop self, oop args, oop env)
oop prim_keys(oop func, oop self, oop args, oop env)
{
oop keys = new(pObject);
if (is(Object, self)) {
int size = _get(self, Object,psize);
struct property *kvs = _get(self, Object,properties);
# if DELOPT
if (nil != _getDelegate(self)) Object_push(keys, prop_delegate);
# if DELOPT
if (nil != _getDelegate(self)) Object_push(keys, prop_delegate);
# endif
switch (getType(self)) {
case Undefined: case Integer: case Float: case String: case Symbol: case Primitive:
break;
case Object: {
int size = _get(self, Object,psize);
struct property *kvs = _get(self, Object,properties);
for (int i = 0; i < size; ++i) Object_push(keys, kvs[i].key);
break;
}
# if PRIMCLOSURE
case Lambda: {
Object_push(keys, sym_parameters);
Object_push(keys, sym_body);
break;
}
case Closure: {
Object_push(keys, sym_fixed);
Object_push(keys, sym_lambda);
Object_push(keys, sym_environment);
break;
}
# endif
for (int i = 0; i < size; ++i) Object_push(keys, kvs[i].key);
}
return keys;
}
@ -2212,37 +2324,16 @@ oop prim_env(oop func, oop self, oop args, oop env)
return env;
}
oop prim_makeForm(oop func, oop self, oop args, oop env)
oop prim_eval(oop func, oop self, oop args, oop env)
{
int argc = _get(args, Object,isize);
oop *indexed = _get(args, Object,indexed);
oop result = nil;
for (int i = 0; i < argc; ++i) {
result = indexed[i];
if (!is(Closure, result)) fatal("makeForm: argument must be closure");
_set(result, Closure,fixed, 1);
}
return result;
}
oop prim_makeMacro(oop func, oop self, oop args, oop env)
{
int argc = _get(args, Object,isize);
oop *indexed = _get(args, Object,indexed);
oop result = nil;
for (int i = 0; i < argc; ++i) {
result = indexed[i];
if (!is(Closure, result)) fatal("makeForm: argument must be closure");
_set(result, Closure,fixed, 1);
if (nil != Object_getLocal(args, sym_env)) {
env = Object_getLocal(args, sym_env);
}
return result;
}
oop prim_eval(oop func, oop self, oop args, oop env)
{
int argc = _get(args, Object,isize);
oop *indexed = _get(args, Object,indexed);
oop result = nil;
for (int i = 0; i < argc; ++i) result = eval(indexed[i], env);
return result;
}
@ -2439,11 +2530,16 @@ int main(int argc, char **argv)
# undef defineProto
#if TYPECODES
Object_put(pObject, prop_eval, newPrimitive(prim_env)); // inherited by all objects
# define defineEvaluator(NAME) \
_set(intern(#NAME), Symbol,typecode, t##NAME);
#else // !TYPECODES
# define defineEvaluator(NAME) \
Object_put(p##NAME, prop_eval, newPrimitive(prim_##NAME##_eval));
#endif // !TYPECODES
doProtos(defineEvaluator);
@ -2460,7 +2556,6 @@ int main(int argc, char **argv)
macros = Object_put(pSymbol, intern("macros"), new(pObject));
_set(intern("__env__" ), Symbol,value, newPrimitive(prim_env));
_set(intern("makeForm" ), Symbol,value, newPrimitive(prim_makeForm));
_set(intern("eval" ), Symbol,value, newPrimitive(prim_eval));
_set(intern("print" ), Symbol,value, newPrimitive(prim_print));
_set(intern("codeString" ), Symbol,value, newPrimitive(prim_codeString));

+ 53
- 3
test.ref Ver fichero

@ -12,7 +12,18 @@ Point.new(x: 3, y: 4) => <>
| y: 4
| x: 3
twice 21 is 42
double => <closure>
double => <<Closure>>
| environment: nil
| function: <<Lambda>>
| | body: <<Object>>
| | | 0: <<Binop>>
| | | | operation: 13
| | | | 0: <<GetVar>>
| | | | | name: x
| | | | 1: <<GetVar>>
| | | | | name: x
| | parameters: <<Object>>
| | | 0: x
Point.new(x:3, y:4).magnitude() => 5.000000
<<?>>
| self: nil =>
@ -50,7 +61,7 @@ ok
----
MyType.__eval__() invoked
42
<closure>
<<Closure>>
====
42
hello
@ -130,7 +141,44 @@ f 102 ( 40 ) 41 32 { 123 32 p 112 r 114 i 105 n 110 t 116 ( 40 _ 95 _ 95 e 1
42
6 * 7
MACRO table <<Object>>
| test: <closure>
| test: <<Closure>>
| | environment: nil
| | function: <<Lambda>>
| | | body: <<Object>>
| | | | 0: <<Call>>
| | | | | arguments: <<Object>>
| | | | | | 0: MACRO EVAL test with
| | | | | | 1: <<GetVar>>
| | | | | | | name: x
| | | | | | 2: and
| | | | | | 3: <<GetVar>>
| | | | | | | name: y
| | | | | | 4:
| | | | | function: <<GetVar>>
| | | | | | name: print
| | | | 1: <<Unyop>>
| | | | | operation: 3
| | | | | 0: <<Block>>
| | | | | | body: <<Object>>
| | | | | | | 0: <<Call>>
| | | | | | | | arguments: <<Object>>
| | | | | | | | | 0: REPLACEMENT
| | | | | | | | | 1: <<Unyop>>
| | | | | | | | | | operation: 4
| | | | | | | | | | 0: <<GetVar>>
| | | | | | | | | | | name: x
| | | | | | | | | 2:
| | | | | | | | function: <<GetVar>>
| | | | | | | | | name: print
| | | | | | | 1: <<Unyop>>
| | | | | | | | operation: 4
| | | | | | | | 0: <<GetVar>>
| | | | | | | | | name: y
| | | parameters: <<Object>>
| | | | 0: x
| | | | 1: y
define testfun
MACRO EVAL test with 1 and 2
MACRO EVAL test with three and four
@ -142,6 +190,8 @@ REPLACEMENT three
0 1 2 3 4 5 6 7 8 9
65 66 67 68 69
1 two 3 four
test.txt:331: *: illegal operand types Integer and String
11: n * factorial(n - 1)
10: if (n < 2) "1" else n * factorial(n - 1)
9: factorial(n - 1)

+ 4
- 2
test.txt Ver fichero

@ -97,7 +97,7 @@ assert(x) {
}
}
makeForm(assert);
assert.fixed = #t; // do not evaluate arguments (x will be an AST suitable for eval())
refute(x) {
if (eval(x)) {
@ -106,7 +106,9 @@ refute(x) {
}
}
makeForm(refute);
refute.fixed = #t;
refute;
assert(1 == 1);
refute(1 == 0);

Cargando…
Cancelar
Guardar