sage
/
pebblisp
1
1
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Several changes. 

Add `reduce` and `islist`.
 - Reduce is broken with lambdas for some reason.
Remove `switch` from lib (breaks `penv`).
More detailed lambda to-stringing.
A bit of fixing for lambdas that return lambdas.
Re-org Object fields for simpler visual debugging.
Let `cat` work with one argument.
Add prompt option for `inp`.
Some more refinement of the webby.pl example.
This commit is contained in:
Sage Vaillancourt 2022-03-16 16:36:04 -04:00 committed by Sage Vaillancourt
parent 7faf2ebbb3
commit 711719289f
8 changed files with 150 additions and 56 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
src/env.c
View File

@ -164,13 +164,14 @@ void printEnv(struct Environment* env)
printf("NULL env\n"); printf("NULL env\n");
return; return;
} }
printf("env->size = %d\n", env->size);
for (int i = 0; i < env->size; i++) { for (int i = 0; i < env->size; i++) {
if (env->strings[i] == NULL) { if (env->strings[i] == NULL) {
printf("env[%d]: NULL %p\n", i, env->strings[i]); printf("env[%d]: NULL %p\n", i, env->strings[i]);
break; break;
} }
printf("env[%d]: '%s' %p\n", i, env->strings[i], env->strings[i]); printf("env[%d]: `%s` %p :: ", i, env->strings[i], env->strings[i]);
printf(" "); printf("");
printObj(&env->objects[i]); printObj(&env->objects[i]);
printf(""); printf("");
} }
@ -259,6 +260,7 @@ struct Environment defaultEnv()
{"len", &len}, {"len", &len},
{"ap", &append}, {"ap", &append},
{"pre", &prepend}, {"pre", &prepend},
{"reduce", &reduce},
{"at", &at}, {"at", &at},
{"rest", &rest}, {"rest", &rest},
{"chat", &charAt}, {"chat", &charAt},
@ -266,6 +268,7 @@ struct Environment defaultEnv()
{"rev", &reverse}, {"rev", &reverse},
#endif #endif
{"isnum", &isNum}, {"isnum", &isNum},
{"islist", &isList},
{"isstr", &isString}, {"isstr", &isString},
{"iserr", &isErr}, {"iserr", &isErr},
{"char", &charVal}, {"char", &charVal},

14
src/examples/lib.pbl
View File

@ -27,10 +27,10 @@
; Switch expression ; Switch expression
; Doesn't yet work with lambdas ; Doesn't yet work with lambdas
(def switch (fn (val pair_list) ;(def switch (fn (val pair_list)
(if (= 0 (len pair_list)) "no match" ; (if (= 0 (len pair_list)) "no match"
(if (= val (at 0 (at 0 pair_list))) (at 1 (at 0 pair_list)) ( ; (if (= val (at 0 (at 0 pair_list))) (at 1 (at 0 pair_list)) (
(switch val (rest pair_list)) ; (switch val (rest pair_list))
)) ; ))
) ; )
)) ;))

57
src/examples/webby.pl
View File

@ -3,20 +3,27 @@
(struct Post (struct Post
(title body)) (title body))
;(def element (fn (type) (fn (text) (cat "<" type ">" text "</" type ">")))) (def element (fn (type)
;(def link (element "link")) (fn (text)
;(prnl (link "howdy")) (cat "<" type ">"
(if (islist text) (reduce (text "") cat) (reduce ((text) "") cat))
"</" type ">"))))
(def html (fn (text) (cat "<html>" text "</html>"))) (def html (element "html"))
(def head (fn (text) (cat "<head>" text "</head>"))) (def body (element "body"))
(def body (fn (text) (cat "<body>" text "</body>"))) (def head (element "head"))
(def link (fn (text) (cat "<link " text ">"))) (def h1 (element "h1"))
(def h1 (fn (text) (cat "<h1>" text "</h1> (def h2 (element "h2"))
"))) (def p (element "p"))
(def h2 (fn (text) (cat "<h2>" text "</h2>"))) (def div (element "div"))
(def p (fn (text) (cat "<p>" text "</p> (def article (element "article"))
")))
(def singleton (fn (type) (fn (text) (cat "<" type " " (reduce (text "") cat) ">"))))
(def link (singleton "link"))
(def attribute (fn (type) (fn (value) (cat type "='" value "'"))))
(def rel (attribute "rel"))
(def href (attribute "href"))
(def htmlize (fn (po) (cat (def htmlize (fn (po) (cat
(h2 po's title) (h2 po's title)
@ -29,12 +36,15 @@ and the interpreter won't even instantly crash over it! It's truly astounding
stuff, when you think about it." stuff, when you think about it."
)) ))
(def homepage (fn () (html (cat (def homepage (fn () (html (
(head (link "rel='stylesheet' href='styles.css'")) (head (
(body (cat (link ((rel "stylesheet") (href "styles.css")))
(h1 "This is Sage's Blog") ))
(body (
(h1 "This is a sweet PebbLisp blog")
(htmlize p1) (htmlize p1)
(htmlize p2)))))) ) (htmlize p2)))
))))
(get "/" homepage) (get "/" homepage)
@ -54,9 +64,14 @@ body {
(def PORT 9090) (def PORT 9090)
(serve PORT) (serve PORT)
(prnl (cat "Hosting server on " PORT ". Press enter to exit."))
(prnl (cat "Hosting server on " PORT ". Entering simple REPL. q to quit"))
(def repl (fn () ( (def repl (fn () (
(eval (inp)) (def input (inp "webby>> "))
(repl) (if (= input "q") () (
))) (eval input)
(repl)
))
)))
(repl) (repl)

44
src/object.c
View File

@ -356,8 +356,21 @@ char* stringNObj(char* dest, const Object* obj, const size_t len)
break; break;
} }
case TYPE_FUNC: case TYPE_FUNC:
stringf(dest, len, "F%d", obj->number);
break;
case TYPE_LAMBDA: case TYPE_LAMBDA:
stringf(dest, len, "X%d", obj->number); #ifdef STANDALONE
dest += stringf(dest, len, "\\x%d", obj->number);
stringNObj(dest, &obj->lambda->params, len);
dest += strlen(dest);
strcat(dest, " -> ");
dest += 4;
stringNObj(dest, &obj->lambda->body, len);
dest += strlen(dest);
strcat(dest, ">");
#else
stringf(dest, len, "\\x%d", obj->number);
#endif
break; break;
case TYPE_OTHER: case TYPE_OTHER:
stringf(dest, len, "%p", obj->other->data); stringf(dest, len, "%p", obj->other->data);
@ -396,6 +409,10 @@ void debugObj(const Object* obj)
void printType(const Object* obj) void printType(const Object* obj)
{ {
if (!obj) {
printf("NULL OBJECT");
return;
}
switch (obj->type) { switch (obj->type) {
SIMPLE_TYPE(TYPE_NUMBER); SIMPLE_TYPE(TYPE_NUMBER);
SIMPLE_TYPE(TYPE_STRUCT); SIMPLE_TYPE(TYPE_STRUCT);
@ -425,6 +442,10 @@ void _printObj(const Object* obj, int newline)
printType(obj); printType(obj);
#endif #endif
if (!obj) {
printf(newline ? "\n" : "");
return;
}
if (obj->type == TYPE_LAMBDA) { if (obj->type == TYPE_LAMBDA) {
printObj(&obj->lambda->params); printObj(&obj->lambda->params);
printf("->"); printf("->");
@ -710,7 +731,7 @@ inline int isValidType(const Object test)
*/ */
inline Object cloneLambda(const Object old) inline Object cloneLambda(const Object old)
{ {
return constructLambda(&old.lambda->params, &old.lambda->body); return constructLambda(&old.lambda->params, &old.lambda->body, NULL);
} }
Object cloneString(Object obj) Object cloneString(Object obj)
@ -807,7 +828,7 @@ inline Object symFromSlice(const char* string, int len)
return o; return o;
} }
inline Object constructLambda(const Object* params, const Object* body) inline Object constructLambda(const Object* params, const Object* body, struct Environment* env)
{ {
if (!params || !body) { if (!params || !body) {
return errorObject(NULL_LAMBDA_LIST); return errorObject(NULL_LAMBDA_LIST);
@ -823,6 +844,23 @@ inline Object constructLambda(const Object* params, const Object* body)
o.lambda->body = listObject(); o.lambda->body = listObject();
copyList(&o.lambda->params, params); copyList(&o.lambda->params, params);
copyList(&o.lambda->body, body); copyList(&o.lambda->body, body);
if (env) {
Object *dest = &o.lambda->body;
FOR_POINTER_IN_LIST(dest) {
if (POINTER->type == TYPE_SYMBOL) {
Object fetched = fetchFromEnvironment(POINTER->string, env);
// TODO: Figure out why lambdas in particular break when doing this.
if (!isError(fetched, DID_NOT_FIND_SYMBOL) && fetched.type != TYPE_LAMBDA) {
fetched.forward = POINTER->forward;
cleanObject(POINTER);
*POINTER = fetched;
} else {
cleanObject(&fetched);
}
}
}
}
return o; return o;
} }

6
src/object.h
View File

@ -94,8 +94,6 @@ struct Error {
struct Object { struct Object {
Type type; Type type;
Object *forward;
union { union {
int number; int number;
Object *list; Object *list;
@ -112,6 +110,8 @@ struct Object {
struct Error *error; struct Error *error;
#endif #endif
}; };
Object *forward;
}; };
struct StructDef { struct StructDef {
@ -240,7 +240,7 @@ void errorAddContext(Object *o, const char *context);
struct Error noError(); struct Error noError();
Object constructLambda(const Object *params, const Object *body); Object constructLambda(const Object *params, const Object *body, struct Environment* env);
// Object version of listLength() // Object version of listLength()
Object len(Object obj1, Object, struct Environment *); Object len(Object obj1, Object, struct Environment *);

62
src/pebblisp.c
View File

@ -116,11 +116,9 @@ Object evalIfArgs(const Object* argForms, struct Environment* env)
return result; return result;
} }
Object evalLambdaArgs(const Object* argForms) Object evalLambdaArgs(const Object* argForms, struct Environment* env)
{ {
return constructLambda(argForms, // Params return constructLambda(argForms, argForms ? argForms->forward : NULL, env);
argForms ? argForms->forward : NULL // Body
);
} }
Object evalMapArgs(const Object* argForms, struct Environment* env) Object evalMapArgs(const Object* argForms, struct Environment* env)
@ -179,7 +177,7 @@ Object evalBuiltIns(const Object* first, const Object* rest,
} else if (strcmp(first->string, "if") == 0) { } else if (strcmp(first->string, "if") == 0) {
return evalIfArgs(rest, env); return evalIfArgs(rest, env);
} else if (strcmp(first->string, "fn") == 0) { } else if (strcmp(first->string, "fn") == 0) {
return evalLambdaArgs(rest); return evalLambdaArgs(rest, env);
} else if (strcmp(first->string, "map") == 0) { } else if (strcmp(first->string, "map") == 0) {
return evalMapArgs(rest, env); return evalMapArgs(rest, env);
} else if (strcmp(first->string, "struct") == 0) { } else if (strcmp(first->string, "struct") == 0) {
@ -276,7 +274,6 @@ Object listEvalLambda(Object* lambda, const Object* remaining,
struct Environment newEnv = struct Environment newEnv =
envForLambda(&lambda->lambda->params, remaining, env); envForLambda(&lambda->lambda->params, remaining, env);
Object ret = eval(&lambda->lambda->body, &newEnv); Object ret = eval(&lambda->lambda->body, &newEnv);
deleteEnv(&newEnv); deleteEnv(&newEnv);
cleanObject(lambda); cleanObject(lambda);
@ -329,14 +326,9 @@ Object evalList(const Object* obj, struct Environment* env)
while (outerEnv->outer) { while (outerEnv->outer) {
outerEnv = outerEnv->outer; outerEnv = outerEnv->outer;
} }
//printf("evalList firstElementName: %s\n", first_form->string);
//printf("checking for struct `%s`\n", first_form->string);
//printf("%d structs available\n", outerEnv->structCount);
for (int i = 0; i < outerEnv->structCount; i++) { for (int i = 0; i < outerEnv->structCount; i++) {
//printf("struct[%d] - `%s`\n", i, outerEnv->structDefs[i].name);
if (strcmp(first_form->string, outerEnv->structDefs[i].name) == 0) { if (strcmp(first_form->string, outerEnv->structDefs[i].name) == 0) {
def = i; def = i;
//printf("Found struct definition for %s!\n", first_form->string);
break; break;
} }
} }
@ -409,11 +401,43 @@ Object eval(const Object* obj, struct Environment* env)
return errorObject(BAD_TYPE); return errorObject(BAD_TYPE);
} }
/**
* (reduce (list, initial) (fn (prev total) (+ prev total)))
*/
Object reduce(const Object listInitial, const Object func, struct Environment* env)
{
Object* list = itemAt(&listInitial, 0);
Object total = cloneObject(*list->forward); // From given initial value
// Object l;
// if (list->type != TYPE_LIST) {
// l = startList(*list);
// list = &l;
// }
FOR_POINTER_IN_LIST(list) {
Object funcList = startList(func);
nf_addToList(&funcList, total);
Object current = cloneObject(*POINTER);
nf_addToList(&funcList, current);
//Object oldTotal = total;
total = eval(&funcList, env);
//cleanObject(&oldTotal);
//cleanObject(&funcList);
//cleanObject(&current);
}
return total;
}
#define CAT_MAX 1024 #define CAT_MAX 1024
Object catObjects(const Object obj1, const Object obj2, struct Environment* env) Object catObjects(const Object obj1, const Object obj2, struct Environment* env)
{ {
Object evalObj1 = eval(&obj1, env); Object evalObj1 = eval(&obj1, env);
Object evalObj2 = eval(&obj2, env); Object evalObj2 = eval(&obj2, env);
if (isError(evalObj2, ONLY_ONE_ARGUMENT)) {
return evalObj1;
}
char str1[CAT_MAX] = ""; char str1[CAT_MAX] = "";
char str2[CAT_MAX] = ""; char str2[CAT_MAX] = "";
@ -627,6 +651,11 @@ Object isNum(Object test, Object ignore, struct Environment* ignore2)
return test.type == TYPE_NUMBER ? boolObject(1) : boolObject(0); return test.type == TYPE_NUMBER ? boolObject(1) : boolObject(0);
} }
Object isList(Object test, Object ignore, struct Environment* ignore2)
{
return test.type == TYPE_LIST ? boolObject(1) : boolObject(0);
}
Object isString(Object test, Object ignore, struct Environment* ignore2) Object isString(Object test, Object ignore, struct Environment* ignore2)
{ {
return test.type == TYPE_STRING ? boolObject(1) : boolObject(0); return test.type == TYPE_STRING ? boolObject(1) : boolObject(0);
@ -711,11 +740,7 @@ Object pChar(Object c, Object i1, struct Environment* i2)
Object printEnvO(Object i1, Object i2, struct Environment* env) Object printEnvO(Object i1, Object i2, struct Environment* env)
{ {
while (env->outer) { printEnv(global());
env = env->outer;
}
printEnv(env);
return numberObject(0); return numberObject(0);
} }
@ -736,8 +761,11 @@ Object parseEvalO(Object text, Object ignore, struct Environment* env)
#ifdef STANDALONE #ifdef STANDALONE
Object takeInput(Object i1, Object i2, struct Environment* i3) Object takeInput(Object prompt, Object i2, struct Environment* i3)
{ {
if (prompt.type == TYPE_STRING) {
printf("%s", prompt.string);
}
char input[256] = ""; char input[256] = "";
fgets(input, 256, stdin); fgets(input, 256, stdin);
return stringFromSlice(input, strlen(input) - 1); return stringFromSlice(input, strlen(input) - 1);

6
src/pebblisp.h
View File

@ -28,7 +28,7 @@ void evalForms(Object* destList, const Object* src, struct Environment* env);
void copySlice(char* dest, struct Slice* src); void copySlice(char* dest, struct Slice* src);
Object evalLambdaArgs(const Object* arg_forms); Object evalLambdaArgs(const Object* arg_forms, struct Environment* env);
Object listEvalLambda(Object* lambda, const Object* remaining, Object listEvalLambda(Object* lambda, const Object* remaining,
struct Environment* env); struct Environment* env);
@ -70,6 +70,8 @@ Object append(Object list, Object newElement, struct Environment* env);
Object prepend(Object list, Object newElement, struct Environment* env); Object prepend(Object list, Object newElement, struct Environment* env);
Object reduce(Object listInitial, Object func, struct Environment* env);
Object at(Object index, Object list, struct Environment* env); Object at(Object index, Object list, struct Environment* env);
Object rest(Object list, Object ignore, struct Environment* env); Object rest(Object list, Object ignore, struct Environment* env);
@ -78,6 +80,8 @@ Object reverse(Object _list, Object ignore, struct Environment* ignore2);
Object isNum(Object test, Object ignore, struct Environment* ignore2); Object isNum(Object test, Object ignore, struct Environment* ignore2);
Object isList(Object test, Object ignore, struct Environment* ignore2);
Object isString(Object test, Object ignore, struct Environment* ignore2); Object isString(Object test, Object ignore, struct Environment* ignore2);
Object isErr(Object test, Object ignore, struct Environment* ignore2); Object isErr(Object test, Object ignore, struct Environment* ignore2);

10
src/tests.sh
View File

@ -153,7 +153,7 @@ check "FbnciSeq" "\
a \ a \
(+ (fib (- a 1)) (fib (- a 2))) \ (+ (fib (- a 1)) (fib (- a 2))) \
)));\ )));\
(fib 20)" "6765" (fib 11)" "89"
check "Factorial" "\ check "Factorial" "\
(def fac (fn (a) \ (def fac (fn (a) \
(if (= a 1) \ (if (= a 1) \
@ -169,7 +169,7 @@ title "Cat"
check "ExplicitCat" "(cat \"Big\" \" Kitty\")" "Big Kitty" check "ExplicitCat" "(cat \"Big\" \" Kitty\")" "Big Kitty"
check "CatNums" "(cat \"There are \" (+ 2 3) \" kitties\")" "There are 5 kitties" check "CatNums" "(cat \"There are \" (+ 2 3) \" kitties\")" "There are 5 kitties"
check "ImplicitCat" "(+ \"There are \" (* 5 4) \" bonks\")" "There are 20 bonks" check "ImplicitCat" "(+ \"There are \" (* 5 4) \" bonks\")" "There are 20 bonks"
# Mixing of `+` and implicit cat not recommended: # Mixing of `+` and implicit cat currently expected but not recommended:
check "CatAssocLeft" "(+ 10 20 \" rascals\")" "30 rascals" check "CatAssocLeft" "(+ 10 20 \" rascals\")" "30 rascals"
endBlock endBlock
@ -179,6 +179,12 @@ check "FilterEval" "(fil (= 1000) ((+ 450 550) (* 20 50) (/ 30 3) (- 10000 100))
check "MapFilter" "(fil (< 50) (map sq (1 2 3 4 5 6 7 8 9 10 11 12)))" "( 64 81 100 121 144 )" check "MapFilter" "(fil (< 50) (map sq (1 2 3 4 5 6 7 8 9 10 11 12)))" "( 64 81 100 121 144 )"
endBlock endBlock
title "HigherOrder"
check "FuncReturningAFunc" "(def plusser (fn (outer) (fn (inner) (+ outer inner))))\
(def plusFive (plusser 5))\
(plusFive 10)" "15"
endBlock
title "ShouldError" title "ShouldError"
check "LenOfNotList" "(len 5)" "NOT_A_LIST" check "LenOfNotList" "(len 5)" "NOT_A_LIST"
check "NoMapList" "(map sq)" "( )" check "NoMapList" "(map sq)" "( )"