From 430dee99610f4238a1f3087ab24f9a5872911b2e Mon Sep 17 00:00:00 2001
From: antirez <antirez@gmail.com>
Date: Thu, 22 Dec 2022 18:30:57 +0100
Subject: [PATCH] uplevel + get@ for strings, tuples.

---
 aocla.c            | 71 +++++++++++++++++++++++++++++++++++++---------
 examples/map.aocla |  8 +++---
 2 files changed, 62 insertions(+), 17 deletions(-)

diff --git a/aocla.c b/aocla.c
index fa54ed5..0d3b54d 100644
--- a/aocla.c
+++ b/aocla.c
@@ -446,6 +446,17 @@ obj *newBool(int b) {
     return o;
 }
 
+/* Allocate a string object initialized with the content at 's' for
+ * 'len' bytes. */
+obj *newString(const char *s, size_t len) {
+    obj *o = newObject(OBJ_TYPE_STRING);
+    o->str.len = len;
+    o->str.ptr = myalloc(len+1);
+    memcpy(o->str.ptr,s,len);
+    o->str.ptr[len] = 0;
+    return o;
+}
+
 /* Deep copy the passed object. Return an object with refcount = 1. */
 obj *deepCopy(obj *o) {
     if (o == NULL) return NULL;
@@ -879,6 +890,22 @@ int procEval(aoclactx *ctx) {
     return retval;
 }
 
+/* Like eval, but the code is evaluated in the stack frame of the calling
+ * procedure, if any. */
+int procUpeval(aoclactx *ctx) {
+    if (checkStackType(ctx,1,OBJ_TYPE_LIST)) return 1;
+    obj *l = stackPop(ctx);
+    stackframe *saved = NULL;
+    if (ctx->frame->prev) {
+        saved = ctx->frame;
+        ctx->frame = ctx->frame->prev;
+    }
+    int retval = eval(ctx,l);
+    if (saved) ctx->frame = saved;
+    release(l);
+    return retval;
+}
+
 /* Print the top object to stdout, consuming it */
 int procPrint(aoclactx *ctx) {
     if (checkStackLen(ctx,1)) return 1;
@@ -888,6 +915,13 @@ int procPrint(aoclactx *ctx) {
     return 0;
 }
 
+/* Like print but also prints a newline at the end. */
+int procPrintnl(aoclactx *ctx) {
+    if (checkStackLen(ctx,1)) return 1;
+    int ret = procPrint(ctx); printf("\n");
+    return ret;
+}
+
 /* Len -- gets object len. Works with many types.
  * (object) => (len) */
 int procLen(aoclactx *ctx) {
@@ -927,24 +961,28 @@ int procListAppend(aoclactx *ctx) {
     return 0;
 }
 
-/* @idx -- get element at index:
- * (list index) => (element)
- *
- * TODO: this should work for strings as well. */
+/* @idx -- get element at index. Works for lists, strings, tuples.
+ * (object index) => (element). */
 int procListGetAt(aoclactx *ctx) {
-    if (checkStackType(ctx,2,OBJ_TYPE_LIST,OBJ_TYPE_INT)) return 1;
+    if (checkStackType(ctx,2,OBJ_TYPE_LIST|OBJ_TYPE_STRING|OBJ_TYPE_TUPLE,
+                             OBJ_TYPE_INT)) return 1;
     obj *idx = stackPop(ctx);
-    obj *list = stackPop(ctx);
+    obj *o = stackPop(ctx);
     int i = idx->i;
-    if (i < 0) i = list->l.len+i; /* -1 is last element, and so forth. */
+    size_t len = o->type == OBJ_TYPE_STRING ? o->str.len : o->l.len;
+    if (i < 0) i = len+i; /* -1 is last element, and so forth. */
     release(idx);
-    if (i < 0 || (size_t)i >= list->l.len) {
+    if (i < 0 || (size_t)i >= len) {
         stackPush(ctx,newBool(0)); // Out of index? Just push false.
     } else {
-        stackPush(ctx,list->l.ele[i]);
-        retain(list->l.ele[i]);
+        if (o->type == OBJ_TYPE_STRING) {
+            stackPush(ctx,newString(o->str.ptr+i,1));
+        } else {
+            stackPush(ctx,o->l.ele[i]);
+            retain(o->l.ele[i]);
+        }
     }
-    release(list);
+    release(o);
     return 0;
 }
 
@@ -954,6 +992,7 @@ int procShowStack(aoclactx *ctx) {
     return 0;
 }
 
+/* Load the "standard library" of Aocla in the specified context. */
 void loadLibrary(aoclactx *ctx) {
     addProc(ctx,"+",procBasicMath,NULL);
     addProc(ctx,"-",procBasicMath,NULL);
@@ -971,16 +1010,22 @@ void loadLibrary(aoclactx *ctx) {
     addProc(ctx,"ifelse",procIf,NULL);
     addProc(ctx,"while",procIf,NULL);
     addProc(ctx,"eval",procEval,NULL);
+    addProc(ctx,"upeval",procUpeval,NULL);
     addProc(ctx,"print",procPrint,NULL);
+    addProc(ctx,"printnl",procPrintnl,NULL);
     addProc(ctx,"len",procLen,NULL);
     addProc(ctx,"->",procListAppend,NULL);
     addProc(ctx,"<-",procListAppend,NULL);
     addProc(ctx,"get@",procListGetAt,NULL);
     addProc(ctx,"showstack",procShowStack,NULL);
+
+    /* Since the point of this interpreter to be a short and understandable
+     * programming example, we implement as much as possible in Aocla itself
+     * without caring much about performances. */
     addProcString(ctx,"dup","[(x) $x $x]");
     addProcString(ctx,"swap","[(x y) $y $x]");
     addProcString(ctx,"drop","[(_)]");
-    addProcString(ctx,"map", "[(l f) $l len (e) 0 (j) [] [$j $e <] [ $l $j get@ $f eval swap -> $j 1 + (j)] while]");
+    addProcString(ctx,"map", "[(l f) $l len (e) 0 (j) [] [$j $e <] [ $l $j get@ $f upeval swap -> $j 1 + (j)] while]");
 }
 
 /* ================================ CLI ===================================== */
@@ -1080,7 +1125,7 @@ int main(int argc, char **argv) {
     if (argc == 1) {
         repl();
     } else if (argc >= 2) {
-        if (evalFile(argv[1],argv+1,argc-1)) return 1;
+        if (evalFile(argv[1],argv+2,argc-2)) return 1;
     }
     return 0;
 }
diff --git a/examples/map.aocla b/examples/map.aocla
index 2e79079..c965a8b 100644
--- a/examples/map.aocla
+++ b/examples/map.aocla
@@ -1,5 +1,5 @@
-// This is an implementation of map. There is already one inside
-// Aocla, but this will redefine it.
+// This is a commented version of the implementation of 'map' inside
+// the standard library.
 
 [(l f) // list and function to apply
     $l len (e)  // Get list len in "e"
@@ -7,11 +7,11 @@
     []          // We will populate this empty list
     [$j $e <] [
         $l $j get@
-        $f eval
+        $f upeval
         swap ->
         $j 1 + (j)
     ] while
 ] 'map def
 
 [1 2 3] [dup *] map
-print
+printnl