klisp

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

kgkeywords.c (2901B)

      1 /*
      2 ** kgkeywords.c
      3 ** Keyword 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 "klisp.h"
     16 #include "kstring.h"
     17 #include "ksymbol.h"
     18 #include "kkeyword.h"
     19 #include "kerror.h"
     20 
     21 #include "kghelpers.h"
     22 #include "kgkeywords.h"
     23 
     24 /* ?.? keyword? */
     25 /* uses typep */
     26 
     27 /* ?.? keyword->string, string->keyword */
     28 void keyword_to_string(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     UNUSED(xparams);
     35     UNUSED(denv);
     36     bind_1tp(K, ptree, "keyword", ttiskeyword, keyw);
     37     /* The strings in keywords are immutable so we can just return that */
     38     TValue str = kkeyword_str(keyw);
     39     kapply_cc(K, str);
     40 }
     41 
     42 void string_to_keyword(klisp_State *K)
     43 {
     44     TValue *xparams = K->next_xparams;
     45     TValue ptree = K->next_value;
     46     TValue denv = K->next_env;
     47     klisp_assert(ttisenvironment(K->next_env));
     48     UNUSED(xparams);
     49     UNUSED(denv);
     50     bind_1tp(K, ptree, "string", ttisstring, str);
     51     /* If the string is mutable it is copied */
     52     TValue new_keyw = kkeyword_new_str(K, str);
     53     kapply_cc(K, new_keyw);
     54 }
     55 
     56 /* ?.? keyword->symbol, string->symbol */
     57 void keyword_to_symbol(klisp_State *K)
     58 {
     59     TValue *xparams = K->next_xparams;
     60     TValue ptree = K->next_value;
     61     TValue denv = K->next_env;
     62     klisp_assert(ttisenvironment(K->next_env));
     63     UNUSED(xparams);
     64     UNUSED(denv);
     65     bind_1tp(K, ptree, "keyword", ttiskeyword, keyw);
     66     TValue sym = ksymbol_new_str(K, kkeyword_str(keyw), KNIL);
     67     kapply_cc(K, sym);
     68 }
     69 
     70 void symbol_to_keyword(klisp_State *K)
     71 {
     72     TValue *xparams = K->next_xparams;
     73     TValue ptree = K->next_value;
     74     TValue denv = K->next_env;
     75     klisp_assert(ttisenvironment(K->next_env));
     76     UNUSED(xparams);
     77     UNUSED(denv);
     78     bind_1tp(K, ptree, "symbol", ttissymbol, sym);
     79     TValue new_keyw = kkeyword_new_str(K, ksymbol_str(sym));
     80     kapply_cc(K, new_keyw);
     81 }
     82 
     83 /* init ground */
     84 void kinit_keywords_ground_env(klisp_State *K)
     85 {
     86     TValue ground_env = G(K)->ground_env;
     87     TValue symbol, value;
     88 
     89     /*
     90     ** This section is missing from the report. The bindings here are
     91     ** should not be considered standard. 
     92     */
     93 
     94     /* ?.? keyword? */
     95     add_applicative(K, ground_env, "keyword?", typep, 2, symbol, 
     96                     i2tv(K_TKEYWORD));
     97     /* ?.? keyword->string, string->keyword */
     98     add_applicative(K, ground_env, "keyword->string", keyword_to_string, 0);
     99     add_applicative(K, ground_env, "string->keyword", string_to_keyword, 0);
    100     /* ?.? keyword->symbol, symbol->keyword */
    101     add_applicative(K, ground_env, "keyword->symbol", keyword_to_symbol, 0);
    102     add_applicative(K, ground_env, "symbol->keyword", symbol_to_keyword, 0);
    103 }