Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

allow reading of uninterned symbols

  • Loading branch information...
commit fdcb9831b9cfb76f226ed6d331d6ac8b79c5f7b6 1 parent 9c0a512
Aleš Hakl authored
1  dfsch/dfsch.h
@@ -323,6 +323,7 @@ extern "C" {
323 323
324 324 /** Makes symbol object from string. */
325 325 extern dfsch_object_t* dfsch_make_symbol(char* symbol);
  326 + extern dfsch_object_t* dfsch_make_uninterned_symbol(char* symbol);
326 327
327 328 /** Returns unique generated symbol. */
328 329 extern dfsch_object_t* dfsch_gensym();
8 src/package.c
@@ -604,6 +604,14 @@ dfsch_object_t* dfsch_make_symbol(char* symbol){
604 604 return dfsch_intern_symbol(dfsch_get_current_package(), symbol);
605 605 }
606 606
  607 +dfsch_object_t* dfsch_make_uninterned_symbol(char* symbol){
  608 + dfsch__symbol_t* sym;
  609 + sym = GC_NEW(dfsch__symbol_t);
  610 + sym->name = dfsch_stracpy(symbol);
  611 + sym->package = NULL;
  612 + return DFSCH_TAG_ENCODE(sym, 2);
  613 +}
  614 +
607 615
608 616 char* dfsch_symbol(dfsch_object_t* symbol){
609 617 symbol_t* s;
13 src/parse.c
@@ -740,6 +740,10 @@ static void dispatch_number_base(dfsch_parser_ctx_t *ctx, char *data){
740 740 parse_object(ctx, dfsch_make_number_from_string(data, ctx->hash_arg));
741 741 }
742 742
  743 +static void dispatch_uninterned(dfsch_parser_ctx_t *ctx, char *data){
  744 + parse_object(ctx, dfsch_make_uninterned_symbol(data));
  745 +}
  746 +
743 747 static void dispatch_atom(dfsch_parser_ctx_t *ctx, char *data){
744 748 #ifdef T_DEBUG
745 749 printf(";; Atom: [%s]\n", data);
@@ -1056,7 +1060,14 @@ static void tokenizer_process (dfsch_parser_ctx_t *ctx, char* data){
1056 1060 ctx->column++;
1057 1061
1058 1062 ctx->dispatch_atom_hook=dispatch_number_base;
1059   - ctx->tokenizer_state = T_ATOM;
  1063 + ctx->tokenizer_state = T_ATOM;
  1064 + break;
  1065 + case ':':
  1066 + ++data;
  1067 + ctx->column++;
  1068 +
  1069 + ctx->dispatch_atom_hook=dispatch_uninterned;
  1070 + ctx->tokenizer_state = T_ATOM;
1060 1071 break;
1061 1072
1062 1073 case '\\':
8 tests/fix-regression-tests.scm
@@ -8,3 +8,11 @@
8 8
9 9 (define-evaluation-test fracnum-absolute-value (:regression)
10 10 ((abs -1/2) ===> 1/2))
  11 +
  12 +(define-test gensym-print (:language :numbers)
  13 + (let ((l1 (string->object (object->string (let ((x (gensym)))
  14 + (list x x)))))
  15 + (l2 (string->object (object->string (let ((x (unintern 'mnau)))
  16 + (list x x))))))
  17 + (assert-equal (car l1) (cadr l1))
  18 + (assert-equal (car l2) (cadr l2))))

0 comments on commit fdcb983

Please sign in to comment.
Something went wrong with that request. Please try again.