artemist/mes
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

Revert "core: Remove pmatch-car, pmatch-cdr hack."

Browse source 
This reverts commit be1e84624ea4a158173f34af923e3c4a3793412a.
This commit is contained in:
Jan Nieuwenhuizen 2018-04-29 07:46:40 +02:00
parent c03449ac5a
commit 1400489a94
No known key found for this signature in database
GPG key ID: F3C1A0D9C1D65273
4 changed files with 53 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

7
module/mes/guile.scm
View file

@ -42,12 +42,17 @@
core:write
core:write-error
core:write-port
core:type)
core:type
pmatch-car
pmatch-cdr
)
;;#:re-export (open-input-file open-input-string with-input-from-string)
)
(cond-expand
(guile
(define pmatch-car car)
(define pmatch-cdr cdr)
(define core:exit exit)
(define core:display display)
(define core:display-port display)

2
module/mes/pmatch.scm
View file

@ -74,6 +74,6 @@
((_ v (unquote var) kt kf) (let ((var v)) kt))
((_ v (x . y) kt kf)
(if (pair? v)
(ppat (car v) x (ppat (cdr v) y kt kf) kf)
(ppat (pmatch-car v) x (ppat (pmatch-cdr v) y kt kf) kf)
kf))
((_ v lit kt kf) (if (eq? v (quote lit)) kt kf))))

4
scaffold/mini-mes.c
View file

@ -135,6 +135,8 @@ struct scm scm_symbol_mes_version = {TSYMBOL, "%version",0};
struct scm scm_symbol_car = {TSYMBOL, "car",0};
struct scm scm_symbol_cdr = {TSYMBOL, "cdr",0};
struct scm scm_symbol_pmatch_car = {TSYMBOL, "pmatch-car",0};
struct scm scm_symbol_pmatch_cdr = {TSYMBOL, "pmatch-cdr",0};
struct scm scm_vm_evlis = {TSPECIAL, "*vm-evlis*",0};
struct scm scm_vm_evlis2 = {TSPECIAL, "*vm-evlis2*",0};
@ -143,6 +145,8 @@ struct scm scm_vm_apply = {TSPECIAL, "core:apply",0};
struct scm scm_vm_apply2 = {TSPECIAL, "*vm-apply2*",0};
struct scm scm_vm_eval = {TSPECIAL, "core:eval",0};
struct scm scm_vm_eval_pmatch_car = {TSPECIAL, "*vm-eval-pmatch-car*",0};
struct scm scm_vm_eval_pmatch_cdr = {TSPECIAL, "*vm-eval-pmatch-cdr*",0};
struct scm scm_vm_eval_define = {TSPECIAL, "*vm-eval-define*",0};
struct scm scm_vm_eval_set_x = {TSPECIAL, "*vm-eval-set!*",0};

42
src/mes.c
View file

@ -177,6 +177,8 @@ struct scm scm_symbol_mes_version = {TSYMBOL, "%version",0};
struct scm scm_symbol_car = {TSYMBOL, "car",0};
struct scm scm_symbol_cdr = {TSYMBOL, "cdr",0};
struct scm scm_symbol_pmatch_car = {TSYMBOL, "pmatch-car",0};
struct scm scm_symbol_pmatch_cdr = {TSYMBOL, "pmatch-cdr",0};
struct scm scm_vm_evlis = {TSPECIAL, "*vm-evlis*",0};
struct scm scm_vm_evlis2 = {TSPECIAL, "*vm-evlis2*",0};
@ -185,6 +187,8 @@ struct scm scm_vm_apply = {TSPECIAL, "core:apply",0};
struct scm scm_vm_apply2 = {TSPECIAL, "*vm-apply2*",0};
struct scm scm_vm_eval = {TSPECIAL, "core:eval",0};
struct scm scm_vm_eval_pmatch_car = {TSPECIAL, "*vm-eval-pmatch-car*",0};
struct scm scm_vm_eval_pmatch_cdr = {TSPECIAL, "*vm-eval-pmatch-cdr*",0};
struct scm scm_vm_eval_define = {TSPECIAL, "*vm-eval-define*",0};
struct scm scm_vm_eval_set_x = {TSPECIAL, "*vm-eval-set!*",0};
@ -971,6 +975,8 @@ eval_apply ()
case cell_vm_apply: goto apply;
case cell_vm_apply2: goto apply2;
case cell_vm_eval: goto eval;
case cell_vm_eval_pmatch_car: goto eval_pmatch_car;
case cell_vm_eval_pmatch_cdr: goto eval_pmatch_cdr;
case cell_vm_eval_define: goto eval_define;
case cell_vm_eval_set_x: goto eval_set_x;
case cell_vm_eval_macro_expand_eval: goto eval_macro_expand_eval;
@ -1117,6 +1123,26 @@ eval_apply ()
{
switch (CAR (r1))
{
case cell_symbol_pmatch_car:
{
push_cc (CADR (r1), r1, r0, cell_vm_eval_pmatch_car);
goto eval;
eval_pmatch_car:
x = r1;
gc_pop_frame ();
r1 = CAR (x);
goto eval_apply;
}
case cell_symbol_pmatch_cdr:
{
push_cc (CADR (r1), r1, r0, cell_vm_eval_pmatch_cdr);
goto eval;
eval_pmatch_cdr:
x = r1;
gc_pop_frame ();
r1 = CDR (x);
goto eval_apply;
}
case cell_symbol_quote:
{
x = r1;
@ -1695,6 +1721,12 @@ g_cells[cell_symbol_car] = scm_symbol_car;
g_free++;
g_cells[cell_symbol_cdr] = scm_symbol_cdr;
g_free++;
g_cells[cell_symbol_pmatch_car] = scm_symbol_pmatch_car;
g_free++;
g_cells[cell_symbol_pmatch_cdr] = scm_symbol_pmatch_cdr;
g_free++;
g_cells[cell_vm_evlis] = scm_vm_evlis;
@ -1713,6 +1745,12 @@ g_cells[cell_vm_apply2] = scm_vm_apply2;
g_free++;
g_cells[cell_vm_eval] = scm_vm_eval;
g_free++;
g_cells[cell_vm_eval_pmatch_car] = scm_vm_eval_pmatch_car;
g_free++;
g_cells[cell_vm_eval_pmatch_cdr] = scm_vm_eval_pmatch_cdr;
g_free++;
g_cells[cell_vm_eval_define] = scm_vm_eval_define;
@ -1872,6 +1910,8 @@ g_cells[cell_symbol_mes_prefix].car = cstring_to_list (scm_symbol_mes_prefix.nam
g_cells[cell_symbol_mes_version].car = cstring_to_list (scm_symbol_mes_version.name);
g_cells[cell_symbol_car].car = cstring_to_list (scm_symbol_car.name);
g_cells[cell_symbol_cdr].car = cstring_to_list (scm_symbol_cdr.name);
g_cells[cell_symbol_pmatch_car].car = cstring_to_list (scm_symbol_pmatch_car.name);
g_cells[cell_symbol_pmatch_cdr].car = cstring_to_list (scm_symbol_pmatch_cdr.name);
g_cells[cell_vm_evlis].car = cstring_to_list ("*vm*");
g_cells[cell_vm_evlis2].car = g_cells[cell_vm_evlis].car;
@ -1879,6 +1919,8 @@ g_cells[cell_vm_evlis3].car = g_cells[cell_vm_evlis].car;
g_cells[cell_vm_apply].car = g_cells[cell_vm_evlis].car;
g_cells[cell_vm_apply2].car = g_cells[cell_vm_evlis].car;
g_cells[cell_vm_eval].car = g_cells[cell_vm_evlis].car;
g_cells[cell_vm_eval_pmatch_car].car = g_cells[cell_vm_evlis].car;
g_cells[cell_vm_eval_pmatch_cdr].car = g_cells[cell_vm_evlis].car;
g_cells[cell_vm_eval_define].car = g_cells[cell_vm_evlis].car;
g_cells[cell_vm_eval_set_x].car = g_cells[cell_vm_evlis].car;
g_cells[cell_vm_eval_macro_expand_eval].car = g_cells[cell_vm_evlis].car;