1 files changed, 57 insertions, 25 deletions

diff --git a/SmurfParse.icl b/SmurfParse.icl
index 81f6c2f..bf59b64 100644
--- a/SmurfParse.icl
+++ b/SmurfParse.icl
@@ -1,8 +1,10 @@
 implementation module SmurfParse
 
 from StdFunc import o, flip
+import StdArray
 import StdChar
 import StdList
+import StdMisc
 import StdFile
 import StdTuple
 import StdString
@@ -14,36 +16,66 @@ import Control.Monad
 
 import Smurf
 
+eToVarChars :: Expr -> [VarChar]
+eToVarChars (Lit s)         = map Char $ fromString s
+eToVarChars (Var v)         = [VarString v]
+eToVarChars (ECat a b)      = eToVarChars a ++ eToVarChars b
+eToVarChars (EHead (Var v)) = abort "head of var\n"
+eToVarChars (EHead a)       = [hd $ eToVarChars a]
+eToVarChars (ETail (Var v)) = abort "tail of var\n"
+eToVarChars (ETail a)       = tl $ eToVarChars a
+eToVarChars (EQuotify a)    = [Quoted a]
+
 parse :: ![Char] -> Maybe Program
-parse []       = pure []
-parse ['"':cs] = parseString cs >>= \(s,cs`) -> append (Push $ Lit s) $ parse cs`
-parse ['i':cs] = apparse Input cs
-parse ['o':cs] = apparse Output cs
-parse ['+':cs] = apparse Cat cs
-parse ['h':cs] = apparse Head cs
-parse ['t':cs] = apparse Tail cs
-parse ['q':cs] = apparse Quotify cs
-parse ['p':cs] = apparse Put cs
-parse ['g':cs] = apparse Get cs
-parse ['x':cs] = apparse Exec cs
-parse [c:cs]   = if (isSpace c) (parse cs) empty
-
-apparse :: Stm -> [Char] -> Maybe Program
-apparse stm = append stm o parse
+parse cs = parsev $ map Char cs
+
+parsev :: ![VarChar] -> Maybe Program
+parsev []            = pure []
+parsev [Char '"':cs] = parseString cs >>= \(s,cs`) -> append (Push s) $ parsev cs`
+parsev [Char 'i':cs] = apparse Input cs
+parsev [Char 'o':cs] = apparse Output cs
+parsev [Char '+':cs] = apparse Cat cs
+parsev [Char 'h':cs] = apparse Head cs
+parsev [Char 't':cs] = apparse Tail cs
+parsev [Char 'q':cs] = apparse Quotify cs
+parsev [Char 'p':cs] = apparse Put cs
+parsev [Char 'g':cs] = apparse Get cs
+parsev [Char 'x':cs] = apparse Exec cs
+parsev [Char c:cs]   = if (isSpace c) (parsev cs) empty
+parsev [Quoted e:cs] = apparse (Push e) cs
+parsev _             = empty
+
+apparse :: Stm -> [VarChar] -> Maybe Program
+apparse stm = append stm o parsev
 
 append :: a (m [a]) -> m [a] | Monad m
 append x mx = mx >>= \xs -> pure [x:xs]
 
-parseString :: ![Char] -> Maybe (String, [Char])
+parseString :: ![VarChar] -> Maybe (Expr, [VarChar])
 parseString cs = pS [] cs
 where
-    pS :: ![Char] ![Char] -> Maybe (String, [Char])
-    pS _ []             = empty
-    pS s ['"':cs]       = pure (toString $ reverse s, cs)
-    pS s ['\\':'n':cs]  = pS ['\n':s] cs
-    pS s ['\\':'r':cs]  = pS ['\r':s] cs
-    pS s ['\\':'t':cs]  = pS ['\t':s] cs
-    pS s ['\\':'\\':cs] = pS ['\\':s] cs
-    pS s ['\\':'"':cs]  = pS ['"':s] cs
-    pS s [c:cs]         = pS [c:s] cs
+	pS :: ![VarChar] ![VarChar] -> Maybe (Expr, [VarChar])
+	pS _ []             = empty
+	pS s [Char '"':cs]
+		= pure (toExpr $ reverse s, cs)
+	pS s [Char '\\':Char 'n':cs]  = pS [Char '\n':s] cs
+	pS s [Char '\\':Char 'r':cs]  = pS [Char '\r':s] cs
+	pS s [Char '\\':Char 't':cs]  = pS [Char '\t':s] cs
+	pS s [Char '\\':Char '\\':cs] = pS [Char '\\':s] cs
+	pS s [Char '\\':Char '"':cs]  = pS [Char '"':s] cs
+	pS s [c:cs]                   = pS [c:s] cs
 
+	toExpr :: [VarChar] -> Expr
+	toExpr cs = simplify $ te cs
+	where
+		te :: [VarChar] -> Expr
+		te []               = Lit ""
+		te [VarString v:cs] = ECat (Var v) (te cs)
+		te [Char c:cs]      = ECat (Lit {c}) (te cs)
+		te [Quoted e:cs2]   = ECat e (te cs2)
+		
+		simplify :: Expr -> Expr
+		simplify (ECat a b) = case (simplify a, simplify b) of
+			(Lit x, Lit y) = Lit $ x +++ y
+			(x, y)         = ECat x y
+		simplify e = e