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
List.map ev vs
let () = add_builtin "+" iadd
let () = add_builtin "-" isub
let () = add_builtin "+" add
let () = add_builtin "-" sub
let () = add_builtin "car" car
let () = add_builtin "cdr" cdr
let () = add_builtin "cons" cons

60
lib/interpreterStdlib.ml
View File

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