commit 0976be07fc99735a634affb524aa75d5b0553cda Author: Abigail Magalhães Date: Fri Sep 3 20:27:27 2021 -0300 first commit diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..e481408 --- /dev/null +++ b/.gitignore @@ -0,0 +1,2 @@ +/.stack-work +/.vscode diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..ca46626 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright Abigail Magalhães (c) 2021 + +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 Abigail Magalhães 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. \ No newline at end of file diff --git a/README.md b/README.md new file mode 100644 index 0000000..71dc050 --- /dev/null +++ b/README.md @@ -0,0 +1 @@ +# layout diff --git a/Setup.hs b/Setup.hs new file mode 100644 index 0000000..9a994af --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/hie.yaml b/hie.yaml new file mode 100644 index 0000000..142e69f --- /dev/null +++ b/hie.yaml @@ -0,0 +1,2 @@ +cradle: + stack: \ No newline at end of file diff --git a/layout.cabal b/layout.cabal new file mode 100644 index 0000000..f61d4a9 --- /dev/null +++ b/layout.cabal @@ -0,0 +1,27 @@ +name: layout +version: 0.1.0.0 +-- synopsis: +-- description: +homepage: https://github.com/plt-hokusai/layout#readme +license: BSD3 +license-file: LICENSE +author: Abigail Magalhães +maintainer: me@abby.how +copyright: 2021 Abigail Magalhães +category: Web +build-type: Simple +cabal-version: >=1.10 +extra-source-files: README.md + +executable layout + hs-source-dirs: src + main-is: Main.hs + default-language: Haskell2010 + build-depends: base >= 4.7 && < 5 + , array >= 0.5 && < 0.6 + , mtl + + build-tool-depends: alex:alex >= 3.2.4 && < 4.0 + , happy:happy >= 1.19.12 && < 2.0 + + other-modules: Syntax, Lexer, Lexer.Support, Parser diff --git a/src/Lexer.x b/src/Lexer.x new file mode 100644 index 0000000..d1b879c --- /dev/null +++ b/src/Lexer.x @@ -0,0 +1,130 @@ +{ +module Lexer where + +import Control.Monad.State +import Control.Monad.Error +import Lexer.Support + +import Debug.Trace + +} + +%encoding "latin1" + +$lower = [ a-z ] +$upper = [ A-Z ] + +@ident = $lower [ $lower $upper _ ' ]* + +:- + [\ \t]+ ; + +<0> "in" { token TkIn } +<0> "let" { layoutKw TkLet } +<0> "where" { layoutKw TkWhere } + +<0> @ident { emit TkIdent } +<0> \\ { token TkBackslash } +<0> "->" { token TkArrow } +<0> \= { token TkEqual } +<0> \( { token TkLParen } +<0> \) { token TkRParen } +<0> \{ { token TkOpen } +<0> \} { token TkClose } + + +<0> "--" .* \n { \_ -> pushStartCode newline *> scan } +<0> \n { \_ -> pushStartCode newline *> scan } + + { + -- Skip comments and whitespace + "--" .* \n ; + \n ; + + \{ { openBrace } + () { startLayout } +} + + () { emptyLayout } + + { + \n ; + "--" .* \n ; + + () { offsideRule } +} + + () { doEOF } + +{ +handleEOF = pushStartCode eof *> scan + +doEOF _ = do + t <- Lexer.Support.layout + case t of + Nothing -> do + popStartCode + pure TkEOF + _ -> do + popLayout + pure TkVClose + +scan :: Lexer Token +scan = do + input@(Input _ _ _ string) <- gets lexerInput + startcode <- startCode + case alexScan input startcode of + AlexEOF -> handleEOF + AlexError (Input _ _ _ inp) -> + throwError $ "Lexical error: " ++ show (head inp) + AlexSkip input' _ -> do + modify' $ \s -> s { lexerInput = input' } + scan + AlexToken input' tokl action -> do + modify' $ \s -> s { lexerInput = input' } + action (take tokl string) + +layoutKw t _ = do + pushStartCode Lexer.layout + pure t + +openBrace _ = do + popStartCode + pushLayout ExplicitLayout + pure TkOpen + +startLayout _ = do + popStartCode + + reference <- Lexer.Support.layout + col <- gets (inpColumn . lexerInput) + + if Just (LayoutColumn col) <= reference + then pushStartCode empty_layout + else pushLayout (LayoutColumn col) + + pure TkVOpen + +emptyLayout _ = do + popStartCode + pushStartCode newline + pure TkVClose + +offsideRule _ = do + context <- Lexer.Support.layout + col <- gets (inpColumn . lexerInput) + + let continue = popStartCode *> scan + + case context of + Just (LayoutColumn col') -> do + case col `compare` col' of + EQ -> do + popStartCode + pure TkVSemi + GT -> continue + LT -> do + popLayout + pure TkVClose + _ -> continue +} \ No newline at end of file diff --git a/src/Lexer/Support.hs b/src/Lexer/Support.hs new file mode 100644 index 0000000..46cbfd2 --- /dev/null +++ b/src/Lexer/Support.hs @@ -0,0 +1,114 @@ +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +module Lexer.Support where + +import Data.Word +import Data.List (uncons) +import Data.Char (ord) +import Control.Monad.State +import Data.List.NonEmpty (NonEmpty ((:|))) +import qualified Data.List.NonEmpty as NE +import Control.Monad.Except + +data Token + = TkIdent String -- identifiers + + -- Keywords + | TkLet | TkIn | TkWhere + + -- Punctuation + | TkEqual | TkOpen | TkSemi | TkClose + | TkLParen | TkRParen + | TkBackslash | TkArrow + + -- Layout punctuation + | TkVOpen | TkVSemi | TkVClose + | TkEOF + deriving (Eq, Show) + +data AlexInput + = Input { inpLine :: {-# UNPACK #-} !Int + , inpColumn :: {-# UNPACK #-} !Int + , inpLast :: {-# UNPACK #-} !Char + , inpStream :: String + } + deriving (Eq, Show) + +alexPrevInputChar :: AlexInput -> Char +alexPrevInputChar = inpLast + +alexGetByte :: AlexInput -> Maybe (Word8, AlexInput) +alexGetByte inp@Input{inpStream = str} = advance <$> uncons str where + advance ('\n', rest) = + ( fromIntegral (ord '\n') + , Input { inpLine = inpLine inp + 1 + , inpColumn = 0 + , inpLast = '\n' + , inpStream = rest } + ) + advance (c, rest) = + ( fromIntegral (ord c) + , Input { inpLine = inpLine inp + , inpColumn = inpColumn inp + 1 + , inpLast = c + , inpStream = rest } + ) + +newtype Lexer a = Lexer { _getLexer :: StateT LexerState (Either String) a } + deriving (Functor, Applicative, Monad, MonadState LexerState, MonadError String) + +data Layout = ExplicitLayout | LayoutColumn Int + deriving (Eq, Show, Ord) + +data LexerState + = LS { lexerInput :: {-# UNPACK #-} !AlexInput + , lexerStartCodes :: {-# UNPACK #-} !(NonEmpty Int) + , lexerLayout :: [Layout] + } + deriving (Eq, Show) + +startCode :: Lexer Int +startCode = gets (NE.head . lexerStartCodes) + +pushStartCode :: Int -> Lexer () +pushStartCode i = modify' $ \st -> + st { lexerStartCodes = NE.cons i (lexerStartCodes st) + } + +popStartCode :: Lexer () +popStartCode = modify' $ \st -> + st { lexerStartCodes = + case lexerStartCodes st of + _ :| [] -> 0 :| [] + _ :| (x:xs) -> x :| xs + } + +layout :: Lexer (Maybe Layout) +layout = gets (fmap fst . uncons . lexerLayout) + +pushLayout :: Layout -> Lexer () +pushLayout i = modify' $ \st -> + st { lexerLayout = i:lexerLayout st } + +popLayout :: Lexer () +popLayout = modify' $ \st -> + st { lexerLayout = + case lexerLayout st of + _:xs -> xs + [] -> [] + } + +initState :: String -> LexerState +initState str = LS { lexerInput = Input 0 1 '\n' str + , lexerStartCodes = 0 :| [] + , lexerLayout = [] + } + +emit :: (String -> Token) -> String -> Lexer Token +emit = (pure .) + +token :: Token -> String -> Lexer Token +token = const . pure + +runLexer :: Lexer a -> String -> Either String a +runLexer act s = fst <$> runStateT (_getLexer act) (initState s) diff --git a/src/Main.hs b/src/Main.hs new file mode 100644 index 0000000..12a35d8 --- /dev/null +++ b/src/Main.hs @@ -0,0 +1,19 @@ +module Main where + +import Lexer.Support +import Lexer +import Debug.Trace (traceM) +import Control.Monad.RWS + +main :: IO () +main = do + putStrLn "hello world" + +lexAll :: Lexer () +lexAll = do + tok <- scan + case tok of + TkEOF -> pure () + x -> do + traceM (show x) + lexAll \ No newline at end of file diff --git a/src/Parser.y b/src/Parser.y new file mode 100644 index 0000000..f71e9e2 --- /dev/null +++ b/src/Parser.y @@ -0,0 +1,81 @@ +{ +module Parser where + +import Control.Monad.Error +import Lexer.Support +import Syntax +import Lexer (scan) + +} + +%name parseExpr Expr +%name parseDecl Decl + +%tokentype { Token } +%monad { Lexer } +%lexer { lexer } { TkEOF } + +%errorhandlertype explist +%error { parseError } + +%token + VAR { TkIdent $$ } + 'let' { TkLet } + 'in' { TkIn } + 'where' { TkWhere } + + '=' { TkEqual } + '{' { TkOpen } + ';' { TkSemi } + '}' { TkClose } + '\\' { TkBackslash } + '->' { TkArrow } + + '(' { TkLParen } + ')' { TkRParen } + + OPEN { TkVOpen } + SEMI { TkVSemi } + CLOSE { TkVClose } + +%% + +Atom :: { Expr } + : VAR { Var $1 } + | '(' Expr ')' { $2 } + +Expr :: { Expr } + : '\\' VAR '->' Expr { Lam $2 $4 } + | 'let' DeclBlock 'in' Expr { Let $2 $4 } + | FuncExpr { $1 } + +FuncExpr :: { Expr } + : FuncExpr Atom { App $1 $2 } + | Atom { $1 } + +DeclBlock :: { [Decl] } + : '{' DeclListSemi '}' { $2 } + | OPEN DeclListSEMI Close { $2 } + +DeclListSemi :: { [Decl] } + : Decl ';' DeclListSemi { $1:$3 } + | Decl { [$1] } + | {- empty -} { [] } + +DeclListSEMI :: { [Decl] } + : Decl SEMI DeclListSemi { $1:$3 } + | Decl { [$1] } + | {- empty -} { [] } + +Close + : CLOSE { () } + | error {% popLayout } + +Decl + : VAR '=' Expr { Decl $1 $3 Nothing } + | VAR '=' Expr 'where' DeclBlock { Decl $1 $3 (Just $5) } +{ +lexer cont = scan >>= cont + +parseError = throwError . show +} \ No newline at end of file diff --git a/src/Syntax.hs b/src/Syntax.hs new file mode 100644 index 0000000..9b78ef1 --- /dev/null +++ b/src/Syntax.hs @@ -0,0 +1,17 @@ +module Syntax (Expr(..), Decl(..), Program) where + +data Expr + = Var String + | App Expr Expr + | Lam String Expr + | Let [Decl] Expr + deriving (Eq, Show) + +data Decl + = Decl { declName :: String + , declRhs :: Expr + , declWhere :: Maybe [Decl] + } + deriving (Eq, Show) + +type Program = [Decl] \ No newline at end of file diff --git a/stack.yaml b/stack.yaml new file mode 100644 index 0000000..ed0c36e --- /dev/null +++ b/stack.yaml @@ -0,0 +1,67 @@ +# 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/4.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: [] + +# 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 diff --git a/stack.yaml.lock b/stack.yaml.lock new file mode 100644 index 0000000..fadacf7 --- /dev/null +++ b/stack.yaml.lock @@ -0,0 +1,13 @@ +# 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 + +packages: [] +snapshots: +- completed: + size: 585817 + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/18/4.yaml + sha256: ea3a318eafa9e9cc56bfbe46099fd0d54d32641ab7bbe1d182ed8f5de39f804c + original: + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/18/4.yaml diff --git a/that-code-from-before.hs b/that-code-from-before.hs new file mode 100644 index 0000000..77f9757 --- /dev/null +++ b/that-code-from-before.hs @@ -0,0 +1,14 @@ +Right + (Decl { declName = "foo" + , declRhs = + Let [ Decl { declName = "x" + , declRhs = + Let + [ Decl {declName = "y", declRhs = Var "z", declWhere = Nothing} ] + (Var "y") + , declWhere = Nothing + } + ] + (Var "x") + , declWhere = Nothing + }) \ No newline at end of file