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