commit 3545f2430ea31ab81eb3a5d1648e7a84a3392b1a Author: caandt Date: Sat May 9 04:09:12 2026 -0500 initial commit diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..e35d885 --- /dev/null +++ b/.gitignore @@ -0,0 +1 @@ +_build diff --git a/dune-project b/dune-project new file mode 100644 index 0000000..e1b8e59 --- /dev/null +++ b/dune-project @@ -0,0 +1 @@ +(lang dune 3.21) diff --git a/shell.nix b/shell.nix new file mode 100644 index 0000000..70f84a8 --- /dev/null +++ b/shell.nix @@ -0,0 +1,11 @@ +let + pkgs = import {}; +in + pkgs.mkShell { + packages = with pkgs.ocamlPackages; [ + ocaml + dune_3 + findlib + ppx_deriving + ]; + } diff --git a/src/dune b/src/dune new file mode 100644 index 0000000..07b5208 --- /dev/null +++ b/src/dune @@ -0,0 +1,6 @@ +(executable + (name main) + (preprocess (pps ppx_deriving.show))) + +(ocamllex lexer) +(ocamlyacc parser) diff --git a/src/exec.ml b/src/exec.ml new file mode 100644 index 0000000..d7c9a4c --- /dev/null +++ b/src/exec.ml @@ -0,0 +1,49 @@ +open Types + +let update m x v = fun y -> if x=y then v else m y + +let rec builtin_iop f = + let iop1 m v = + match m "", v with + | VInt a, VInt b -> EInt (f a b) + | _, _ -> raise (Failure "iop: not int") in + VFn (builtin, "", EFnB iop1) +and builtin_bop f = + let bop1 m v = + match m "", v with + | VBool a, VBool b -> EBool (f a b) + | _, _ -> raise (Failure "bop: not bool") in + VFn (builtin, "", EFnB bop1) +and builtin = function + | "add" -> builtin_iop (+) + | "sub" -> builtin_iop (-) + | "mul" -> builtin_iop ( * ) + | "div" -> builtin_iop (/) + | "and" -> builtin_bop (&&) + | "or" -> builtin_bop (||) + | _ -> raise (Failure "undefined var") + +let rec eval (m: mem) (e: exp) : value = + match e with + | EInt i -> VInt i + | EBool b -> VBool b + | EVar x -> m x + | EFn (x, e) -> VFn (m, x, e) + | EFnB f -> VFnB (m, f) + | EApp (e1, e2) -> + (match eval m e1, eval m e2 with + | VFn (m, x, body), v -> eval (update m x v) body + | VFnB (m, f), v -> eval m (f m v) + | v, _ -> raise (Failure ("not a func"))) + | EIf (b, e1, e2) -> + (match eval m b with + | VBool b -> eval m (if b then e1 else e2) + | _ -> raise (Failure "not a bool")) + | EScope s -> fst (exec m s) +and exec (m: mem) (s: stmt) = + match s with + | SExp e -> eval m e, m + | SAsgn (x, e) -> + let v = eval m e in + v, update m x v + | SSeq (s1, s2) -> exec (snd (exec m s1)) s2 diff --git a/src/lexer.mll b/src/lexer.mll new file mode 100644 index 0000000..681ebb5 --- /dev/null +++ b/src/lexer.mll @@ -0,0 +1,28 @@ +{ + open Parser +} +rule token = parse + [' ' '\t' '\n'] + { token lexbuf } + | '(' { LPAREN } + | ')' { RPAREN } + (* | '{' { LBRACE } *) + (* | '}' { RBRACE } *) + | ';' { SEMICOLON } + | '=' { EQUAL } + | '+' { PLUS } + | '-' { MINUS } + | '*' { TIMES } + | '/' { DIVIDE } + | "&&" { AND } + | "||" { OR } + | "if" { IF } + | "then" { THEN } + | "else" { ELSE } + | "true" { TRUE } + | "false" { FALSE } + | "fn" { FN } + | ['0'-'9']+ { NUM (int_of_string (Lexing.lexeme lexbuf)) } + | ['A'-'Z' 'a'-'z' '_'] (['A'-'Z' 'a'-'z' '0'-'9' '_'])* + { VAR (Lexing.lexeme lexbuf) } + | eof { EOF } diff --git a/src/main.ml b/src/main.ml new file mode 100644 index 0000000..912e906 --- /dev/null +++ b/src/main.ml @@ -0,0 +1,6 @@ +let main () = + let s = Parser.parse_stmt Lexer.token + (Lexing.from_channel (open_in Sys.argv.(1))) in + print_endline (Types.show_stmt s); + print_endline (Types.show_value (fst (Exec.exec Exec.builtin s)));; +main ();; diff --git a/src/parser.mly b/src/parser.mly new file mode 100644 index 0000000..202a804 --- /dev/null +++ b/src/parser.mly @@ -0,0 +1,59 @@ +%{ + open Types + let app2 x a b = EApp (EApp (EVar x, a), b) +%} +%token LPAREN RPAREN SEMICOLON EQUAL OR AND PLUS MINUS TIMES DIVIDE EOF +%token IF THEN ELSE TRUE FALSE FN +%token NUM +%token VAR + +%nonassoc EQUAL IF THEN ELSE +%left OR +%left AND +%right NOT +%nonassoc TRUE FALSE +%left PLUS MINUS +%left TIMES DIVIDE +%nonassoc NUM VAR +%right LPAREN RPAREN +%nonassoc EOF + +%start parse_stmt +%type parse_stmt + +%% + +parse_stmt: + | stmt { $1 } + | stmt SEMICOLON parse_stmt { SSeq ($1,$3) } + +stmt: + | parse_exp { SExp $1 } + | VAR EQUAL parse_exp { SAsgn ($1,$3) } + +parse_exp: + | exp { $1 } + | parse_exp exp { EApp ($1,$2) } + | IF parse_exp THEN parse_exp ELSE parse_exp + { EIf ($2,$4,$6) } + | parse_exp AND parse_exp + { app2 "and" $1 $3 } + | parse_exp OR parse_exp + { app2 "or" $1 $3 } + | parse_exp PLUS parse_exp + { app2 "add" $1 $3 } + | parse_exp MINUS parse_exp + { app2 "sub" $1 $3 } + | parse_exp TIMES parse_exp + { app2 "mul" $1 $3 } + | parse_exp DIVIDE parse_exp + { app2 "div" $1 $3 } + | FN VAR parse_exp + { EFn ($2,$3) } + +exp: + | NUM { EInt $1 } + | TRUE { EBool true } + | FALSE { EBool false } + | VAR { EVar $1 } + | LPAREN parse_exp RPAREN { $2 } diff --git a/src/types.ml b/src/types.ml new file mode 100644 index 0000000..c69e915 --- /dev/null +++ b/src/types.ml @@ -0,0 +1,26 @@ +type var = string +[@@deriving show] + +type exp = + | EInt of int + | EBool of bool + | EVar of var + | EFn of (var * exp) + | EFnB of fnb + | EApp of (exp * exp) + | EIf of (exp * exp * exp) + | EScope of stmt +[@@deriving show] +and stmt = + | SExp of exp + | SAsgn of (var * exp) + | SSeq of (stmt * stmt) +[@@deriving show] +and mem = var -> value +and fnb = mem -> value -> exp +and value = + | VInt of int + | VBool of bool + | VFn of (mem * var * exp) + | VFnB of (mem * fnb) +[@@deriving show]