Add open_in and close_in

main.ml

@@ -2864,6 +2864,8 @@ let rec generate (letfuncs, strings, typedefs, exps) =
     gen_c_func "aqaml_printf_ksprintf5"
       [CTyPtr; CTyPtr; CTyPtr; CTyPtr; CTyPtr; CTyPtr]
       CTyPtr ;
+    gen_c_func "aqaml_get_stdin" [CTyUnit] CTyPtr ;
+    gen_c_func "aqaml_close_in" [CTyPtr] CTyUnit ;
     appstr buf "aqaml_input_char:" ;
     let exit_label = make_label () in
     appstr buf "mov rdi, rax" ;
@@ -2874,6 +2876,18 @@ let rec generate (letfuncs, strings, typedefs, exps) =
     appfmt buf "%s:" exit_label ;
     appstr buf "ret" ;
     appstr buf "" ;
+    appstr buf "aqaml_open_in:" ;
+    let exit_label = make_label () in
+    appstr buf "mov rdi, rax" ;
+    appstr buf "call aqaml_open_in_detail@PLT" ;
+    appstr buf "cmp rax, 0" ;
+    appfmt buf "jne %s" exit_label ;
+    (* TODO: raise 'No such file or directory *)
+    appstr buf "mov rax, 0" ;
+    appstr buf @@ gen_raise_exp_of "Sys_error" true ;
+    appfmt buf "%s:" exit_label ;
+    appstr buf "ret" ;
+    appstr buf "" ;
     appstr buf "aqaml_structural_inequal:" ;
     appstr buf "mov rdi, rax" ;
     appstr buf "mov rsi, rbx" ;

stdlib.ml

@@ -20,12 +20,20 @@ exception Not_found
 
 exception Failure of string
 
+exception Sys_error of string
+
 type in_channel = {descriptor: int}
 
-let stdin = {descriptor= 0}
+external _aqaml_get_stdin : unit -> in_channel = "aqaml_get_stdin"
+
+let stdin = _aqaml_get_stdin ()
 
 external input_char : in_channel -> char = "aqaml_input_char"
 
+external open_in : string -> in_channel = "aqaml_open_in"
+
+external close_in : string -> in_channel = "aqaml_close_in"
+
 type 'a option = Some of 'a | None
 
 let ignore _ = ()

test.ml

@@ -1633,3 +1633,9 @@ let sub x y = x - y
 
 ;;
 test (10 |> add 2 |> sub 8) (-4)
+
+;;
+let ch = open_in "test.ml" in
+test (input_char ch) 'l' ;
+test (input_char ch) 'e' ;
+close_in ch

utility.c

@@ -207,13 +207,40 @@ void aqaml_prerr_string_detail(uint64_t ptr)
     for (uint64_t i = 0; i < length; i++) fputc(val.string->str[i], stderr);
 }
 
+uint64_t aqaml_open_in_detail(uint64_t path_src)
+{
+    AQamlValue path = get_value(path_src);
+    assert(path.kind == AQAML_STRING);
+    FILE *fp = fopen((char *)(path.string->str), "r");
+    if (fp == NULL) return 0;
+    uint64_t ret_src = aqaml_alloc_block(1, 0, 247);
+    AQamlValue ret = get_value(ret_src);
+    ret.array->data[0] = (uint64_t)fp;
+    return ret_src;
+}
+
+void aqaml_close_in_detail(uint64_t chan_src)
+{
+    AQamlValue chan = get_value(chan_src);
+    assert(chan.kind == AQAML_ARRAY);
+    FILE *fp = (FILE *)(chan.array->data[0]);
+    fclose(fp);
+}
+
+uint64_t aqaml_get_stdin_detail()
+{
+    uint64_t ret_src = aqaml_alloc_block(1, 0, 247);
+    AQamlValue ret = get_value(ret_src);
+    ret.array->data[0] = (uint64_t)stdin;
+    return ret_src;
+}
+
 uint64_t aqaml_input_char_detail(uint64_t ptr)
 {
     AQamlValue chan = get_value(ptr);
     assert(chan.kind == AQAML_ARRAY);
-    uint64_t fd = chan.array->data[0] >> 1;
-    assert(fd == 0);  // TODO: other in_channel
-    int ch = fgetc(stdin);
+    FILE *fp = (FILE *)(chan.array->data[0]);
+    int ch = fgetc(fp);
     if (ch == EOF) return -1;
     return ((uint64_t)ch << 1) | 1;
 }