Skip to content

Commit 0f278f3

Browse files
nojimanojima
committed
Add ml
1 parent 03d6aac commit 0f278f3

14 files changed

+463
-0
lines changed

‎ml/.gitignore

+2
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,2 @@
1+
.stack-work/
2+
*~

‎ml/ChangeLog.md

+3
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,3 @@
1+
# Changelog for ml
2+
3+
## Unreleased changes

‎ml/LICENSE

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

‎ml/README.md

+1
Original file line numberDiff line numberDiff line change
@@ -0,0 +1 @@
1+
# ml

‎ml/Setup.hs

+2
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,2 @@
1+
import Distribution.Simple
2+
main = defaultMain

‎ml/app/Main.hs

+18
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,18 @@
1+
module Main where
2+
3+
import qualified System.IO as IO
4+
import qualified System.Exit as Exit
5+
import qualified Data.Text.IO as TIO
6+
import qualified Parse
7+
8+
main :: IO ()
9+
main = do
10+
IO.putStr "> "
11+
IO.hFlush IO.stdout
12+
source <- TIO.getLine
13+
case Parse.parse source of
14+
Left errorMessage -> do
15+
IO.hPutStr IO.stderr errorMessage
16+
Right ast -> do
17+
print ast
18+
main

‎ml/ml.cabal

+74
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,74 @@
1+
cabal-version: 1.12
2+
3+
-- This file has been generated from package.yaml by hpack version 0.34.4.
4+
--
5+
-- see: https://github.com/sol/hpack
6+
7+
name: ml
8+
version: 0.1.0.0
9+
description: Please see the README on GitHub at <https://github.com/githubuser/ml#readme>
10+
homepage: https://github.com/githubuser/ml#readme
11+
bug-reports: https://github.com/githubuser/ml/issues
12+
author: Author name here
13+
maintainer: [email protected]
14+
copyright: 2021 Author name here
15+
license: BSD3
16+
license-file: LICENSE
17+
build-type: Simple
18+
extra-source-files:
19+
README.md
20+
ChangeLog.md
21+
22+
source-repository head
23+
type: git
24+
location: https://github.com/githubuser/ml
25+
26+
library
27+
exposed-modules:
28+
Identifier
29+
Parse
30+
Syntax
31+
other-modules:
32+
Paths_ml
33+
hs-source-dirs:
34+
src
35+
build-depends:
36+
base >=4.7 && <5
37+
, containers
38+
, megaparsec
39+
, parser-combinators
40+
, text
41+
default-language: Haskell2010
42+
43+
executable ml-exe
44+
main-is: Main.hs
45+
other-modules:
46+
Paths_ml
47+
hs-source-dirs:
48+
app
49+
ghc-options: -threaded -rtsopts -with-rtsopts=-N
50+
build-depends:
51+
base >=4.7 && <5
52+
, containers
53+
, megaparsec
54+
, ml
55+
, parser-combinators
56+
, text
57+
default-language: Haskell2010
58+
59+
test-suite ml-test
60+
type: exitcode-stdio-1.0
61+
main-is: Spec.hs
62+
other-modules:
63+
Paths_ml
64+
hs-source-dirs:
65+
test
66+
ghc-options: -threaded -rtsopts -with-rtsopts=-N
67+
build-depends:
68+
base >=4.7 && <5
69+
, containers
70+
, megaparsec
71+
, ml
72+
, parser-combinators
73+
, text
74+
default-language: Haskell2010

‎ml/package.yaml

+52
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,52 @@
1+
name: ml
2+
version: 0.1.0.0
3+
github: "githubuser/ml"
4+
license: BSD3
5+
author: "Author name here"
6+
maintainer: "[email protected]"
7+
copyright: "2021 Author name here"
8+
9+
extra-source-files:
10+
- README.md
11+
- ChangeLog.md
12+
13+
# Metadata used when publishing your package
14+
# synopsis: Short description of your package
15+
# category: Web
16+
17+
# To avoid duplicated efforts in documentation and dealing with the
18+
# complications of embedding Haddock markup inside cabal files, it is
19+
# common to point users to the README.md file.
20+
description: Please see the README on GitHub at <https://github.com/githubuser/ml#readme>
21+
22+
dependencies:
23+
- base >= 4.7 && < 5
24+
- text
25+
- megaparsec
26+
- parser-combinators
27+
- containers
28+
29+
library:
30+
source-dirs: src
31+
32+
executables:
33+
ml-exe:
34+
main: Main.hs
35+
source-dirs: app
36+
ghc-options:
37+
- -threaded
38+
- -rtsopts
39+
- -with-rtsopts=-N
40+
dependencies:
41+
- ml
42+
43+
tests:
44+
ml-test:
45+
main: Spec.hs
46+
source-dirs: test
47+
ghc-options:
48+
- -threaded
49+
- -rtsopts
50+
- -with-rtsopts=-N
51+
dependencies:
52+
- ml

‎ml/src/Identifier.hs

+22
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,22 @@
1+
{-# LANGUAGE StrictData #-}
2+
module Identifier
3+
( Identifier(..)
4+
, fromText
5+
) where
6+
7+
import Data.String (IsString(..))
8+
import Data.Text (Text)
9+
import qualified Data.Text as T
10+
11+
newtype Identifier = Identifier
12+
{ name :: Text }
13+
deriving (Eq, Ord)
14+
15+
fromText :: Text -> Identifier
16+
fromText = Identifier
17+
18+
instance Show Identifier where
19+
show (Identifier n) = show (T.unpack n)
20+
21+
instance IsString Identifier where
22+
fromString str = Identifier (T.pack str)

‎ml/src/Parse.hs

+153
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,153 @@
1+
{-# LANGUAGE StrictData, OverloadedStrings #-}
2+
module Parse (parse) where
3+
4+
import qualified Data.Char as Char
5+
import qualified Data.Bifunctor as Bifunctor
6+
import Data.Function ((&))
7+
import qualified Data.List.NonEmpty as NonEmpty
8+
import Data.Set (Set)
9+
import qualified Data.Set as Set
10+
import Data.Text (Text)
11+
import qualified Data.Text as T
12+
import Data.Void (Void)
13+
import qualified Control.Applicative as Applicative
14+
import qualified Control.Monad.Combinators.Expr as CombinatorsExpr
15+
import Text.Megaparsec (Parsec, (<?>))
16+
import qualified Text.Megaparsec as Parsec
17+
import qualified Text.Megaparsec.Char as ParsecChar
18+
import qualified Text.Megaparsec.Char.Lexer as Lexer
19+
import qualified Text.Megaparsec.Error as ParsecError
20+
import qualified Syntax
21+
import Identifier (Identifier)
22+
import qualified Identifier
23+
24+
type Parser a = Parsec Void Text a
25+
26+
---------------------------------------------------------------------------------------------------
27+
28+
space :: Parser ()
29+
space =
30+
Lexer.space
31+
ParsecChar.space1
32+
Applicative.empty
33+
(Lexer.skipBlockComment "(*" "*)")
34+
35+
lexeme :: Parser a -> Parser a
36+
lexeme =
37+
Lexer.lexeme space
38+
39+
symbol :: Text -> Parser ()
40+
symbol s =
41+
() <$ Lexer.symbol space s
42+
43+
decimal :: Parser Integer
44+
decimal =
45+
lexeme Lexer.decimal
46+
47+
keywords :: Set Text
48+
keywords = Set.fromList ["if", "then", "else", "true", "false"]
49+
50+
keyword :: Text -> Parser ()
51+
keyword str =
52+
lexeme $
53+
() <$ ParsecChar.string str
54+
<* Parsec.notFollowedBy ParsecChar.alphaNumChar
55+
56+
identifierOrKeyword :: Parser Text
57+
identifierOrKeyword =
58+
let
59+
alphaChar =
60+
Parsec.satisfy
61+
(\c -> (Char.isAlpha c || c == '_') && Char.isAscii c)
62+
<?> "alphabet"
63+
64+
alnumChars =
65+
Parsec.takeWhileP
66+
(Just "alphabets or numbers")
67+
(\c -> (Char.isAlpha c || Char.isNumber c || c == '_') && Char.isAscii c)
68+
in
69+
lexeme (T.cons <$> alphaChar <*> alnumChars)
70+
71+
identifier :: Parser Identifier
72+
identifier =
73+
Parsec.try $ Parsec.label "identifier" $ do
74+
offset <- Parsec.getOffset
75+
word <- identifierOrKeyword
76+
if Set.member word keywords then
77+
let
78+
actual = ParsecError.Tokens (NonEmpty.fromList (T.unpack word))
79+
expected = ParsecError.Label (NonEmpty.fromList "identifier")
80+
err = ParsecError.TrivialError offset (Just actual) (Set.singleton expected)
81+
in
82+
Parsec.parseError err
83+
else
84+
return $ Identifier.fromText word
85+
86+
---------------------------------------------------------------------------------------------------
87+
88+
toplevel :: Parser Syntax.Expr
89+
toplevel =
90+
expr <* symbol ";;"
91+
92+
expr :: Parser Syntax.Expr
93+
expr =
94+
Parsec.choice [ ifExpr, simpleExpr ]
95+
96+
ifExpr :: Parser Syntax.Expr
97+
ifExpr =
98+
Syntax.If
99+
<$ keyword "if"
100+
<*> expr
101+
<* keyword "then"
102+
<*> expr
103+
<* keyword "else"
104+
<*> expr
105+
106+
simpleExpr :: Parser Syntax.Expr
107+
simpleExpr =
108+
CombinatorsExpr.makeExprParser
109+
term
110+
[ [ binaryOperator CombinatorsExpr.InfixL "*" Syntax.Mul ]
111+
, [ binaryOperator CombinatorsExpr.InfixL "+" Syntax.Add ]
112+
, [ binaryOperator CombinatorsExpr.InfixN "<" Syntax.Lt ]
113+
]
114+
<?> "expression"
115+
where
116+
binaryOperator infix_ name op =
117+
infix_ $ Parsec.label "binary operator" $
118+
Syntax.BinOp op <$ symbol name
119+
120+
term :: Parser Syntax.Expr
121+
term =
122+
Parsec.choice
123+
[ intLiteral
124+
, boolLiteral
125+
, variable
126+
, parens
127+
]
128+
129+
boolLiteral :: Parser Syntax.Expr
130+
boolLiteral =
131+
Syntax.Bool <$> Parsec.choice
132+
[ True <$ keyword "true"
133+
, False <$ keyword "false"
134+
]
135+
136+
intLiteral :: Parser Syntax.Expr
137+
intLiteral =
138+
Syntax.Int <$> decimal
139+
140+
variable :: Parser Syntax.Expr
141+
variable =
142+
Syntax.Variable <$> identifier
143+
144+
parens :: Parser Syntax.Expr
145+
parens =
146+
symbol "(" *> expr <* symbol ")"
147+
148+
---------------------------------------------------------------------------------------------------
149+
150+
parse :: Text -> Either String Syntax.Expr
151+
parse source =
152+
Parsec.parse toplevel "" source
153+
& Bifunctor.first Parsec.errorBundlePretty

‎ml/src/Syntax.hs

+24
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,24 @@
1+
{-# LANGUAGE StrictData #-}
2+
module Syntax
3+
( Expr(..)
4+
, BinOp(..)
5+
) where
6+
7+
import qualified Data.Text as T
8+
import Identifier (Identifier)
9+
import qualified Identifier
10+
11+
newtype Program
12+
= Program Expr
13+
deriving (Show, Eq)
14+
15+
data Expr
16+
= Variable Identifier
17+
| Int Integer
18+
| Bool Bool
19+
| BinOp BinOp Expr Expr
20+
| If Expr Expr Expr
21+
deriving (Show, Eq)
22+
23+
data BinOp = Add | Mul | Lt
24+
deriving (Show, Eq)

0 commit comments

Comments
 (0)