definitions, imports, logic

diff --git a/Arithmetic.lc b/Arithmetic.lc
index 115a869..5a30a17 100644 (file)
--- a/Arithmetic.lc
+++ b/Arithmetic.lc
@@ -1,4 +1,13 @@
-Nula=\f.\x.x
+import Logic

 Succ=\n.\f.\x.(f ((n f) x))
 Succ=\n.\f.\x.(f ((n f) x))

-\f.\x.(f x)
-(\n.\f.\x.(f ((n f) x)) \f.\x.(f x))
+Zero=\f.\x.x
+One=(Succ Zero)
+Two=(Succ One)
+Three=(Succ Two)
+Add=\n.\m.\f.\x.((n f) ((m f) x))
+Mult=\n.\m.\f.(n (m f))
+IsZero=\n.\x.\y.((n \z.y) x)
+((Add Two) Three)
+((Mult Two) Three)
+(PrintBool (IsZero Zero))
+(PrintBool (IsZero ((Add One) Two)))

diff --git a/Logic.lc b/Logic.lc
new file mode 100644 (file)
index 0000000..27b52fc
--- /dev/null
+++ b/Logic.lc
@@ -0,0 +1,5 @@
+True=\x.\y.x
+False=\x.\y.y
+And=\a.\b.((a b) False)
+If=\x.x
+PrintBool=\x.(((If x) TRUE) FALSE)

diff --git a/src/Main.hs b/src/Main.hs
index 4de3762..1405086 100644 (file)
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -2,11 +2,12 @@
 
 module Main where
 
 
 module Main where
 

-import Data.Text as T (Text)
+import Data.Text as T (Text, pack)

 import qualified Data.Text.IO as T
 import Data.Attoparsec.Text
 import qualified Data.Map as M
 import Control.Applicative
 import qualified Data.Text.IO as T
 import Data.Attoparsec.Text
 import qualified Data.Map as M
 import Control.Applicative

+import Control.Monad

 import System.Environment
 
 import Lambda
 import System.Environment
 
 import Lambda


@@ -23,24 +24,38 @@ parseDefinition = do
   t <- parseTerm
   return $! Definition name t
 
   t <- parseTerm
   return $! Definition name t
 

-parseFile :: Text -> ([Definition], [Term])
+parseImport :: Parser String
+parseImport = do
+  string (T.pack "import ")
+  many1 letter
+
+parseFile :: Text -> ([FilePath], [Definition], [Term])

 parseFile txt = case cnt of
     (Right t) -> t
     (Left e) -> error e
   where cnt = parseOnly (parserF <* endOfInput) txt
         parserF = do
 parseFile txt = case cnt of
     (Right t) -> t
     (Left e) -> error e
   where cnt = parseOnly (parserF <* endOfInput) txt
         parserF = do

+          imports <- many (parseImport <* char '\n')

           defs <- many (parseDefinition <* char '\n')
           terms <- many (parseTerm <* char '\n')
           defs <- many (parseDefinition <* char '\n')
           terms <- many (parseTerm <* char '\n')

-          return $! (defs, terms)
+          return (imports, defs, terms)

 
 

-printEval :: Term -> IO ()
-printEval t = do
+printEval :: (Term -> Term) -> Term -> IO ()
+printEval def t = do

   putStrLn $ show t ++ ":"
   putStrLn $ show t ++ ":"

-  putStrLn $ "  " ++ show (reduce t)
+  putStrLn $ "  " ++ show (reduce $ def t)

   putStrLn ""
 
   putStrLn ""
 

+makeDefTerm :: [Definition] -> Term -> Term
+makeDefTerm (Definition name dTerm : ds) t = App (Lambda name (makeDefTerm ds t)) dTerm
+makeDefTerm [] t = t
+

 main :: IO ()
 main = do
   [filename] <- getArgs
 main :: IO ()
 main = do
   [filename] <- getArgs

-  (defs, terms) <- parseFile <$> T.readFile filename
-  mapM_ printEval terms
+  (imports, defs, terms) <- parseFile <$> T.readFile filename
+  importDefs <- forM imports $ \ file ->  do
+        (_, idefs, _) <- parseFile <$> T.readFile (file ++ ".lc")
+        return idefs
+  let defT = makeDefTerm $ concat importDefs ++ defs
+  mapM_ (printEval defT) terms