mirror of
https://github.com/carp-lang/Carp.git
synced 2024-11-04 01:25:04 +03:00
chore: Move some examples to test/produces-output (#989)
* chore: Moved examples that work more as tests to folder 'test/produces-output' * fix: Corrections to the release script * fix: Correct filename on Windows * fix: Move more files around * fix: Remove check-malloc example * fix: Apparently unicode example does not work * chore: Move nested_lambdas.carp back to examples * chore: Remove .DS_Store files * fix: Bring back unicode test * test: Make sure benchmark compile (had to remove mandelbrot and n-bodies) * fix: Replacement implementation of clock_gettime on Windows * chore: Trigger CI * fix: Define CLOCK_REALTIME Co-authored-by: Erik Svedang <erik@Eriks-iMac.local>
This commit is contained in:
Erik Svedäng
GitHub
parent
8e9f7bfd90
commit
a873099640
@ -1,3 +1,70 @@
|
||||
#if defined _WIN32
|
||||
|
||||
// The function 'clock_gettime' is not available on Windows.
|
||||
// Our replacement implementation was taken from Stack overflow:
|
||||
// https://stackoverflow.com/questions/5404277/porting-clock-gettime-to-windows
|
||||
|
||||
#include <windows.h>
|
||||
|
||||
#define CLOCK_REALTIME 0
|
||||
|
||||
LARGE_INTEGER getFILETIMEoffset() {
|
||||
SYSTEMTIME s;
|
||||
FILETIME f;
|
||||
LARGE_INTEGER t;
|
||||
|
||||
s.wYear = 1970;
|
||||
s.wMonth = 1;
|
||||
s.wDay = 1;
|
||||
s.wHour = 0;
|
||||
s.wMinute = 0;
|
||||
s.wSecond = 0;
|
||||
s.wMilliseconds = 0;
|
||||
SystemTimeToFileTime(&s, &f);
|
||||
t.QuadPart = f.dwHighDateTime;
|
||||
t.QuadPart <<= 32;
|
||||
t.QuadPart |= f.dwLowDateTime;
|
||||
return (t);
|
||||
}
|
||||
|
||||
int clock_gettime(int X, struct timeval *tv) {
|
||||
LARGE_INTEGER t;
|
||||
FILETIME f;
|
||||
double microseconds;
|
||||
static LARGE_INTEGER offset;
|
||||
static double frequencyToMicroseconds;
|
||||
static int initialized = 0;
|
||||
static BOOL usePerformanceCounter = 0;
|
||||
|
||||
if (!initialized) {
|
||||
LARGE_INTEGER performanceFrequency;
|
||||
initialized = 1;
|
||||
usePerformanceCounter = QueryPerformanceFrequency(&performanceFrequency);
|
||||
if (usePerformanceCounter) {
|
||||
QueryPerformanceCounter(&offset);
|
||||
frequencyToMicroseconds = (double)performanceFrequency.QuadPart / 1000000.;
|
||||
} else {
|
||||
offset = getFILETIMEoffset();
|
||||
frequencyToMicroseconds = 10.;
|
||||
}
|
||||
}
|
||||
if (usePerformanceCounter) QueryPerformanceCounter(&t);
|
||||
else {
|
||||
GetSystemTimeAsFileTime(&f);
|
||||
t.QuadPart = f.dwHighDateTime;
|
||||
t.QuadPart <<= 32;
|
||||
t.QuadPart |= f.dwLowDateTime;
|
||||
}
|
||||
|
||||
t.QuadPart -= offset.QuadPart;
|
||||
microseconds = (double)t.QuadPart / frequencyToMicroseconds;
|
||||
t.QuadPart = microseconds;
|
||||
tv->tv_sec = t.QuadPart / 1000000;
|
||||
tv->tv_usec = t.QuadPart % 1000000;
|
||||
return (0);
|
||||
}
|
||||
#endif
|
||||
|
||||
double get_time_elapsed() {
|
||||
struct timespec tv;
|
||||
clock_gettime(CLOCK_REALTIME, &tv);
|
||||
|
||||
@ -1,25 +0,0 @@
|
||||
(use Array)
|
||||
(use String)
|
||||
|
||||
(defn ex1 []
|
||||
(let [a (Array.allocate 2)
|
||||
b (Array.aset a 0 (fn [] @"Hello"))
|
||||
c (Array.aset b 1 (fn [] @"World"))
|
||||
]
|
||||
(do
|
||||
(println* (@(Array.unsafe-nth &c 0)))
|
||||
(println* (@(Array.unsafe-nth &c 1))))))
|
||||
|
||||
(defn ex2 []
|
||||
(let [a (Array.allocate 2)
|
||||
b (Array.aset a 0 (fn [x] (String.append "Hello" x)))
|
||||
c (Array.aset b 1 (fn [s] (String.append s "World")))
|
||||
]
|
||||
(do
|
||||
(println* (@(Array.unsafe-nth &c 0) " World"))
|
||||
(println* (@(Array.unsafe-nth &c 1) "Hello ")))))
|
||||
|
||||
(defn main []
|
||||
(do
|
||||
(ex1)
|
||||
(ex2)))
|
||||
@ -1,67 +0,0 @@
|
||||
;;; Taken from
|
||||
;;; http://benchmarksgame.alioth.debian.org/u64q/program.php?test=mandelbrot&lang=gcc&id=2
|
||||
|
||||
(add-cflag "-Wall -pipe -O3 -fomit-frame-pointer -march=native")
|
||||
|
||||
(use Double)
|
||||
(use Int)
|
||||
(use String)
|
||||
(use IO)
|
||||
|
||||
(def w 16000.0)
|
||||
(def h 16000.0)
|
||||
|
||||
(system-include "stdio.h")
|
||||
(register-type FILE)
|
||||
(register stdout FILE)
|
||||
(register putc (Fn [Int FILE] ()))
|
||||
|
||||
(defn main []
|
||||
(do
|
||||
(print &(str* @"P4\n" (str w) @" " (str h) @"\n"))
|
||||
(let [iter 50
|
||||
limit 2.0
|
||||
byte_acc 0
|
||||
bit_num 0]
|
||||
(for [y 0 (to-int h)]
|
||||
(for [x 0 (to-int w)]
|
||||
(let [Zr 0.0
|
||||
Zi 0.0
|
||||
Tr 0.0
|
||||
Ti 0.0
|
||||
Cr (- (/ (* 2.0 (from-int x)) w) 1.5)
|
||||
Ci (- (/ (* 2.0 (from-int y)) w) 1.0)]
|
||||
(do
|
||||
(let [i 0]
|
||||
(while (and (< i iter)
|
||||
(<= (+ Tr Ti) (* limit limit)))
|
||||
(do
|
||||
(set! Zi (+ (* 2.0 (* Zr Zi)) Ci))
|
||||
(set! Zr (+ (- Tr Ti) Cr))
|
||||
(set! Tr (* Zr Zr))
|
||||
(set! Ti (* Zi Zi))
|
||||
(set! i (inc i)))))
|
||||
|
||||
(set! byte_acc (* 2 byte_acc))
|
||||
|
||||
(when (<= (+ Tr Ti) (* limit limit))
|
||||
(set! byte_acc (bit-or byte_acc 1)))
|
||||
|
||||
(set! bit_num (inc bit_num))
|
||||
|
||||
(if (= bit_num 8)
|
||||
(do
|
||||
(putc byte_acc stdout)
|
||||
(set! byte_acc 0)
|
||||
(set! bit_num 0))
|
||||
(if (= x (- (to-int w) 1))
|
||||
(do
|
||||
(set! byte_acc
|
||||
(bit-shift-left byte_acc (- 8 (mod (to-int w) 8))))
|
||||
(putc byte_acc stdout)
|
||||
(set! byte_acc 0)
|
||||
(set! bit_num 0))
|
||||
())))))))))
|
||||
|
||||
|
||||
;;; (build)
|
||||
@ -1,159 +0,0 @@
|
||||
;;; Taken from
|
||||
;;; http://benchmarksgame.alioth.debian.org/u64q/program.php?test=nbody&lang=gcc&id=1
|
||||
|
||||
(add-cflag "-Wall -pipe -O3 -fomit-frame-pointer -march=native -mfpmath=sse -msse3")
|
||||
|
||||
(use IO)
|
||||
(use Double)
|
||||
(use Array)
|
||||
(use Int)
|
||||
|
||||
;;; pow(double, double) is 5 times slower for (pow x 3)
|
||||
; int Int_pow(int x, int y) {
|
||||
; int r = 1;
|
||||
; while (y) {
|
||||
; if (y & 1)
|
||||
; r *= x;
|
||||
; y >>= 1;
|
||||
; x *= x;
|
||||
; }
|
||||
; return r;
|
||||
; }
|
||||
(defn ipow [x y]
|
||||
(let-do [r 1.0]
|
||||
(while (/= y 0)
|
||||
(do
|
||||
(when (/= (bit-and y 1) 0)
|
||||
(set! r (* r x)))
|
||||
(set! y (/ y 2))
|
||||
(set! x (* x x))))
|
||||
r))
|
||||
|
||||
(def n 50000000)
|
||||
|
||||
(defn solar_mass [] (* (* 4.0 pi) pi)) ;; I cannot #DEFINE, so solar_mass cannot be a `def`
|
||||
(def days_per_year 365.24)
|
||||
|
||||
(deftype Planet
|
||||
[ x Double y Double z Double
|
||||
vx Double vy Double vz Double
|
||||
mass Double ])
|
||||
|
||||
; for eg. 1.03e-03
|
||||
(defn e [d exp]
|
||||
(* d (pow 10.0 (from-int exp))))
|
||||
|
||||
|
||||
|
||||
; currying would make this a single line
|
||||
; + lambdas would make this unneeded
|
||||
(defn reduce-px [t b] (+ @t (* (Planet.vx b) (Planet.mass b))))
|
||||
(defn reduce-py [t b] (+ @t (* (Planet.vy b) (Planet.mass b))))
|
||||
(defn reduce-pz [t b] (+ @t (* (Planet.vz b) (Planet.mass b))))
|
||||
|
||||
(defn offset_momentum [bodies]
|
||||
(let [b (unsafe-nth bodies 0)
|
||||
px (reduce reduce-px 0.0 bodies)
|
||||
py (reduce reduce-py 0.0 bodies)
|
||||
pz (reduce reduce-pz 0.0 bodies)]
|
||||
(do
|
||||
(Planet.set-vx! b (/ (neg px) (solar_mass)))
|
||||
(Planet.set-vy! b (/ (neg py) (solar_mass)))
|
||||
(Planet.set-vz! b (/ (neg pz) (solar_mass))))))
|
||||
|
||||
|
||||
|
||||
(defn energy [bodies]
|
||||
(let-do [e 0.0]
|
||||
(for [i 0 (length bodies)]
|
||||
(let-do [b (unsafe-nth bodies i)]
|
||||
(set! e (+ e (* 0.5 (* (Planet.mass b)
|
||||
(+ (ipow (Planet.vx b) 2)
|
||||
(+ (ipow (Planet.vy b) 2)
|
||||
(ipow (Planet.vz b) 2)))))))
|
||||
|
||||
(for [j (+ i 1) (length bodies)]
|
||||
(let [b2 (unsafe-nth bodies j)
|
||||
dx (- (Planet.x b) (Planet.x b2))
|
||||
dy (- (Planet.y b) (Planet.y b2))
|
||||
dz (- (Planet.z b) (Planet.z b2))
|
||||
dist (sqrt (+ (ipow dx 2) (+ (ipow dy 2) (ipow dz 2))))]
|
||||
(set! e (- e (/ (* (Planet.mass b) (Planet.mass b2)) dist)))))))
|
||||
e))
|
||||
|
||||
|
||||
(defn update-planet [i bodies dt]
|
||||
(let [b (unsafe-nth bodies i)]
|
||||
(do
|
||||
(Planet.set-x! b (+ (Planet.x b) (* dt (Planet.vx b))))
|
||||
(Planet.set-y! b (+ (Planet.y b) (* dt (Planet.vy b))))
|
||||
(Planet.set-z! b (+ (Planet.z b) (* dt (Planet.vz b)))))))
|
||||
|
||||
(defn advance [bodies dt]
|
||||
(do
|
||||
(for [i 0 (length bodies)]
|
||||
(let [b (unsafe-nth bodies i)]
|
||||
(for [j (+ i 1) (length bodies)]
|
||||
(let [b2 (unsafe-nth bodies j)
|
||||
dx (- (Planet.x b) (Planet.x b2))
|
||||
dy (- (Planet.y b) (Planet.y b2))
|
||||
dz (- (Planet.z b) (Planet.z b2))
|
||||
dist (sqrt (+ (ipow dx 2) (+ (ipow dy 2) (ipow dz 2))))
|
||||
mag (/ dt (ipow dist 3))]
|
||||
(do
|
||||
(Planet.set-vx! b (- (Planet.vx b) (* dx (* (Planet.mass b2) mag))))
|
||||
(Planet.set-vy! b (- (Planet.vy b) (* dy (* (Planet.mass b2) mag))))
|
||||
(Planet.set-vz! b (- (Planet.vz b) (* dz (* (Planet.mass b2) mag))))
|
||||
|
||||
(Planet.set-vx! b2 (+ (Planet.vx b2) (* dx (* (Planet.mass b) mag))))
|
||||
(Planet.set-vy! b2 (+ (Planet.vy b2) (* dy (* (Planet.mass b) mag))))
|
||||
(Planet.set-vz! b2 (+ (Planet.vz b2) (* dz (* (Planet.mass b) mag)))))))))
|
||||
|
||||
(for [i 0 (length bodies)]
|
||||
(update-planet i bodies dt))))
|
||||
|
||||
; defining bodies outside main (`def`) results in c compile error:
|
||||
; - solar mass is a function
|
||||
; - i cannot do eg. 1.01e-03
|
||||
(defn main []
|
||||
(let-do [bodies [
|
||||
(Planet.init 0.0 0.0 0.0 0.0 0.0 0.0 (solar_mass))
|
||||
(Planet.init ; jupiter
|
||||
(e 4.84143144246472090 0)
|
||||
(e -1.16032004402742839 0)
|
||||
(e -1.03622044471123109 -1)
|
||||
(* (e 1.66007664274403694 -3) days_per_year)
|
||||
(* (e 7.69901118419740425 -3) days_per_year)
|
||||
(* (e -6.90460016972063023 -5) days_per_year)
|
||||
(* (e 9.54791938424326609 -4) (solar_mass)))
|
||||
(Planet.init ; saturn
|
||||
(e 8.34336671824457987 0)
|
||||
(e 4.12479856412430479 0)
|
||||
(e -4.03523417114321381 -1)
|
||||
(* (e -2.76742510726862411 -3) days_per_year)
|
||||
(* (e 4.99852801234917238 -3) days_per_year)
|
||||
(* (e 2.30417297573763929 -5) days_per_year)
|
||||
(* (e 2.85885980666130812 -4) (solar_mass)))
|
||||
(Planet.init ; uranus
|
||||
(e 1.28943695621391310 1)
|
||||
(e -1.51111514016986312 1)
|
||||
(e -2.23307578892655734 -1)
|
||||
(* (e 2.96460137564761618 -3) days_per_year)
|
||||
(* (e 2.37847173959480950 -3) days_per_year)
|
||||
(* (e -2.96589568540237556 -5) days_per_year)
|
||||
(* (e 4.36624404335156298 -5) (solar_mass)))
|
||||
(Planet.init ; neptune
|
||||
(e 1.53796971148509165 1)
|
||||
(e -2.59193146099879641 1)
|
||||
(e 1.79258772950371181 -1)
|
||||
(* (e 2.68067772490389322 -3) days_per_year)
|
||||
(* (e 1.62824170038242295 -3) days_per_year)
|
||||
(* (e -9.51592254519715870 -5) days_per_year)
|
||||
(* (e 5.15138902046611451 -5) (solar_mass)))
|
||||
]]
|
||||
(offset_momentum &bodies)
|
||||
(println &(str (energy &bodies))) ; printf %.9f
|
||||
(for [i 0 n]
|
||||
(do
|
||||
(advance &bodies 0.01)))
|
||||
(println &(str (energy &bodies))))) ;
|
||||
@ -1,4 +0,0 @@
|
||||
(Debug.check-allocations)
|
||||
|
||||
(defn main []
|
||||
(println* &(Array.repeat 10000000 &Int.zero)))
|
||||
@ -1,67 +0,0 @@
|
||||
#include <stdio.h>
|
||||
#include <stdlib.h>
|
||||
|
||||
// (defn main []
|
||||
// (let-do [x 123
|
||||
// f (fn [y] (+ x y))
|
||||
// g square]
|
||||
// (f 210)
|
||||
// (g 3))
|
||||
|
||||
// Environment for this particular lambda
|
||||
typedef struct Env_main_0 {
|
||||
int x;
|
||||
} Env_main_0;
|
||||
|
||||
// Deleter
|
||||
void delete_Env_main_0(Env_main_0 *env) {
|
||||
// no managed members to free in this case
|
||||
free(env);
|
||||
printf("Deleted Env_main_0\n");
|
||||
}
|
||||
|
||||
typedef struct Closure {
|
||||
void *callback;
|
||||
void *env;
|
||||
void (*delete)(void*);
|
||||
} Closure;
|
||||
|
||||
typedef int (*Fn_CallClosure__Int_Int)(void*, int);
|
||||
typedef int (*Fn_Int_Int)(int);
|
||||
|
||||
// The body of the lambda, but lifted to its own function. Takes the environment as a first argument.
|
||||
int lifted_lambda_main_0(Env_main_0 *env, int y) {
|
||||
return env->x + y; // simplified for readability
|
||||
}
|
||||
|
||||
int square(int x) {
|
||||
return x * x;
|
||||
}
|
||||
|
||||
int main() {
|
||||
// let x
|
||||
int x = 123;
|
||||
// let f
|
||||
Env_main_0 *env_0 = malloc(sizeof(Env_main_0));
|
||||
env_0->x = x;
|
||||
Closure f = {
|
||||
.callback = (void*)lifted_lambda_main_0,
|
||||
.env = env_0,
|
||||
.delete = (void*)delete_Env_main_0
|
||||
};
|
||||
//let g
|
||||
Closure g = {
|
||||
.callback = square,
|
||||
.env = NULL,
|
||||
.delete = NULL
|
||||
};
|
||||
// call f
|
||||
int _1 = f.env ? ((Fn_CallClosure__Int_Int)f.callback)(f.env, 210) : ((Fn_Int_Int)f.callback)(210);
|
||||
// delete f
|
||||
if(f.delete) { f.delete(f.env); }
|
||||
// call g
|
||||
int _2 = g.env ? ((Fn_CallClosure__Int_Int)g.callback)(f.env, 3) : ((Fn_Int_Int)g.callback)(3);
|
||||
// delete g
|
||||
if(g.delete) { f.delete(f.env); }
|
||||
printf("_1 = %d\n_2 = %d\n", _1, _2);
|
||||
}
|
||||
@ -1,29 +0,0 @@
|
||||
;; Initial type
|
||||
(deftype A [])
|
||||
|
||||
;; Initial function
|
||||
(definterface f (λ [x] String))
|
||||
(defmodule A
|
||||
(defn f [x]
|
||||
(str* "It's an A: " &(A.str x))))
|
||||
|
||||
;; Add a new function
|
||||
(definterface g (λ [x] String))
|
||||
(defmodule A
|
||||
(defn g [x]
|
||||
(str* "It's also an A: " &(A.str x))))
|
||||
|
||||
;; Add a new type
|
||||
(deftype B [])
|
||||
(defmodule B
|
||||
(defn f [x]
|
||||
(str* "It's a B: " &(B.str x)))
|
||||
(defn g [x]
|
||||
(str* "It's also a B: " &(B.str x))))
|
||||
|
||||
;; Run
|
||||
(defn-do main []
|
||||
(println* &(f &(A.init)))
|
||||
(println* &(g &(A.init)))
|
||||
(println* &(f &(B.init)))
|
||||
(println* &(g &(B.init))))
|
||||
@ -1,4 +1,4 @@
|
||||
(relative-include "banana.h")
|
||||
(relative-include "headers/banana.h")
|
||||
(Project.no-echo)
|
||||
|
||||
(register-type Apple)
|
||||
|
||||
@ -1,7 +1,6 @@
|
||||
(load "SDL.carp")
|
||||
(load "SDL_ttf.carp")
|
||||
|
||||
;;(Debug.sanitize-addresses)
|
||||
(Project.config "title" "Fonts")
|
||||
|
||||
(def font (the (Ptr TTF_Font) NULL))
|
||||
|
||||
@ -2,6 +2,7 @@
|
||||
(use GLFW)
|
||||
|
||||
(load "OpenGL.carp")
|
||||
(Project.config "cflag" "-DGL_SILENCE_DEPRECATION")
|
||||
|
||||
(defn t []
|
||||
(Double.to-float (get-time)))
|
||||
|
||||
@ -1,178 +0,0 @@
|
||||
(Debug.sanitize-addresses)
|
||||
(Project.config "print-ast" true)
|
||||
|
||||
;; Preventing the usage of a reference to a deleted object
|
||||
;; (defn f []
|
||||
;; (let-do [x @"DATA"
|
||||
;; r &x]
|
||||
;; (delete x)
|
||||
;; (IO.println r)))
|
||||
|
||||
;; Same as above, but deleting the argument
|
||||
;; (defn g [x]
|
||||
;; (let-do [r &x]
|
||||
;; (delete (the String x))
|
||||
;; (IO.println r)))
|
||||
|
||||
;; A function accepting two refs and returning one of them
|
||||
;; (defn two-refs [x a b]
|
||||
;; (if x
|
||||
;; (the (Ref t q) a)
|
||||
;; (the (Ref t w) b)))
|
||||
|
||||
;; Lambdas
|
||||
;; (defn l []
|
||||
;; (let [x @"DATA"
|
||||
;; r &x
|
||||
;; f (fn [] (IO.println r))]
|
||||
;; (do
|
||||
;; (String.delete x)
|
||||
;; (f))))
|
||||
|
||||
;; (defn from-ptr [a]
|
||||
;; (if (null? a)
|
||||
;; (Maybe.Nothing)
|
||||
;; (Maybe.Just @(Pointer.to-ref a))))
|
||||
|
||||
;; (defn pair-eq [p1 p2]
|
||||
;; (and (= (Pair.a p1) (Pair.a p2))
|
||||
;; (= (Pair.b p1) (Pair.b p2)))
|
||||
;; )
|
||||
|
||||
;; (defn map-put []
|
||||
;; (fn [b]
|
||||
;; (let [n &b]
|
||||
;; ())))
|
||||
|
||||
|
||||
;; (defn f [x y]
|
||||
;; (let [s @"hej"
|
||||
;; z 123]
|
||||
;; (Int.+ x y)))
|
||||
|
||||
|
||||
|
||||
;; (defn f []
|
||||
;; &100) ;; TODO: Number literals should create prim var deleter too!
|
||||
|
||||
|
||||
|
||||
;; use-ref-in-lambda-after-free
|
||||
;; (defn boo []
|
||||
;; (let-do [data @"DATA"
|
||||
;; r &data
|
||||
;; f (fn []
|
||||
;; (IO.println (id r)))]
|
||||
;; ;;(String.delete data)
|
||||
;; (f)))
|
||||
|
||||
|
||||
|
||||
;; (defn foo []
|
||||
;; (let-do [data [10 20 30]
|
||||
;; r &data
|
||||
;; f (fn [] (Array.nth r 1))]
|
||||
;; ;;(Array.delete data)
|
||||
;; (println* (f))))
|
||||
|
||||
;; (defn lam []
|
||||
;; (let [stuff [100 200 300]
|
||||
;; ;;r &stuff
|
||||
;; f (fn []
|
||||
;; (println* (id &stuff)))]
|
||||
;; (f)))
|
||||
|
||||
|
||||
|
||||
;; Problematic order of arguments, the variable 'b' will depend on 'snake', which is consumed first in the call to Snake.set-body
|
||||
;; (use Array)
|
||||
;; (deftype Snake [body (Array Int)])
|
||||
|
||||
;; (defn grow [snake]
|
||||
;; (let [b (Snake.body &snake)]
|
||||
;; (Snake.set-body snake (push-back @b 0))))
|
||||
|
||||
;;(unsafe-last b)
|
||||
|
||||
|
||||
;; (defn dangling-1 []
|
||||
;; (let [b [1 2 3]]
|
||||
;; &b))
|
||||
|
||||
;; (defn dangling-2 []
|
||||
;; (let [b [1 2 3]
|
||||
;; r &b]
|
||||
;; r))
|
||||
|
||||
|
||||
;; (defn unique []
|
||||
;; (let [r1 (the &String "DATA")
|
||||
;; r2 (the &String "DATA") ;; should get another lifetime variable than r1
|
||||
;; r3 "DATA"]
|
||||
;; ()))
|
||||
|
||||
|
||||
;; (defn fool [s1 s2]
|
||||
;; (let [r1 (the (Ref String Static) s1)
|
||||
;; r2 (the (Ref String b) s2)]
|
||||
;; (do
|
||||
;; (if (= r1 r2) () ())
|
||||
;; ;;(delete s1)
|
||||
;; ;;(= r1 r2)
|
||||
;; ;;()
|
||||
;; r2)))
|
||||
|
||||
|
||||
;; This should be detected as an error too:
|
||||
;; (defn f [s]
|
||||
;; (let [r &s]
|
||||
;; r))
|
||||
;;(f @"hej")
|
||||
|
||||
|
||||
|
||||
;; (defn magic []
|
||||
;; (let [s @"DATA"]
|
||||
;; &s)) ;; shouldn't work either
|
||||
|
||||
;; (defn simple-fool []
|
||||
;; (let [r (magic) ;; 'magic' returns (Ref String a)
|
||||
;; static (the (Ref String Static) "")]
|
||||
;; (do
|
||||
;; (if (= r static) () ()) ;; shouldn't just be possible to trick 'r' that its lifetime is Static
|
||||
;; ())))
|
||||
|
||||
;; (defn first [xs]
|
||||
;; (Array.nth xs 0))
|
||||
|
||||
;;(defn f [x] (fn [] (IO.println x)))
|
||||
|
||||
|
||||
|
||||
;; (defn g []
|
||||
;; (let-do [s @"DATA"
|
||||
;; r &s
|
||||
;; f (fn [] (IO.println r))]
|
||||
;; ;;(delete s)
|
||||
;; ;;(f)
|
||||
;; f))
|
||||
|
||||
|
||||
|
||||
;; (defn ok [r]
|
||||
;; (let-do [f (fn [] (IO.println r))]
|
||||
;; f))
|
||||
|
||||
|
||||
|
||||
(deftype Blah [x Int])
|
||||
|
||||
(defn trick []
|
||||
(let[s1 (Blah.init 100)
|
||||
r1 &s1
|
||||
g (let [s2 (Blah.init 200)
|
||||
r2 &s2
|
||||
f (fn [] (println* r1 r2))]
|
||||
f)]
|
||||
(g) ;; shouldn't work because 's2' has been deleted and 'r2' is thus a dead reference
|
||||
))
|
||||
@ -1,6 +1,8 @@
|
||||
; this compiles without needing the core libraries (--no-core flag)
|
||||
;; This compiles without needing the core libraries (--no-core flag)
|
||||
|
||||
(system-include "limits.h")
|
||||
(system-include "carp_stdbool.h")
|
||||
|
||||
(load "Interfaces.carp")
|
||||
(load "Bool.carp")
|
||||
(load "Pointer.carp")
|
||||
|
||||
@ -1,41 +0,0 @@
|
||||
// This is a comment
|
||||
void boo();
|
||||
char hoo();
|
||||
// This is also a comment
|
||||
int foo(int x);
|
||||
float goo(double x, double y);
|
||||
|
||||
// some people use too much whitespace
|
||||
float weird ( double x , double y ) ;
|
||||
|
||||
// Struct types
|
||||
vector2 middle(vector2 p1, vector2 p2);
|
||||
|
||||
// Pointers are also useful to parse
|
||||
void gah(int *x);
|
||||
void dah(int *x, float* y);
|
||||
char *blah(int *x, float* y);
|
||||
|
||||
vector2 *more(vector3* in);
|
||||
|
||||
GLFWAPI GLFWwindow* glfwCreateWindow(int width, int height, const char* title, GLFWmonitor* monitor, GLFWwindow* share);
|
||||
|
||||
|
||||
// TODO:
|
||||
GLFWAPI void glfwPollEvents(void);
|
||||
|
||||
|
||||
|
||||
// C Macros
|
||||
|
||||
#define K_BLAH 12345
|
||||
#define K_BLAX 0x123
|
||||
#define K_GLAH 12345
|
||||
|
||||
// C function-like macros
|
||||
|
||||
#define X(a, b) a + b
|
||||
#define Y(a, b) {\
|
||||
foo(a, b);\
|
||||
}
|
||||
#define Z(a, b) "hi"
|
||||
@ -1,80 +0,0 @@
|
||||
(Debug.sanitize-addresses)
|
||||
(Project.config "print-ast" true)
|
||||
|
||||
; (deftype JSON
|
||||
; (Str [String])
|
||||
; (Num [Double])
|
||||
; (Arr [(Array JSON)])
|
||||
; (Obj [(Map String JSON)]))
|
||||
|
||||
;; Refs in structs
|
||||
;; (deftype (Aha a) [x a])
|
||||
;; (def b (Aha.init "bleh"))
|
||||
|
||||
;; Refs in sumtypes
|
||||
;;(def x (Maybe.Just "Heya"))
|
||||
|
||||
;; (defn f []
|
||||
;; (match x
|
||||
;; (Maybe.Just a) a
|
||||
;; (Maybe.Nothing) 0))
|
||||
|
||||
|
||||
|
||||
;; Adding pre-existing functions to interface when it's defined
|
||||
;; (defmodule Foo
|
||||
;; (defn tripoli [x y z] (Int.= 0 (+ x (+ y z)))))
|
||||
|
||||
;; ;; 'foo' will match this interface that is defined AFTER foo
|
||||
;; (definterface tripoli (λ [Int Int Int] Bool))
|
||||
|
||||
;; ;; This should still be added, obviously
|
||||
;; (defmodule Goo
|
||||
;; (defn tripoli [x y z] (Int.= 0 (+ x (+ y z)))))
|
||||
|
||||
|
||||
|
||||
;; Issue #681
|
||||
;; (deftype (X a) [member a])
|
||||
;; (deftype (Y a) [x (X a)])
|
||||
|
||||
;; (defmodule Y
|
||||
;; (defn foo [y]
|
||||
;; (set-x! y (X.init 1))))
|
||||
|
||||
;; (defn main []
|
||||
;; (let [y (Y.init (X.init 10))]
|
||||
;; (Y.foo &y)))
|
||||
|
||||
|
||||
|
||||
;; Nesting match
|
||||
;; (use Maybe)
|
||||
;; (defn main []
|
||||
;; (let [s (Just (Just (Just @"Oh, but hello.")))]
|
||||
;; (match s
|
||||
;; (Just (Just (Just x))) (println* "It's just just just '" &x "'")
|
||||
;; (Just (Just (Nothing))) (IO.println "It's just just nothing.")
|
||||
;; (Just (Nothing)) (IO.println "It's just nothing.")
|
||||
;; (Nothing) (IO.println "Didn't match."))))
|
||||
|
||||
|
||||
;; Match on refs
|
||||
(use Maybe)
|
||||
(defn main []
|
||||
(let [s (Just @"Yo")]
|
||||
(match-ref &s
|
||||
(Just x) (IO.println x)
|
||||
(Nothing) (IO.println "nada"))))
|
||||
|
||||
(defn f []
|
||||
(let [s (Just @"Yo")]
|
||||
(match s
|
||||
(Just x) (IO.println &x)
|
||||
(Nothing) (IO.println "nada"))))
|
||||
|
||||
(defn deep [x]
|
||||
(match-ref x
|
||||
(Nothing) (IO.println "nothing")
|
||||
(Just (Nothing)) (IO.println "just nothing")
|
||||
(Just (Just x)) (IO.println x)))
|
||||
@ -1,11 +0,0 @@
|
||||
(load "Test.carp")
|
||||
(use Test)
|
||||
(use Int)
|
||||
(use String)
|
||||
|
||||
(defn main []
|
||||
(with-test test
|
||||
(assert-equal test 1 2 "1 == 2")
|
||||
(assert-true test (Int.> (Array.length &[1 2 3]) 1) "len([1 2 3]) == 1")
|
||||
(assert-not-equal test "hi" "bye" "hi != bye")
|
||||
(print-test-results test)))
|
||||
@ -25,6 +25,8 @@ else
|
||||
fi
|
||||
fi
|
||||
|
||||
./scripts/carp.sh ./docs/core/generate_core_docs.carp
|
||||
|
||||
mkdir -p "$fullPath"
|
||||
|
||||
echo
|
||||
@ -41,7 +43,7 @@ cp -r "./docs/" "$fullPath/docs/"
|
||||
echo "Copying README.md..."
|
||||
cp -r "./README.md" "$fullPath/README.md"
|
||||
echo "Copying img..."
|
||||
cp -r "./img/" "$fullPath/img/"
|
||||
cp -r "./resources/" "$fullPath/resources/"
|
||||
echo "Copying examples..."
|
||||
cp -r "./examples/" "$fullPath/examples/"
|
||||
|
||||
|
||||
@ -22,11 +22,13 @@ Get-ChildItem -Filter test/*.carp | ForEach-Object -Process {
|
||||
}
|
||||
}
|
||||
|
||||
# TODO Add test for empty project (with and without core)
|
||||
|
||||
# TODO Add tests for error messages
|
||||
|
||||
# Just make sure these compile
|
||||
exitOnError { stack exec carp "--" ./examples/mutual_recursion.carp -b }
|
||||
exitOnError { stack exec carp "--" ./examples/guessing.carp -b }
|
||||
exitOnError { stack exec carp "--" ./examples/guessing_game.carp -b }
|
||||
exitOnError { stack exec carp "--" ./examples/no_core.carp --no-core --no-profile -b }
|
||||
exitOnError { stack exec carp "--" ./examples/check_malloc.carp -b }
|
||||
|
||||
|
||||
@ -11,19 +11,21 @@ fi
|
||||
./scripts/build.sh
|
||||
|
||||
echo "Build and run some examples"
|
||||
./test/execute.sh ./examples/basics.carp
|
||||
./test/execute.sh ./examples/functor.carp
|
||||
./test/execute.sh ./examples/external_struct.carp
|
||||
./test/execute.sh ./examples/updating.carp
|
||||
./test/execute.sh ./examples/sorting.carp
|
||||
./test/execute.sh ./examples/globals.carp
|
||||
./test/execute.sh ./examples/generic_structs.carp
|
||||
./test/execute.sh ./examples/setting_variables.carp
|
||||
./test/execute.sh ./examples/function_members.carp
|
||||
./test/execute.sh ./examples/maps.carp
|
||||
./test/execute.sh ./examples/lambdas.carp
|
||||
./test/execute.sh ./examples/sumtypes.carp
|
||||
|
||||
echo "Build and run some tests that print (check their output)"
|
||||
./test/execute.sh ./test/produces-output/basics.carp
|
||||
./test/execute.sh ./test/produces-output/function_members.carp
|
||||
./test/execute.sh ./test/produces-output/globals.carp
|
||||
./test/execute.sh ./test/produces-output/lambdas.carp
|
||||
./test/execute.sh ./test/produces-output/setting_variables.carp
|
||||
|
||||
echo "Actual tests (using the test suite)"
|
||||
for f in ./test/*.carp; do
|
||||
echo $f
|
||||
@ -37,11 +39,17 @@ for f in ./test-for-errors/*.carp; do
|
||||
./test/check.sh $f
|
||||
done
|
||||
|
||||
echo "Make sure the benchmarks compile."
|
||||
for f in ./bench/*.carp; do
|
||||
echo $f
|
||||
./scripts/carp.sh -b $f
|
||||
done
|
||||
|
||||
echo "Compile-only examples"
|
||||
compileOnlyExamples="\
|
||||
examples/mutual_recursion.carp \
|
||||
examples/guessing.carp \
|
||||
examples/check_malloc.carp \
|
||||
examples/guessing_game.carp \
|
||||
examples/unicode.carp \
|
||||
examples/nested_lambdas.carp
|
||||
"
|
||||
|
||||
@ -50,6 +58,7 @@ for e in $compileOnlyExamples ; do
|
||||
./scripts/carp.sh $e -b
|
||||
done
|
||||
|
||||
# Make sure a no-core build works
|
||||
echo ./examples/no_core.carp
|
||||
./scripts/carp.sh ./examples/no_core.carp --no-core --no-profile -b
|
||||
|
||||
@ -57,13 +66,13 @@ echo ./examples/no_core.carp
|
||||
if [ ${NO_SDL} -eq 0 ]; then
|
||||
echo "Compile-only SDL examples"
|
||||
compileOnlySdlExamples="
|
||||
examples/ant.carp
|
||||
examples/reptile.carp
|
||||
examples/game.carp
|
||||
examples/minimal_sdl.carp
|
||||
examples/sounds.carp
|
||||
examples/fonts.carp
|
||||
"
|
||||
examples/langtons_ant.carp
|
||||
examples/reptile.carp
|
||||
examples/carp_demo.carp
|
||||
examples/minimal_sdl.carp
|
||||
examples/sounds.carp
|
||||
examples/fonts.carp
|
||||
"
|
||||
|
||||
for e in $compileOnlySdlExamples ; do
|
||||
echo $e
|
||||
|
||||
Loading…
Reference in New Issue
Block a user