klisp

an open source interpreter for the Kernel Programming Language.
git clone http://git.hanabi.in/repos/klisp.git
Log | Files | Refs | README

kgks_vars.c (2503B)

      1 /*
      2 ** kgks_vars.c
      3 ** Keyed Static Variables features for the ground environment
      4 ** See Copyright Notice in klisp.h
      5 */
      6 
      7 #include <assert.h>
      8 #include <stdio.h>
      9 #include <stdlib.h>
     10 #include <stdbool.h>
     11 #include <stdint.h>
     12 
     13 #include "kstate.h"
     14 #include "kobject.h"
     15 #include "kpair.h"
     16 #include "kcontinuation.h"
     17 #include "koperative.h"
     18 #include "kapplicative.h"
     19 #include "kenvironment.h"
     20 #include "kerror.h"
     21 
     22 #include "kghelpers.h"
     23 #include "kgks_vars.h"
     24 
     25 /* Helpers for make-static-dynamic-variable */
     26 
     27 /* accesor returned */
     28 void do_sv_access(klisp_State *K)
     29 {
     30     TValue *xparams = K->next_xparams;
     31     TValue ptree = K->next_value;
     32     TValue denv = K->next_env;
     33     klisp_assert(ttisenvironment(K->next_env));
     34     /*
     35     ** xparams[0]: static key 
     36     */
     37     check_0p(K, ptree);
     38 
     39     TValue key = xparams[0];
     40     /* this may throw an exception if not bound */
     41     TValue val = kget_keyed_static_var(K, denv, key);
     42     kapply_cc(K, val);
     43 }
     44 
     45 /* binder returned */
     46 void do_sv_bind(klisp_State *K)
     47 {
     48     TValue *xparams = K->next_xparams;
     49     TValue ptree = K->next_value;
     50     TValue denv = K->next_env;
     51     klisp_assert(ttisenvironment(K->next_env));
     52     /*
     53     ** xparams[0]: static key 
     54     */
     55     bind_2tp(K, ptree, "any", anytype, obj,
     56 	         "environment", ttisenvironment, env);
     57     UNUSED(denv); 
     58     TValue key = xparams[0];
     59     /* GC: all objs are rooted in ptree, or xparams */
     60     TValue new_env = kmake_keyed_static_env(K, env, key, obj);
     61     kapply_cc(K, new_env);
     62 }
     63 
     64 /* 11.1.1 make-static-dynamic-variable */
     65 void make_keyed_static_variable(klisp_State *K)
     66 {
     67     TValue *xparams = K->next_xparams;
     68     TValue ptree = K->next_value;
     69     TValue denv = K->next_env;
     70     klisp_assert(ttisenvironment(K->next_env));
     71     UNUSED(denv); 
     72     UNUSED(xparams);
     73 
     74     check_0p(K, ptree);
     75     /* the key is just a dummy pair */
     76     TValue key = kcons(K, KINERT, KINERT);
     77     krooted_tvs_push(K, key);
     78     TValue a = kmake_applicative(K, do_sv_access, 1, key);
     79     krooted_tvs_push(K, a);
     80     TValue b = kmake_applicative(K, do_sv_bind, 1, key);
     81     krooted_tvs_push(K, b);
     82     TValue ls = klist(K, 2, b, a);
     83 
     84     krooted_tvs_pop(K); krooted_tvs_pop(K); krooted_tvs_pop(K);
     85 
     86     kapply_cc(K, ls);
     87 }
     88 
     89 
     90 /* init ground */
     91 void kinit_kgks_vars_ground_env(klisp_State *K)
     92 {
     93     TValue ground_env = G(K)->ground_env;
     94     TValue symbol, value;
     95 
     96     /* 11.1.1 make-keyed-static-variable */
     97     add_applicative(K, ground_env, "make-keyed-static-variable", 
     98                     make_keyed_static_variable, 0); 
     99 }