Resolve #2: enable/disable showing types

1 files 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)