# www.jquigley.com
# Sat Feb 24 02:06:20 CST 2007

Lisp := Object clone do (

   evalExpr := method( env, expr,
      if ( expr isEmpty, return Sexpr newBool(false) )
      evalSexprList( env, Parser parseSexpr(expr) )
   )

   #---------------------------------------------------------------------------

   evalQuote := method ( env, sexpr,
      value := true
      if( sexpr xtype isNil ) then (
            Exception raise("Invalid S-expr: #{sexpr}" interpolate)
      )


      if( sexpr xtype == "CONS" ) then (
         car := sexpr car
         if( car xtype == "OP" and car lexeme == "," ) then (
            value = evalSexpr( env, sexpr cdr )
         ) else (
            evalCar := Lisp evalQuote( env, car )
            cdr     := Lisp evalQuote( env, sexpr cdr )
            value    = Sexpr cons( evalCar, cdr )
         )
      ) else (
         value = sexpr
      )
      value
   )

   #---------------------------------------------------------------------------

   evalSexprList := method( env, sexprList, idx,
      count := sexprList size

      if( idx isNil,
         idx = 0 )

      if( idx >= count ) then (
         return nil
      ) else (
         firstValue := evalSexpr( env, sexprList at(idx) )
         if( idx+1 == count ) then (
            return firstValue
         ) else (
            return evalSexprList( env, sexprList, idx + 1 )
         )
      )
   )

   #---------------------------------------------------------------------------

   evalSexpr := method( env, sexpr,
      value := nil
      if( sexpr xtype isNil ) then (
         Exception raise( "Invalid S-expr: #{sexpr}" interpolate )
      )

      if( sexpr xtype == "CONS" ) then (
         # 1. CONS cell
         car := sexpr car
         if( car xtype == "OP" and car lexeme == "'" ) then (
            value = sexpr cdr
         ) elseif( car xtype == "OP" and car lexeme == "`" ) then (
            value = evalQuote( env, sexpr cdr )
         ) else (
            fun := evalSexpr( env, car )
            if( fun isNil or fun xtype != "FUN" ) then (
               Exception raise( "The S-expr did not evaluate" .. \
                  " to a function: #{car}" interpolate )
            )

            # The function can be either "lazy," in that it deals with
            # evaluation of its arguments itself, a "macro," which
            # requires a second evaluation after the macro expansion,
            # or a regular eager one.

            args := nil
            if( fun special == "lazy" or fun special == "macro" ) then (
               args = sexpr cdr
            ) else (
               args = evalList( env, sexpr cdr )
            )
            value = fun getSlot("fun") call( env, args )
         )
      ) elseif ( sexpr xtype == "SYM" ) then (
         # 2. Symbol
         value = env lookup( sexpr lexeme )
         if ( value isNil, Exception raise(
            "The symbol '#{sexpr lexeme}' is not defined." interpolate ) )
      ) else (
         # 3. Constant
         value = sexpr
      )
      value
   )

   #---------------------------------------------------------------------------

   evalList := method( env, list,
      value := nil
      if ( list isNil, "HELLO" println )
      if ( list xtype == "CONS" ) then (
         value = Sexpr cons( evalSexpr(env, list car),
                             evalList( env, list cdr))
      ) else (
         value = list
      )
      value
   )
                             

   #---------------------------------------------------------------------------

   applyEnv := method( env, expr,
      newSexpr := nil
      if ( expr xtype == "CONS" ) then (
         newSexpr = Sexpr cons( applyEnv(env, expr car),
                                applyEnv(env, expr cdr))
      ) elseif ( expr xtype := "SYM" ) then (
         newSexpr =  env lookup( expr lexeme )
         if( newSexpr isNil, newSexpr = expr )
      ) else (
         newSexpr = expr
      )
      newSexpr
   )

   #---------------------------------------------------------------------------

   getPrimitiveScope := method(
      scope := Map clone
      core  := LispCore clone
      sexpr := Sexpr clone

      scope atPut("car",   sexpr newFun("car",   core getSlot("prim_car")))
      scope atPut("cdr",   sexpr newFun("cdr",   core getSlot("prim_cdr")))
      scope atPut("cons",  sexpr newFun("cons",  core getSlot("prim_cons")))
      scope atPut("<",     sexpr newFun("<",     core getSlot("prim_lt")))
      scope atPut("+",     sexpr newFun("+",     core getSlot("prim_plus")))
      scope atPut("-",     sexpr newFun("-",     core getSlot("prim_minus")))
      scope atPut("*",     sexpr newFun("*",     core getSlot("prim_mult")))
      scope atPut("neg",   sexpr newFun("neg",   core getSlot("prim_neg")))
      scope atPut("eq",    sexpr newFun("eq",    core getSlot("prim_eq")))
      scope atPut("consp", sexpr newFun("consp", core getSlot("prim_consp")))
      scope atPut("eval",  sexpr newFun("eval",  core getSlot("prim_eval")))
      scope atPut("load",  sexpr newFun("load",  core getSlot("prim_load")))
      scope atPut("echo",  sexpr newFun("echo",  core getSlot("prim_echo")))

      scope atPut("if",    sexpr newFun("if", 
         core getSlot("prim_if"),       "lazy"))
      scope atPut("lambda",   sexpr newFun("lambda",
         core getSlot("prim_lambda"),   "lazy"))
      scope atPut("setq",     sexpr newFun("setq",
         core getSlot("prim_setq"),     "lazy"))
      scope atPut("defmacro", sexpr newFun("defmacro",
         core getSlot("prim_defmacro"), "lazy"))

      scope
   )

   #---------------------------------------------------------------------------

   getGlobalEnv := method(
      env   := Env clone new( getPrimitiveScope )
      runFile( env, "../lib/Prelude.lsp" )
      env
   )

   #---------------------------------------------------------------------------

   runFile := method( env, filename,
      file := File clone openForReading( filename )
      code := file contents
      file close
      lastValue := evalExpr( env, code )
      lastValue
   )

   #---------------------------------------------------------------------------

   readEval := method(
      env := Lisp getGlobalEnv()

      ";; IOLISP 00.02"                    println
      ";; #{Date}" interpolate             println
      ";; John Quigley @ www.jquigley.com" println
      ";;"                                 println
      ";; (load \"Prelude.lsp\")"          println

      loop (
         File standardOutput write("IOLISP> ")
         line := File standardInput readLine
         ";; #{line}" interpolate println
         if ( line == "(quit)" or line isNil, break )
         e := try (
            Sexpr prettyPrint( evalExpr(env, line) ) println
         )
         e catch ( Exception,
            e coroutine showStack println
         )
      )
   )
)

# EOF