/**
 * Adds a layer on top of unsignedArith, logic, pairs and locals,
 * providing dynamic type checking. Any type error in an expression
 * returns the value #null.
 *
 * @author Jacob Andersen
 */

let
  typesafe = "typesafe.l"
in let
  source = "signedArith.l" + "logic.l" + "pairs.l" + "locals.l"
in let
  literals = src("literals2unsignedArith.x")
in
  (|
    typesafe + source -> typesafe + source + literals

    [Exp -> Exp, Id -> Id]

    Exp.zero   =  'cons(#0,1)' ;
    Exp.succ   =  'let x = $1 in (integer?(x) ? cons(++ car(x),1)
                                              : #null)' ;
    Exp.pred   =  'let x = $1 in (integer?(x) ? cons(-- car(x),1)
                                              : #null)' ;
    Exp.add    =  'let a = cons($1,$2) in 
                    ((integer?(car(a)) & integer?(cdr(a))) ?
                     cons (car(car(a)) + car(cdr(a)),1) : #null)' ;
    Exp.sub    =  'let a = cons($1,$2) in 
                    ((integer?(car(a)) & integer?(cdr(a))) ?
                     cons (car(car(a)) - car(cdr(a)),1) : #null)' ;
    Exp.mul    =  'let a = cons($1,$2) in 
                    ((integer?(car(a)) & integer?(cdr(a))) ?
                     cons (car(car(a)) * car(cdr(a)),1) : #null)' ;
    Exp.iszero =  'let x = $1 in (integer?(x) ? cons(zero?(car(x)),2)
                                              : #null)' ;
    Exp.ispos  =  'let x = $1 in (integer?(x) ? cons(positive?(car(x)),2)
                                              : #null)' ;
    Exp.isneg  =  'let x = $1 in (integer?(x) ? cons(negative?(car(x)),2)
                                              : #null)' ;
    Exp.paren  =  '($1)' ;

    /* Logic  */

    Exp.true   =  'cons(#t,2)' ;
    Exp.false  =  'cons(#f,2)' ;
    Exp.not    =  'let x = $1 in (boolean?(x) ? cons(!car(x),2)
                                              : #null)' ; 
    Exp.or     =  'let a = cons($1,$2) in 
                    ((boolean?(car(a)) & boolean?(cdr(a))) ?
                     cons (car(car(a)) | car(cdr(a)),2) : #null)' ; 
    Exp.and    =  'let a = cons($1,$2) in 
                    ((boolean?(car(a)) & boolean?(cdr(a))) ?
                     cons (car(car(a)) & car(cdr(a)),2) : #null)' ; 
    Exp.xor    =  'let a = cons($1,$2) in 
                    ((boolean?(car(a)) & boolean?(cdr(a))) ?
                     cons (car(car(a)) ^ car(cdr(a)),2) : #null)' ; 
    Exp.if     =  '(let x = $1 in (!boolean?(x)) | car(x)) ? $2 : $3' ;
    // Note: Scheme semantics: Only #f is false - everything else is true !

    /* Pairs  */

    Exp.cons   =  'cons(cons($1,$2),3)' ;
    Exp.car    =  'let x = $1 in (pair?(x)? car(car(x)) : #null)' ;
    Exp.cdr    =  'let x = $1 in (pair?(x)? cdr(car(x)) : #null)' ;
 
    /*  Locals  */

    Exp.var    =  '$1' ;
    Exp.app    =  '(let x = $1 in 
                    (procedure?(x)? car(x) : (let x(y) = #null in x))) $2' ;
    Exp.letvar =  'let $1 = $2 in $3' ;
    Exp.letfun =  'let $1 = cons(let $1($2) = $3 in $1,4) in $4' ;
    Exp.letrec =  'letrec $1($2) = ($2 let $1($2)=$3 in $1) 4 in $4';

    /*  Typesafe  */

    Exp.null   =  '#null' ;
    Exp.isnull =  'cons(null?($1),2)' ;
    Exp.isint  =  'cons(integer?($1),2)' ;
    Exp.isbool =  'cons(boolean?($1),2)' ;
    Exp.ispair =  'cons(pair?($1),2)' ;
    Exp.isproc =  'cons(procedure?($1),2)' ;
  |)

  |

  idx(source) + idx(literals) + 
    (|
      typesafe -> "pairs.l" + "compare.l" + literals

      [ Exp -> Exp ]
  
      Exp.null   =  'cons(0,0)' ;
      Exp.isnull =  'cdr($1) = 0' ;
      Exp.isint  =  'cdr($1) = 1' ;
      Exp.isbool =  'cdr($1) = 2' ;
      Exp.ispair =  'cdr($1) = 3' ;
      Exp.isproc =  'cdr($1) = 4' ;
    |)