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

5
src/env.c
View File

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

14
src/examples/lib.pbl
View File

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

53
src/examples/webby.pl
View File

@ -3,20 +3,27 @@
(struct Post
(title body))
;(def element (fn (type) (fn (text) (cat "<" type ">" text "</" type ">"))))
;(def link (element "link"))
;(prnl (link "howdy"))
(def element (fn (type)
(fn (text)
(cat "<" type ">"
(if (islist text) (reduce (text "") cat) (reduce ((text) "") cat))
"</" type ">"))))
(def html (fn (text) (cat "<html>" text "</html>")))
(def head (fn (text) (cat "<head>" text "</head>")))
(def body (fn (text) (cat "<body>" text "</body>")))
(def link (fn (text) (cat "<link " text ">")))
(def h1 (fn (text) (cat "<h1>" text "</h1>
")))
(def h2 (fn (text) (cat "<h2>" text "</h2>")))
(def p (fn (text) (cat "<p>" text "</p>
")))
(def html (element "html"))
(def body (element "body"))
(def head (element "head"))
(def h1 (element "h1"))
(def h2 (element "h2"))
(def p (element "p"))
(def div (element "div"))
(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
(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."
))
(def homepage (fn () (html (cat
(head (link "rel='stylesheet' href='styles.css'"))
(body (cat
(h1 "This is Sage's Blog")
(def homepage (fn () (html (
(head (
(link ((rel "stylesheet") (href "styles.css")))
))
(body (
(h1 "This is a sweet PebbLisp blog")
(htmlize p1)
(htmlize p2)))))) )
(htmlize p2)))
))))
(get "/" homepage)
@ -54,9 +64,14 @@ body {
(def PORT 9090)
(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 () (
(eval (inp))
(def input (inp "webby>> "))
(if (= input "q") () (
(eval input)
(repl)
))
)))
(repl)

44
src/object.c
View File

@ -356,8 +356,21 @@ char* stringNObj(char* dest, const Object* obj, const size_t len)
break;
}
case TYPE_FUNC:
stringf(dest, len, "F%d", obj->number);
break;
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;
case TYPE_OTHER:
stringf(dest, len, "%p", obj->other->data);
@ -396,6 +409,10 @@ void debugObj(const Object* obj)
void printType(const Object* obj)
{
if (!obj) {
printf("NULL OBJECT");
return;
}
switch (obj->type) {
SIMPLE_TYPE(TYPE_NUMBER);
SIMPLE_TYPE(TYPE_STRUCT);
@ -425,6 +442,10 @@ void _printObj(const Object* obj, int newline)
printType(obj);
#endif
if (!obj) {
printf(newline ? "\n" : "");
return;
}
if (obj->type == TYPE_LAMBDA) {
printObj(&obj->lambda->params);
printf("->");
@ -710,7 +731,7 @@ inline int isValidType(const Object test)
*/
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)
@ -807,7 +828,7 @@ inline Object symFromSlice(const char* string, int len)
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) {
return errorObject(NULL_LAMBDA_LIST);
@ -823,6 +844,23 @@ inline Object constructLambda(const Object* params, const Object* body)
o.lambda->body = listObject();
copyList(&o.lambda->params, params);
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;
}

6
src/object.h
View File

@ -94,8 +94,6 @@ struct Error {
struct Object {
Type type;
Object *forward;
union {
int number;
Object *list;
@ -112,6 +110,8 @@ struct Object {
struct Error *error;
#endif
};
Object *forward;
};
struct StructDef {
@ -240,7 +240,7 @@ void errorAddContext(Object *o, const char *context);
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 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;
}
Object evalLambdaArgs(const Object* argForms)
Object evalLambdaArgs(const Object* argForms, struct Environment* env)
{
return constructLambda(argForms, // Params
argForms ? argForms->forward : NULL // Body
);
return constructLambda(argForms, argForms ? argForms->forward : NULL, 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) {
return evalIfArgs(rest, env);
} else if (strcmp(first->string, "fn") == 0) {
return evalLambdaArgs(rest);
return evalLambdaArgs(rest, env);
} else if (strcmp(first->string, "map") == 0) {
return evalMapArgs(rest, env);
} else if (strcmp(first->string, "struct") == 0) {
@ -276,7 +274,6 @@ Object listEvalLambda(Object* lambda, const Object* remaining,
struct Environment newEnv =
envForLambda(&lambda->lambda->params, remaining, env);
Object ret = eval(&lambda->lambda->body, &newEnv);
deleteEnv(&newEnv);
cleanObject(lambda);
@ -329,14 +326,9 @@ Object evalList(const Object* obj, struct Environment* env)
while (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++) {
//printf("struct[%d] - `%s`\n", i, outerEnv->structDefs[i].name);
if (strcmp(first_form->string, outerEnv->structDefs[i].name) == 0) {
def = i;
//printf("Found struct definition for %s!\n", first_form->string);
break;
}
}
@ -409,11 +401,43 @@ Object eval(const Object* obj, struct Environment* env)
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
Object catObjects(const Object obj1, const Object obj2, struct Environment* env)
{
Object evalObj1 = eval(&obj1, env);
Object evalObj2 = eval(&obj2, env);
if (isError(evalObj2, ONLY_ONE_ARGUMENT)) {
return evalObj1;
}
char str1[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);
}
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)
{
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)
{
while (env->outer) {
env = env->outer;
}
printEnv(env);
printEnv(global());
return numberObject(0);
}
@ -736,8 +761,11 @@ Object parseEvalO(Object text, Object ignore, struct Environment* env)
#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] = "";
fgets(input, 256, stdin);
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);
Object evalLambdaArgs(const Object* arg_forms);
Object evalLambdaArgs(const Object* arg_forms, struct Environment* env);
Object listEvalLambda(Object* lambda, const Object* remaining,
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 reduce(Object listInitial, Object func, struct Environment* env);
Object at(Object index, Object list, 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 isList(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);

10
src/tests.sh
View File

@ -153,7 +153,7 @@ check "FbnciSeq" "\
a \
(+ (fib (- a 1)) (fib (- a 2))) \
)));\
(fib 20)" "6765"
(fib 11)" "89"
check "Factorial" "\
(def fac (fn (a) \
(if (= a 1) \
@ -169,7 +169,7 @@ title "Cat"
check "ExplicitCat" "(cat \"Big\" \" Kitty\")" "Big Kitty"
check "CatNums" "(cat \"There are \" (+ 2 3) \" kitties\")" "There are 5 kitties"
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"
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 )"
endBlock
title "HigherOrder"
check "FuncReturningAFunc" "(def plusser (fn (outer) (fn (inner) (+ outer inner))))\
(def plusFive (plusser 5))\
(plusFive 10)" "15"
endBlock
title "ShouldError"
check "LenOfNotList" "(len 5)" "NOT_A_LIST"
check "NoMapList" "(map sq)" "( )"