From 5cb98e56427777858b429a551f2a2671d68a2c51 Mon Sep 17 00:00:00 2001 From: Camil Staps Date: Tue, 1 Nov 2016 22:35:12 +0100 Subject: Resolve #2: enable/disable showing types --- iclean.icl | 91 ++++++++++++++++++++++++++++++++++++++++++++++---------------- 1 file changed, 68 insertions(+), 23 deletions(-) diff --git a/iclean.icl b/iclean.icl index 7683619..e1eb385 100644 --- a/iclean.icl +++ b/iclean.icl @@ -39,48 +39,67 @@ template :== map ((+++) "import ") ["StdEnv", "StdDynamic", "genLibTest"] template_file :== "/home/.iclean_template" // END SETTINGS -temp_file :== temp_path +++ temp_module +++ ".icl" +temp_file =: temp_path +++ temp_module +++ ".icl" -help :== +help =: "\tInteractive Clean - known commands:\n\n" +++ "\t:quit\t\t\tExit iClean\n" +++ "\t:mem\t\t\tDisplay current memory\n" +++ "\t:help\t\t\tDisplay this message\n\n" +++ + "\t:set K V\t\tSet iClean's setting K to value V\n\n" +++ "\t:import MODULE\t\tAdd an import to the memory\n" +++ - "\t:def F X1 .. X2 = RHS\tAdd a rewrite rule to the memory\n" +++ + "\t:def F X1 .. Xn = RHS\tAdd a rewrite rule to the memory\n" +++ "\t:undef F\t\tRemove all rewrite rules starting with 'F ' from the memory\n" +:: Status + = { memory :: [String] + , settings :: Settings + } + +instance zero Status where zero = { memory = [], settings = zero } + +:: Settings + = { show_type :: Bool + } + +instance zero Settings where zero = { show_type = False } + Start :: *World -> *World Start w # w = setReadLineName "iClean" w # w = usingHistory w # w = checkedWorldFunc readHistory "Couldn't read history" readline_history w # (more_template,w) = readTemplate template_file w -# w = loop (template ++ more_template) True w +# w = loop {zero & memory = template ++ more_template} True w # w = checkedWorldFunc writeHistory "Couldn't write history" readline_history w = w where - loop :: ![String] Bool !*World -> *World - loop mem success w + loop :: !Status Bool !*World -> *World + loop stat success w # prompt = color (if success None Red) "λ. " # (s,w) = readLine prompt False w | isNothing s = print "\n" w # s = fromJust s - | s == "" = loop mem False (print "Use Ctrl-D to exit\n" w) + | s == "" = loop stat False (print "Use Ctrl-D to exit\n" w) # w = addHistory s w | s == ":quit" || s == ":q" = w - | s == ":mem" = loop mem True (print (join "\n" mem) w) - | matches ":import " s = loop (mem ++ [skip 1 s]) True w - | matches ":def " s = loop (mem ++ [skip 5 s]) True w - | matches ":undef " s = loop (filter (undef (skip 7 s)) mem) True w - | s == ":help" = loop mem True (print help w) - | matches ":" s = loop mem False (print ("Unknown command\n") w) - # w = writemodule mem s w + | s == ":mem" = loop stat True (print (join "\n" stat.memory) w) + | matches ":import " s = loop {stat & memory = stat.memory ++ [skip 1 s]} True w + | matches ":def " s = loop {stat & memory = stat.memory ++ [skip 5 s]} True w + | matches ":undef " s = loop {stat & memory = filter (undef (skip 7 s)) stat.memory} True w + | matches ":set " s + # (setting, value) = span ((<>) ' ') (fromString (skip 5 s)) + # (setting, value) = (toString setting, toString (drop 1 value)) + # (ok, msg, stat) = set setting value stat + = loop stat ok (if (isNothing msg) id (print (fromJust msg +++ "\n")) w) + | s == ":help" = loop stat True (print help w) + | matches ":" s = loop stat False (print ("Unknown command\n") w) + # w = writemodule stat s w # (r,w) = compile temp_path temp_module w - | r <> 0 = loop mem False w + | r <> 0 = loop stat False w # (r,w) = run (temp_path +++ temp_module) w - | r <> 0 = loop mem False w - = loop mem True w + | r <> 0 = loop stat False w + = loop stat True w undef :: !String !String -> Bool undef n h = not (matches (n +++ " ") h) @@ -102,6 +121,26 @@ where = ([line % (0,size line - 2):lines], f) // iClean functions +set :: !String !String !Status -> (Bool, Maybe String, Status) +set k v stat = case lookup k settings of + Nothing = (False, Just "Unknown setting", stat) + (Just f) = f v stat +where + set_bool :: String String (Bool -> Status -> Status) String Status -> (Bool, Maybe String, Status) + set_bool iftrue iffalse f s stat + | isMember s ["True", "true", "1"] = (True, Just iftrue, f True stat) + | isMember s ["False", "false", "0"] = (False, Just iffalse, f False stat) + = (False, Just ("Couldn't parse '" +++ v +++ "' as boolean"), stat) + + settings = + [ ("show_type", set_bool "Showing types" "Not showing types" + (\b s -> {s & settings.show_type = b})) + ] + + lookup :: k [(k,v)] -> Maybe v | == k + lookup _ [] = Nothing + lookup k [(k`,v):vs] = if (k == k`) (Just v) (lookup k vs) + checkedWorldFunc :: (a *World -> (Bool, *World)) !String !a !*World -> *World checkedWorldFunc f err s w # (ok, w) = f s w @@ -116,19 +155,25 @@ print s w | not ok = abort "Couldn't close stdio\n" | otherwise = w -writemodule :: ![String] !String !*World -> *World -writemodule mem s w +writemodule :: !Status !String !*World -> *World +writemodule stat s w # (ok,f,w) = fopen temp_file FWriteText w | not ok = abort ("Couldn't open " +++ temp_file +++ " for writing.\n") # f = f <<< "module " <<< temp_module <<< "\n" -# f = f <<< join "\n" mem +# f = f <<< join "\n" stat.memory # f = f <<< "start = " <<< s <<< "\n" - <<< "rslt = genShow{|*|} \"\" True start []\n" - <<< "Start = toString (typeCodeOfDynamic (dynamic start)) " - <<< "+++ \" :: \" +++ foldl (+++) \"\" rslt +++ \"\\n\"\n" + <<< "rslt = genShow{|*|} \"\" True start []\n" + <<< "Start = " <<< start # (ok,w) = fclose f w | not ok = abort ("Couldn't close " +++ temp_file +++ "\n") | otherwise = w +where + start + | stat.settings.show_type + = "toString (typeCodeOfDynamic (dynamic start)) " +++ + "+++ \" :: \" +++ foldl (+++) \"\" rslt +++ \"\\n\"\n" + | otherwise + = "foldl (+++) \"\" rslt +++ \"\\n\"\n" // C functions compile :: !String !String !*World -> *(!Int,!*World) -- cgit v1.2.3