summary refs log tree commit diff
diff options
context:
space:
mode:
authortzlil <tzlils@protonmail.com>2023-07-08 19:20:59 +0300
committertzlil <tzlils@protonmail.com>2023-07-08 19:20:59 +0300
commit40ef69c2f91a6e341ae09b4df3b896df25b536d1 (patch)
tree9b9b0cd373c6c8d320fdd7a372426b1c1428b206
parenteacfe73f33bb4468e160266b18c4f67071f4a255 (diff)
idk whats fucked D:
-rw-r--r--Untyped.hs24
1 files changed, 16 insertions, 8 deletions
diff --git a/Untyped.hs b/Untyped.hs
index ab92bdf..523776f 100644
--- a/Untyped.hs
+++ b/Untyped.hs
@@ -13,7 +13,7 @@ data Term = Var String | App Term Term | Lam String Term | Let String Term | Lit
 instance Show Term where
     show (Lit n) = show n
     show (Var x) = x
-    show (App x y) = show x ++ show y
+    show (App x y) = "("++show x ++ show y++")"
     show (Lam x y) = "(λ"++x++". "++show y++")"
 
 parens p = char '(' *> spaces *> p <* spaces <* char ')'
@@ -38,7 +38,7 @@ elet = do
   return $ Let name body 
 
 lit = Lit <$> read <$> many1 digit
-app = foldl1 App <$> sepBy1 (var <|> parens term) spaces
+app = foldl1 App <$> sepBy1 (var <|> lit <|> parens term) spaces
 
 term :: Parser Term
 term = elet <|> lam <|> app <|> lit <|> var 
@@ -49,19 +49,28 @@ normalstep :: Term -> State Env (Maybe Term)
 normalstep (App m n) = do
   (Env env) <- get
   case m of
-    Lam x m -> return $ evalState (normalstep n) (Env $ insert x m env) 
+    Lam x m -> do
+      m' <- return $ evalState (normalstep m) (Env $ alter (const $ Just $ n) x env)
+      case m' of
+        Nothing -> return $ Just $ m
+	Just m' -> return $ Just $ m'
     _ -> do 
          m' <- normalstep m
 	 case m' of
-           Nothing -> do 
+           Nothing -> do
 	     n' <- normalstep n
 	     return $ App m <$> n'
 	   Just m' -> return $ Just $ App m' n
 
-normalstep (Lam x m) = do
+normalstep l@(Lam x m) = do
   (Env env) <- get
-  m' <- return $ evalState (normalstep m) (Env $ alter (const $ Just $ Var x) x env)
+  --case env !? x of
+  --  Nothing -> return $ Lam x <$> evalState (normalstep m) (Env $ alter (const $ Just $ Var x) x env)
+  --  Just n -> return $ evalState (normalstep m) e 
+  --m' <- return $ evalState (normalstep m) (Env $ alter (const $ Just $ Var x) x env)
+  m' <- return $ evalState (normalstep m) (Env $ alter (const $ Just $ Var x) x env) 
   return $ Lam x <$> m'
+  --return Nothing
 
 normalstep (Let s n) = do
   (Env env) <- get
@@ -72,11 +81,10 @@ normalstep (Var s) = do
   (Env env) <- get
   case env !? s of
     Nothing -> error $ "unbound variable: " ++ s
-    --Nothing -> return Nothing
     Just v@(Var s') | s == s' -> return Nothing 
     Just term -> return $ Just $ term 
 
-normalstep n@(Lit _) = return Nothing
+normalstep (Lit _) = return Nothing
 
 
 eval term = do