first commit

.gitignore

@@ -0,0 +1,2 @@
+/.stack-work
+/.vscode

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.

README.md

@@ -0,0 +1 @@
+# layout

Setup.hs

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

hie.yaml

@@ -0,0 +1,2 @@
+cradle:
+  stack:

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:          [email protected]
+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

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 }
+
+<layout> {
+  -- Skip comments and whitespace
+  "--" .* \n ;
+  \n       ;
+
+  \{ { openBrace }
+  () { startLayout }
+}
+
+<empty_layout> () { emptyLayout }
+
+<newline> {
+  \n         ;
+  "--" .* \n ;
+  
+  () { offsideRule }
+}
+
+<eof> () { 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
+}

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) 

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

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 
+}

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]

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

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

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
+        })