haxala1r/olisp
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Changed the addition and subtraction functions to be clearer

Browse Source
This commit is contained in:
Emin Arslan
2025-10-16 22:28:11 +03:00
committed by Emin Arslan
parent 8273baecf1
commit 6c3efde5e9
2 changed files with 30 additions and 34 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
lib/eval.ml
View File

@@ -113,8 +113,8 @@ let eval_all env vs =
let ev v = eval_one env v in let ev v = eval_one env v in
List.map ev vs List.map ev vs
let () = add_builtin "+" iadd let () = add_builtin "+" add
let () = add_builtin "-" isub let () = add_builtin "-" sub
let () = add_builtin "car" car let () = add_builtin "car" car
let () = add_builtin "cdr" cdr let () = add_builtin "cdr" cdr
let () = add_builtin "cons" cons let () = add_builtin "cons" cons

60
lib/interpreterStdlib.ml
View File

@@ -1,37 +1,33 @@
open Ast;; open Ast;;
let iadd _ vs : lisp_val = let add _ vs =
let rec auxi vs accum = let rec aux accum = function
match vs with | LCons (a, b) ->
| LCons (LInt a, b) -> (auxi b (accum + a)) (match accum, a with
| LCons (LDouble a, b) -> (auxf b ((float_of_int accum) +. a)) | LInt x , LInt y -> aux (LInt (x + y)) b
| _ -> LInt accum | LDouble x, LInt y -> aux (LDouble (x +. (float_of_int y))) b
and auxf vs accum = | LInt x, LDouble y -> aux (LDouble ((float_of_int x) +. y)) b
match vs with | LDouble x, LDouble y -> aux (LDouble (x +. y)) b
| LCons (LInt a, b) -> (auxf b (accum +. (float_of_int a))) | _ -> invalid_arg "invalid args to +")
| LCons (LDouble a, b) -> (auxf b (accum +. a)) | LNil -> accum
| _ -> LDouble accum | _ -> invalid_arg "invalid args to +"
in (auxi vs 0);; in aux (LInt 0) vs
let isub _ vs = let sub _ vs =
let rec auxi vs accum = let rec aux accum = function
match vs with | LNil -> accum
| LNil -> LInt accum | LCons (a, b) -> (match accum, a, b with
| LCons (LInt a, b) -> auxi b (accum - a) | LNil, LDouble x, LNil -> LDouble (-. x)
| LCons (LDouble a, b) -> auxf b ((float_of_int accum) -. a) | LNil, LInt x, LNil -> LInt (-x)
| _ -> raise (Invalid_argument "-: invalid argument to subtraction operator") | LNil, LDouble _, _
and auxf vs accum = | LNil, LInt _, _ -> aux a b
match vs with | LInt x, LInt y, _ -> aux (LInt (x - y)) b
| LNil -> LDouble accum | LInt x, LDouble y, _ -> aux (LDouble ((float_of_int x) -. y)) b
| LCons (LInt a, b) -> auxf b (accum -. (float_of_int a)) | LDouble x, LDouble y, _ -> aux (LDouble (x -. y)) b
| LCons (LDouble a, b) -> auxf b (accum -. a) | LDouble x, LInt y, _ -> aux (LDouble (x -. (float_of_int y))) b
| _ -> raise (Invalid_argument "-: invalid argument to subtraction operator") | _ -> invalid_arg "invalid argument to -")
in | _ -> invalid_arg "argument to -"
match vs with in aux LNil vs
| LCons (LInt a, LNil) -> LInt (-a)
| LCons (LInt a, b) -> auxi b a
| LCons (LDouble a, LNil) -> LDouble (-. a)
| LCons (LDouble a, b) -> auxf b a
| _ -> auxi vs 0;;
let car _ vs = let car _ vs =