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

Separated mutually recursive definition of desugar phases

Browse Source 
They do not need to be mutually recursive at all. At first I thought
they would have to be, because I thought it would be best if each phase
completely desugared the bodies of the expressions they handle, but now
I see that would probably lead to an infinite loop.

There is simply no reason to couple them so tightly.
This commit is contained in:
Emin Arslan
2025-12-27 16:44:18 +03:00
parent cd8337b650
commit 26463a4c00
1 changed files with 7 additions and 6 deletions
Download Patch File Download Diff File Expand all files Collapse all files

13
lib/compiler/sugar.ml
View File

@@ -63,7 +63,7 @@ let make_letif sym value cond t e =
*) *)
let rec desugar_define_function = function let rec desugar_define_function = function
| LCons (LSymbol "define", LCons (LCons (LSymbol _ as sym, args), body)) -> | LCons (LSymbol "define", LCons (LCons (LSymbol _ as sym, args), body)) ->
let body = sexpr_map desugar body in let body = sexpr_map desugar_define_function body in
let lamb = LCons (LSymbol "lambda", LCons (args, body)) in let lamb = LCons (LSymbol "lambda", LCons (args, body)) in
let def = LCons (LSymbol "define", LCons (sym, LCons (lamb, LNil))) in let def = LCons (LSymbol "define", LCons (sym, LCons (lamb, LNil))) in
def def
@@ -87,14 +87,14 @@ let rec desugar_define_function = function
((f (lambda () (display "hi")))) ((f (lambda () (display "hi"))))
(f) (f))) (f) (f)))
*) *)
and desugar_internal_define = function let rec desugar_internal_define = function
| LCons (LSymbol "lambda", LCons (args, body)) -> | LCons (LSymbol "lambda", LCons (args, body)) ->
LCons (LSymbol "lambda", LCons (args, (make_letrec body))) LCons (LSymbol "lambda", LCons (args, (make_letrec body)))
| LCons (_, _) as expr -> | LCons (_, _) as expr ->
sexpr_map desugar_internal_define expr sexpr_map desugar_internal_define expr
| expr -> expr | expr -> expr
(* Turn bodies of lambdas and letrec's *) (* Turn bodies of lambdas and letrec's *)
and beginize = function let rec beginize = function
| LCons (LSymbol "letrec" as sym, LCons (args, body)) | LCons (LSymbol "letrec" as sym, LCons (args, body))
| LCons (LSymbol "lambda" as sym, LCons (args, body)) -> | LCons (LSymbol "lambda" as sym, LCons (args, body)) ->
let body = beginize body in let body = beginize body in
@@ -118,7 +118,7 @@ and beginize = function
__generated_or2 __generated_or2
())))) ()))))
*) *)
and desugar_logical_or = function let rec desugar_logical_or = function
| LCons (LSymbol "or", LCons (f, rest)) -> | LCons (LSymbol "or", LCons (f, rest)) ->
let sym = LSymbol (Gensym.gensym "or") in let sym = LSymbol (Gensym.gensym "or") in
let f = desugar_logical_or f in let f = desugar_logical_or f in
@@ -130,7 +130,7 @@ and desugar_logical_or = function
sexpr_map desugar_logical_or expr sexpr_map desugar_logical_or expr
| expr -> expr | expr -> expr
and desugar_logical_and = function let rec desugar_logical_and = function
| LCons (LSymbol "and", LCons (first, rest)) -> | LCons (LSymbol "and", LCons (first, rest)) ->
let sym = LSymbol (Gensym.gensym "and") in let sym = LSymbol (Gensym.gensym "and") in
let first = desugar_logical_and first in let first = desugar_logical_and first in
@@ -141,7 +141,8 @@ and desugar_logical_and = function
| LCons (_, _) as expr -> | LCons (_, _) as expr ->
sexpr_map desugar_logical_and expr sexpr_map desugar_logical_and expr
| expr -> expr | expr -> expr
and desugar x =
let desugar x =
x x
|> desugar_define_function |> desugar_define_function
|> desugar_internal_define |> desugar_internal_define