lambda-mountain/lib/std/array.lsts at 21fa8396f5d0a47735d913fb9493359249c50d0b · andrew4328/lambda-mountain · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102

declare-binop( $"!=", raw-type(base-type[]), raw-type(base-type[]), raw-type(U64), ( l"("; x; l"!="; y; l")"; ) );
declare-binop( $"==", raw-type(base-type[]), raw-type(base-type[]), raw-type(U64), ( l"("; x; l"=="; y; l")"; ) );
declare-binop( $"<",  raw-type(base-type[]), raw-type(base-type[]), raw-type(U64), ( l"("; x; l"<"; y; l")"; ) );
declare-binop( $"<=", raw-type(base-type[]), raw-type(base-type[]), raw-type(U64), ( l"("; x; l"<="; y; l")"; ) );
declare-binop( $">",  raw-type(base-type[]), raw-type(base-type[]), raw-type(U64), ( l"("; x; l">"; y; l")"; ) );
declare-binop( $">=", raw-type(base-type[]), raw-type(base-type[]), raw-type(U64), ( l"("; x; l">="; y; l")"; ) );

declare-binop( $"+", raw-type(base-type[]), raw-type(U64), raw-type(base-type[]), ( l"("; x; l"+"; y; l")"; ) );
declare-binop( $"+", raw-type(base-type[]), raw-type(ISize), raw-type(base-type[]), ( l"("; x; l"+"; y; l")"; ) );
declare-binop( $"-", raw-type(base-type[]), raw-type(U64), raw-type(base-type[]), ( l"("; x; l"-"; y; l")"; ) );
declare-binop( $"-", raw-type(base-type[]), raw-type(ISize), raw-type(base-type[]), ( l"("; x; l"-"; y; l")"; ) );
declare-binop( $"-", raw-type(base-type[]), raw-type(base-type[]), raw-type(U64), ( l"("; x; l"-"; y; l")"; ) );

declare-unop( not, raw-type(base-type[]), raw-type(U64), ( l"(!"; x; l")"; ) );

declare-unop( into-branch-conditional, raw-type(base-type[]), raw-type(U64), x );

declare-binop( $"[]", raw-type(base-type[]), raw-type(U64), raw-type(base-type), ( l"("; x; l"["; y; l"])"; ) );
declare-ternop( $"set[]", raw-type(base-type[]), raw-type(U64), raw-type(base-type), raw-type(base-type), ( l"("; x; l"["; y; l"]="; z; l")"; ) );

declare-unop( open, raw-type(t), raw-type(t), x );
declare-unop( open, raw-type(base-type[]), raw-type(base-type), (l"(*"; x; l")";) );
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 );

# TODO: configure this with conditional compilation to remove if unused
# EXAMPLE: # if CFG.debug
#          let safe-alloc-block-count = 0_u64;
#          let safe-alloc-block-count-monotonic = 0_u64;
#          # endif
# safe-alloc-block-count is an increment/decrement counter to track active malloc blocks
# safe-alloc-block-count-monotonic is an increment-only counter to track historical malloc blocks
let safe-alloc-block-count = 0_u64;
let safe-alloc-block-count-monotonic = 0_u64;

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[]) + 1) as t[];
   };
);

let safe-alloc-impl(nb: U64): ?[] = (
   # BEFORE CHANGING THIS: talk to alex

   let ptr = malloc(nb);
   if ptr as U64 == 0_u64 {
      fail("malloc \{nb}B fail");
   };

   mark-memory-as-safe(ptr as U8[], nb);

   # TODO: wrap counter adjustments in conditional compilation
   safe-alloc-block-count = safe-alloc-block-count + 1;
   safe-alloc-block-count-monotonic = safe-alloc-block-count-monotonic + 1;

   ptr
);

let safe-realloc-impl(ptr: ?[], nb: U64): ?[] = (
   # BEFORE CHANGING THIS: talk to alex

   let new_ptr = realloc(ptr, nb) as ?[];
   if new_ptr as U64 == 0_u64 {
      fail("realloc to \{nb}B fail");
   };

   mark-memory-as-safe(new_ptr as U8[], nb);

   # TODO: wrap counter adjustments in conditional compilation
   safe-alloc-block-count-monotonic = safe-alloc-block-count-monotonic + 1;

   new_ptr
);

## 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);
   safe-alloc-impl(nb) as t[]
);

## 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);
   safe-realloc-impl(ptr as ?[], nb) as t[]
);

let close(x: p): p[] = (
   let r = safe-alloc(1_u64, type(p));
   r[0_u64] = x;
   r
);