From a87309964043c8acc6fea55bc06d2515bb6e3160 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Erik=20Sved=C3=A4ng?= Date: Mon, 23 Nov 2020 06:30:43 +0100 Subject: [PATCH] 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 --- core/carp_bench.h | 67 +++++++ examples/arrays.carp | 25 --- examples/benchmark_mandelbrot.carp | 67 ------- examples/benchmark_n-body.carp | 159 ---------------- examples/{game.carp => carp_demo.carp} | 0 examples/check_malloc.carp | 4 - examples/closures.c | 67 ------- examples/expression_problem.carp | 29 --- examples/external_struct.carp | 2 +- examples/fonts.carp | 1 - examples/{life.carp => game_of_life.carp} | 0 examples/glfw.carp | 1 + .../{guessing.carp => guessing_game.carp} | 0 examples/{ => headers}/banana.h | 0 examples/{ant.carp => langtons_ant.carp} | 0 examples/lifetimes.carp | 178 ------------------ examples/no_core.carp | 4 +- examples/parse_me.h | 41 ---- examples/temp.carp | 80 -------- examples/test.carp | 11 -- scripts/release.sh | 4 +- scripts/run_carp_tests.ps1 | 4 +- scripts/run_carp_tests.sh | 37 ++-- .../basics.carp.output.expected | 0 .../function_members.carp.output.expected | 0 .../globals.carp.output.expected | 0 .../lambdas.carp.output.expected | 0 .../setting_variables.carp.output.expected | 0 .../produces-output}/basics.carp | 0 {examples => test/produces-output}/empty.carp | 0 .../produces-output}/function_members.carp | 0 .../produces-output}/globals.carp | 0 .../produces-output}/lambdas.carp | 0 .../produces-output}/setting_variables.carp | 0 34 files changed, 101 insertions(+), 680 deletions(-) delete mode 100644 examples/arrays.carp delete mode 100644 examples/benchmark_mandelbrot.carp delete mode 100644 examples/benchmark_n-body.carp rename examples/{game.carp => carp_demo.carp} (100%) delete mode 100644 examples/check_malloc.carp delete mode 100644 examples/closures.c delete mode 100644 examples/expression_problem.carp rename examples/{life.carp => game_of_life.carp} (100%) rename examples/{guessing.carp => guessing_game.carp} (100%) rename examples/{ => headers}/banana.h (100%) rename examples/{ant.carp => langtons_ant.carp} (100%) delete mode 100644 examples/lifetimes.carp delete mode 100644 examples/parse_me.h delete mode 100644 examples/temp.carp delete mode 100644 examples/test.carp rename test/output/{examples => test/produces-output}/basics.carp.output.expected (100%) rename test/output/{examples => test/produces-output}/function_members.carp.output.expected (100%) rename test/output/{examples => test/produces-output}/globals.carp.output.expected (100%) rename test/output/{examples => test/produces-output}/lambdas.carp.output.expected (100%) rename test/output/{examples => test/produces-output}/setting_variables.carp.output.expected (100%) rename {examples => test/produces-output}/basics.carp (100%) rename {examples => test/produces-output}/empty.carp (100%) rename {examples => test/produces-output}/function_members.carp (100%) rename {examples => test/produces-output}/globals.carp (100%) rename {examples => test/produces-output}/lambdas.carp (100%) rename {examples => test/produces-output}/setting_variables.carp (100%) diff --git a/core/carp_bench.h b/core/carp_bench.h index 1372fe85..e7f0f7be 100644 --- a/core/carp_bench.h +++ b/core/carp_bench.h @@ -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 + +#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); diff --git a/examples/arrays.carp b/examples/arrays.carp deleted file mode 100644 index e690eb9c..00000000 --- a/examples/arrays.carp +++ /dev/null @@ -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))) diff --git a/examples/benchmark_mandelbrot.carp b/examples/benchmark_mandelbrot.carp deleted file mode 100644 index 597ac52a..00000000 --- a/examples/benchmark_mandelbrot.carp +++ /dev/null @@ -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) diff --git a/examples/benchmark_n-body.carp b/examples/benchmark_n-body.carp deleted file mode 100644 index 164b7da1..00000000 --- a/examples/benchmark_n-body.carp +++ /dev/null @@ -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))))) ; diff --git a/examples/game.carp b/examples/carp_demo.carp similarity index 100% rename from examples/game.carp rename to examples/carp_demo.carp diff --git a/examples/check_malloc.carp b/examples/check_malloc.carp deleted file mode 100644 index 03d76135..00000000 --- a/examples/check_malloc.carp +++ /dev/null @@ -1,4 +0,0 @@ -(Debug.check-allocations) - -(defn main [] - (println* &(Array.repeat 10000000 &Int.zero))) diff --git a/examples/closures.c b/examples/closures.c deleted file mode 100644 index 0aea210a..00000000 --- a/examples/closures.c +++ /dev/null @@ -1,67 +0,0 @@ -#include -#include - -// (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); -} diff --git a/examples/expression_problem.carp b/examples/expression_problem.carp deleted file mode 100644 index dd0de592..00000000 --- a/examples/expression_problem.carp +++ /dev/null @@ -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)))) diff --git a/examples/external_struct.carp b/examples/external_struct.carp index 27047bbe..89bd64bb 100644 --- a/examples/external_struct.carp +++ b/examples/external_struct.carp @@ -1,4 +1,4 @@ -(relative-include "banana.h") +(relative-include "headers/banana.h") (Project.no-echo) (register-type Apple) diff --git a/examples/fonts.carp b/examples/fonts.carp index 915c6875..c89abaa6 100644 --- a/examples/fonts.carp +++ b/examples/fonts.carp @@ -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)) diff --git a/examples/life.carp b/examples/game_of_life.carp similarity index 100% rename from examples/life.carp rename to examples/game_of_life.carp diff --git a/examples/glfw.carp b/examples/glfw.carp index e307f9dc..f11faacf 100644 --- a/examples/glfw.carp +++ b/examples/glfw.carp @@ -2,6 +2,7 @@ (use GLFW) (load "OpenGL.carp") +(Project.config "cflag" "-DGL_SILENCE_DEPRECATION") (defn t [] (Double.to-float (get-time))) diff --git a/examples/guessing.carp b/examples/guessing_game.carp similarity index 100% rename from examples/guessing.carp rename to examples/guessing_game.carp diff --git a/examples/banana.h b/examples/headers/banana.h similarity index 100% rename from examples/banana.h rename to examples/headers/banana.h diff --git a/examples/ant.carp b/examples/langtons_ant.carp similarity index 100% rename from examples/ant.carp rename to examples/langtons_ant.carp diff --git a/examples/lifetimes.carp b/examples/lifetimes.carp deleted file mode 100644 index c3d49eb9..00000000 --- a/examples/lifetimes.carp +++ /dev/null @@ -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 - )) diff --git a/examples/no_core.carp b/examples/no_core.carp index 1b2f61a3..e226d405 100644 --- a/examples/no_core.carp +++ b/examples/no_core.carp @@ -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") diff --git a/examples/parse_me.h b/examples/parse_me.h deleted file mode 100644 index 50fe5449..00000000 --- a/examples/parse_me.h +++ /dev/null @@ -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" diff --git a/examples/temp.carp b/examples/temp.carp deleted file mode 100644 index 385953b4..00000000 --- a/examples/temp.carp +++ /dev/null @@ -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))) diff --git a/examples/test.carp b/examples/test.carp deleted file mode 100644 index 873baa08..00000000 --- a/examples/test.carp +++ /dev/null @@ -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))) diff --git a/scripts/release.sh b/scripts/release.sh index 6d8085a7..2acbdd61 100755 --- a/scripts/release.sh +++ b/scripts/release.sh @@ -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/" diff --git a/scripts/run_carp_tests.ps1 b/scripts/run_carp_tests.ps1 index 92873ad2..c011d068 100644 --- a/scripts/run_carp_tests.ps1 +++ b/scripts/run_carp_tests.ps1 @@ -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 } diff --git a/scripts/run_carp_tests.sh b/scripts/run_carp_tests.sh index b31cb6f4..37c9b6b2 100755 --- a/scripts/run_carp_tests.sh +++ b/scripts/run_carp_tests.sh @@ -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 diff --git a/test/output/examples/basics.carp.output.expected b/test/output/test/produces-output/basics.carp.output.expected similarity index 100% rename from test/output/examples/basics.carp.output.expected rename to test/output/test/produces-output/basics.carp.output.expected diff --git a/test/output/examples/function_members.carp.output.expected b/test/output/test/produces-output/function_members.carp.output.expected similarity index 100% rename from test/output/examples/function_members.carp.output.expected rename to test/output/test/produces-output/function_members.carp.output.expected diff --git a/test/output/examples/globals.carp.output.expected b/test/output/test/produces-output/globals.carp.output.expected similarity index 100% rename from test/output/examples/globals.carp.output.expected rename to test/output/test/produces-output/globals.carp.output.expected diff --git a/test/output/examples/lambdas.carp.output.expected b/test/output/test/produces-output/lambdas.carp.output.expected similarity index 100% rename from test/output/examples/lambdas.carp.output.expected rename to test/output/test/produces-output/lambdas.carp.output.expected diff --git a/test/output/examples/setting_variables.carp.output.expected b/test/output/test/produces-output/setting_variables.carp.output.expected similarity index 100% rename from test/output/examples/setting_variables.carp.output.expected rename to test/output/test/produces-output/setting_variables.carp.output.expected diff --git a/examples/basics.carp b/test/produces-output/basics.carp similarity index 100% rename from examples/basics.carp rename to test/produces-output/basics.carp diff --git a/examples/empty.carp b/test/produces-output/empty.carp similarity index 100% rename from examples/empty.carp rename to test/produces-output/empty.carp diff --git a/examples/function_members.carp b/test/produces-output/function_members.carp similarity index 100% rename from examples/function_members.carp rename to test/produces-output/function_members.carp diff --git a/examples/globals.carp b/test/produces-output/globals.carp similarity index 100% rename from examples/globals.carp rename to test/produces-output/globals.carp diff --git a/examples/lambdas.carp b/test/produces-output/lambdas.carp similarity index 100% rename from examples/lambdas.carp rename to test/produces-output/lambdas.carp diff --git a/examples/setting_variables.carp b/test/produces-output/setting_variables.carp similarity index 100% rename from examples/setting_variables.carp rename to test/produces-output/setting_variables.carp