Make parsing more robust

1 files changed, 17 insertions, 11 deletions

diff --git a/pf.icl b/pf.icl
index 46016e1..76a54f9 100644
--- a/pf.icl
+++ b/pf.icl
@@ -1,8 +1,9 @@
 module pf
 
+import StdArray
 import StdBool
 import StdFile
-from StdFunc import flip
+from StdFunc import flip, o
 import StdMisc
 import StdString
 import StdTuple
@@ -12,6 +13,7 @@ import GenEq
 import Control.Applicative
 import Control.Monad
 import Data.Either
+import Data.Error
 from Data.Func import $
 import Data.Functor
 import Data.List
@@ -43,11 +45,11 @@ import Yard
 
 derive gEq Token; instance == Token where == a b = a === b
 
-tokenize :: ([Char] -> [Token])
+tokenize :: ([Char] -> MaybeError String [Token])
 tokenize = flip tok []
 where
-	tok :: [Char] [Token] -> [Token]
-	tok []           tks = reverse tks
+	tok :: [Char] [Token] -> MaybeError String [Token]
+	tok []           tks = Ok $ reverse tks
 	tok ['\\':cs]    tks = tok cs [TBackSlash:tks]
 	tok ['(':cs]     tks = tok cs [TParenOpen:tks]
 	tok [')':cs]     tks = tok cs [TParenClose:tks]
@@ -59,16 +61,20 @@ where
 	| isDigit c          = tok rest [TInt (toInt (toString digs)):tks]
 		with (digs,rest) = span isDigit [c:cs]
 	| isIdentChar c      = tok rest [TIdent (toString ids):tks]
-		with (ids,rest) = span isIdentChar [c:cs]
+		with (ids,rest)  = span isIdentChar [c:cs]
+	| otherwise          = Error $ "Unexpected character '" +++ {c} +++ "' in input."
 
 	isIdentChar :: Char -> Bool
 	isIdentChar c = isAlpha c || c == '_'
 
-parse :: String -> Maybe Expr
-parse s = case runParser expr (tokenize $ fromString s) of
-	(Right e, []) -> Just e
-	_             -> Nothing
+parse :: String -> MaybeError String Expr
+parse s = tokenize (fromString s) >>= cast o runParser expr
 where
+	cast :: (Either String a, [b]) -> MaybeError String a
+	cast (Right e, []) = Ok e
+	cast (Right _, _)  = Error "Not all input could be consumed."
+	cast (Left _, _)   = Error "Parse error"
+
 	simple :: Parser Token Expr
 	simple = liftM2 lambda (item TBackSlash *> some ident <* item TArrow) expr
 		<|> Literal <$> LitInt  <$> int
@@ -160,8 +166,8 @@ Start w
 # ([prg:cmd],w) = getCommandLine w
 | length cmd <> 1 = err ("Usage: " +++ prg +++ " EXPRESSION") w
 # e = parse (hd cmd)
-| isNothing e = err "Expression could not be parsed." w
-# e = fromJust e
+| isError e = err (fromError e) w
+# e = fromOk e
 # (io,w) = stdio w
 # io = io <<< "Request: " <<< print e <<< "\n"
 # io = io <<< "Result:  " <<< print (optim e) <<< "\n"