REQUIRES: contrib/match contrib/parser-combinators ;

USING: kernel match math arrays sequences namespaces strings ;
IN: scratchpad

MATCH-VARS: ?i ?t ?b ?e ?a ?b ;

TUPLE: lit i ;
TUPLE: inc t ;
TUPLE: isz t ;
TUPLE: iff b t e ;
TUPLE: pair a b ;
TUPLE: fst t ;
TUPLE: snd t ;

: eval1 ( a -- a )
  {
    { T{ lit  f ?i }       [ ?i ] }
    { T{ inc  f ?t }       [ ?t eval1 1+ ] }
    { T{ isz  f ?t }       [ ?t eval1 zero? ] }
    { T{ iff  f ?b ?t ?e } [ ?b eval1 [ ?t ] [ ?e ] if eval1 ] }
    { T{ pair f ?a ?b }    [ ?a eval1 ?b eval1 2array ] }
    { T{ fst  f ?t }       [ ?t eval1 first ] }
    { T{ snd  f ?t }       [ ?t eval1 second ] }
  } match-cond ;  
  

GENERIC: eval2 ( a -- a )

M: lit  eval2 ( a -- a ) lit-i ;
M: inc  eval2 ( a -- a ) inc-t eval2 1+ ;
M: isz  eval2 ( a -- a ) isz-t eval2 zero? ;
M: iff  eval2 ( a -- a ) dup iff-b eval2 [ iff-t ] [ iff-e ] if eval2 ;
M: pair eval2 ( a -- a ) dup pair-a eval2 swap pair-b eval2 2array ;
M: fst  eval2 ( a -- a ) fst-t eval2 first ;
M: snd  eval2 ( a -- a ) snd-t eval2 second ;

: driver ( -- v )
  5 <lit> <inc> <inc> <isz> 
    6 <lit>
    7 <lit>
  <iff> 
  42 <lit> 8 <lit> 9 <lit> <pair> <pair> <snd> <fst> <pair> ;

: test1 ( -- v )
  driver eval1 ;

: test2 ( -- v )
  driver eval2 ;

: (compile1) ( a -- )
  {
    { T{ lit  f ?i }       [ ?i , ] }
    { T{ inc  f ?t }       [ ?t (compile1) \ 1+ , ] }
    { T{ isz  f ?t }       [ ?t (compile1) \ zero? , ] }
    { T{ iff  f ?b ?t ?e } [ ?b (compile1) [ ?t (compile1) ] [ ] make , [ ?e (compile1) ] [ ] make , \ if , ] }
    { T{ pair f ?a ?b }    [ ?a (compile1) ?b (compile1) \ 2array , ] }
    { T{ fst  f ?t }       [ ?t (compile1) \ first , ] }
    { T{ snd  f ?t }       [ ?t (compile1) \ second , ] }
  } match-cond ;  

: compile1 ( a -- quot )
  [ (compile1) ] [ ] make ;

: (compile2) ( a -- )
  {
    { T{ lit  f ?i }       [ ?i number>string % ] }
    { T{ inc  f ?t }       [ ?t (compile2) "+1" % ] }
    { T{ isz  f ?t }       [ ?t (compile2) "== 0" % ] }
    { T{ iff  f ?b ?t ?e } [ 
        "function() {if(" % 
        ?b (compile2) 
        ") {return " % 
        ?t (compile2)
        "} else { return " %
        ?e (compile2)
        "}}()" %
      ] 
    }
    { T{ pair f ?a ?b }    [ "{ first:" % ?a (compile2) ",second:" % ?b (compile2) " }" % ] }
    { T{ fst  f ?t }       [ ?t (compile2) ".first" % ] }
    { T{ snd  f ?t }       [ ?t (compile2) ".second" % ] }
  } match-cond ;  

: compile2 ( a -- quot )
  [ "(" % (compile2) ")" % ] "" make ;


PROVIDE: contrib/interpreter ;