c

Author: alex-s168

.github/workflows/rust.yml

@@ -16,9 +16,7 @@ jobs:
 
     steps:
     - uses: actions/checkout@v3
-    - name: Build
-      run: cargo build --verbose
     - name: Run tests
-      run: cargo test --verbose
+      run: shopt -s expand_aliases && alias cc='clang' &&  cargo test --verbose
     - name: Run deploy
-      run: make deploy-lite
+      run: make deploy-lite CC=clang

BOOTSTRAP/cli.c

@@ -1,12 +1,14 @@
 CC = cc
+CFLAGS = -O3 -march=native -mtune=native
 
 dev: install-production
-	lm SRC/index-index.lm
+	lm tests/regress/seq-macro.lm
 	cc tmp.c
+	./a.out
 
 build: compile-production
 	time ./production --c -o deploy1.c SRC/index-index.lm
-	$(CC) -O3 deploy1.c -o deploy1
+	$(CC) $(CFLAGS) deploy1.c -o deploy1
 	time ./deploy1 --c -o deploy2.c SRC/index-index.lm
 	diff deploy1.c deploy2.c
 	mv deploy1.c BOOTSTRAP/cli.c
@@ -16,8 +18,14 @@ build: compile-production
 deploy: build smoke-test
 deploy-lite: build smoke-test-lite
 
+valgrind: install-bootstrap
+	valgrind --tool=callgrind lm SRC/index-index.lm
+
+valgrind-view:
+	callgrind_annotate callgrind.out.6386
+
 gprof:
-	$(CC) -O3 -pg -o bootstrap.exe BOOTSTRAP/cli.c
+	$(CC) $(CFLAGS) -pg -o bootstrap.exe BOOTSTRAP/cli.c
 	./bootstrap.exe SRC/index-index.lm
 
 gprof-view-count:
@@ -32,12 +40,12 @@ profile: install-bootstrap
 
 compile-bootstrap:
 	rm -f bootstrap.exe
-	$(CC) -O3 -o bootstrap.exe BOOTSTRAP/cli.c
+	$(CC) $(CFLAGS) -o bootstrap.exe BOOTSTRAP/cli.c
 
 compile-production: compile-bootstrap
 	rm -f production
 	./bootstrap.exe --c -o production.c SRC/index-index.lm
-	$(CC) -O3 -o production production.c
+	$(CC) $(CFLAGS) -o production production.c
 	rm -f production.c
 
 install-production: compile-production
@@ -72,7 +80,7 @@ smoke-test: smoke-test-clang smoke-test-gcc smoke-test-musl
 smoke-test-lite: smoke-test-clang smoke-test-gcc
 
 install:
-	$(CC) -O3 -o lm BOOTSTRAP/cli.c
+	$(CC) $(CFLAGS) -o lm BOOTSTRAP/cli.c
 ifeq ($(shell test -w /usr/local/bin; echo $$?), 0)
 	mv lm /usr/local/bin/lm
 else

Makefile

@@ -27,22 +27,42 @@ declare-unop( $"&", raw-type(t), raw-type(t[]), (l"(&"; x; l")";) );
 declare-unop( raw, raw-type(t), raw-type(t), x );
 declare-unop( raw, raw-type(base-type[]), raw-type(base-type[]+Raw), x );
 
+let mark-memory-as-safe(ptr: t[], len: U64): Nil = (
+   # BEFORE CHANGING THIS: talk to alex
+
+   while len > 0_u64 {
+      let ignored = ptr[0_u64];
+      len = len - 1_u64;
+      ptr = ((ptr as U8[]) + sizeof(t)) as t[];
+   };
+);
+
+## this will fail if len is 0
 let safe-alloc(len: U64, ty: Type<t>): t[] = (
+   # BEFORE CHANGING THIS: talk to alex
+
    let nb = len * sizeof(t);
-   let ptr = malloc(nb);
+   let ptr = malloc(nb) as t[];
    if ptr as U64 == 0_u64 {
       fail("malloc(\{nb}) fail");
    };
-   ptr as t[]
+
+   mark-memory-as-safe(ptr, len);
+   ptr
 );
 
+## this will fail if len is 0
 let safe-realloc(ptr: t[], len: U64, ty: Type<t>): t[] = (
+   # BEFORE CHANGING THIS: talk to alex
+
    let nb = len * sizeof(t);
-   let new_ptr = realloc(ptr as ?[], nb);
+   let new_ptr = realloc(ptr as ?[], nb) as t[];
    if new_ptr as U64 == 0_u64 {
       fail("realloc(\{nb}) fail");
    };
-   new_ptr as t[]
+
+   mark-memory-as-safe(new_ptr, len);
+   new_ptr
 );
 
 let close(x: p): p[] = (

PLATFORM/C/LIB/array.lsts

@@ -49,6 +49,16 @@ macro ( ('for-each (item 'in iter) loop) ) (
    )))
 );
 
+macro ( ('for-each-v (item 'in iter) loop) ) (
+   (let (uuid iter-term) iter)
+   (let (uuid iter-i) 0_u64)
+   (let (uuid iter-length) (.length (uuid iter-term)))
+   (while (<( (uuid iter-i) (uuid iter-length))) (match ([]( (uuid iter-term) (uuid iter-i) )) (
+      ()
+      (item( loop (set (uuid iter-i) (+( (uuid iter-i) 1_u64 )) ) ))
+   )))
+);
+
 for-arg-i := λ: Blob(: vi x...). (: () x);
 macro ( ('for-arg (item 'in iter) loop) ) (
    (scope('for-arg_r (

PLATFORM/C/LIB/common-macros.lm

@@ -1,14 +1,19 @@
 
 ## faster than [type(List<t>)]. should be used when you append or remove data a lot
-type Vector<t> = Vector { data: t[], length: U64, capacity: U64 };
+type Vector<t> = Vector { data: t[], _length: U32, capacity: U32 };
 type Vector<t> implements Collection<t>;
 
-let mk-vector(ty: Type<t>): Vector<t> = (
-   mk-vector(ty, 0_u64)
+let .length(v: Vector<t>): U64 = (
+   v._length
 );
 
 let mk-vector(type: Type<t>, capacity: U64): Vector<t> = (
-   Vector { safe-alloc(capacity, type(t)), 0_u64, capacity }
+   let ptr = if (capacity == 0_u64) then (0_u64 as t[]) else (safe-alloc(capacity, type(t)));
+   Vector { ptr, 0_u32, capacity as U32 }
+);
+
+let mk-vector(ty: Type<t>): Vector<t> = (
+   mk-vector(ty, 0_u64)
 );
 
 ## generate a [type(Vector<t>)], in which each element is [value]
@@ -23,14 +28,14 @@ let fill-vector(value: t, len: U64): Vector<t> = (
 
 ## does not change the length length, or destroy old elements!
 let .realloc(v: Vector<t>, target-capacity: U64): Vector<t> = (
-   let newp = safe-realloc(v.data, target-capacity, type(t));
-   Vector { newp, v.length, target-capacity }
+   let newp = if (target-capacity == 0_u64) then (0_u64 as t[]) else (safe-realloc(v.data, target-capacity, type(t)));
+   Vector { newp, v.length as U32, target-capacity as U32 }
 );
 
 ## reserve additional num elements to the current length
 let .reserve-additional(v: Vector<t>, additional: U64): Vector<t> = (
-   if (v.capacity - v.length) < additional {
-      v.realloc(v.length + additional)
+   if (v.capacity - v.length) < additional as U32 {
+      v.realloc((v.length as U64) + additional)
    } else {
       v
    }
@@ -42,12 +47,12 @@ let .push(v: Vector<t>, i: t): Vector<t> = (
       let new-cap = if v.capacity == 0 {
          4_u64
       } else {
-         (v.length >> 1_u64) + v.length # this is mul 1.5, not 3
+         (v.length >> 1_u32) + v.length # this is mul 1.5, not 3
       };
-      v = v.realloc(new-cap);
+      v = v.realloc(new-cap as U64);
    };
-   v.data[v.length] = i;
-   v.length = v.length + 1_u64;
+   v.data[v.length as U64] = i;
+   v._length = v._length + 1_u32;
    v
 );
 
@@ -80,7 +85,7 @@ let .remove-front(v: Vector<t>, num: U64): Vector<t> = (
         v[i-num] = v[i];
         i = i + 1;
     };
-    v.length = v.length - num;
+    v._length = v._length - (num as U32);
 
     v.shrink();
 );
@@ -91,7 +96,7 @@ let .remove-back(v: Vector<t>, num: U64): Vector<t> = (
         fail("tried to remove \{num} elements from vector, but only have \{v.length()}");
     };
 
-    v.length = v.length - num;
+    v._length = v._length - (num as U32);
 
     v.shrink();
 );
@@ -115,14 +120,14 @@ let .pop(v: Vector<t>): Tuple<Vector<t>, t> = (
     };
 
     let lasti = v.length - 1;
-    let last = v[lasti];
+    let last = v[lasti as U64];
     v = v.remove-back(1);
 
     Tuple { v, last }
 );
 
 let $"[]"( v: Vector<t>, i: U64 ): t = (
-   if i >= v.length {
+   if i >= (v.length as U64) {
       fail("Vector Index Out of Bounds");
    };
    v.data[i]
@@ -131,9 +136,9 @@ let $"[]"( v: Vector<t>, i: U64 ): t = (
 let $"+"( vl: Vector<t>, vr: Vector<t> ): t = (
    let v = mk-vector(type(t), vl.length + vr.length);
    let vi = 0_u64;
-   while vi < vl.length { v = v.push(vl[vi]); };
+   while vi < (vl.length as U64) { v = v.push(vl[vi]); vi = vi + 1; };
    vi = 0_u64;
-   while vi < vr.length { v = v.push(vr[vi]); };
+   while vi < (vr.length as U64) { v = v.push(vr[vi]); vi = vi + 1; };
    v
 );
 

PLATFORM/C/LIB/vector.lsts

@@ -59,8 +59,8 @@ is-incomplete-typedef := λ(: tt Type). (: (
       ( (TGround( 'Cons_s (LCons( p1 (LCons( p2 LEOF )) )) )) (
          (set r (||( (is-incomplete-typedef p1) (is-incomplete-typedef p2) )))
       ))
-      ( (TAnd( lt rt )) (
-         (set r (||( (is-incomplete-typedef lt) (is-incomplete-typedef rt) )))
+      ( (TAnd( conjugate )) (
+         (for-each-v (c in conjugate) (set r (||( r (is-incomplete-typedef c) ))))
       ))
       ( TAny () )
       ( (TVar _) () )

PLUGINS/BACKEND/C/compile-c-typedef.lm

@@ -41,12 +41,12 @@ compile-expr-direct := λ(: ctx FContext)(: term AST)(: stack-offset I64)(: used
                 (+( (mangle-c-type tt) (SAtom '\]\]_s) ))
             ))
          )))
-         (let et (TAnd( 
-            (close(t1 'Literal_s))
-            (close(TAnd(
-               (close(t1 'Constant_s))
-               (close(t1 'U64_s))
-            )))
+         (let et (&&(
+            (t1 'Literal_s)
+            (&&(
+               (t1 'Constant_s)
+               (t1 'U64_s)
+            ))
          )))
          (set.type( e et ))
          (set.context( e (close ctx) ))

PLUGINS/BACKEND/C/compile-expr-direct.lm

@@ -3,7 +3,11 @@ is-const-array := λ(: tt Type). (: (
    (let r 0_u64)
    (match tt (
       ()
-      ( (TAnd( t1 t2 )) (set r (||( (is-const-array( t1 )) (is-const-array( t2 )) ))) )
+      ( (TAnd( conjugate )) (
+         (for-each-v (c in conjugate) (
+            (set r (||( r (is-const-array( c )) )))
+         ))
+      ))
       ( (TGround( 'Array_s (LCons( (TGround( 'CONST_s _ )) (LCons( array-base _ )) )) )) (set r 1_u64) )
       ( _ () )
    ))

PLUGINS/BACKEND/C/is-const-array.lm

@@ -10,9 +10,10 @@ mangle-c-type-internal := λ(: tt Type). (: (
    (let r SNil)
    (match tt (
       ()
-      ( (TAnd( lt rt )) (
-         (set r (mangle-c-type lt))
-         (if (non-zero r) () (set r (mangle-c-type rt)))
+      ( (TAnd( conjugate )) (
+         (for-each-v (c in conjugate) (
+            (if (non-zero r) () (set r (mangle-c-type c)))
+         ))
       ))
       ( TAny (set r (SAtom 'void_s)) )
       ( (TVar _) () )