laria/apfl
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Implement symbol values

Browse source
This commit is contained in:
Laria 2023-03-23 23:38:35 +01:00
parent 6056e3a450
commit 1cff056e53
15 changed files with 329 additions and 5 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

19
README.md
View file

@ -36,6 +36,7 @@ apfl has these types of values:
- strings - Immutable byte string
- lists - An ordered list of values
- dictionaries - An unordered mapping from arbitrary keys to values
- symbols - A unique value
- pairs - A pair of two values
- functions - Can be called with values as arguments and returns a value
@ -126,6 +127,18 @@ Individual values can be accessed using the `dict@key` syntax, where the `key` c
k = "baz"
print d@k # Prints 3
### Symbols
A symbol is a value, that is unique. It can only ne used for comparison and will only compare equal with itself. A symbol can optionally have a name that will be shown when printing or on the REPL to aid during development but can't otherwise be accessed.
A symbol can be created by calling the built-in function `symbol`, optionally with a name:
Anon1 := (symbol) # A symbol without a name
Anon2 := (symbol) # Another symbol without a namem distinct from Anon1
Foo1 := symbol 'Foo # A symbol with the name "Foo"
Foo2 := symbol 'Foo # Another symbol with the name "Foo", distinct from Foo2, even though they have the same name
### Pairs
A pair is created with the `::` operator between two values. Both the left and the right side can be arbitrary values, including other pairs.
@ -299,8 +312,8 @@ It is often useful to deconstruct a pair and check the left value against a pred
However, sometimes the left value is not a constant. We could use predicates for this (see below), but we also have another syntax at hand for this:
a := {}
b := {}
a := symbol 'a
b := symbol 'b
foo := {
a:x -> + 10 x
@ -311,7 +324,7 @@ However, sometimes the left value is not a constant. We could use predicates for
foo b :: 2 # prints 20, second subfunction was chosen
foo {} :: 3 # Will fail, no subfunction matches
In these examples, we say that the parameter x is tagged with a / b.
In these examples, we say that the parameter x is tagged with the symbol a / b.
A parameter list can also contain up to one expansion, a variable name preceded by `~`. All remaining arguments are copied into the variable as a list.

4
src/CMakeLists.txt
View file

@ -32,6 +32,7 @@ add_library(apfl
context.c
eval.c
scope.c
symbols.c
mod_globals.c
)
@ -114,6 +115,9 @@ functionaltest("join")
functionaltest("quine")
functionaltest("string-manip")
functionaltest("pairs")
functionaltest("symbols")
functionaltest("get-optional")
functionaltest("has-key")
install(TARGETS apfl DESTINATION lib)
install(TARGETS apfl-bin DESTINATION bin)

18
src/apfl.h
View file

@ -668,6 +668,7 @@ enum apfl_value_type {
APFL_VALUE_DICT,
APFL_VALUE_PAIR,
APFL_VALUE_FUNC,
APFL_VALUE_SYMBOL,
APFL_VALUE_USERDATA,
};
@ -709,6 +710,14 @@ bool apfl_iterative_runner_run_repl(
);
void apfl_iterative_runner_destroy(apfl_iterative_runner);
// Macro to define a C symbol
#define APFL_DEFINE_CSYMBOL(name, str) \
void \
name(apfl_ctx ctx) \
{ \
apfl_push_csymbol(ctx, &name, str); \
}
typedef void (*apfl_cfunc)(apfl_ctx);
// Get the type of a value on the stack
@ -732,6 +741,12 @@ void apfl_push_number(apfl_ctx, apfl_number);
void apfl_push_string_view_copy(apfl_ctx, struct apfl_string_view);
// Push a constant string.
void apfl_push_const_string(apfl_ctx, const char *);
// Push a C symbol onto the stack.
void apfl_push_csymbol(apfl_ctx, apfl_cfunc, const char *);
// Push a symbol onto the stack. s is a string value that will be popped from the stack.
void apfl_push_symbol(apfl_ctx, apfl_stackidx s);
// Push an anonymous symbol onto the stack.
void apfl_push_anon_symbol(apfl_ctx);
// Joins all elements of the list parts together with glue into a string that is pushed onto the stack.
// glue and parts are popped off the stack. glue and the elements of parts are converted into a string if they are not
// already one.
@ -852,6 +867,9 @@ noreturn void apfl_raise_invalid_stackidx(apfl_ctx);
// Raise an error with a message derived from an struct apfl_error.
noreturn void apfl_raise_error_object(apfl_ctx, struct apfl_error);
// Known symbols
void apfl_sym_some(apfl_ctx); // Some
struct apfl_messages {
const char *invalid_stack_index;
const char *could_not_alloc_mem;

41
src/builtins.c
View file

@ -629,6 +629,44 @@ iterate_dict(apfl_ctx ctx)
apfl_push_nil(ctx);
}
static void
get_optional(apfl_ctx ctx)
{
size_t args = apfl_len(ctx, 0);
if (args != 2) {
apfl_raise_const_error(ctx, "get-optional needs exactly 2 arguments");
}
apfl_get_list_member_by_index(ctx, 0, 0);
apfl_get_list_member_by_index(ctx, 0, 1);
apfl_stack_drop(ctx, 0);
if (apfl_get_member_if_exists(ctx, -1, -2)) {
apfl_sym_some(ctx);
apfl_push_pair(ctx, -1, -2);
} else {
apfl_push_nil(ctx);
}
}
static void
symbol(apfl_ctx ctx)
{
size_t args = apfl_len(ctx, 0);
switch (args) {
case 0:
apfl_push_anon_symbol(ctx);
return;
case 1:
apfl_get_list_member_by_index(ctx, 0, 0);
apfl_drop(ctx, 0);
apfl_push_symbol(ctx, -1);
return;
default:
apfl_raise_const_error(ctx, "symbol need 0 or 1 argument");
}
}
static void
add_builtin(apfl_ctx ctx, const char *name, apfl_cfunc func)
{
@ -678,4 +716,7 @@ apfl_builtins(apfl_ctx ctx)
add_builtin(ctx, "substring", substring);
add_builtin(ctx, "stringsearch", stringsearch);
add_builtin(ctx, "iterate-dict", iterate_dict);
add_builtin(ctx, "symbol", symbol);
add_builtin(ctx, "get-optional", get_optional);
add_builtin(ctx, "getsym-Some", apfl_sym_some);
}

58
src/context.c
View file

@ -1235,6 +1235,60 @@ apfl_push_pair(apfl_ctx ctx, apfl_stackidx l, apfl_stackidx r)
apfl_gc_tmproots_restore(&ctx->gc, tmproots);
}
void
apfl_push_csymbol(apfl_ctx ctx, apfl_cfunc id, const char *name)
{
apfl_stack_must_push(ctx, (struct apfl_value) {
.type = VALUE_CSYMBOL,
.csymbol = {
.id = id,
.name = name,
},
});
}
static void
push_symbol_inner(apfl_ctx ctx, apfl_stackidx idx)
{
apfl_move_to_top_of_stack(ctx, idx);
if (apfl_get_type(ctx, -1) != APFL_VALUE_STRING) {
apfl_raise_errorfmt(ctx, "Expected string, got {stack:type}", -1);
}
struct apfl_string *name = apfl_to_dynamic_string(ctx, -1);
if (!apfl_gc_tmproot_add(&ctx->gc, GC_OBJECT_FROM(name, GC_TYPE_STRING))) {
apfl_raise_alloc_error(ctx);
}
apfl_stack_drop(ctx, -1);
CREATE_GC_OBJECT_VALUE_ON_STACK(
ctx,
VALUE_SYMBOL,
symbol,
apfl_symbol_new(&ctx->gc, name)
)
}
void
apfl_push_symbol(apfl_ctx ctx, apfl_stackidx idx)
{
size_t tmproots = apfl_gc_tmproots_begin(&ctx->gc);
push_symbol_inner(ctx, idx);
apfl_gc_tmproots_restore(&ctx->gc, tmproots);
}
void
apfl_push_anon_symbol(apfl_ctx ctx)
{
CREATE_GC_OBJECT_VALUE_ON_STACK(
ctx,
VALUE_SYMBOL,
symbol,
apfl_symbol_new(&ctx->gc, NULL)
)
}
bool
apfl_get_member_if_exists(
apfl_ctx ctx,
@ -1373,6 +1427,8 @@ apfl_len(apfl_ctx ctx, apfl_stackidx index)
case VALUE_CFUNC:
case VALUE_USERDATA:
case VALUE_NATIVE_OBJECT:
case VALUE_SYMBOL:
case VALUE_CSYMBOL:
apfl_raise_errorfmt(
ctx,
"Can not get length of value of type {value:type}",
@ -1438,6 +1494,8 @@ get_string_view_of_value(struct apfl_string_view *sv, struct apfl_value value)
case VALUE_DICT:
case VALUE_PAIR:
case VALUE_NATIVE_OBJECT:
case VALUE_SYMBOL:
case VALUE_CSYMBOL:
return false;
case VALUE_STRING:
*sv = apfl_string_view_from(*value.string);

37
src/functional-tests/get-optional.at Normal file
View file

@ -0,0 +1,37 @@
===== script =====
s := (symbol)
d := [
'a -> 100
'b -> 200
'c -> nil
s -> 42
]
l := [nil 1 2 'Hello]
print (== (get-optional 'a d) Some :: 100)
print (== (get-optional 'b d) Some :: 200)
print (== (get-optional 'c d) Some :: nil)
print (== (get-optional 'd d) nil)
print (== (get-optional s d) Some :: 42)
print ""
print (== (get-optional 0 l) Some :: nil)
print (== (get-optional 1 l) Some :: 1)
print (== (get-optional 2 l) Some :: 2)
print (== (get-optional 3 l) Some :: 'Hello)
print (== (get-optional 4 l) nil)
===== output =====
true
true
true
true
true
true
true
true
true
true

37
src/functional-tests/has-key.at Normal file
View file

@ -0,0 +1,37 @@
===== script =====
s := (symbol)
d := [
'a -> 100
'b -> 200
'c -> nil
s -> 42
]
l := [nil 1 2 'Hello]
print (has-key 'a d)
print (has-key 'b d)
print (has-key 'c d)
print (has-key 'd d)
print (has-key s d)
print ""
print (has-key 0 l)
print (has-key 1 l)
print (has-key 2 l)
print (has-key 3 l)
print (has-key 4 l)
===== output =====
true
true
true
false
true
true
true
true
true
false

2
src/functional-tests/pairs.at
View file

@ -16,8 +16,6 @@ fn 'a :: 42
fn 'c :: p
fn 'c :: 10 :: 1
symbol := {->{}}
sym-a := (symbol)
sym-b := (symbol)
sym-c := (symbol)

24
src/functional-tests/symbols.at Normal file
View file

@ -0,0 +1,24 @@
===== script =====
foo1 := symbol 'foo
foo2 := symbol 'foo
print (== foo1 foo1)
print (== foo2 foo2)
print (== foo1 foo2)
print ""
anon1 := (symbol)
anon2 := (symbol)
print (== anon1 anon1)
print (== anon2 anon2)
print (== anon1 anon2)
===== output =====
true
true
false
true
true
false

8
src/gc.c
View file

@ -35,6 +35,7 @@ struct gc_object {
struct matcher matcher;
struct native_object native_object;
struct value_pair pair;
struct apfl_string* symbol;
};
enum gc_type type;
enum gc_status status;
@ -192,6 +193,7 @@ IMPL_NEW(struct matcher_instruction_list, apfl_gc_new_matcher_instructions, GC_T
IMPL_NEW(struct matcher, apfl_gc_new_matcher, GC_TYPE_MATCHER, matcher )
IMPL_NEW(struct native_object, apfl_gc_new_native_object, GC_TYPE_NATIVE_OBJECT, native_object )
IMPL_NEW(struct value_pair, apfl_gc_new_pair, GC_TYPE_PAIR, pair )
IMPL_NEW(struct apfl_string *, apfl_gc_new_symbol, GC_TYPE_SYMBOL, symbol )
size_t
apfl_gc_tmproots_begin(struct gc *gc)
@ -301,6 +303,9 @@ visit_children(struct gc_object *object, gc_visitor cb, void *opaque)
case GC_TYPE_PAIR:
apfl_gc_pair_traverse(&object->pair, cb, opaque);
return;
case GC_TYPE_SYMBOL:
apfl_gc_symbol_traverse(&object->symbol, cb, opaque);
return;
}
assert(false);
@ -354,6 +359,7 @@ deinit_object(struct gc *gc, struct gc_object *object)
return;
case GC_TYPE_VAR:
case GC_TYPE_PAIR:
case GC_TYPE_SYMBOL:
return;
case GC_TYPE_STRING:
apfl_string_deinit(gc->allocator, &object->string);
@ -528,6 +534,8 @@ type_to_string(enum gc_type type)
return "native object";
case GC_TYPE_PAIR:
return "pair";
case GC_TYPE_SYMBOL:
return "symbol";
}
assert(false);

2
src/gc.h
View file

@ -34,6 +34,7 @@ enum gc_type {
GC_TYPE_MATCHER,
GC_TYPE_NATIVE_OBJECT,
GC_TYPE_PAIR,
GC_TYPE_SYMBOL,
};
struct gc_tmproots {
@ -91,6 +92,7 @@ struct matcher_instruction_list* apfl_gc_new_matcher_instructions(struct gc *);
struct matcher* apfl_gc_new_matcher(struct gc *);
struct native_object* apfl_gc_new_native_object(struct gc *);
struct value_pair* apfl_gc_new_pair(struct gc *);
struct apfl_string** apfl_gc_new_symbol(struct gc *);
#ifdef __cplusplus
}

15
src/globals.apfl
View file

@ -26,9 +26,13 @@
fclose := builtins.fclose
loadfile := builtins.loadfile
loadstring := builtins.loadstring
get-optional := builtins.get-optional
symbol := builtins.symbol
-serialize-bytecode := builtins.-serialize-bytecode
-unserialize-bytecode := builtins.-unserialize-bytecode
Some := (builtins.getsym-Some)
-named := { name f ->
builtins.set-func-name f name
}
@ -180,6 +184,13 @@
}
}
has-key := { k container ->
{
Some: _ -> true
nil -> false
} (get-optional k container)
}
# Dictionary of exported functions
[
'if -> if
@ -229,5 +240,9 @@
'!<= -> !<=
'keach -> keach
'each -> each
'get-optional -> get-optional
'has-key -> has-key
'symbol -> symbol
'Some -> Some
]
}

3
src/symbols.c Normal file
View file

@ -0,0 +1,3 @@
#include "apfl.h"
APFL_DEFINE_CSYMBOL(apfl_sym_some, "Some")

55
src/value.c
View file

@ -164,6 +164,20 @@ format(unsigned indent, struct apfl_io_writer w, struct apfl_value value, bool s
TRY(apfl_io_write_string(w, *value.cfunc->name));
}
return true;
case VALUE_SYMBOL:
if (*value.symbol == NULL) {
TRY(apfl_io_write_string(w, "<anonymous symbol>"));
} else {
TRY(apfl_io_write_string(w, **value.symbol));
}
return true;
case VALUE_CSYMBOL:
if (value.csymbol.name == NULL) {
TRY(apfl_io_write_string(w, "<anonymous symbol>"));
} else {
TRY(apfl_io_write_string(w, value.csymbol.name));
}
return true;
case VALUE_USERDATA:
case VALUE_NATIVE_OBJECT:
TRY(apfl_io_write_string(w, "userdata"));
@ -198,6 +212,9 @@ apfl_value_type_to_abstract_type(enum value_type type)
case VALUE_FUNC:
case VALUE_CFUNC:
return APFL_VALUE_FUNC;
case VALUE_SYMBOL:
case VALUE_CSYMBOL:
return APFL_VALUE_SYMBOL;
case VALUE_USERDATA:
case VALUE_NATIVE_OBJECT:
return APFL_VALUE_USERDATA;
@ -227,6 +244,8 @@ apfl_type_name(enum apfl_value_type type)
return "pair";
case APFL_VALUE_FUNC:
return "function";
case APFL_VALUE_SYMBOL:
return "symbol";
case APFL_VALUE_USERDATA:
return "userdata";
}
@ -248,6 +267,17 @@ apfl_pair_new(struct gc *gc, struct apfl_value l, struct apfl_value r)
return pair;
}
struct apfl_string **
apfl_symbol_new(struct gc *gc, struct apfl_string *str)
{
struct apfl_string **symbol = apfl_gc_new_symbol(gc);
if (symbol == NULL) {
return NULL;
}
*symbol = str;
return symbol;
}
struct function *
apfl_func_new(struct gc *gc, size_t cap, struct scope *scope, int line_defined, struct apfl_string *filename)
{
@ -482,6 +512,10 @@ apfl_value_eq(const struct apfl_value a, const struct apfl_value b)
return b.type == VALUE_FUNC && a.func == b.func;
case VALUE_CFUNC:
return b.type == VALUE_CFUNC && a.cfunc == b.cfunc;
case VALUE_SYMBOL:
return b.type == VALUE_SYMBOL && a.symbol == b.symbol;
case VALUE_CSYMBOL:
return b.type == VALUE_CSYMBOL && a.csymbol.id == b.csymbol.id;
case VALUE_USERDATA:
return b.type == VALUE_USERDATA && a.userdata == b.userdata;
case VALUE_NATIVE_OBJECT:
@ -528,6 +562,12 @@ apfl_value_cmp(const struct apfl_value a, const struct apfl_value b)
return CMP_INCOMPATIBLE_TYPES;
}
return CMP_UNCOMPARABLE;
case VALUE_SYMBOL:
case VALUE_CSYMBOL:
if (b.type != VALUE_SYMBOL && b.type != VALUE_CSYMBOL) {
return CMP_INCOMPATIBLE_TYPES;
}
return CMP_UNCOMPARABLE;
case VALUE_FUNC:
case VALUE_CFUNC:
if (b.type != VALUE_FUNC && b.type != VALUE_CFUNC) {
@ -809,6 +849,10 @@ apfl_value_hash(const struct apfl_value value)
return apfl_hash_fnv1a_add(&value.func, sizeof(struct function *), hash);
case VALUE_CFUNC:
return apfl_hash_fnv1a_add(&value.cfunc, sizeof(struct cfunction *), hash);
case VALUE_SYMBOL:
return apfl_hash_fnv1a_add(&value.symbol, sizeof(struct apfl_string **), hash);
case VALUE_CSYMBOL:
return apfl_hash_fnv1a_add(&value.csymbol.id, sizeof(apfl_cfunc), hash);
case VALUE_USERDATA:
return apfl_hash_fnv1a_add(&value.userdata, sizeof(void *), hash);
case VALUE_NATIVE_OBJECT:
@ -829,6 +873,7 @@ apfl_value_get_gc_object(struct apfl_value value)
case VALUE_NUMBER:
case VALUE_CONST_STRING:
case VALUE_USERDATA:
case VALUE_CSYMBOL:
return NULL;
case VALUE_STRING:
return GC_OBJECT_FROM(value.string, GC_TYPE_STRING);
@ -842,6 +887,8 @@ apfl_value_get_gc_object(struct apfl_value value)
return GC_OBJECT_FROM(value.func, GC_TYPE_FUNC);
case VALUE_CFUNC:
return GC_OBJECT_FROM(value.cfunc, GC_TYPE_CFUNC);
case VALUE_SYMBOL:
return GC_OBJECT_FROM(value.symbol, GC_TYPE_SYMBOL);
case VALUE_NATIVE_OBJECT:
return GC_OBJECT_FROM(value.native_object, GC_TYPE_NATIVE_OBJECT);
}
@ -929,3 +976,11 @@ apfl_gc_cfunc_traverse(struct cfunction* cfunc, gc_visitor cb, void *opaque)
cb(opaque, GC_OBJECT_FROM(cfunc->name, GC_TYPE_STRING));
}
}
void
apfl_gc_symbol_traverse(struct apfl_string **symbol, gc_visitor cb, void *opaque)
{
if (*symbol != NULL) {
cb(opaque, GC_OBJECT_FROM(*symbol, GC_TYPE_STRING));
}
}

11
src/value.h
View file

@ -27,6 +27,8 @@ enum value_type {
VALUE_PAIR,
VALUE_FUNC,
VALUE_CFUNC,
VALUE_SYMBOL,
VALUE_CSYMBOL,
VALUE_USERDATA,
VALUE_NATIVE_OBJECT,
};
@ -72,6 +74,11 @@ struct native_object {
const struct apfl_native_object_type *type;
};
struct csymbol {
apfl_cfunc id;
const char *name;
};
struct apfl_value {
enum value_type type;
union {
@ -84,6 +91,8 @@ struct apfl_value {
struct value_pair *pair;
struct function *func;
struct cfunction *cfunc;
struct apfl_string **symbol;
struct csymbol csymbol;
void *userdata;
struct native_object *native_object;
};
@ -153,6 +162,7 @@ size_t apfl_dict_len(struct dict_header *);
void apfl_dict_deinit(struct dict_header *);
struct value_pair *apfl_pair_new(struct gc *, struct apfl_value l, struct apfl_value r);
struct apfl_string **apfl_symbol_new(struct gc *, struct apfl_string *);
struct function *apfl_func_new(
struct gc *,
@ -181,6 +191,7 @@ void apfl_gc_dict_traverse(struct dict_header *, gc_visitor, void *);
void apfl_gc_pair_traverse(struct value_pair *, gc_visitor, void *);
void apfl_gc_func_traverse(struct function*, gc_visitor, void *);
void apfl_gc_cfunc_traverse(struct cfunction*, gc_visitor, void *);
void apfl_gc_symbol_traverse(struct apfl_string **, gc_visitor, void *);
#ifdef __cplusplus
}