1 -- the read-eval-print loop 
    2 -- without the eval
    3 
    4 
    5 module Loop
    6 
    7 ( Val
    8 , expformat
    9 )
   10 
   11 where
   12 
   13 import Options
   14 
   15 import Pretty   -- syslib ghc
   16 import PrettyClass (linewidth)
   17 
   18 
   19 import Syntax (Exp, pr)
   20 import ExpParse (pline)
   21 import PI
   22 import Ids
   23 
   24 import Heuristic
   25 
   26 import Heave (Formatter)
   27 
   28 -----------------------------------------------------------------------
   29 
   30 type Val e = Opts -> e -> Exp -> Either String (Exp, e)
   31 -- evaluates, with some environment
   32 
   33 -- expformat :: [String] -> Val e -> Formatter (IdTable, e)
   34 expformat hs val (opts0, (pi0, env0)) inp =
   35     do  { let (mx, (opts1, pi1)) = pline (opts0, pi0) inp        -- parse input
   36 
   37         ; case mx of
   38             Nothing -> return (pi1, env0)
   39             Just y -> do 
   40 
   41                 -- prepend some defaults (if evaluating)
   42                 { let x = chose opts1 "eval" (heu opts1 hs y) y
   43 
   44                 -- possibly echo the input (with defaults?)
   45                 ; if onoff opts1 "output" && onoff opts1 "exp"
   46                   then (putStr (ppShow linewidth 
   47                                 (pr opts1 (chose opts1 "expand" x y) )))
   48                   else (return ())
   49 
   50                 -- evaluate input
   51                 ; chose opts1 "eval"
   52                     ( case val opts1 env0 x of
   53                   Left msg -> 
   54                     do        { maybePutStrLn opts1 msg
   55                         -- continue with old environment
   56                         ; return (pi1, env0) 
   57                         }
   58 
   59                   Right (y, env1) ->
   60                     do        { if onoff opts1 "output" && onoff opts1 "res"
   61                           then (putChar '\n' >> putStr (ppShow linewidth 
   62                                         (ppSep [ppStr "==", pr opts1 y])))
   63                           else (return () )
   64 
   65                         -- continue with new env
   66                         ; return (pi1, env1)
   67                         }
   68                      )
   69 
   70                 (return (pi1, env0))  -- nothing happens
   71 
   72             }
   73         }
   74 
   75 ------------------------------------------------------------------------
   76 
   77