carp-lang/Carp
1
1
Fork 0
mirror of https://github.com/carp-lang/Carp.git synced 2024-09-11 05:25:28 +03:00
Code Issues Projects Releases Wiki Activity

Merge branch 'master' into static-arrays

Browse Source
This commit is contained in:
Erik Svedäng 2020-04-29 10:39:44 +02:00
commit 89dcad4e79
20 changed files with 614 additions and 125 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
core/Control.carp Normal file
View File

@ -0,0 +1,21 @@
;; This module contains functions that deal with functions, control flow, etc.
(defmodule Control
(doc iterate "Apply function `f` `n` times, first to `start` and then to the result of `f`. TODO: Mention fix points.")
(sig iterate (Fn [Int, (Ref (Fn [a] a b) c), a] a))
(defn iterate [n f start]
(let-do [result start]
(for [i 0 n]
(set! result (~f result)))
result))
(doc iterate-until "Like `iterate`, but f is applied repeatedly until the predicate `pred` is true.")
(sig iterate-until (Fn [a, (Ref (Fn [b] b c) d), (Ref (Fn [b] Bool c) e), b] b))
(defn iterate-until [f pred start]
(let-do [result start]
(while (not (~pred &result))
(set! result (~f result)))
result))
)

1
core/Core.carp
View File

@ -51,3 +51,4 @@
(load "Heap.carp")
(load "Sort.carp")
(load "Binary.carp")
(load "Control.carp")

8
core/Long.carp
View File

@ -27,9 +27,11 @@
to non-refs.")
(register copy (λ [&Long] Long))
(register safe-add (λ [Long Long (Ref Long)] Bool))
(register safe-sub (λ [Long Long (Ref Long)] Bool))
(register safe-mul (λ [Long Long (Ref Long)] Bool))
(not-on-windows ; this seems to generate invalid code on some windows machines
(register safe-add (λ [Long Long (Ref Long)] Bool))
(register safe-sub (λ [Long Long (Ref Long)] Bool))
(register safe-mul (λ [Long Long (Ref Long)] Bool))
)
(register abs (λ [Long] Long))

208
core/Macros.carp
View File

@ -117,8 +117,7 @@
(doc collect-into
"Transforms a dynamic data literal into another, preserving order")
(defndynamic collect-into [xs f]
(list 'quote
(collect-into-internal xs (f) f)))
(collect-into-internal xs (f) f))
(doc empty?
"Returns true if the provided data literal is empty, false otherwise.")
@ -138,11 +137,62 @@
(fn [x y]
(f y x)))
(doc compose
"Returns the composition of two functions `f` and `g` for functions of any
airity; concretely, returns a function accepting the correct number of
arguments for `g`, applies `g` to those arguments, then applies `f` to the
result.
If you only need to compose functions that take a single argument (unary arity)
see `comp`. Comp also generates the form that corresponds to the composition,
compose contrarily evaluates 'eagerly' and returns a computed symbol.
For exmaple:
```
;; a silly composition
((compose empty take) 3 [1 2 3 4 5])
;; => []
(String.join (collect-into ((compose reverse map) Symbol.str '(p r a c)) array))
;; => 'carp'
;; comp for comparison
((comp (curry + 1) (curry + 2)) 4)
;; => (+ 1 (+ 2 4))
```")
(defndynamic compose [f g]
;; Recall that **unquoted** function names evaluate to their definitions in
;; dynamic contexts, e.g. f = (dyanmic f [arg] body)
;;
;; Right now, this cannot handle anonymous functions because they cannot be passed to apply.
;; and not anonymous functions.
;; commands expand to (command <name>), fns expand to a non-list.
;;
;; TODO: Support passing anonymous functions.
(if (not (Dynamic.or (list? f) (list? g)))
(macro-error "compose can only compose named dynamic functions. To
compose anonymous functions, such as curried functions,
see comp.")
(let [f-name (cadr f)
g-name (cadr g)
arguments (caddr g)]
(list 'fn arguments
;; Since we call an eval to apply g immediately, we wrap the args in an
;; extra quote, otherwise, users would need to double quote any sequence of
;; symbols such as '(p r a c)
(list f-name (list 'eval (list 'apply g-name (list 'quote arguments))))))))
;; Dynamic.or already exists, but since it's a special form, it can't be passed
;; to higher order functions like reduce. So, we define an alternative here.
(defndynamic or-internal [x y]
(if x true y))
;; Dynamic.and already exists, but since it's a special form, it can't be passed
;; to higher order functions like reduce. So, we define an alternative here.
(defndynamic and-internal [x y]
(if x y false))
(doc curry
"Returns a curried function accepting a single argument, that applies f to x
and then to the following argument.
@ -155,7 +205,43 @@
```")
(defndynamic curry [f x]
(fn [y]
(f x y)))
(f x y)))
(doc curry*
"Curry functions of any airity.
For example:
```
(map (curry* Dynamic.zip + '(1 2 3)) '((4 5) (6)))
;; => (((+ 1 4) (+ 2 5)) ((+ 1 6)))
((curry Dynamic.zip cons '(1 2 3)) '((4 5) (6)))
;; => ((cons 1 (4 5)) (cons (2 (6))))
(defndynamic add-em-up [x y z] (+ (+ x y) z))
(map (curry* add-em-up 1 2) '(1 2 3))
;; => (4 5 6)
```")
(defndynamic curry* [f :rest args]
(let [f-name (cadr f)
all-args (caddr f)
unfilled-args (- (length all-args) (length args))
remaining (take unfilled-args all-args)
;; Quote the arguments to retain expected behavior and avoid the need
;; for double quotes in curried higher-orders, e.g. zip.
quote-args (map quoted args)]
(list 'fn remaining
;; eval to execute the curried function.
;; otherwise, this resolves to the form that will call the function, e.g. (add-three-vals 2 3 1)
(list 'eval (list 'apply f-name (list 'quote (append quote-args (collect-into
remaining list))))))))
;; Higher-order functions can't currently accept primitives
;; For now, wrapping primitives in a function allows us to pass them
;; to HOFs like map.
(defndynamic quoted [x]
(list 'quote x))
(doc reduce
"Reduces or 'folds' a data literal, such as a list or array, into a single
@ -165,6 +251,92 @@
x
(reduce f (f x (car xs)) (cdr xs))))
(hidden unreduce-internal)
(defndynamic unreduce-internal [f x lim acc counter]
;; Currently only works with anonymous functions and named functions.
;; does not work with commands.
(if (not (Dynamic.or (array? acc) (list? acc)))
(macro-error
"Unreduce requires a dynamic data structure to collect results, such as
(list) or (array).")
(if (= counter lim)
acc
(unreduce-internal f (f x) lim (append acc (cons (eval (f x)) (empty acc))) (+ counter 1)))))
(doc unreduce
"Applies `f` to a starting value `x`, then generates a sequence of values
by successively applying `f` to the result `lim-1` times.
Collects results in the structure given by `acc`.
For example:
```
(unreduce (curry + 1) 0 10 (list))
;; => (1 2 3 4 5 6 7 8 9 10)
```")
(defndynamic unreduce [f x lim acc]
(unreduce-internal f x lim acc 0))
(doc filter
"Returns a list containing only the elements of `xs` that satisify predicate `p`.
For example:
```
(filter (fn [x] (= 'a x)) '(a b a b a b a b))
;; => (a a a a)
```")
(defndynamic filter [p xs]
(let [filter-fn (fn [x y] (if (p y) (append x (list y)) x))]
(reduce filter-fn (list) xs)))
(doc reverse
"Reverses the order of elements in an array or list.
For example:
```
(reverse [1 2 3 4])
;; => [4 3 2 1]
```")
(defndynamic reverse [xs]
(if (array? xs)
(reduce (flip append) (array) (map array xs))
(reduce (flip append) (list) (map list xs))))
(doc empty
"Returns the empty form of `xs`.
For example:
```
(empty '(1 2 3 4))
;; => ()
(empty '[1 2 3 4])
;; => []
```")
(defndynamic empty [xs]
(if (array? xs)
(array)
(list)))
(doc take
"Returns a list containing the first `n` eleements of a list.
For example:
```
(take 3 '(1 2 3 4 5))
;; => (1 2 3)
```")
(defndynamic take [n xs]
;; A more straightforward impl is likely more efficient?
(let [indicies (unreduce (curry + 1) 0 n (list))
result (map cadr (zip list xs indicies))]
(if (array? xs)
(collect-into result array)
result)))
(doc apply
"Applies the function `f` to the provided argument list, passing each value
in the list as an argument to the function.")
@ -185,8 +357,12 @@
;; calls to map or zip (which uses apply) as appropriate--unless we support
;; the quoted function name argument in map-internal or the unquoted one in
;; apply, we can't use zip and map-internal in map.
(if (not (list? f))
(f argument-list)
(let [function-name (list (cadr f))]
(append function-name argument-list)))
(if (array? argument-list)
(append function-name (collect-into argument-list list))
(append function-name argument-list)))))
(hidden map-internal)
(defndynamic map-internal [f xs acc]
@ -234,27 +410,19 @@
(zip-internal f forms (list)))
(doc map
"Applies a function `f` to `forms` and returns a list dynamic data literal
containing the result of the function applications. If a single form is
provided, the function is applied to each member of the form. If multiple
forms are provided, the function is applied to the members of each form in
succession. If the members of a single form are exhuasted, the result of the
applications thus far is returned, and any remaining members in the other
forms are ignored.
"Applies a function `f` to each element in the list or array `xs` and
returns a list dynamic data literal containing the result of the function
applications.
For example:
For example:
```clojure
'(map symbol? '(a b c))
=> (true true true)
'(map + '(1 2 3) '(4 5 6))
=> ((+ 1 4) (2 5) (6 3))
'(map + '(1 2 3) '(4 5 6) '(7))
=> ((+ 1 4 7))
'(map (curry + 1) '(1 2 3))
=> (2 3 4)
```")
(defndynamic map [f :rest forms]
(if (= 1 (length forms))
(map-internal f (car forms) (list))
(zip-internal f forms (list))))
(defndynamic map [f xs]
(map-internal f xs (list)))
)
(defndynamic cond-internal [xs]

14
core/SafeInt.carp
View File

@ -1,10 +1,12 @@
(system-include "carp_safe_int.h")
(defmodule Int
(doc safe-add "Performs an addition and checks whether it overflowed.")
(register safe-add (λ [Int Int (Ref Int)] Bool))
(doc safe-sub "Performs an substraction and checks whether it overflowed.")
(register safe-sub (λ [Int Int (Ref Int)] Bool))
(doc safe-mul "Performs an multiplication and checks whether it overflowed.")
(register safe-mul (λ [Int Int (Ref Int)] Bool))
(not-on-windows ; this seems to generate invalid code on some windows machines
(doc safe-add "Performs an addition and checks whether it overflowed.")
(register safe-add (λ [Int Int (Ref Int)] Bool))
(doc safe-sub "Performs an substraction and checks whether it overflowed.")
(register safe-sub (λ [Int Int (Ref Int)] Bool))
(doc safe-mul "Performs an multiplication and checks whether it overflowed.")
(register safe-mul (λ [Int Int (Ref Int)] Bool))
)
)

6
core/carp_binary.h
View File

@ -10,9 +10,9 @@ uint32_t Binary_to_MINUS_int32(uint8_t b1, uint8_t b2, uint8_t b3, uint8_t b4) {
uint64_t Binary_to_MINUS_int64(uint8_t b1, uint8_t b2, uint8_t b3, uint8_t b4,
uint8_t b5, uint8_t b6, uint8_t b7, uint8_t b8) {
return (uint64_t)b1 | (b2 << 8) | (b3 << 16) | (b4 << 24) |
((uint64_t)b5 << 32) | ((uint64_t)b6 << 40) | ((uint64_t)b7 << 48) |
((uint64_t)b8 << 56);
return (uint64_t)b1 | ((uint64_t)b2 << 8) | ((uint64_t)b3 << 16) |
((uint64_t)b4 << 24) | ((uint64_t)b5 << 32) | ((uint64_t)b6 << 40) |
((uint64_t)b7 << 48) | ((uint64_t)b8 << 56);
}
uint8_t Binary_int16_MINUS_to_MINUS_byte(uint16_t *x) {

10
core/carp_double.h
View File

@ -38,8 +38,8 @@ double Double_from_MINUS_int(int x) {
return (double)x;
}
long Double_to_MINUS_bytes(double x) {
long y;
Long Double_to_MINUS_bytes(double x) {
Long y;
memcpy(&y, &x, sizeof(double));
return y;
}
@ -52,11 +52,11 @@ double Double_from_MINUS_float(float x) {
return (double)x;
}
long Double_to_MINUS_long(double x) {
return (long)x;
Long Double_to_MINUS_long(double x) {
return (Long)x;
}
double Double_from_MINUS_long(long x) {
double Double_from_MINUS_long(Long x) {
return (double)x;
}

2
core/carp_io.h
View File

@ -75,7 +75,7 @@ String IO_get_MINUS_line() {
String IO_read_MINUS_file(const String *filename) {
String buffer = 0;
long length;
Long length;
FILE *f = fopen(*filename, "rb");
if (f) {

60
core/carp_long.h
View File

@ -1,87 +1,87 @@
long Long__PLUS_(long x, long y) {
Long Long__PLUS_(Long x, Long y) {
return x + y;
}
long Long__MINUS_(long x, long y) {
Long Long__MINUS_(Long x, Long y) {
return x - y;
}
long Long__MUL_(long x, long y) {
Long Long__MUL_(Long x, Long y) {
return x * y;
}
long Long__DIV_(long x, long y) {
Long Long__DIV_(Long x, Long y) {
return x / y;
}
#ifndef _WIN32
bool Long_safe_MINUS_add(long x, long y, long* res) {
return __builtin_saddl_overflow(x, y, res);
bool Long_safe_MINUS_add(Long x, Long y, Long* res) {
return __builtin_add_overflow(x, y, res);
}
bool Long_safe_MINUS_sub(long x, long y, long* res) {
return __builtin_ssubl_overflow(x, y, res);
bool Long_safe_MINUS_sub(Long x, Long y, Long* res) {
return __builtin_sub_overflow(x, y, res);
}
bool Long_safe_MINUS_mul(long x, long y, long* res) {
return __builtin_smull_overflow(x, y, res);
bool Long_safe_MINUS_mul(Long x, Long y, Long* res) {
return __builtin_mul_overflow(x, y, res);
}
#endif
bool Long__EQ_(long x, long y) {
bool Long__EQ_(Long x, Long y) {
return x == y;
}
bool Long__LT_(long x, long y) {
bool Long__LT_(Long x, Long y) {
return x < y;
}
bool Long__GT_(long x, long y) {
bool Long__GT_(Long x, Long y) {
return x > y;
}
long Long_neg(long x) {
Long Long_neg(Long x) {
return -x;
}
long Long_inc(long x) {
Long Long_inc(Long x) {
return x + 1;
}
long Long_dec(long x) {
Long Long_dec(Long x) {
return x - 1;
}
long Long_abs(long x) {
Long Long_abs(Long x) {
return x > 0 ? x : -x;
}
long Long_bit_MINUS_shift_MINUS_left(long x, long y) {
Long Long_bit_MINUS_shift_MINUS_left(Long x, Long y) {
return x << y;
}
long Long_bit_MINUS_shift_MINUS_right(long x, long y) {
Long Long_bit_MINUS_shift_MINUS_right(Long x, Long y) {
return x >> y;
}
long Long_bit_MINUS_and(long x, long y) {
Long Long_bit_MINUS_and(Long x, Long y) {
return x & y;
}
long Long_bit_MINUS_or(long x, long y) {
Long Long_bit_MINUS_or(Long x, Long y) {
return x | y;
}
long Long_bit_MINUS_xor(long x, long y) {
Long Long_bit_MINUS_xor(Long x, Long y) {
return x ^ y;
}
long Long_bit_MINUS_not(long x) {
Long Long_bit_MINUS_not(Long x) {
return ~x;
}
long Long_copy(const long* x) {
Long Long_copy(const Long* x) {
return *x;
}
long Long_mod(long x, long divider) {
Long Long_mod(Long x, Long divider) {
return x % divider;
}
void Long_seed(long seed) {
void Long_seed(Long seed) {
srand(seed);
}
bool Long_mask(long a, long b) {
bool Long_mask(Long a, Long b) {
return a & b;
}
int Long_to_MINUS_int(long a) {
int Long_to_MINUS_int(Long a) {
return (int)a;
}
long Long_from_MINUS_int(int a) {
return (long)a;
Long Long_from_MINUS_int(int a) {
return (Long)a;
}

8
core/carp_memory.h
View File

@ -1,12 +1,12 @@
#ifdef LOG_MEMORY
long malloc_balance_counter = 0;
Long malloc_balance_counter = 0;
bool log_memory_balance = false;
void *logged_malloc(size_t size) {
void *ptr = malloc(size);
if (log_memory_balance) {
printf("MALLOC: %p (%ld bytes)\n", ptr, size);
printf("MALLOC: %p (%zu bytes)\n", ptr, size);
}
malloc_balance_counter++;
return ptr;
@ -35,7 +35,7 @@ void Debug_log_MINUS_memory_MINUS_balance_BANG_(bool value) {
#define CARP_FREE(ptr) logged_free(ptr)
#define CARP_REALLOC(ptr, size) realloc(ptr, size)
long Debug_memory_MINUS_balance() {
Long Debug_memory_MINUS_balance() {
return malloc_balance_counter;
}
@ -63,7 +63,7 @@ void* CARP_REALLOC(void* ptr, size_t size) {
#define CARP_FREE(ptr) free(ptr)
long Debug_memory_MINUS_balance() {
Long Debug_memory_MINUS_balance() {
printf(
"Error - calling 'memory-balance' without compiling with LOG_MEMORY "
"enabled (--log-memory).\n");

8
core/carp_safe_int.h
View File

@ -1,9 +1,11 @@
#ifndef _WIN32
bool Int_safe_MINUS_add(int x, int y, int* res) {
return __builtin_sadd_overflow(x, y, res);
return __builtin_add_overflow(x, y, res);
}
bool Int_safe_MINUS_sub(int x, int y, int* res) {
return __builtin_ssub_overflow(x, y, res);
return __builtin_sub_overflow(x, y, res);
}
bool Int_safe_MINUS_mul(int x, int y, int* res) {
return __builtin_smul_overflow(x, y, res);
return __builtin_mul_overflow(x, y, res);
}
#endif

34
core/carp_stdint.h
View File

@ -52,10 +52,10 @@ String Uint8_str(Uint8 x) {
snprintf(buffer, size, "Uint8(%" PRIu8 ")", x);
return buffer;
}
Uint8 Uint8_from_MINUS_long(long x) {
Uint8 Uint8_from_MINUS_long(Long x) {
return (Uint8)x;
}
long Uint8_to_MINUS_long(Uint8 x) {
Long Uint8_to_MINUS_long(Uint8 x) {
return (long)x;
}
Uint8 Uint8_copy(Uint8* x) {
@ -119,10 +119,10 @@ String Uint16_str(Uint16 x) {
snprintf(buffer, size, "Uint16(%" PRIu16 ")", x);
return buffer;
}
Uint16 Uint16_from_MINUS_long(long x) {
Uint16 Uint16_from_MINUS_long(Long x) {
return (Uint16)x;
}
long Uint16_to_MINUS_long(Uint16 x) {
Long Uint16_to_MINUS_long(Uint16 x) {
return (long)x;
}
Uint16 Uint16_copy(Uint16* x) {
@ -186,10 +186,10 @@ String Uint32_str(Uint32 x) {
snprintf(buffer, size, "Uint32(%" PRIu32 ")", x);
return buffer;
}
Uint32 Uint32_from_MINUS_long(long x) {
Uint32 Uint32_from_MINUS_long(Long x) {
return (Uint32)x;
}
long Uint32_to_MINUS_long(Uint32 x) {
Long Uint32_to_MINUS_long(Uint32 x) {
return (long)x;
}
Uint32 Uint32_copy(Uint32* x) {
@ -253,10 +253,10 @@ String Uint64_str(Uint64 x) {
snprintf(buffer, size, "Uint64(%" PRIu64 ")", x);
return buffer;
}
Uint64 Uint64_from_MINUS_long(long x) {
Uint64 Uint64_from_MINUS_long(Long x) {
return (Uint64)x;
}
long Uint64_to_MINUS_long(Uint64 x) {
Long Uint64_to_MINUS_long(Uint64 x) {
return (long)x;
}
Uint64 Uint64_copy(Uint64* x) {
@ -320,10 +320,10 @@ String Int8_str(Int8 x) {
snprintf(buffer, size, "Int8(%" PRId8 ")", x);
return buffer;
}
Int8 Int8_from_MINUS_long(long x) {
Int8 Int8_from_MINUS_long(Long x) {
return (Int8)x;
}
long Int8_to_MINUS_long(Int8 x) {
Long Int8_to_MINUS_long(Int8 x) {
return (long)x;
}
Int8 Int8_copy(Int8* x) {
@ -387,10 +387,10 @@ String Int16_str(Int16 x) {
snprintf(buffer, size, "Int16(%" PRId16 ")", x);
return buffer;
}
Int16 Int16_from_MINUS_long(long x) {
Int16 Int16_from_MINUS_long(Long x) {
return (Int16)x;
}
long Int16_to_MINUS_long(Int16 x) {
Long Int16_to_MINUS_long(Int16 x) {
return (long)x;
}
Int16 Int16_copy(Int16* x) {
@ -454,10 +454,10 @@ String Int32_str(Int32 x) {
snprintf(buffer, size, "Int32(%" PRId32 ")", x);
return buffer;
}
Int32 Int32_from_MINUS_long(long x) {
Int32 Int32_from_MINUS_long(Long x) {
return (Int32)x;
}
long Int32_to_MINUS_long(Int32 x) {
Long Int32_to_MINUS_long(Int32 x) {
return (long)x;
}
Int32 Int32_copy(Int32* x) {
@ -521,11 +521,11 @@ String Int64_str(Int64 x) {
snprintf(buffer, size, "Int64(%" PRId64 ")", x);
return buffer;
}
Int64 Int64_from_MINUS_long(long x) {
Int64 Int64_from_MINUS_long(Long x) {
return (Int64)x;
}
long Int64_to_MINUS_long(Int64 x) {
return (long)x;
Long Int64_to_MINUS_long(Int64 x) {
return (Long)x;
}
Int64 Int64_copy(Int64* x) {
return *x;

10
core/carp_string.h
View File

@ -239,21 +239,21 @@ int Int_from_MINUS_string(const String *s) {
return atoi(*s);
}
String Long_str(long x) {
int size = snprintf(NULL, 0, "%ldl", x) + 1;
String Long_str(Long x) {
int size = snprintf(NULL, 0, "%" PRIi64, x) + 1;
String buffer = CARP_MALLOC(size);
sprintf(buffer, "%ldl", x);
sprintf(buffer, "%" PRIi64, x);
return buffer;
}
String Long_format(const String *str, long x) {
String Long_format(const String *str, Long x) {
int size = snprintf(NULL, 0, *str, x) + 1;
String buffer = CARP_MALLOC(size);
sprintf(buffer, *str, x);
return buffer;
}
long Long_from_MINUS_string(const String *s) {
Long Long_from_MINUS_string(const String *s) {
return atol(*s);
}

8
core/core.h
View File

@ -7,21 +7,17 @@ typedef SSIZE_T ssize_t;
#ifndef _WIN32
#include <unistd.h>
#endif
#include <inttypes.h>
typedef char *String;
typedef char *Pattern;
typedef int64_t Long;
#if defined NDEBUG
#define CHK_INDEX(i, n)
#else
#if defined(WIN32) || defined(_WIN32) || \
defined(__WIN32) && !defined(__CYGWIN__)
// The %zd format flag doesn't seem to work on Windows?
#define CHK_INDEX_FORMAT_STRING ":%u: bad index: %ld < %ld\n"
#else
#define CHK_INDEX_FORMAT_STRING ":%u: bad index: %zd < %zd\n"
#endif
#define CHK_INDEX(i, n) \
do { \

254
docs/core/Dynamic.html
View File

@ -1110,6 +1110,48 @@ in the list as an argument to the function.</p>
</p>
</div>
<div class="binder">
<a class="anchor" href="#compose">
<h3 id="compose">
compose
</h3>
</a>
<div class="description">
dynamic
</div>
<p class="sig">
Dynamic
</p>
<pre class="args">
(compose f g)
</pre>
<p class="doc">
<p>Returns the composition of two functions <code>f</code> and <code>g</code> for functions of any
airity; concretely, returns a function accepting the correct number of
arguments for <code>g</code>, applies <code>g</code> to those arguments, then applies <code>f</code> to the
result.</p>
<pre><code>If you only need to compose functions that take a single argument (unary arity)
see `comp`. Comp also generates the form that corresponds to the composition,
compose contrarily evaluates 'eagerly' and returns a computed symbol.
For exmaple:
```
;; a silly composition
((compose empty take) 3 [1 2 3 4 5])
;; =&gt; []
(String.join (collect-into ((compose reverse map) Symbol.str '(p r a c)) array))
;; =&gt; 'carp'
;; comp for comparison
((comp (curry + 1) (curry + 2)) 4)
;; =&gt; (+ 1 (+ 2 4))
```
</code></pre>
</p>
</div>
<div class="binder">
<a class="anchor" href="#cons">
<h3 id="cons">
@ -1176,6 +1218,40 @@ and then to the following argument.</p>
</p>
</div>
<div class="binder">
<a class="anchor" href="#curry*">
<h3 id="curry*">
curry*
</h3>
</a>
<div class="description">
dynamic
</div>
<p class="sig">
Dynamic
</p>
<pre class="args">
(curry* f :rest args)
</pre>
<p class="doc">
<p>Curry functions of any airity.</p>
<pre><code> For example:
```
(map (curry* Dynamic.zip + '(1 2 3)) '((4 5) (6)))
;; =&gt; (((+ 1 4) (+ 2 5)) ((+ 1 6)))
((curry Dynamic.zip cons '(1 2 3)) '((4 5) (6)))
;; =&gt; ((cons 1 (4 5)) (cons (2 (6))))
(defndynamic add-em-up [x y z] (+ (+ x y) z))
(map (curry* add-em-up 1 2) '(1 2 3))
;; =&gt; (4 5 6)
```
</code></pre>
</p>
</div>
<div class="binder">
<a class="anchor" href="#cxr">
<h3 id="cxr">
@ -1233,6 +1309,35 @@ and then to the following argument.</p>
</p>
</div>
<div class="binder">
<a class="anchor" href="#empty">
<h3 id="empty">
empty
</h3>
</a>
<div class="description">
dynamic
</div>
<p class="sig">
Dynamic
</p>
<pre class="args">
(empty xs)
</pre>
<p class="doc">
<p>Returns the empty form of <code>xs</code>.</p>
<pre><code> For example:
```
(empty '(1 2 3 4))
;; =&gt; ()
(empty '[1 2 3 4])
;; =&gt; []
```
</code></pre>
</p>
</div>
<div class="binder">
<a class="anchor" href="#empty?">
<h3 id="empty?">
@ -1329,6 +1434,33 @@ and then to the following argument.</p>
</p>
</div>
<div class="binder">
<a class="anchor" href="#filter">
<h3 id="filter">
filter
</h3>
</a>
<div class="description">
dynamic
</div>
<p class="sig">
Dynamic
</p>
<pre class="args">
(filter p xs)
</pre>
<p class="doc">
<p>Returns a list containing only the elements of <code>xs</code> that satisify predicate <code>p</code>.</p>
<pre><code> For example:
```
(filter (fn [x] (= 'a x)) '(a b a b a b a b))
;; =&gt; (a a a a)
```
</code></pre>
</p>
</div>
<div class="binder">
<a class="anchor" href="#flip">
<h3 id="flip">
@ -1559,24 +1691,18 @@ and then to the following argument.</p>
Dynamic
</p>
<pre class="args">
(map f :rest forms)
(map f xs)
</pre>
<p class="doc">
<p>Applies a function <code>f</code> to <code>forms</code> and returns a list dynamic data literal
containing the result of the function applications. If a single form is
provided, the function is applied to each member of the form. If multiple
forms are provided, the function is applied to the members of each form in
succession. If the members of a single form are exhuasted, the result of the
applications thus far is returned, and any remaining members in the other
forms are ignored.</p>
<pre><code>For example:
<p>Applies a function <code>f</code> to each element in the list or array <code>xs</code> and
returns a list dynamic data literal containing the result of the function
applications.</p>
<pre><code> For example:
```clojure
'(map symbol? '(a b c))
=&gt; (true true true)
'(map + '(1 2 3) '(4 5 6))
=&gt; ((+ 1 4) (2 5) (6 3))
'(map + '(1 2 3) '(4 5 6) '(7))
=&gt; ((+ 1 4 7))
'(map (curry + 1) '(1 2 3))
=&gt; (2 3 4)
```
</code></pre>
@ -1735,6 +1861,25 @@ forms are ignored.</p>
</p>
</div>
<div class="binder">
<a class="anchor" href="#quoted">
<h3 id="quoted">
quoted
</h3>
</a>
<div class="description">
dynamic
</div>
<p class="sig">
Dynamic
</p>
<pre class="args">
(quoted x)
</pre>
<p class="doc">
</p>
</div>
<div class="binder">
<a class="anchor" href="#read-file">
<h3 id="read-file">
@ -1813,6 +1958,33 @@ value through successive applications of <code>f</code>.</p>
</p>
</div>
<div class="binder">
<a class="anchor" href="#reverse">
<h3 id="reverse">
reverse
</h3>
</a>
<div class="description">
dynamic
</div>
<p class="sig">
Dynamic
</p>
<pre class="args">
(reverse xs)
</pre>
<p class="doc">
<p>Reverses the order of elements in an array or list.</p>
<pre><code> For example:
```
(reverse [1 2 3 4])
;; =&gt; [4 3 2 1]
```
</code></pre>
</p>
</div>
<div class="binder">
<a class="anchor" href="#run">
<h3 id="run">
@ -1908,6 +2080,62 @@ value through successive applications of <code>f</code>.</p>
</p>
</div>
<div class="binder">
<a class="anchor" href="#take">
<h3 id="take">
take
</h3>
</a>
<div class="description">
dynamic
</div>
<p class="sig">
Dynamic
</p>
<pre class="args">
(take n xs)
</pre>
<p class="doc">
<p>Returns a list containing the first <code>n</code> eleements of a list.</p>
<pre><code> For example:
```
(take 3 '(1 2 3 4 5))
;; =&gt; (1 2 3)
```
</code></pre>
</p>
</div>
<div class="binder">
<a class="anchor" href="#unreduce">
<h3 id="unreduce">
unreduce
</h3>
</a>
<div class="description">
dynamic
</div>
<p class="sig">
Dynamic
</p>
<pre class="args">
(unreduce f x lim acc)
</pre>
<p class="doc">
<p>Applies <code>f</code> to a starting value <code>x</code>, then generates a sequence of values
by successively applying <code>f</code> to the result <code>lim-1</code> times.
Collects results in the structure given by <code>acc</code>.</p>
<pre><code> For example:
```
(unreduce (curry + 1) 0 10 (list))
;; =&gt; (1 2 3 4 5 6 7 8 9 10)
```
</code></pre>
</p>
</div>
<div class="binder">
<a class="anchor" href="#write-file">
<h3 id="write-file">

1
run_carp_tests.ps1
View File

@ -32,7 +32,6 @@ exitOnError { stack exec carp "--" ./examples/check_malloc.carp -b }
# Generate docs
exitOnError { stack exec carp "--" ./docs/core/generate_core_docs.carp }
exitOnError { stack exec carp "--" ./docs/sdl/generate_sdl_docs.carp }
echo "ALL TESTS DONE."

12
src/StartingEnv.hs
View File

@ -130,7 +130,7 @@ templatePointerAdd = defineTemplate
(SymPath ["Pointer"] "add")
(FuncTy [PointerTy (VarTy "p"), LongTy] (PointerTy (VarTy "p")) StaticLifetimeTy)
"adds a long integer value to a pointer."
(toTemplate "$p* $NAME ($p *p, long x)")
(toTemplate "$p* $NAME ($p *p, Long x)")
(toTemplate $ unlines ["$DECL {"
," return p + x;"
,"}"])
@ -140,7 +140,7 @@ templatePointerSub = defineTemplate
(SymPath ["Pointer"] "sub")
(FuncTy [PointerTy (VarTy "p"), LongTy] (PointerTy (VarTy "p")) StaticLifetimeTy)
"subtracts a long integer value from a pointer."
(toTemplate "$p* $NAME ($p *p, long x)")
(toTemplate "$p* $NAME ($p *p, Long x)")
(toTemplate $ unlines ["$DECL {"
," return p - x;"
,"}"])
@ -150,7 +150,7 @@ templatePointerWidth = defineTemplate
(SymPath ["Pointer"] "width")
(FuncTy [PointerTy (VarTy "p")] LongTy StaticLifetimeTy)
"gets the byte size of a pointer."
(toTemplate "long $NAME ($p *p)")
(toTemplate "Long $NAME ($p *p)")
(toTemplate $ unlines ["$DECL {"
," return sizeof(*p);"
,"}"])
@ -160,9 +160,9 @@ templatePointerToLong = defineTemplate
(SymPath ["Pointer"] "to-long")
(FuncTy [PointerTy (VarTy "p")] LongTy StaticLifetimeTy)
"converts a pointer to a long integer."
(toTemplate "long $NAME ($p *p)")
(toTemplate "Long $NAME ($p *p)")
(toTemplate $ unlines ["$DECL {"
," return (long)p;"
," return (Long)p;"
,"}"])
(const [])
@ -170,7 +170,7 @@ templatePointerFromLong = defineTemplate
(SymPath ["Pointer"] "from-long")
(FuncTy [LongTy] (PointerTy (VarTy "p")) StaticLifetimeTy)
"converts a long integer to a pointer."
(toTemplate "$p* $NAME (long p)")
(toTemplate "$p* $NAME (Long p)")
(toTemplate $ unlines ["$DECL {"
," return ($p*)p;"
,"}"])

2
src/Types.hs
View File

@ -124,7 +124,7 @@ tyToCManglePtr _ IntTy = "int"
tyToCManglePtr _ BoolTy = "bool"
tyToCManglePtr _ FloatTy = "float"
tyToCManglePtr _ DoubleTy = "double"
tyToCManglePtr _ LongTy = "long"
tyToCManglePtr _ LongTy = "Long"
tyToCManglePtr _ ByteTy = "uint8_t"
tyToCManglePtr _ StringTy = "String"
tyToCManglePtr _ PatternTy = "Pattern"

69
test/macros.carp
View File

@ -68,6 +68,46 @@
(Dynamic.and (= 'ace (Symbol.join (eval (Dynamic.car zipped))))
(= 'dog (Symbol.join (eval (Dynamic.cadr zipped)))))))
(defmacro test-curry []
(= 3 ((Dynamic.curry + 1) 2)))
(defmacro test-flip []
(= 'Foo.Bar ((Dynamic.flip Symbol.prefix) 'Bar 'Foo)))
(defmacro test-compose []
(= '() ((Dynamic.compose Dynamic.empty Dynamic.take) 2 '(1 2 3 4))))
(defmacro test-reduce []
(= 10 (Dynamic.reduce + 0 '(1 2 3 4))))
(defmacro test-unreduce []
(Dynamic.reduce Dynamic.and-internal true
(Dynamic.map 'eval
(Dynamic.zip = '(1 2 3 4) (Dynamic.unreduce (curry + 1) 0 4 (list))))))
(defmacro test-filter []
(Dynamic.reduce Dynamic.and-internal true
(Dynamic.map 'eval
(Dynamic.zip = '('a 'a 'a 'a)
(Dynamic.map Dynamic.quoted
(Dynamic.filter (fn [x] (= 'a x)) '(a b a b a b a b)))))))
(defmacro test-empty []
;; We can't compare '[] and '[] for some reason.
;; But '() and '() are comparable
(Dynamic.and (= '() (Dynamic.empty '(1 2 3 4)))
(empty? (Dynamic.empty '[1 2 3 4]))))
(defmacro test-reverse []
(Dynamic.reduce Dynamic.and-internal true
(Dynamic.map 'eval
(Dynamic.zip = '(4 3 2 1) (Dynamic.reverse '(1 2 3 4))))))
(defmacro test-take []
(let [result (Dynamic.take 2 '(1 2 3 4))]
(Dynamic.and (= 1 (car result ))
(= '() (cddr result)))))
(deftest test
(assert-true test
(test-let-do)
@ -236,5 +276,32 @@
"map works as expected")
(assert-true test
(test-zip)
"zip works as expected")
"zip works as expected")
(assert-true test
(test-curry)
"curry works as expected")
(assert-true test
(test-flip)
"filp works as expected")
(assert-true test
(test-compose)
"compose works as expected")
(assert-true test
(test-reduce)
"reduce works as expected")
(assert-true test
(test-unreduce)
"unreduce works as expected")
(assert-true test
(test-filter)
"filter works as expected")
(assert-true test
(test-reverse)
"reverse works as expected")
(assert-true test
(test-empty)
"empty works as expected")
(assert-true test
(test-take)
"take works as expected")
)

3
test/safe_arithmetic.carp
View File

@ -1,3 +1,6 @@
(windows-only ; safe arithmetic does not currently work on windows
(quit))
(load "Test.carp")
(load "SafeInt.carp")