change some sugar logic

UInterpret.hs

@@ -2,12 +2,25 @@ module UInterpret where
 import System.Environment
 import System.IO
 import qualified Data.Set as Set
+import qualified Data.Map as Map
 import UParse
 import UModuleLoader
 import URunTime
 import UEnvironment
 import ULambdaExpression
 
+showPrettyValue v
+	| isTrueValue v = "True"
+	| isFalseValue v = "False"
+	| otherwise = showValue v
+	where
+	isTrueValue v = case v of
+		VAbs name1 (VClean (VAbs name2 (VRef name3))) -> name1==name3
+		_ -> False
+	isFalseValue v = case v of
+		VAbs name1 (VClean (VAbs name2 (VRef name3))) -> name2==name3
+		_ -> False
+
 runInteractive :: [[Char]] -> Bool -> IO ()
 runInteractive args showHints = do
 	if showHints then putStrLn "; type :q to quit, :? for help" else return ()
@@ -86,8 +99,8 @@ runInteractive args showHints = do
 										UExceptionHappened f -> do
 											(liftUR.putStrLn) ("exception: "++f)
 											repl (c,locals) revimports (Just t)
-										UResultReturned (v,_) -> do
-											(liftUR.putStrLn) (showValue v)
+										UResultReturned (v,vc) -> do
+											(liftUR.putStrLn) (showPrettyValue v)
 											repl (c,locals) revimports (Just t)
 					where
 					tryAddDef :: [Char] -> (STokenTree,SPosition) -> SVisibility -> URealWorldEnv ()
@@ -118,16 +131,5 @@ runFileF fout ifname args = do
 					URunning () -> putStrLn "execution interrupted"
 					UExited x -> if (x==0) then return () else putStrLn ("exit with code "++(show x))
 					UExceptionHappened f -> putStrLn ("exception: "++f)
-					UResultReturned (v,_) -> hPutStrLn fout (showPrettyValue v)
-	where
-		showPrettyValue v
-			| isTrueValue v = "True"
-			| isFalseValue v = "False"
-			| otherwise = showValue v
-		isTrueValue v = case v of
-			VAbs name1 (VClean (VAbs name2 (VRef name3))) -> name1==name3
-			_ -> False
-		isFalseValue v = case v of
-			VAbs name1 (VClean (VAbs name2 (VRef name3))) -> name2==name3
-			_ -> False
+					UResultReturned (v,vc) -> hPutStrLn fout (showPrettyValue v)
 runFile = runFileF stdout

UParse.hs

@@ -210,8 +210,10 @@ parseSSExp (tree,sp) = case tree of
 		(e1,p1) <- parseSSExp f
 		constructApplySugar r (e1,p1)
 	where
-		constructStrSugar [] sp = ((SSRef "empty"),sp)
-		constructStrSugar (a:ar) sp = ((SSApply (SSApply (SSRef "cons",sp) ((SSInt (ord a)),sp),sp) (constructStrSugar ar sp)),sp)
+		--constructStrSugar [] sp = ((SSRef "empty"),sp)
+		constructStrSugar [] sp = (SSLambda "f" (SSLambda "g" (SSRef "f",sp),sp),sp)
+		--constructStrSugar (a:ar) sp = ((SSApply (SSApply (SSRef "cons",sp) ((SSInt (ord a)),sp),sp) (constructStrSugar ar sp)),sp)
+		constructStrSugar (a:ar) sp = (SSLambda "f" (SSLambda "g" (SSApply (SSApply (SSRef "g",sp) (SSInt (ord a),sp),sp) (constructStrSugar ar sp),sp),sp),sp)
 		constructLambdaSugar [] p = SFail "incomplete lambda expression" p
 		constructLambdaSugar (_:[]) p = SFail "incomplete lambda expression" p
 		constructLambdaSugar ((STTNode (STAtom name),p1):body:[]) p = do
@@ -222,11 +224,13 @@ parseSSExp (tree,sp) = case tree of
 			(ebody,pb) <- constructLambdaSugar r p
 			return ((SSLambda name (ebody,pb)),p1)
 		constructLambdaSugar ((_,p1):_) p = SFail "lambda expression needs a variable name" p1
-		constructListSugar [] p = return ((SSRef "empty"),p)
+		-- constructListSugar [] p = return ((SSRef "empty"),p)
+		constructListSugar [] p = return (SSLambda "f" (SSLambda "g" (SSRef "f",p),p),p)
 		constructListSugar (f:r) p = do
 			(e1,p1) <- parseSSExp f
 			(remain,p2) <- constructListSugar r p
-			return ((SSApply ((SSApply ((SSRef "cons"),p1) (e1,p1)),p1) (remain,p2)),p1)
+			--return ((SSApply ((SSApply ((SSRef "cons"),p1) (e1,p1)),p1) (remain,p2)),p1)
+			return (SSLambda "f" (SSLambda "g" (SSApply (SSApply (SSRef "g",p1) (e1,p1),p1) (remain,p2),p1),p1),p1)
 		constructApplySugar [] (e,p) = SSucc (e,p)
 		constructApplySugar (f:r) (e,p) = do
 			(e1,p1) <- parseSSExp f