X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=blobdiff_plain;f=scheme-primitives.4th;h=c1f3626babffbe2971cb9d4f84a9346cf1e3ae06;hb=d1107557350ae9101bfa387dd2af2cad541193cc;hp=c99a0c000bc3ccc64a20e9298dcfec54d407a20c;hpb=8a9d83b586844a04f7ee19f98b56f460063bdcad;p=scheme.forth.jl.git diff --git a/scheme-primitives.4th b/scheme-primitives.4th index c99a0c0..c1f3626 100644 --- a/scheme-primitives.4th +++ b/scheme-primitives.4th @@ -211,3 +211,54 @@ mod fixnum-type ; make-primitive remainder + +( = Pairs and Lists = ) + +:noname ( args -- pair ) + 2dup 2 ensure-arg-count + + 2dup car 2swap cdr car + cons +; make-primitive cons + +:noname ( args -- pair ) + 2dup 1 ensure-arg-count + + + 2dup car 2swap cdr car + cons +; make-primitive cons + +:noname ( args -- pair ) + 2dup 1 ensure-arg-count + car pair-type ensure-arg-type + + car +; make-primitive car + +:noname ( args -- pair ) + 2dup 1 ensure-arg-count + car pair-type ensure-arg-type + + cdr +; make-primitive cdr + +:noname ( args -- pair ) + 2dup 2 ensure-arg-count + 2dup car pair-type ensure-arg-type + swap cdr car + + 2swap set-car! + + ok-symbol +; make-primitive set-car! + +:noname ( args -- pair ) + 2dup 2 ensure-arg-count + 2dup car pair-type ensure-arg-type + swap cdr car + + 2swap set-cdr! + + ok-symbol +; make-primitive set-cdr!