stdlib/start.ajla

   1 {*
   2  * Copyright (C) 2024 Mikulas Patocka
   3  *
   4  * This file is part of Ajla.
   5  *
   6  * Ajla is free software: you can redistribute it and/or modify it under the
   7  * terms of the GNU General Public License as published by the Free Software
   8  * Foundation, either version 3 of the License, or (at your option) any later
   9  * version.
  10  *
  11  * Ajla is distributed in the hope that it will be useful, but WITHOUT ANY
  12  * WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  13  * A PARTICULAR PURPOSE. See the GNU General Public License for more details.
  14  *
  15  * You should have received a copy of the GNU General Public License along with
  16  * Ajla. If not, see <https://www.gnu.org/licenses/>.
  17  *}
  18
  19 private unit start;
  20
  21 uses io;
  22
  23 fn start : world;
  24
  25 implementation
  26
  27 uses treemap;
  28 uses spawn;
  29 uses pcode;
  30 uses charset;
  31 uses compiler.compiler;
  32
  33 fn std_handles(w : world) : (world, list(handle))
  34 [
  35         var w2 : world;
  36         var n : int;
  37         pcode IO IO_N_Std_Handles 2 1 0 =w2 =n w;
  38         w := w2;
  39         var h := empty(handle);
  40         for i := 0 to n do [
  41                 var w3 : world;
  42                 var hndl : handle;
  43                 pcode IO IO_Get_Std_Handle 2 2 0 =w3 =hndl w i;
  44                 w := w3;
  45                 h +<= hndl;
  46         ]
  47         return w, h;
  48 ]
  49
  50 fn get_environment_string(w : world) : (world, bytes)
  51 [
  52         var env : bytes;
  53         var w2 : world;
  54         pcode IO IO_Get_Environment 2 1 0 =w2 =env w;
  55         return w2, env;
  56 ]
  57
  58 fn env_string_to_map(b : bytes) : treemap(bytes, bytes)
  59 [
  60         implicit var m := treemap_init(bytes, bytes);
  61         var e := list_break(b, 0);
  62         for i := 0 to len(e) do [
  63                 var l := e[i];
  64                 var eq := list_search(l, '=');
  65                 if eq = -1 then
  66                         continue;
  67                 var name := l[ .. eq];
  68                 var value := l[eq + 1 .. ];
  69                 treemap_insert(name, value);
  70         ]
  71 ]
  72
  73 fn get_sub~spark(f : uint64) : list(uint64)
  74 [
  75         var sub_f : list(uint64);
  76         pcode IO IO_Get_SubFunctions 1 1 0 =sub_f f;
  77         return sub_f;
  78 ]
  79
  80 fn extract_modules(path_idx : int, file : bytes, program : bool) : list(tuple2(int, istring))
  81 [
  82         //eval debug("preparsing: " + file);
  83         var opt := empty(list(pcode_t));
  84         var pcl, modules := compile_module~save(libpath, path_idx, file, program);
  85         pcode IO IO_Deep_Eval 1 1 0 =pcl pcl;
  86         xeval pcl;
  87         var r := empty(tuple2(int, istring));
  88         for i := 0 to len(modules) do [
  89                 if modules[i].path_index > 0 then
  90                         r +<= mktuple2(modules[i].path_index, modules[i].unit_string);
  91         ]
  92         return r;
  93 ]
  94
  95 fn preparse(w : world, file : bytes) : world
  96 [
  97         if list_ends_with(file, ".ajla") then
  98                 file := file[ .. len(file) - 5];
  99         var lp := libpath;
 100         var idx := 0;
 101         for i := 0 to len(lp) do
 102                 if lp[i] = 0 then
 103                         idx += 1;
 104         var queue := [ extract_modules~spark(idx - 1, file, true) ];
 105         var mod_visited := treeset_from_list([ mktuple2(1, i_encode(file)) ]);
 106         while len_greater_than(queue, 0) do [
 107                 var idx := any_list(queue);
 108                 var m := queue[idx];
 109                 queue := queue[ .. idx] + queue[idx + 1 .. ];
 110                 for i := 0 to len(m) do [
 111                         var t := m[i];
 112                         if not treeset_test(mod_visited, t) then [
 113                                 mod_visited := treeset_set(mod_visited, t);
 114                                 var ml := extract_modules~spark(t.v1, i_decode(t.v2), false);
 115                                 queue +<= ml;
 116                         ]
 117                 ]
 118         ]
 119         return w;
 120 ]
 121
 122 fn precompile(w : world, main : main_function_type) : world
 123 [
 124         var main_ptr : uint64;
 125         pcode IO IO_Get_Function_Ptr 1 1 0 =main_ptr main;
 126
 127         var visited := treeset_from_list([ main_ptr ]);
 128         var queue := [ get_sub(main_ptr) ];
 129
 130         while len_greater_than(queue, 0) do [
 131                 //eval debug("queue size: " + ntos(len(queue)));
 132                 var idx := any_list(queue);
 133                 var q := queue[idx];
 134                 queue := queue[ .. idx] + queue[idx + 1 .. ];
 135                 for i := 0 to len(q) do [
 136                         var p := q[i];
 137                         if not treeset_test(visited, p) then [
 138                                 visited := treeset_set(visited, p);
 139                                 queue +<= get_sub(p);
 140                         ]
 141                 ]
 142         ]
 143
 144         return w;
 145 ]
 146
 147 {fn lmbd(implicit w : world, h : list(handle)) : world
 148 [
 149         var l := lambda(a : int, b : int) : int [ return a + b + lambda : int [ return 10; ]; ];
 150         var m := lambda(a : int, b : int) : int [ return a + b + lambda : int [ return 10; ]; ];
 151         write(h[1], ntos(l(2, 3) + m(1, 2)) + nl);
 152 ]}
 153
 154 fn start : world
 155 [
 156         var w := unsafe_get_world;
 157
 158         var h : list(handle);
 159         w, h := std_handles(w);
 160
 161         //w := lmbd(w, h);
 162
 163         var env_string : bytes;
 164         w, env_string := get_environment_string(w);
 165         var env := env_string_to_map~lazy(env_string);
 166
 167         var args := get_args(w);
 168         if len(args) = 0 then [
 169                 var loc := locale_console_init(env);
 170                 w := write(w, h[1], "Ajla " + uname(uname_flag_ajla_version)[0] + nl);
 171                 w := write(w, h[1], string_to_locale(loc, `Copyright (C) 2024 Mikuláš Patočka`) + nl);
 172                 w := write(w, h[1], nl);
 173                 w := write(w, h[1], "Ajla is free software: you can redistribute it and/or modify it under the terms" + nl);
 174                 w := write(w, h[1], "of the GNU General Public License as published by the Free Software Foundation," + nl);
 175                 w := write(w, h[1], "either version 3 of the License, or (at your option) any later version." + nl);
 176                 w := write(w, h[1], nl);
 177                 w := write(w, h[1], "Ajla is distributed in the hope that it will be useful, but WITHOUT ANY" + nl);
 178                 w := write(w, h[1], "WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A" + nl);
 179                 w := write(w, h[1], "PARTICULAR PURPOSE. See the GNU General Public License for more details." + nl);
 180                 w := write(w, h[1], nl);
 181                 w := write(w, h[1], "You should have received a copy of the GNU General Public License along with" + nl);
 182                 w := write(w, h[1], "Ajla. If not, see <https://www.gnu.org/licenses/>." + nl);
 183                 w := write(w, h[1], nl);
 184
 185                 abort exit_msg(w, 127, "No arguments");
 186         ]
 187
 188         var program := args[0];
 189         w, program := path_canonical(w, dcwd(w), program);
 190
 191         var main : main_function_type;
 192         w, main := load_program(w, program);
 193
 194         if sysprop(SystemProperty_Compile) <> 0 then [
 195                 var w1 := preparse~spark(w, program);
 196                 var w2 := precompile~spark(w, main);
 197                 w := join(w1, w2);
 198                 return w;
 199         ]
 200
 201         w := main(w, dcwd(w), h, args[1 .. ], env);
 202
 203         return w;
 204 ]