balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Michelson: removes amount from calling convention

Browse Source
This commit is contained in:
Milo Davis 2017-07-24 12:28:41 +02:00
parent aa49d7bb31
commit 7bfaf2fe9b
36 changed files with 91 additions and 86 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/client/embedded/alpha/client_proto_programs.ml
View File

@ -517,7 +517,7 @@ let unexpand_macros type_map (program : Script.code) =
match node with
| Seq (loc, l) ->
begin match caddr type_map [] l with
| None ->
| None | Some [] ->
let type_map, l =
List.fold_left
(fun (type_map, acc) e ->

55
src/proto/alpha/docs/language.md
View File

@ -1052,7 +1052,7 @@ for under/overflows.
Forge a new contract.
:: key : key? : bool : bool : tez : lambda (pair (pair tez 'p) 'g) (pair 'r 'g) : 'g : 'S
:: key : key? : bool : bool : tez : lambda (pair 'p 'g) (pair 'r 'g) : 'g : 'S
-> contract 'p 'r : 'S
As with non code-emitted originations the
@ -1061,7 +1061,7 @@ for under/overflows.
the global data and returns it to be stored and retrieved on the
next transaction. These data are initialized by another
parameter. The calling convention for the code is as follows:
`(Pair (Pair amount arg) globals)) -> (Pair ret globals)`, as
`(Pair arg globals)) -> (Pair ret globals)`, as
extrapolable from the instruction type. The first parameters are
the manager, optional delegate, then spendable and delegatable
flags and finally the initial amount taken from the currently
@ -1149,12 +1149,12 @@ for under/overflows.
:: 'a : 'S -> string : 'S
* `CHECK_SIGNATURE`
* `CHECK_SIGNATURE`:
Check that a sequence of bytes has been signed with a given key.
:: key : pair signature string : 'S -> bool : 'S
* `COMPARE`
* `COMPARE`:
:: key : key : 'S -> int64 : 'S
@ -1349,27 +1349,23 @@ data storage. The type of the global data of the storage is fixed for
each contract at origination time. This is ensured statically by
checking on origination that the code preserves the type of the global
data. For this, the code of the contract is checked to be of the
following type lambda (pair (pair tez 'arg) 'global) -> (pair 'ret
following type lambda (pair 'arg 'global) -> (pair 'ret
'global) where 'global is the type of the original global store given
on origination. The contract also takes a parameter and an amount, and
on origination. The contract also takes a parameter and
returns a value, hence the complete calling convention above.
### Empty contract
Because of the calling convention, the empty sequence is not a valid
contract of type `(contract unit unit)`. The code for building a
contract of such a type must take a `unit` argument, an amount in `tez`,
and transform a unit global storage, and must thus be of type `(lambda
(pair (pair tez unit) unit) (pair unit unit))`.
Any contract with the same `parameter` and `return` types
may be written with an empty sequence in its `code` section.
The simplest contracts is the contract for which the
`parameter`, `storage`, and `return` are all of type `unit`.
This contract is as follows:
Such a minimal contract code is thus `{ CDR ; UNIT ; PAIR }`.
A valid contract source file would be as follows.
code { CDR ; UNIT ; PAIR }
storage unit
parameter unit
return unit
code { };
storage unit;
parameter unit;
return unit;
### Reservoir contract
@ -1393,13 +1389,13 @@ Hence, the global data of the contract has the following type
Following the contract calling convention, the code is a lambda of type
lambda
pair (pair tez unit) 'g
pair unit 'g
pair unit 'g
writen as
lambda
pair (pair tez unit)
pair unit
pair
pair timestamp tez
pair (contract unit unit) (contract unit unit)
@ -1614,9 +1610,8 @@ At the beginning of the transaction:
S via a CDDDDADR
W via a CDDDDDR
the delivery counter via a CDAAR
the amount versed by the buyer via a CDADAR
the amount versed by the seller via a CDADDR
the argument via a CADR
the argument via a CAR
The contract returns a unit value, and we assume that it is created
with the minimum amount, set to `(Tez "1.00")`.
@ -1640,12 +1635,12 @@ The complete source `forward.tz` is:
PUSH uint64 86400 ; SWAP ; ADD ; # one day in second
NOW ; COMPARE ; LT ;
IF { # Before Z + 24
DUP ; CADR ; # we must receive (Left "buyer") or (Left "seller")
DUP ; CAR ; # we must receive (Left "buyer") or (Left "seller")
IF_LEFT
{ DUP ; PUSH string "buyer" ; COMPARE ; EQ ;
IF { DROP ;
DUP ; CDADAR ; # amount already versed by the buyer
DIP { DUP ; CAAR } ; ADD ; # transaction
DIP { AMOUNT } ; ADD ; # transaction
# then we rebuild the globals
DIP { DUP ; CDADDR } ; PAIR ; # seller amount
PUSH uint32 0 ; PAIR ; # delivery counter at 0
@ -1654,7 +1649,7 @@ The complete source `forward.tz` is:
UNIT ; PAIR }
{ PUSH string "seller" ; COMPARE ; EQ ;
IF { DUP ; CDADDR ; # amount already versed by the seller
DIP { DUP ; CAAR } ; ADD ; # transaction
DIP { AMOUNT } ; ADD ; # transaction
# then we rebuild the globals
DIP { DUP ; CDADAR } ; SWAP ; PAIR ; # buyer amount
PUSH uint32 0 ; PAIR ; # delivery counter at 0
@ -1693,11 +1688,11 @@ The complete source `forward.tz` is:
NOW ; COMPARE ; LT
IF { # Between T and T + 24
# we only accept transactions from the buyer
DUP ; CADR ; # we must receive (Left "buyer")
DUP ; CAR ; # we must receive (Left "buyer")
IF_LEFT
{ PUSH string "buyer" ; COMPARE ; EQ ;
IF { DUP ; CDADAR ; # amount already versed by the buyer
DIP { DUP ; CAAR } ; ADD ; # transaction
DIP { AMOUNT } ; ADD ; # transaction
# The amount must not exceed Q * K
DUP ;
DIIP { DUP ; CDDAAR ; # Q
@ -1736,7 +1731,7 @@ The complete source `forward.tz` is:
SOURCE unit unit ; MANAGER ;
COMPARE ; NEQ ;
IF { FAIL } {} # fail if not the warehouse
DUP ; CADR ; # we must receive (Right amount)
DUP ; CAR ; # we must receive (Right amount)
IF_LEFT
{ FAIL } # (Left _)
{ # We increment the counter
@ -1763,7 +1758,7 @@ The complete source `forward.tz` is:
UNIT ; TRANSFER_TOKENS ; DROP ;
# and return unit
UNIT ; PAIR } } } } } } }
X - Full grammar
----------------

4
src/proto/alpha/script_interpreter.ml
View File

@ -512,14 +512,14 @@ and execute ?log origination orig source ctxt storage script amount arg qta =
(Lwt.return (parse_ty arg_type)) >>=? fun (Ex_ty arg_type) ->
(Lwt.return (parse_ty ret_type)) >>=? fun (Ex_ty ret_type) ->
(Lwt.return (parse_ty storage_type)) >>=? fun (Ex_ty storage_type) ->
let arg_type_full = Pair_t (Pair_t (Tez_t, arg_type), storage_type) in
let arg_type_full = Pair_t (arg_type, storage_type) in
let ret_type_full = Pair_t (ret_type, storage_type) in
trace
(Ill_typed_contract (code, arg_type, ret_type, storage_type, []))
(parse_lambda ~storage_type ctxt arg_type_full ret_type_full code) >>=? fun lambda ->
parse_data ctxt arg_type arg >>=? fun arg ->
parse_data ctxt storage_type storage >>=? fun storage ->
interp ?log origination qta orig source amount ctxt lambda ((amount, arg), storage)
interp ?log origination qta orig source amount ctxt lambda (arg, storage)
>>=? fun (ret, qta, ctxt, origination) ->
let ret, storage = ret in
return (unparse_data storage_type storage,

6
src/proto/alpha/script_ir_translator.ml
View File

@ -1275,7 +1275,7 @@ and parse_instr
(Bool_t, Item_t
(Bool_t, Item_t
(Tez_t, Item_t
(Lambda_t (Pair_t (Pair_t (Tez_t, p), gp),
(Lambda_t (Pair_t (p, gp),
Pair_t (r, gr)), Item_t
(ginit, rest))))))) ->
check_item_ty gp gr loc "CREATE_CONTRACT" 5 7 >>=? fun (Eq _) ->
@ -1437,7 +1437,7 @@ let parse_script
(Lwt.return (parse_ty ret_type)) >>=? fun (Ex_ty ret_type) ->
(Lwt.return (parse_ty init_storage_type)) >>=? fun (Ex_ty init_storage_type) ->
(Lwt.return (parse_ty storage_type)) >>=? fun (Ex_ty storage_type) ->
let arg_type_full = Pair_t (Pair_t (Tez_t, arg_type), storage_type) in
let arg_type_full = Pair_t (arg_type, storage_type) in
let ret_type_full = Pair_t (ret_type, storage_type) in
Lwt.return (ty_eq init_storage_type storage_type) >>=? fun (Eq _) ->
parse_data ?type_logger ctxt storage_type storage >>=? fun storage ->
@ -1546,7 +1546,7 @@ let typecheck_code
trace
(Ill_formed_type (Some "storage", storage_type))
(Lwt.return (parse_ty storage_type)) >>=? fun (Ex_ty storage_type) ->
let arg_type_full = Pair_t (Pair_t (Tez_t, arg_type), storage_type) in
let arg_type_full = Pair_t (arg_type, storage_type) in
let ret_type_full = Pair_t (ret_type, storage_type) in
let result =
parse_lambda ctxt

4
src/proto/alpha/script_typed_ir.ml
View File

@ -40,7 +40,7 @@ end
type ('key, 'value) map = (module Boxed_map with type key = 'key and type value = 'value)
type ('arg, 'ret, 'storage) script =
{ code : (((Tez.t, 'arg) pair, 'storage) pair, ('ret, 'storage) pair) lambda ;
{ code : (('arg, 'storage) pair, ('ret, 'storage) pair) lambda ;
arg_type : 'arg ty ;
ret_type : 'ret ty ;
storage : 'storage ;
@ -270,7 +270,7 @@ and ('bef, 'aft) instr =
| Default_account : (public_key_hash * 'rest, (unit, unit) typed_contract * 'rest) instr
| Create_contract : 'g ty * 'p ty * 'r ty ->
(public_key_hash * (public_key_hash option * (bool * (bool * (Tez.t *
(((Tez.t * 'p) * 'g, 'r * 'g) lambda * ('g * 'rest)))))),
(('p * 'g, 'r * 'g) lambda * ('g * 'rest)))))),
('p, 'r) typed_contract * 'rest) instr
| Now :
('rest, Timestamp.t * 'rest) instr

3
test/contracts/and.tz
View File

@ -1,5 +1,4 @@
parameter (pair bool bool);
return bool;
storage unit;
code {DUP; CADR; CAR; SWAP; CADR; CDR; AND;
UNIT; SWAP; PAIR};
code {CAR; DUP; CAR; DIP{CDR}; AND; UNIT; SWAP; PAIR};

2
test/contracts/build_list.tz
View File

@ -1,7 +1,7 @@
parameter uint64;
return (list uint64);
storage unit;
code {CADR; NIL uint64; SWAP; DUP; PUSH uint64 0; CMPNEQ;
code {CAR; NIL uint64; SWAP; DUP; PUSH uint64 0; CMPNEQ;
LOOP {DUP; DIP {SWAP}; CONS; SWAP; PUSH uint64 1; SWAP; SUB;
DUP; PUSH uint64 0; CMPNEQ};
CONS; UNIT; SWAP; PAIR};

2
test/contracts/check_signature.tz
View File

@ -2,4 +2,4 @@ parameter key;
storage (pair signature string);
return bool;
code {DUP; DUP; DIP{CDR; DUP; CAR; DIP{CDR; H}; PAIR};
CADR; CHECK_SIGNATURE; DIP{CDR}; PAIR};
CAR; CHECK_SIGNATURE; DIP{CDR}; PAIR};

2
test/contracts/compare.tz
View File

@ -1,7 +1,7 @@
parameter (pair tez tez);
return (list bool);
storage unit;
code {CADR; DUP; DUP; DUP; DUP; DIIIIIP {NIL bool};
code {CAR; DUP; DUP; DUP; DUP; DIIIIIP {NIL bool};
DIIIIP {DUP; CAR; DIP {CDR}; COMPARE; LE; CONS};
DIIIP {DUP; CAR; DIP {CDR}; COMPARE; GE; CONS};
DIIP{DUP; CAR; DIP {CDR}; COMPARE; LT; CONS};

3
test/contracts/concat_hello.tz
View File

@ -1,4 +1,5 @@
parameter (list string);
return (list string);
storage unit;
code {CADR; LAMBDA string string {PUSH string "Hello "; CONCAT}; MAP; UNIT; SWAP; PAIR};
code{CAR; LAMBDA string string {PUSH string "Hello "; CONCAT};
MAP; UNIT; SWAP; PAIR};

5
test/contracts/concat_list.tz
View File

@ -1,5 +1,6 @@
parameter (list string);
return string;
storage unit;
code {CADR; PUSH string ""; SWAP; LAMBDA (pair string string) string {DUP; CAR; SWAP; CDR; SWAP; CONCAT}; REDUCE;
UNIT; SWAP; PAIR};
code {CAR; PUSH string ""; SWAP;
LAMBDA (pair string string) string {DUP; CAR; SWAP; CDR; SWAP; CONCAT};
REDUCE; UNIT; SWAP; PAIR};

6
test/contracts/contains_all.tz
View File

@ -1,8 +1,10 @@
parameter (pair (list string) (list string));
storage unit;
return bool;
code {CADR; DUP; CAR; DIP{CDR}; EMPTY_SET string; SWAP;
code {CAR; DUP; CAR; DIP{CDR}; EMPTY_SET string; SWAP;
LAMBDA (pair string (set string)) (set string) {DUP; CAR; DIP{CDR}; PUSH bool True; SWAP; UPDATE};
REDUCE; PUSH bool True; SWAP; PAIR; SWAP;
LAMBDA (pair string (pair (set string) bool)) (pair (set string) bool) {DUP; DUP; CAR; DIP{CDAR; DIP{CDDR}; DUP}; MEM; DIP{SWAP}; AND; SWAP; PAIR};
LAMBDA (pair string (pair (set string) bool))
(pair (set string) bool)
{DUP; DUP; CAR; DIP{CDAR; DIP{CDDR}; DUP}; MEM; DIP{SWAP}; AND; SWAP; PAIR};
REDUCE; CDR; UNIT; SWAP; PAIR};

4
test/contracts/create_account.tz
View File

@ -1,5 +1,5 @@
parameter key;
return unit;
storage (contract unit unit);
code {CADR; DIP{PUSH tez "100.00"; PUSH bool False; NONE key}; CREATE_ACCOUNT;
UNIT; PAIR};
code {CAR; DIP{PUSH tez "100.00"; PUSH bool False; NONE key};
CREATE_ACCOUNT; UNIT; PAIR};

10
test/contracts/create_contract.tz
View File

@ -1,7 +1,11 @@
parameter key;
storage string;
return unit;
code {CADR; DIP{UNIT; LAMBDA (pair (pair tez string) unit) (pair string unit) {CADR; UNIT; SWAP; PAIR};
PUSH tez "100.00"; PUSH bool False; PUSH bool False; NONE key};
CREATE_CONTRACT; DIP{PUSH string ""}; PUSH tez "0.00"; PUSH string "abcdefg"; TRANSFER_TOKENS;
code {CAR; DIP{UNIT; LAMBDA (pair string unit)
(pair string unit)
{CAR; UNIT; SWAP; PAIR};
PUSH tez "100.00"; PUSH bool False;
PUSH bool False; NONE key};
CREATE_CONTRACT; DIP{PUSH string ""}; PUSH tez "0.00";
PUSH string "abcdefg"; TRANSFER_TOKENS;
DIP{DROP}; UNIT; PAIR};

3
test/contracts/default_account.tz
View File

@ -1,4 +1,5 @@
parameter key
return unit
storage unit
code {DIP{UNIT}; CADR; DEFAULT_ACCOUNT; PUSH tez "100"; UNIT; TRANSFER_TOKENS; PAIR}
code {DIP{UNIT}; CAR; DEFAULT_ACCOUNT;
PUSH tez "100"; UNIT; TRANSFER_TOKENS; PAIR}

5
test/contracts/empty_map.tz
View File

@ -1,4 +1,7 @@
storage unit;
return (map string string);
parameter unit;
code {DROP; EMPTY_MAP string string; PUSH string "world"; SOME; PUSH string "hello"; UPDATE; UNIT; SWAP; PAIR};
code {DROP;
EMPTY_MAP string string;
PUSH string "world"; SOME; PUSH string "hello"; UPDATE;
UNIT; SWAP; PAIR};

4
test/contracts/exec_concat.tz
View File

@ -1,4 +1,6 @@
parameter string;
return string;
storage unit;
code {CADR; LAMBDA string string {PUSH string "_abc"; SWAP; CONCAT}; SWAP; EXEC; UNIT; SWAP; PAIR};
code {CAR;
LAMBDA string string {PUSH string "_abc"; SWAP; CONCAT};
SWAP; EXEC; UNIT; SWAP; PAIR};

2
test/contracts/fail_amount.tz
View File

@ -2,4 +2,4 @@
parameter unit;
storage unit;
return unit;
code {CAAR; PUSH tez "10"; CMPGT; IF {FAIL} {UNIT; UNIT; PAIR}}
code {AMOUNT; PUSH tez "10"; CMPGT; IF {FAIL} {}}

2
test/contracts/get_map_value.tz
View File

@ -1,4 +1,4 @@
parameter string;
storage (map string string);
return (option string);
code {DUP; CADR; DIP{CDR; DUP}; GET; PAIR};
code {DUP; CAR; DIP{CDR; DUP}; GET; PAIR};

2
test/contracts/hash_string.tz
View File

@ -1,4 +1,4 @@
parameter string;
return string;
storage unit;
code {CADR; H; UNIT; SWAP; PAIR};
code {CAR; H; UNIT; SWAP; PAIR};

2
test/contracts/if.tz
View File

@ -1,4 +1,4 @@
parameter bool;
storage unit;
return bool;
code {CADR; IF {PUSH bool True} {PUSH bool False}; UNIT; SWAP; PAIR};
code {CAR; IF {PUSH bool True} {PUSH bool False}; UNIT; SWAP; PAIR};

4
test/contracts/max_in_list.tz
View File

@ -1,10 +1,10 @@
parameter (list int32);
storage unit;
return (option int32);
code {CADR; DIP{NONE int32};
code {CAR; DIP{NONE int32};
LAMBDA
(pair int32 (option int32))
(option int32)
{DUP; DUP; CAR; SWAP; CDR;
{DUP; DUP; CAR; SWAP; CDR;
IF_NONE {DIP{DROP}; SOME} {CMPGT; IF {CDR} {CAR; SOME}}};
REDUCE; UNIT; SWAP; PAIR};

11
test/contracts/noop.tz
View File

@ -1,7 +1,4 @@
parameter unit
code
{ # This is a noop contract
CDR ; UNIT ; PAIR
}
return unit
storage unit
parameter unit;
code {};
return unit;
storage unit;

2
test/contracts/not.tz
View File

@ -1,4 +1,4 @@
parameter bool;
return bool;
storage unit;
code {CADR; NOT; UNIT; SWAP; PAIR};
code {CAR; NOT; UNIT; SWAP; PAIR};

2
test/contracts/or.tz
View File

@ -1,5 +1,5 @@
parameter (pair bool bool);
return bool;
storage unit;
code {CADR; DUP; CAR; SWAP; CDR; OR;
code {CAR; DUP; CAR; SWAP; CDR; OR;
UNIT; SWAP; PAIR};

6
test/contracts/originator.tz
View File

@ -2,16 +2,16 @@ storage unit ;
parameter uint16 ;
return (list (contract unit unit)) ;
code
{ CADR ; DUP ; PUSH uint16 0 ; CMPNEQ ;
{ CAR ; DUP ; PUSH uint16 0 ; CMPNEQ ;
DIIP { NIL (contract unit unit) } ;
LOOP
{ PUSH tez "5.00" ;
PUSH bool True ; # delegatable
NONE key ; # delegate
PUSH key "Nf4DPTCksayh83VhjDVE8M8et7KmXAppD3s7" ; # manager
PUSH key "tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx" ; # manager
CREATE_ACCOUNT ;
SWAP ; DIP { CONS } ;
PUSH uint16 1 ; SWAP ; SUB ;
DUP ; PUSH uint16 0 ; CMPNEQ } ;
DROP ;
UNIT ; SWAP ; PAIR }
UNIT ; SWAP ; PAIR }

2
test/contracts/ret_int.tz
View File

@ -1,4 +1,4 @@
parameter unit;
code {CADR; PUSH uint32 300; PAIR};
code {CAR; PUSH uint32 300; PAIR};
return uint32;
storage unit;

2
test/contracts/reverse.tz
View File

@ -1,7 +1,7 @@
parameter (list string);
storage unit;
return (list string);
code {CADR; DIP {NIL string}; SWAP; PUSH bool True;
code {CAR; DIP {NIL string}; SWAP; PUSH bool True;
# INV: BOOL : ORIG_LIST : REV_LIST : []
LOOP {IF_CONS {DIP {SWAP}; CONS; SWAP; PUSH bool True} {NIL string; PUSH bool False}};
DROP; UNIT; SWAP; PAIR};

2
test/contracts/set_member.tz
View File

@ -1,4 +1,4 @@
parameter string;
storage (set string);
return bool;
code {DUP; CADR; DIP{CDR}; MEM; DIP{EMPTY_SET string}; PAIR};
code {DUP; CAR; DIP{CDR}; MEM; DIP{EMPTY_SET string}; PAIR};

2
test/contracts/store_input.tz
View File

@ -1,4 +1,4 @@
parameter string;
return unit;
storage string;
code {CADR; UNIT; PAIR};
code {CAR; UNIT; PAIR};

2
test/contracts/str_id.tz
View File

@ -1,4 +1,4 @@
parameter string;
return string;
storage unit;
code {CADR; UNIT; SWAP; PAIR};
code {CAR; UNIT; SWAP; PAIR};

2
test/contracts/swap_left_right.tz
View File

@ -1,4 +1,4 @@
parameter (or bool string);
return (or string bool);
storage unit;
code {CADR; IF_LEFT {RIGHT string} {LEFT bool}; UNIT; SWAP; PAIR};
code {CAR; IF_LEFT {RIGHT string} {LEFT bool}; UNIT; SWAP; PAIR};

2
test/contracts/tez_add_sub.tz
View File

@ -1,6 +1,6 @@
parameter (pair tez tez);
storage unit;
return (pair tez tez);
code {CADR; DUP; DUP; CAR; DIP{CDR}; ADD;
code {CAR; DUP; DUP; CAR; DIP{CDR}; ADD;
DIP{DUP; CAR; DIP{CDR}; SUB};
PAIR; UNIT; SWAP; PAIR};

2
test/contracts/transfer_to.tz
View File

@ -1,4 +1,4 @@
parameter (contract unit unit);
return unit;
storage unit;
code {CADR; DIP{UNIT}; PUSH tez "100.00"; UNIT; TRANSFER_TOKENS; PAIR};
code {CAR; DIP{UNIT}; PUSH tez "100.00"; UNIT; TRANSFER_TOKENS; PAIR};

6
test/contracts/weather_insurance.tz
View File

@ -4,12 +4,12 @@ parameter (pair signature uint16);
storage (pair (pair (contract unit unit) (contract unit unit)) (pair uint16 key));
return unit;
code {DUP; DUP;
CADR; DUP; DIP{CDR; H}; CAR; PAIR;
CAR; DUP; DIP{CDR; H}; CAR; PAIR;
SWAP; CDDDR; CHECK_SIGNATURE; # Check if the data has been correctly signed
IF {NOP} {FAIL} # If signature is not correct, end the execution
IF {} {FAIL} # If signature is not correct, end the execution
DUP; DUP; DUP; DIIIP{CDR}; # Place storage type on bottom of stack
DIIP{CDAR}; # Place contracts below numbers
DIP{CADDR}; # Get actual rain
DIP{CADR}; # Get actual rain
CDDAR; # Get rain threshold
CMPLT; IF {CAR} {CDR}; # Select contract to receive tokens
BALANCE; UNIT; TRANSFER_TOKENS; # Setup and execute transfer

2
test/contracts/xor.tz
View File

@ -1,4 +1,4 @@
parameter (pair bool bool);
return bool;
storage unit;
code {CADR; DUP; CAR; DIP{CDR}; XOR; UNIT; SWAP; PAIR};
code {CAR; DUP; CAR; DIP{CDR}; XOR; UNIT; SWAP; PAIR};