###############################################################################
# Date:     Sat Feb 24 02:06:20 CST 2007
# Author:   John Quigley <jquigley@jquigley.com>
# Revision: $Id$
###############################################################################

LispCore := Object clone do (

   #---------------------------------------------------------------------------
   # CAR

   prim_car := method ( env, args,
      args car car
   )

   #---------------------------------------------------------------------------
   # CDR

   prim_cdr := method ( env, args,
      args car cdr
   )

   #---------------------------------------------------------------------------
   # CONS

   prim_cons := method ( env, args,
      Sexpr cons( args car, args cdr car )
   )

   #---------------------------------------------------------------------------
   # +

   prim_plus := method ( env, args,
      num1 := args car lexeme asNumber
      num2 := args cdr car lexeme asNumber
      Sexpr newAtom( num1 + num2 )
   )

   #---------------------------------------------------------------------------
   # +

   prim_minus := method ( env, args,
      num1 := args car lexeme asNumber
      num2 := args cdr car lexeme asNumber
      Sexpr newAtom( num1 - num2 )
   )

   #---------------------------------------------------------------------------
   # *

   prim_mult := method ( env, args,
      num1 := args car lexeme asNumber
      num2 := args cdr car lexeme asNumber
      Sexpr newAtom( num1 * num2 )
   )

   #---------------------------------------------------------------------------
   # LAMBDA

   prim_lambda := method ( env, args,
      formalParams := args car
      body         := args cdr car
      codeblock    := block (env2, actualParams,
         localEnv := env addBindings( formalParams, actualParams )
         Lisp evalSexpr( localEnv, body )
      )
      fun := Sexpr newFun( "(lambda #{Sexpr prettyPrint(formalParams)} #{Sexpr prettyPrint(body)})" interpolate, getSlot("codeblock") )
      
      fun
   )

   #---------------------------------------------------------------------------
   # IF

   prim_if := method ( env, args,
      cond := Lisp evalSexpr( env, args car )
      expr := nil
      if( cond xtype == "LITERAL" and cond lexeme == "nil" ) then (
         expr = args cdr cdr car
      ) else (
         expr = args cdr car
      )
      Lisp evalSexpr( env, expr )
   )

   #---------------------------------------------------------------------------
   # EQ

   prim_eq := method ( env, args,
      arg1 := args car
      arg2 := args cdr car
      Sexpr newBool( arg1 xtype  == arg2 xtype and
                     arg1 xtype  != "CONS"     and
                     arg1 lexeme == arg2 lexeme )
   )

   #---------------------------------------------------------------------------
   # <

   prim_lt := method ( env, args,
      Sexpr newBool( args car lexeme asNumber <
                     args cdr car lexeme asNumber )
   )

   #---------------------------------------------------------------------------
   # CONSP

   prim_consp := method ( env, args,
      Sexpr newBool( args car xtype == "CONS" )
   )

   #---------------------------------------------------------------------------
   # NEG

   prim_neg := method ( env, args,
      Sexpr newAtom( - args car lexeme asNumber )
   )

   #---------------------------------------------------------------------------
   # SETQ

   prim_setq := method ( env, args,
      sym   := args car
      value := Lisp evalSexpr( env, args cdr car )
      env add( sym lexeme, value )
      value
   )

   #---------------------------------------------------------------------------
   # EVAL

   prim_eval := method ( env, sexpr,
      value := nil
      car   := sexpr car
      if ( car xtype == "STR" ) then (
         value = Lisp evalExpr( env, car lexeme )
      ) else (
         value = Lisp evalSexpr( env, car )
      )
      value
   )

   #---------------------------------------------------------------------------
   # LOAD

   prim_load := method ( env, sexpr,
      filename  := sexpr car lexeme
      lastValue := Lisp runFile( env, filename )
      Sexpr newBool( true )
   )

   #---------------------------------------------------------------------------
   # ECHO

   prim_echo := method ( env, sexpr,
      "#{Sexpr prettyPrint( sexpr car )}" interpolate println
      Sexpr newBool( true )
   )

   #---------------------------------------------------------------------------
   # DEFMACRO

   prim_defmacro := method ( env, sexpr,
      name   := sexpr car
      params := sexpr cdr car
      body   := sexpr cdr cdr car
      macro  := block ( env2, e,
         paramScope := Map clone
         Env bind( paramScope, params, e )
         subsEnv  := Env new( paramScope )
         expanded := Lisp applyEnv( subsEnv, body )
         value    := Lisp evalSexpr( env2, expanded )
         value
      )
      fun := Sexpr newFun( "(defmacro #{name lexeme} " .. \
         "#{Sexpr prettyPrint(params)} #{Sexpr prettyPrint(body)})" \
         interpolate, getSlot("macro"), "macro" )
      env add( name lexeme, fun )
      fun
   )

)

# EOF