############################################################################
#
#	File:     qei.icn
#
#	Subject:  Program to evaluate Icon expressions interactively
#
#	Authors:  William H. Mitchell and Ralph E. Griswold
#
#	Date:     March 26, 2002
#
############################################################################
#
#   This file is in the public domain.
#
############################################################################
#
#  This program takes expressions entered at the command line and
#  evaluates them.
#
#  A semicolon is required to complete an expression.  If one is not
#  provided, the subsequent line is added to what already has been
#  entered.
#
#  It is important to know that qei accumulates expressions and evaluates
#  all previously entered expressions before it evaluates a new one.
#
#  A line beginning with a colon is a command.  The commands are:
#
#
#	:clear		clear the accumulated expressions.
#
#	:every		generate all the results from the expression;
#			otherwise, at most one is produced.
#
#	:exit		terminate the session
#	:quit		terminate the session
#
#	:list		list the accumulated expressions.
#
#	:type		toggle switch that displays the type of the
#			result; the program starts with this switch on.
#
############################################################################
#
#  "qei" is derived from the Latin "quod erat inveniendum" -- "which was
#  to be found out".
#
############################################################################
#
#  Requires:  co-expressions and system()
#
############################################################################

procedure main()
   local a, tag, header, incfiles, prog, extras, showtype
   local uselines, line, inline, src, files, w, f, Generate, sfile
   local curexp, t, rc, sc

   write("Icon Expression Evaluator, Version 1.2, type :? for help")
   
   if not(&features == "co-expressions") | not(&features == "system function")
   then stop("*** This program requires co-expressions ***")

   tag := create "r" || seq() || "_"

   header := [
      "global showtype, showimage, showImage",
      "procedure main()", "hwrite := -1; write :=: hwrite",
      "hwrites := -1; writes :=: hwrites",
      "hread := -1; read :=: hread"
      ]

   incfiles := []
   prog := []
   extras := ["write := hwrite", "read := hread", "writes := hwrites"]
   showtype := 1
   uselines := []

   repeat {
     line := ""
     repeat {
        if *uselines ~= 0 then {
           inline := get(uselines)
           }
        else {
           writes(if *line = 0 then "> " else "... ")
           inline := (read() | shut_down())
           }
      
        inline := trim(inline, ' \t')
        case inline of {
           ":type": {
              (/showtype := 1) | (showtype := &null)
              write("Will ",(/showtype & "not ")|"","display types")
              next
              }
           ":exit" | ":quit": shut_down()
           ":clear": {
              prog := []
              tag := ^tag		# reset variable numbering
              next
              }
           ":list": {
              every(write(!prog))
              next
              }
           ":help" | ":?": {
              Help()
              next
              }
            }
         inline ? {
           if =":edit" then {
              src := prog[-1][1:-1]
              src := replace(src, "\n#", "\n")
              src ? {
                 tab(upto('(') + 1) &
                 line := atos(Edit([tab(0)]), "\n") &
                 break
                 }
              }
           else if =":edit all" then {
              prog := Edit(prog)
              next
              }
           else if =":link" then {
              push(header, inline[2:0] ? tab(upto(';') | 0))
              next
              }
           else if =":include" then {
              inline := replace(inline, ";", "")
              inline ? (tab(upto(' \t') + 1) & files := tab(0))
              files := split(files, ', \t')
              incfiles |||:= files
              next
              }
           else if =":load" then {
              w := split(inline, ' ,\t\'\";')
              if f := open(w[2]) then {
                 while put(uselines, read(f))
                 close(f)
                 next
                 }
              else {
                 write("*** cannot open ", image(w[2]))
                 next
                 }
              }
            }

      line ||:= inline || "\n"
         if line[-2:0] == ";\n" then {
            line[-2:0] := ""
            break
            }
          }

   if \showtype then    
        put(extras, "showtype := 1")

   if line ?:= (=":every " & tab(0)) then Generate := 1
    
   sfile := open("qei_.icn","w")

   every write(sfile, !(header | prog | extras))
   
   curexp := (t :=@tag) || " := (" || line || ")"
   
   if \Generate then {
       write(sfile, "every WR(\"\",", curexp, ")")
       }
       else {
          write(sfile, "if (", curexp, ") then WR(\"", t, " := \",", t, ")")
          write(sfile, "else write(\"Failure\")")
          }
   
      write(sfile, "end")

      WriteWR(sfile)

      close(sfile)

$ifdef _MS_WINDOWS
      sc :=  system("wicont -s qei_.icn " || atos(incfiles, " "))
$else
      sc :=  system("icont -s qei_.icn " || atos(incfiles, " "))
$endif
      if sc = 0 then rc := system("qei_")

      if sc = 0 & rc = 0 then
         put(prog, curexp)
      else
         put(prog, "#" || replace(curexp, "\n", "\n#"))

      extras := ["write := hwrite", "read := hread", "writes := hwrites"]

      Generate := &null

      }

end

procedure WriteWR(f)
   write(f, "procedure WR(tag, e)")
   write(f, "writes(\"   \",tag, image(e))")
   write(f, "\twrite(if \\showtype then \"  (\"|| type(e)|| \")\" else \"\")")
   write(f, "end");

end

procedure Help()

   write("Enter any Icon expression to evaluate it")
   write()
   write(":edit -- edit last expression")
   write(":edit all -- edit the list of expressions")
   write(":every <expression> -- show generated results for expresion")
   write(":exit or :quit -- exit qei")
   write(":help or :? -- print this message")
   write(":include <files>, e.g. :include \"x.icn\" -- include Icon files")
   write(":limit <n> -- limit results of :every to <n>")
   write(":link <files>, e.g. link image -- link ucode files")
   write(":list -- list expressions")
   write(":load <file>, e.g. :load x -- load expressions from the file x")
   write(":type -- toggle display of type")

   return

end

procedure Edit(p)
   local f

   f := open("qei_.icn", "w") | stop("*** cannot open program file")

   every write(f, !p)

   close(f)
    
   system("$EDITOR qei_.icn")

   f := open("qei_.icn") | stop("*** cannot re-open program file")

   p := []

   while put(p, read(f))

   return p

end
    
procedure atos(a,delim)
   local e, s

   s := ""
   /delim := ","

   every e := !a do
      (/s := e) | (s ||:= delim || e)

   return s

end

#
#  replace string (from the IPL)
#
procedure replace(s1,s2,s3)
   local result, i

   result := ""
   i := *s2

   s1 ? {
      while result ||:= tab(find(s2)) do {
         result ||:= s3
         move(i)
         }
      return result || tab(0)
      }

end

procedure split(line,dlms)
   local w

   /dlms := ' \t'
   w := []

   line ? repeat {
      tab(upto(~dlms))
      put(w, tab(many(~dlms))) | break
      }

   return w

end

procedure shut_down()

   remove("qei_")
   remove("qei_.icn")

   exit()

end