Compare commits

...

2 Commits

Author SHA1 Message Date
Steve Biedermann e1be190beb step 2026-04-29 18:35:55 +02:00
Steve Biedermann fd00f725f5 step 2026-04-29 18:15:08 +02:00
12 changed files with 169 additions and 18 deletions

View File

@ -1,11 +1,5 @@
type generator = Json | C type generator = Json | C
let read_file path =
let ic = open_in_bin path in
Fun.protect
~finally:(fun () -> close_in ic)
(fun () -> really_input_string ic (in_channel_length ic))
let write_file path content = let write_file path content =
let oc = open_out_bin path in let oc = open_out_bin path in
Fun.protect Fun.protect
@ -36,14 +30,8 @@ let () =
prerr_endline "Missing required --input argument."; prerr_endline "Missing required --input argument.";
Arg.usage specs usage; Arg.usage specs usage;
exit 2); exit 2);
let src =
try read_file !input_path
with Sys_error msg ->
prerr_endline ("Input error: " ^ msg);
exit 1
in
let ast = let ast =
match Spooky.parse_string src with match Spooky.parse_file !input_path with
| Error msg -> | Error msg ->
prerr_endline msg; prerr_endline msg;
exit 1 exit 1

View File

@ -0,0 +1,3 @@
int add(int a, int b) {
return a + b;
}

View File

@ -0,0 +1,4 @@
struct Point {
int x;
int y;
};

View File

@ -12,7 +12,7 @@ int sum_array(int[] arr) {
} }
int main() { int main() {
struct Point p; Point p;
int[] nums; int[] nums;
int x = 1 + 2 * 3; int x = 1 + 2 * 3;
p.x = x; p.x = x;

View File

@ -0,0 +1,9 @@
import "modules/types.spooky";
import "modules/math.spooky";
int main() {
Point p;
p.x = 1;
p.y = 2;
return add(p.x, p.y);
}

79
lib/module_system.ml Normal file
View File

@ -0,0 +1,79 @@
module StringSet = Set.Make (String)
let starts_with ~prefix s =
let lp = String.length prefix in
String.length s >= lp && String.sub s 0 lp = prefix
let trim = String.trim
let parse_import_line line =
let t = trim line in
if not (starts_with ~prefix:"import" t) then None
else
let rest = trim (String.sub t 6 (String.length t - 6)) in
if String.length rest < 2 || rest.[0] <> '"' then
Some (Error ("malformed import: " ^ line))
else
try
let q2 = String.index_from rest 1 '"' in
let path = String.sub rest 1 (q2 - 1) in
let tail = trim (String.sub rest (q2 + 1) (String.length rest - q2 - 1)) in
let valid_tail =
String.equal tail ";"
|| String.equal tail ""
|| (starts_with ~prefix:";" tail && starts_with ~prefix:"//" (trim (String.sub tail 1 (String.length tail - 1))))
in
if not valid_tail then Some (Error ("malformed import terminator: " ^ line)) else Some (Ok path)
with Not_found -> Some (Error ("unterminated import string: " ^ line))
let read_file path =
let ic = open_in_bin path in
Fun.protect
~finally:(fun () -> close_in ic)
(fun () -> really_input_string ic (in_channel_length ic))
let resolve_path ~from_dir p = if Filename.is_relative p then Filename.concat from_dir p else p
let load_source_with_imports entry_path =
let rec load_file stack visited path =
if List.mem path stack then
Error ("import cycle detected at: " ^ path)
else if StringSet.mem path visited then Ok (visited, "")
else
let content =
try Ok (read_file path) with Sys_error msg -> Error ("cannot read " ^ path ^ ": " ^ msg)
in
match content with
| Error _ as e -> e
| Ok content ->
let dir = Filename.dirname path in
let lines = String.split_on_char '\n' content in
let rec scan imports body = function
| [] -> Ok (List.rev imports, List.rev body)
| ln :: tl ->
(match parse_import_line ln with
| None -> scan imports (ln :: body) tl
| Some (Ok p) -> scan (p :: imports) body tl
| Some (Error e) -> Error e)
in
(match scan [] [] lines with
| Error _ as e -> e
| Ok (imports, body_lines) ->
let rec load_imports vis acc = function
| [] -> Ok (vis, List.rev acc)
| imp :: tl ->
let resolved = resolve_path ~from_dir:dir imp in
(match load_file (path :: stack) vis resolved with
| Error _ as e -> e
| Ok (vis', src) -> load_imports vis' (src :: acc) tl)
in
match load_imports visited [] imports with
| Error _ as e -> e
| Ok (visited', imported_sources) ->
let self_src = String.concat "\n" body_lines in
let full = String.concat "\n" (imported_sources @ [ self_src ]) in
Ok (StringSet.add path visited', full))
in
match load_file [] StringSet.empty entry_path with
| Error _ as e -> e
| Ok (_, src) -> Ok src

1
lib/module_system.mli Normal file
View File

@ -0,0 +1 @@
val load_source_with_imports : string -> (string, string) result

View File

@ -10,6 +10,9 @@ type parser_state = {
let mk_state toks = { toks = Array.of_list toks; i = 0 } let mk_state toks = { toks = Array.of_list toks; i = 0 }
let peek st = if st.i < Array.length st.toks then st.toks.(st.i) else TEOF let peek st = if st.i < Array.length st.toks then st.toks.(st.i) else TEOF
let peek_n st n =
let idx = st.i + n in
if idx < Array.length st.toks then st.toks.(idx) else TEOF
let consume st = let consume st =
let t = peek st in let t = peek st in
@ -61,7 +64,23 @@ let expect_ident st =
| TIdent s -> s | TIdent s -> s
| _ -> raise (Parse_error "expected identifier") | _ -> raise (Parse_error "expected identifier")
let starts_type = function TIntKw | TBoolKw | TVoidKw | TStructKw -> true | _ -> false let starts_builtin_type = function TIntKw | TBoolKw | TVoidKw | TStructKw -> true | _ -> false
let rec skip_array_suffixes st j =
match peek_n st j with
| TLBracket ->
(match peek_n st (j + 1) with
| TRBracket -> skip_array_suffixes st (j + 2)
| _ -> j)
| _ -> j
let looks_like_type_start st =
match peek st with
| t when starts_builtin_type t -> true
| TIdent _ ->
let j = skip_array_suffixes st 1 in
(match peek_n st j with TIdent _ -> true | _ -> false)
| _ -> false
let rec parse_type st = let rec parse_type st =
let base = let base =
@ -70,6 +89,7 @@ let rec parse_type st =
| TBoolKw -> TBool | TBoolKw -> TBool
| TVoidKw -> TVoid | TVoidKw -> TVoid
| TStructKw -> TStruct (expect_ident st) | TStructKw -> TStruct (expect_ident st)
| TIdent s -> TStruct s
| _ -> raise (Parse_error "expected type") | _ -> raise (Parse_error "expected type")
in in
let rec arrays t = let rec arrays t =
@ -115,6 +135,7 @@ and parse_top st =
let ty = TStruct sname in let ty = TStruct sname in
parse_top_after_type st ty) parse_top_after_type st ty)
| _ -> | _ ->
if not (looks_like_type_start st) then raise (Parse_error "expected top-level declaration");
let ty = parse_type st in let ty = parse_type st in
parse_top_after_type st ty parse_top_after_type st ty
@ -208,7 +229,7 @@ and parse_stmt st =
in in
expect st TSemicolon; expect st TSemicolon;
Return v Return v
| t when starts_type t -> | _ when looks_like_type_start st ->
let ty = parse_type st in let ty = parse_type st in
let n = expect_ident st in let n = expect_ident st in
let init = let init =

View File

@ -4,12 +4,19 @@ module Parser = Parser
module Typechecker = Typechecker module Typechecker = Typechecker
module Generator_json = Generator_json module Generator_json = Generator_json
module Generator_c = Generator_c module Generator_c = Generator_c
module Module_system = Module_system
type program = Ast.program type program = Ast.program
let parse_string = Parser.parse_string let parse_string = Parser.parse_string
let string_of_program = Ast.string_of_program let string_of_program = Ast.string_of_program
let type_check = Typechecker.type_check let type_check = Typechecker.type_check
let load_source_with_imports = Module_system.load_source_with_imports
let parse_file path =
match load_source_with_imports path with
| Error e -> Error e
| Ok src -> parse_string src
let parse_and_type_check src = let parse_and_type_check src =
match parse_string src with match parse_string src with
@ -19,5 +26,13 @@ let parse_and_type_check src =
| Ok () -> Ok prog | Ok () -> Ok prog
| Error e -> Error ("type error: " ^ e)) | Error e -> Error ("type error: " ^ e))
let parse_and_type_check_file path =
match parse_file path with
| Error e -> Error e
| Ok prog ->
(match type_check prog with
| Ok () -> Ok prog
| Error e -> Error ("type error: " ^ e))
let generate_json = Generator_json.generate let generate_json = Generator_json.generate
let generate_c = Generator_c.generate let generate_c = Generator_c.generate

View File

@ -4,12 +4,16 @@ module Parser = Parser
module Typechecker = Typechecker module Typechecker = Typechecker
module Generator_json = Generator_json module Generator_json = Generator_json
module Generator_c = Generator_c module Generator_c = Generator_c
module Module_system = Module_system
type program = Ast.program type program = Ast.program
val parse_string : string -> (program, string) result val parse_string : string -> (program, string) result
val load_source_with_imports : string -> (string, string) result
val parse_file : string -> (program, string) result
val string_of_program : program -> string val string_of_program : program -> string
val type_check : program -> (unit, string) result val type_check : program -> (unit, string) result
val parse_and_type_check : string -> (program, string) result val parse_and_type_check : string -> (program, string) result
val parse_and_type_check_file : string -> (program, string) result
val generate_json : program -> string val generate_json : program -> string
val generate_c : program -> string val generate_c : program -> string

View File

@ -1,3 +1,3 @@
(test (test
(name test_spooky) (name test_spooky)
(libraries spooky)) (libraries spooky unix))

View File

@ -14,7 +14,7 @@ int fold(int[] xs) {
int main() { int main() {
int[] xs; int[] xs;
struct Item it; Item it;
int y = 2 + 3 * 4; int y = 2 + 3 * 4;
it.value = y; it.value = y;
if (y >= 0) { if (y >= 0) {
@ -46,7 +46,34 @@ let test_invalid_program () =
| Ok _ -> failwith "expected type error, but got success" | Ok _ -> failwith "expected type error, but got success"
| Error _ -> () | Error _ -> ()
let write_file path content =
let oc = open_out_bin path in
Fun.protect ~finally:(fun () -> close_out oc) (fun () -> output_string oc content)
let test_imports () =
let base = Filename.concat (Filename.get_temp_dir_name ()) "spooky_import_test" in
let modules_dir = Filename.concat base "modules" in
Unix.mkdir base 0o755;
Unix.mkdir modules_dir 0o755;
let cleanup () =
(try Sys.remove (Filename.concat modules_dir "math.spooky") with _ -> ());
(try Sys.remove (Filename.concat base "main.spooky") with _ -> ());
(try Unix.rmdir modules_dir with _ -> ());
(try Unix.rmdir base with _ -> ())
in
Fun.protect
~finally:cleanup
(fun () ->
write_file (Filename.concat modules_dir "math.spooky")
"int add(int a, int b) { return a + b; }\n";
write_file (Filename.concat base "main.spooky")
"import \"modules/math.spooky\";\nint main() { return add(1, 2); }\n";
match Spooky.parse_and_type_check_file (Filename.concat base "main.spooky") with
| Ok _ -> ()
| Error msg -> failwith ("expected valid import program, got: " ^ msg))
let () = let () =
test_valid_program (); test_valid_program ();
test_invalid_program (); test_invalid_program ();
test_imports ();
print_endline "All parser/type-check tests passed." print_endline "All parser/type-check tests passed."