first commit

This commit is contained in:
Raphael Jacobs 2022-02-20 02:26:08 +01:00
commit cd0ba1eb61
14 changed files with 477 additions and 0 deletions

2
.gitignore vendored Normal file
View File

@ -0,0 +1,2 @@
.stack-work/
*~

3
ChangeLog.md Normal file
View File

@ -0,0 +1,3 @@
# Changelog for lambdatest
## Unreleased changes

30
LICENSE Normal file
View File

@ -0,0 +1,30 @@
Copyright Author name here (c) 2022
All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:
* Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.
* Redistributions in binary form must reproduce the above
copyright notice, this list of conditions and the following
disclaimer in the documentation and/or other materials provided
with the distribution.
* Neither the name of Author name here nor the names of other
contributors may be used to endorse or promote products derived
from this software without specific prior written permission.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

1
README.md Normal file
View File

@ -0,0 +1 @@
# lambdatest

2
Setup.hs Normal file
View File

@ -0,0 +1,2 @@
import Distribution.Simple
main = defaultMain

6
app/Main.hs Normal file
View File

@ -0,0 +1,6 @@
module Main where
import Lib
main :: IO ()
main = entrypoint

70
lambdatest.cabal Normal file
View File

@ -0,0 +1,70 @@
cabal-version: 1.12
-- This file has been generated from package.yaml by hpack version 0.34.4.
--
-- see: https://github.com/sol/hpack
name: lambdatest
version: 0.1.0.0
description: Please see the README on GitHub at <https://github.com/githubuser/lambdatest#readme>
author: Raphael Jacobs
maintainer: raphy@dekedin.me
copyright: 2022 Raphael Jacobs
license: BSD3
license-file: LICENSE
build-type: Simple
extra-source-files:
README.md
ChangeLog.md
library
exposed-modules:
Lib
Parser
UntypedLambda
other-modules:
Paths_lambdatest
hs-source-dirs:
src
build-depends:
attoparsec
, base >=4.7 && <5
, bytestring
, cleff
, containers
default-language: Haskell2010
executable lambdatest-exe
main-is: Main.hs
other-modules:
Paths_lambdatest
hs-source-dirs:
app
default-extensions:
OverloadedStrings
ghc-options: -threaded -rtsopts -with-rtsopts=-N
build-depends:
attoparsec
, base >=4.7 && <5
, bytestring
, cleff
, containers
, lambdatest
default-language: Haskell2010
test-suite lambdatest-test
type: exitcode-stdio-1.0
main-is: Spec.hs
other-modules:
Paths_lambdatest
hs-source-dirs:
test
ghc-options: -threaded -rtsopts -with-rtsopts=-N
build-depends:
attoparsec
, base >=4.7 && <5
, bytestring
, cleff
, containers
, lambdatest
default-language: Haskell2010

54
package.yaml Normal file
View File

@ -0,0 +1,54 @@
name: lambdatest
version: 0.1.0.0
# github: "githubuser/lambdatest"
license: BSD3
author: "Raphael Jacobs"
maintainer: "raphy@dekedin.me"
copyright: "2022 Raphael Jacobs"
extra-source-files:
- README.md
- ChangeLog.md
# Metadata used when publishing your package
# synopsis: Short description of your package
# category: Web
# To avoid duplicated efforts in documentation and dealing with the
# complications of embedding Haddock markup inside cabal files, it is
# common to point users to the README.md file.
description: Please see the README on GitHub at <https://github.com/githubuser/lambdatest#readme>
dependencies:
- base >= 4.7 && < 5
- cleff
- attoparsec
- bytestring
- containers
library:
source-dirs: src
executables:
lambdatest-exe:
main: Main.hs
source-dirs: app
ghc-options:
- -threaded
- -rtsopts
- -with-rtsopts=-N
dependencies:
- lambdatest
default-extensions:
- OverloadedStrings
tests:
lambdatest-test:
main: Spec.hs
source-dirs: test
ghc-options:
- -threaded
- -rtsopts
- -with-rtsopts=-N
dependencies:
- lambdatest

45
src/Lib.hs Normal file
View File

@ -0,0 +1,45 @@
-- {-# LANGUAGE DataKinds, GADTs, TemplateHaskell, TypeOperators #-}
-- {-# LANGUAGE KindSignatures #-}
-- {-# LANGUAGE FlexibleContexts #-}
module Lib
( Identifier(..), Expression(..), -- exported for testing
entrypoint
) where
import System.IO
import Parser
import UntypedLambda
-- import Cleff
-- import Cleff.Input
-- import Cleff.Output
-- import Cleff.State
-- import Data.Maybe (fromMaybe)
--
mainloop :: Int -> Expression -> IO ()
mainloop i expr = do
putStrLn $ show i ++ ": " ++ show expr
-- _ <- getLine
let new = reduce expr
if new == expr
then do
putStrLn "reached normal form. Quitting."
else mainloop (i+1) $ reduce expr
entrypoint = do
setupbuffering
putStrLn "Write your lambda expression:\n"
expr <- getLine
case runparse expr of
Right ex -> mainloop 0 ex
Left err -> putStrLn $ "Parsing failed! :" ++ err
setupbuffering :: IO ()
setupbuffering = do
hSetBuffering stdin LineBuffering
hSetBuffering stdout LineBuffering

62
src/Parser.hs Normal file
View File

@ -0,0 +1,62 @@
module Parser where
import UntypedLambda
import Data.Attoparsec.ByteString
import Data.Attoparsec.ByteString.Char8
import qualified Data.ByteString as BS
import qualified Data.String as BS
import Control.Applicative ((<|>))
expressionparser :: Parser Expression
expressionparser = choice [applyparser, parensparser, identparser, lambdaparser]
-- exp <- choice [parensparser,
-- identparser,
-- lambdaparser,
-- applyparser]
-- endOfInput
-- return exp
parensparser :: Parser Expression
parensparser = do
char '('
many' space
exp <- expressionparser
many' space
char ')'
-- <?>
return exp
identparser :: Parser Expression
identparser = Var . Identifier <$> many1 letter_ascii
-- identparser = do
-- name <- many1 letter_ascii
lambdaparser :: Parser Expression
lambdaparser = do
char '\\' <|> char 'λ'
ids <- sepBy1' (many1 letter_ascii) (many1' space)
many' space
char '.'
many' space
Lambda (fmap Identifier ids) <$> expressionparser
applyparser :: Parser Expression
applyparser = do
firstexp <- nonrecexpparse
many1' space
otherexp <- sepBy1' nonrecexpparse (many1' space)
return $ leftassoc firstexp otherexp
-- Application e1 <$> expressionparser
where nonrecexpparse = choice [parensparser, identparser, lambdaparser]
leftassoc :: Expression -> [Expression] -> Expression
leftassoc x xs = foldl1 Application (x:xs)
-- runparse :: String -> Result Expression
runparse = parseOnly expressionparser . BS.fromString

59
src/UntypedLambda.hs Normal file
View File

@ -0,0 +1,59 @@
module UntypedLambda where
import qualified Data.Map as M
-- Let's start defining a few wrapper types, togheter with
-- the definition of our lambda expression and a map-based environment.
newtype Identifier = Identifier String
deriving Eq
instance Show Identifier where
show (Identifier s) = s
data Expression = Var Identifier
| Lambda [Identifier] Expression
| Application Expression Expression
deriving (Eq)
instance Show Expression where
show (Var s) = show s
show (Lambda ids ex) = "λ" ++ show ids ++ "." ++ show ex
show (Application m n) = enclosem m ++ " " ++ enclosen n
where
enclosem k@(Lambda _ _) = enclose $ show k
enclosem x = show x
enclosen k@(Lambda _ _) = enclose $ show k
enclosen k@(Application _ _) = enclose $ show k
enclosen x = show x
enclose s = "(" ++ s ++ ")"
-- name a more iconic duo: eval and apply!
--
-- data Lcomp :: Effect where
-- Reduce :: Expression -> Lcomp m Expression -- also known as EVAL
-- Apply :: Expression -> Expression -> Lcomp m Expression
-- makeEffect ''Lcomp
--
-- let's make our first, naive interpreter.
replace :: Identifier -> Expression -> Expression -> Expression
replace var ex k@(Var p) = if p == var then ex else k
replace var ex k@(Lambda ids body) = if var `elem` ids then k else Lambda ids (replace var ex body)
replace var ex k@(Application m n) = Application (replace var ex m) (replace var ex n)
simpleapply :: Expression -> Expression -> Expression
simpleapply (Lambda [] ex) p = Application ex p -- lambdas with no arguments are constants.
simpleapply (Lambda [i] ex) p = replace i p ex
simpleapply (Lambda (i:ids) ex) p = Lambda ids (replace i p ex)
simpleapply m n = Application m n
reduce :: Expression -> Expression
reduce (Application m n) = simpleapply (reduce m) (reduce n)
reduce (Lambda ids m) = Lambda ids (reduce m)
reduce (Var id) = Var id

69
stack.yaml Normal file
View File

@ -0,0 +1,69 @@
# This file was automatically generated by 'stack init'
#
# Some commonly used options have been documented as comments in this file.
# For advanced use and comprehensive documentation of the format, please see:
# https://docs.haskellstack.org/en/stable/yaml_configuration/
# Resolver to choose a 'specific' stackage snapshot or a compiler version.
# A snapshot resolver dictates the compiler version and the set of packages
# to be used for project dependencies. For example:
#
# resolver: lts-3.5
# resolver: nightly-2015-09-21
# resolver: ghc-7.10.2
#
# The location of a snapshot can be provided as a file or url. Stack assumes
# a snapshot provided as a file might change, whereas a url resource does not.
#
# resolver: ./custom-snapshot.yaml
# resolver: https://example.com/snapshots/2018-01-01.yaml
resolver:
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/18/25.yaml
# User packages to be built.
# Various formats can be used as shown in the example below.
#
# packages:
# - some-directory
# - https://example.com/foo/bar/baz-0.0.2.tar.gz
# subdirs:
# - auto-update
# - wai
packages:
- .
# Dependency packages to be pulled from upstream that are not in the resolver.
# These entries can reference officially published versions as well as
# forks / in-progress versions pinned to a git hash. For example:
#
# extra-deps:
# - acme-missiles-0.3
# - git: https://github.com/commercialhaskell/stack.git
# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
#
extra-deps:
- cleff-0.2.1.0
- rec-smallarray-0.1.0.0
# Override default flag values for local packages and extra-deps
# flags: {}
# Extra package databases containing global packages
# extra-package-dbs: []
# Control whether we use the GHC we find on the path
# system-ghc: true
#
# Require a specific version of stack, using version ranges
# require-stack-version: -any # Default
# require-stack-version: ">=2.7"
#
# Override the architecture used by stack, especially useful on Windows
# arch: i386
# arch: x86_64
#
# Extra directories used by stack for building
# extra-include-dirs: [/path/to/dir]
# extra-lib-dirs: [/path/to/dir]
#
# Allow a newer minor version of GHC than the snapshot specifies
# compiler-check: newer-minor

27
stack.yaml.lock Normal file
View File

@ -0,0 +1,27 @@
# This file was autogenerated by Stack.
# You should not edit this file by hand.
# For more information, please see the documentation at:
# https://docs.haskellstack.org/en/stable/lock_files
snapshots:
- original:
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/18/25.yaml
completed:
sha256: 1b74fb5e970497b5aefae56703f1bd44aa648bd1a5ef95c1eb8c29775087e2bf
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/18/25.yaml
size: 587393
packages:
- original:
hackage: cleff-0.2.1.0
completed:
pantry-tree:
sha256: 6a3da74b18631cde90e29a371f791003d130c5d8f16f02c7490949d15f9d8c7e
size: 2030
hackage: cleff-0.2.1.0@sha256:94e50aaf971a071ccf995de9e516daaab7e52de0f4fced0d6bcb7f4f5a9cdba5,5925
- original:
hackage: rec-smallarray-0.1.0.0
completed:
pantry-tree:
sha256: 5b23f667b0dd7c3966b572c12c0d04a502d653ed00adcc5e11467311086ded5a
size: 383
hackage: rec-smallarray-0.1.0.0@sha256:d79627e8790f2d5a19192e5df790a292237929b9572cecbfbcf3648a77b2e14c,2857

47
test/Spec.hs Normal file
View File

@ -0,0 +1,47 @@
{-# LANGUAGE OverloadedStrings #-}
import Parser
import Data.Attoparsec.ByteString
-- GHETTO TESTING TIME!!!!
test :: String -> Bool -> IO ()
test name cond = if cond
then putStrLn $ "Test " ++ name ++ " passed."
else putStrLn $ "Test " ++ name ++ " not passed!!"
-- force s = case runparse s of
-- Fail {} -> "Fail"
-- Partial f -> show $ f ""
-- Done _ r -> show r
main :: IO ()
main = do
print $ runparse "(x)"
print $ runparse "( x )"
print $ runparse "( 33)"
print $ runparse "( (( ( y ))))"
print $ runparse "(((p ))"
print $ "testing lambda"
print $ runparse "\\x.x"
print $ runparse "\\x.(x)"
print $ runparse "(\\x.y)"
print $ runparse "\\x y z.x"
print $ "testing application"
print $ runparse "x y"
print $ runparse "x y z"
print $ runparse "(x y) z"
print $ runparse "\\x.(x x)"
print $ runparse "\\x.x x x"