├── .gitignore ├── .gitpod.yml ├── .travis.yml ├── Dockerfile ├── README.md ├── docs ├── grin-0.1.0.0 │ ├── Data-Functor-FoldableM.html │ ├── Grin-CheatSheet.html │ ├── Grin-Examples.html │ ├── Grin-Exp.html │ ├── Grin-GExp.html │ ├── Grin-GExpToExp.html │ ├── Grin-Interpreter-Abstract-Base.html │ ├── Grin-Interpreter-Abstract-Interpreter.html │ ├── Grin-Interpreter-Abstract-TypeInference.html │ ├── Grin-Interpreter-Base.html │ ├── Grin-Interpreter-Definitional.html │ ├── Grin-Interpreter-Env.html │ ├── Grin-Interpreter-Store.html │ ├── Grin-Pretty.html │ ├── Grin-TypeEnv.html │ ├── Grin-Value.html │ ├── LICENSE │ ├── Tutorial-Chapter01-Exercise01.html │ ├── Tutorial-Chapter01-Exercise02.html │ ├── Tutorial-Chapter02-Exercise01.html │ ├── Tutorial-Chapter02-Exercise02.html │ ├── Tutorial-Chapter03-Exercise01.html │ ├── Tutorial-Chapter03-Exercise02.html │ ├── doc-index-60.html │ ├── doc-index-95.html │ ├── doc-index-A.html │ ├── doc-index-All.html │ ├── doc-index-B.html │ ├── doc-index-C.html │ ├── doc-index-D.html │ ├── doc-index-E.html │ ├── doc-index-F.html │ ├── doc-index-G.html │ ├── doc-index-H.html │ ├── doc-index-I.html │ ├── doc-index-K.html │ ├── doc-index-L.html │ ├── doc-index-M.html │ ├── doc-index-N.html │ ├── doc-index-O.html │ ├── doc-index-P.html │ ├── doc-index-R.html │ ├── doc-index-S.html │ ├── doc-index-T.html │ ├── doc-index-U.html │ ├── doc-index-V.html │ ├── doc-index-W.html │ ├── doc-index-Y.html │ ├── doc-index.html │ ├── doc-index.json │ ├── grin.haddock │ ├── grin.txt │ ├── haddock-bundle.min.js │ ├── hslogo-16.png │ ├── index.html │ ├── meta.json │ ├── minus.gif │ ├── ocean.css │ ├── plus.gif │ ├── quick-jump.css │ ├── quick-jump.min.js │ ├── src │ │ ├── Data.Functor.FoldableM.html │ │ ├── Grin.CheatSheet.html │ │ ├── Grin.Examples.html │ │ ├── Grin.Exp.html │ │ ├── Grin.GExp.html │ │ ├── Grin.GExpToExp.html │ │ ├── Grin.Interpreter.Abstract.Base.html │ │ ├── Grin.Interpreter.Abstract.Interpreter.html │ │ ├── Grin.Interpreter.Abstract.TypeInference.html │ │ ├── Grin.Interpreter.Base.html │ │ ├── Grin.Interpreter.Definitional.html │ │ ├── Grin.Interpreter.Env.html │ │ ├── Grin.Interpreter.Store.html │ │ ├── Grin.Pretty.html │ │ ├── Grin.TypeEnv.html │ │ ├── Grin.Value.html │ │ ├── Tutorial.Chapter01.Exercise01.html │ │ ├── Tutorial.Chapter01.Exercise02.html │ │ ├── Tutorial.Chapter02.Exercise01.html │ │ ├── Tutorial.Chapter02.Exercise02.html │ │ ├── Tutorial.Chapter03.Exercise01.html │ │ ├── Tutorial.Chapter03.Exercise02.html │ │ ├── highlight.js │ │ └── style.css │ └── synopsis.png └── index.html ├── grin ├── LICENSE ├── app │ └── GrinCLI.hs ├── grin.cabal ├── src │ ├── Data │ │ └── Functor │ │ │ └── FoldableM.hs │ ├── Grin │ │ ├── CheatSheet.hs │ │ ├── Examples.hs │ │ ├── Exp.hs │ │ ├── GExp.hs │ │ ├── GExpToExp.hs │ │ ├── Interpreter │ │ │ ├── Abstract │ │ │ │ ├── Base.hs │ │ │ │ ├── Interpreter.hs │ │ │ │ └── TypeInference.hs │ │ │ ├── Base.hs │ │ │ ├── Definitional.hs │ │ │ ├── Env.hs │ │ │ └── Store.hs │ │ ├── Pretty.hs │ │ ├── TypeEnv.hs │ │ └── Value.hs │ └── Tutorial │ │ ├── Chapter01 │ │ ├── Exercise01.hs │ │ └── Exercise02.hs │ │ ├── Chapter02 │ │ ├── Exercise01.hs │ │ └── Exercise02.hs │ │ └── Chapter03 │ │ ├── Exercise01.hs │ │ └── Exercise02.hs └── test │ ├── Spec.hs │ └── Tutorial │ ├── Chapter01 │ ├── Exercise01Spec.hs │ └── Exercise02Spec.hs │ ├── Chapter02 │ ├── Exercise01Spec.hs │ └── Exercise02Spec.hs │ └── Chapter03 │ ├── Exercise01Spec.hs │ └── Exercise02Spec.hs └── stack.yaml /.gitignore: -------------------------------------------------------------------------------- 1 | .stack 2 | .stack-work 3 | stack.yaml.lock 4 | tags 5 | -------------------------------------------------------------------------------- /.gitpod.yml: -------------------------------------------------------------------------------- 1 | image: 2 | file: Dockerfile 3 | tasks: 4 | - init: "echo 'export STACK_ROOT=/workspace/mini-grin/.stack' >> ~/.bashrc; source ~/.bashrc; mkdir -p $STACK_ROOT; echo 'local-bin-path: /workspace/mini-grin/.bin' > $STACK_ROOT/config.yaml; stack install" 5 | command: "echo 'export STACK_ROOT=/workspace/mini-grin/.stack' >> ~/.bashrc; source ~/.bashrc" 6 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | sudo: false 2 | dist: xenial 3 | language: c 4 | 5 | env: 6 | global: 7 | - GCC=gcc-5 8 | - GXX=g++-5 9 | - LLVM_VER=7.1.0 10 | 11 | cache: 12 | directories: 13 | - $HOME/.stack/ 14 | 15 | addons: 16 | apt: 17 | packages: 18 | - gcc-5 19 | - g++-5 20 | - libgmp-dev 21 | - llvm-7-dev 22 | sources: 23 | - llvm-toolchain-xenial-7 24 | - ubuntu-toolchain-r-test 25 | 26 | before_install: 27 | - mkdir -p ~/.local/bin 28 | - export PATH=~/.local/bin:$PATH 29 | - travis_retry curl -L https://www.stackage.org/stack/linux-x86_64 | tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack' 30 | - export CC=/usr/bin/$GCC 31 | - export CXX=/usr/bin/$GXX 32 | 33 | install: 34 | - stack update 35 | - travis_wait 120 stack --no-terminal --install-ghc test --only-dependencies 36 | 37 | script: 38 | - mkdir .output 39 | - stack --no-terminal test --coverage 40 | 41 | #after_script: 42 | # - travis_retry curl -L https://github.com/rubik/stack-hpc-coveralls/releases/download/v0.0.4.0/shc-linux-x64-8.0.1.tar.bz2 | tar -xj 43 | # - ./shc grin grin-test 44 | -------------------------------------------------------------------------------- /Dockerfile: -------------------------------------------------------------------------------- 1 | FROM gitpod/workspace-full 2 | 3 | USER root 4 | 5 | RUN curl -sSL https://get.haskellstack.org/ | sh 6 | RUN echo "deb http://archive.canonical.com/ubuntu cosmic partner" >> /etc/apt/source.list 7 | RUN apt update 8 | RUN apt install -y apt-utils 9 | # TODO: Souffle 10 | # RUN apt-key adv --keyserver hkp://keyserver.ubuntu.com:80 --recv-keys 379CE192D401AB61 11 | # RUN add-apt-repository https://dl.bintray.com/souffle-lang/deb/ 12 | # RUN apt-get install -y souffle 13 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # mini-grin 2 | ICFP tutorial 3 | 4 | https://andorp.github.io/mini-grin/ 5 | 6 | ## support 7 | 8 | 9 | 10 | 11 | -------------------------------------------------------------------------------- /docs/grin-0.1.0.0/Data-Functor-FoldableM.html: -------------------------------------------------------------------------------- 1 | Data.Functor.FoldableM

grin-0.1.0.0

Safe HaskellSafe
LanguageHaskell2010

Data.Functor.FoldableM

Synopsis

Documentation

apoM :: (Monad m, Traversable (Base t), Corecursive t) => (a -> m (Base t (Either t a))) -> a -> m t Source #

apoM is the monadic counterpart of the apomorphism. 2 | Exercise: Read the definition of the ana and apo 3 | http://hackage.haskell.org/package/recursion-schemes-5.1.3/docs/src/Data.Functor.Foldable.html#ana 4 | http://hackage.haskell.org/package/recursion-schemes-5.1.3/docs/src/Data.Functor.Foldable.html#apo

In general apo is an extended anamorphism. Anamoprhism builds up an expression tree, using 5 | a seed and a function that creates a new layer of the tree. Anamorphism builds the tree from 6 | top to bottom.

The apomorphism, has the ability to generate a subtree in one go and stop the recursion there.

apoM is the Monadic variant, which can have some side effect meanwhile the generation of the 7 | next layer happens.

-------------------------------------------------------------------------------- /docs/grin-0.1.0.0/Grin-Examples.html: -------------------------------------------------------------------------------- 1 | Grin.Examples

grin-0.1.0.0

Safe HaskellNone
LanguageHaskell2010

Grin.Examples

Contents

Synopsis

Test expression

Factorial

Sum simple

-------------------------------------------------------------------------------- /docs/grin-0.1.0.0/Grin-GExpToExp.html: -------------------------------------------------------------------------------- 1 | Grin.GExpToExp

grin-0.1.0.0

Safe HaskellNone
LanguageHaskell2010

Grin.GExpToExp

Documentation

gexpToExp :: forall ctx. Exp ctx -> Exp Source #

-------------------------------------------------------------------------------- /docs/grin-0.1.0.0/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2017, Andor Pénzes, Csaba Hruska, Péter Podlovics 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 Andor Pénzes, Csaba Hruska, Péter Podlovics 17 | nor the names of other contributors may be used to endorse or 18 | promote products derived from this software without specific 19 | prior written permission. 20 | 21 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 24 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 25 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 26 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 27 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 28 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 29 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 30 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 31 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 32 | -------------------------------------------------------------------------------- /docs/grin-0.1.0.0/Tutorial-Chapter01-Exercise01.html: -------------------------------------------------------------------------------- 1 | Tutorial.Chapter01.Exercise01

grin-0.1.0.0

Safe HaskellNone
LanguageHaskell2010

Tutorial.Chapter01.Exercise01

Documentation

convertGExpToExp :: forall ctx. Exp ctx -> Exp Source #

-------------------------------------------------------------------------------- /docs/grin-0.1.0.0/Tutorial-Chapter03-Exercise01.html: -------------------------------------------------------------------------------- 1 | Tutorial.Chapter03.Exercise01

grin-0.1.0.0

Safe HaskellNone
LanguageHaskell2010

Tutorial.Chapter03.Exercise01

Contents

Synopsis

Documentation

Helper

-------------------------------------------------------------------------------- /docs/grin-0.1.0.0/Tutorial-Chapter03-Exercise02.html: -------------------------------------------------------------------------------- 1 | Tutorial.Chapter03.Exercise02

grin-0.1.0.0

Safe HaskellNone
LanguageHaskell2010

Tutorial.Chapter03.Exercise02

Synopsis

Documentation

sparseCaseOptimisation :: TypeEnv -> Exp -> Exp Source #

Sparse case optimisation uses ana to transform the program from top to down. 2 | It checks if the given alterntive can be removed. The alternative can be removed 3 | if it does not match any of the Nodes in the type associated with the variable. 4 | Literal matching alternatives must be kept.

matchingAlt :: Type -> CPat -> Bool Source #

Returns True if the given pattern can be matched with the type of the scrutinee

removeTheRedundantDefault :: Type -> [Alt] -> [Alt] Source #

Remove the redundant detault

-------------------------------------------------------------------------------- /docs/grin-0.1.0.0/doc-index-60.html: -------------------------------------------------------------------------------- 1 | grin-0.1.0.0 (Index - <)

grin-0.1.0.0

Index - <

<$$>Grin.Pretty
<+>Grin.Pretty
<//>Grin.Pretty
</>Grin.Pretty
<>Grin.Pretty
-------------------------------------------------------------------------------- /docs/grin-0.1.0.0/doc-index-95.html: -------------------------------------------------------------------------------- 1 | grin-0.1.0.0 (Index - _)

grin-0.1.0.0

Index - _

_absEnvGrin.Interpreter.Abstract.Base
_absExtGrin.Interpreter.Abstract.Base
_absFunGrin.Interpreter.Abstract.Base
_absStrGrin.Interpreter.Abstract.Base
_defEnvGrin.Interpreter.Definitional
_defFunsGrin.Interpreter.Definitional
_defOpsGrin.Interpreter.Definitional
_function 
1 (Function)Grin.TypeEnv, Grin.GExp
2 (Function)Grin.Interpreter.Abstract.Base
_heapGrin.Interpreter.Abstract.Base
_locationGrin.TypeEnv, Grin.GExp
_locationsGrin.TypeEnv, Grin.GExp
_nodeSetGrin.TypeEnv, Grin.GExp
_simpleTypeGrin.TypeEnv, Grin.GExp
_variable 
1 (Function)Grin.TypeEnv, Grin.GExp
2 (Function)Grin.Interpreter.Abstract.Base
-------------------------------------------------------------------------------- /docs/grin-0.1.0.0/doc-index-B.html: -------------------------------------------------------------------------------- 1 | grin-0.1.0.0 (Index - B)

grin-0.1.0.0

Index - B

backslashGrin.Pretty
baseEvalGrin.Interpreter.Base
BindGrin.GExp
bindNormalisationTutorial.Chapter03.Exercise01
bindPattern 
1 (Function)Grin.Interpreter.Base
2 (Function)Tutorial.Chapter01.Exercise02
3 (Function)Tutorial.Chapter02.Exercise01
Bind_Grin.GExp
blackGrin.Pretty
BlockGrin.Exp
BlockFGrin.Exp
blueGrin.Pretty
BNodePatGrin.Exp, Grin.GExp
boldGrin.Pretty
boolGrin.Pretty
BPat 
1 (Type/Class)Grin.Exp, Grin.GExp
2 (Type/Class)Grin.CheatSheet
bracesGrin.Pretty
bracketsGrin.Pretty
BUnitGrin.Exp, Grin.GExp
BVarGrin.Exp, Grin.GExp
-------------------------------------------------------------------------------- /docs/grin-0.1.0.0/doc-index-C.html: -------------------------------------------------------------------------------- 1 | grin-0.1.0.0 (Index - C)

grin-0.1.0.0

Index - C

CGrin.Value, Grin.GExp
C01E02_AddressGrin.CheatSheet
C01E02_DefinitionalGrin.CheatSheet
C01E02_FunctionsGrin.CheatSheet
C01E02_InterpretExternalGrin.CheatSheet
C01E02_NodeGrin.CheatSheet
C01E02_SValueGrin.CheatSheet
C01E02_ValueGrin.CheatSheet
C02E02_NodeGrin.CheatSheet
Cache 
1 (Type/Class)Grin.Interpreter.Abstract.Base
2 (Data Constructor)Grin.Interpreter.Abstract.Base
3 (Type/Class)Grin.CheatSheet
cache2TypeEnvGrin.Interpreter.Abstract.Interpreter
calcTypeEnvGrin.Interpreter.Abstract.TypeInference
CAppGrin.Interpreter.Abstract.Base
CaseGrin.GExp
Case_Grin.GExp
catGrin.Pretty
CExpGrin.Interpreter.Abstract.Base
cfgExpGrin.Interpreter.Abstract.Base
cfgStoreGrin.Interpreter.Abstract.Base
charGrin.Pretty
collectEnvGrin.Interpreter.Abstract.Interpreter
collectFunctionTypeGrin.Interpreter.Abstract.Interpreter
colonGrin.Pretty
columnGrin.Pretty
columnsGrin.Pretty
commaGrin.Pretty
Config 
1 (Type/Class)Grin.Interpreter.Abstract.Base
2 (Data Constructor)Grin.Interpreter.Abstract.Base
convertGExpToExpTutorial.Chapter01.Exercise01
CPat 
1 (Type/Class)Grin.Exp, Grin.GExp
2 (Type/Class)Grin.CheatSheet
cyanGrin.Pretty
-------------------------------------------------------------------------------- /docs/grin-0.1.0.0/doc-index-D.html: -------------------------------------------------------------------------------- 1 | grin-0.1.0.0 (Index - D)

grin-0.1.0.0

Index - D

DCTutorial.Chapter01.Exercise02
deboldGrin.Pretty
Def 
1 (Data Constructor)Grin.Exp
2 (Type/Class)Grin.Exp
3 (Data Constructor)Grin.GExp
DefaultPatGrin.Exp, Grin.GExp
DefEnv 
1 (Type/Class)Grin.Interpreter.Definitional
2 (Data Constructor)Grin.Interpreter.Definitional
defEnvGrin.Interpreter.Definitional
DefFGrin.Exp
defFunsGrin.Interpreter.Definitional
Definitional 
1 (Type/Class)Tutorial.Chapter01.Exercise02
2 (Data Constructor)Tutorial.Chapter01.Exercise02
DefinitionalT 
1 (Type/Class)Grin.Interpreter.Definitional
2 (Data Constructor)Grin.Interpreter.Definitional
definitionalTGrin.Interpreter.Definitional
defOpsGrin.Interpreter.Definitional
Def_Grin.GExp
deunderlineGrin.Pretty
displayIOGrin.Pretty
displaySGrin.Pretty
DNodeGrin.Interpreter.Definitional
DocGrin.Pretty
dotGrin.Pretty
doubleGrin.Pretty
dquoteGrin.Pretty
dquotesGrin.Pretty
dullblackGrin.Pretty
dullblueGrin.Pretty
dullcyanGrin.Pretty
dullgreenGrin.Pretty
dullmagentaGrin.Pretty
dullredGrin.Pretty
dullwhiteGrin.Pretty
dullyellowGrin.Pretty
DUnitGrin.Interpreter.Definitional
DVal 
1 (Type/Class)Grin.Interpreter.Definitional
2 (Data Constructor)Grin.Interpreter.Definitional
-------------------------------------------------------------------------------- /docs/grin-0.1.0.0/doc-index-F.html: -------------------------------------------------------------------------------- 1 | grin-0.1.0.0 (Index - F)

grin-0.1.0.0

Index - F

FGrin.Value, Grin.GExp
factGrin.Examples
FetchGrin.GExp
fetchStore 
1 (Function)Grin.Interpreter.Base
2 (Function)Tutorial.Chapter01.Exercise02
3 (Function)Tutorial.Chapter02.Exercise01
fillGrin.Pretty
fillBreakGrin.Pretty
fillCatGrin.Pretty
fillSepGrin.Pretty
fixCacheGrin.Interpreter.Abstract.Interpreter
flatAltGrin.Pretty
floatGrin.Pretty
forMonadPlusGrin.Interpreter.Abstract.Base
funCall 
1 (Function)Grin.Interpreter.Base
2 (Function)Tutorial.Chapter01.Exercise02
3 (Function)Tutorial.Chapter02.Exercise01
functionGrin.TypeEnv, Grin.GExp
Functions 
1 (Type/Class)Tutorial.Chapter01.Exercise02
2 (Data Constructor)Tutorial.Chapter01.Exercise02
functionsTutorial.Chapter01.Exercise02
FunctionT 
1 (Type/Class)Grin.Interpreter.Abstract.Base
2 (Data Constructor)Grin.Interpreter.Abstract.Base
funcToFunctionsGrin.Interpreter.Abstract.TypeInference
-------------------------------------------------------------------------------- /docs/grin-0.1.0.0/doc-index-G.html: -------------------------------------------------------------------------------- 1 | grin-0.1.0.0 (Index - G)

grin-0.1.0.0

Index - G

getCacheGrin.Interpreter.Abstract.Base
getCacheOutGrin.Interpreter.Abstract.Interpreter
getNameGrin.Value, Grin.GExp
getStoreGrin.Interpreter.Abstract.Interpreter
GExpGrin.CheatSheet
gexpToExpGrin.GExpToExp
greenGrin.Pretty
groupGrin.Pretty
-------------------------------------------------------------------------------- /docs/grin-0.1.0.0/doc-index-H.html: -------------------------------------------------------------------------------- 1 | grin-0.1.0.0 (Index - H)

grin-0.1.0.0

Index - H

hangGrin.Pretty
hardlineGrin.Pretty
hcatGrin.Pretty
HeapVal 
1 (Type/Class)Grin.Interpreter.Base
2 (Type/Class)Tutorial.Chapter02.Exercise01
heapVal2val 
1 (Function)Grin.Interpreter.Base
2 (Function)Tutorial.Chapter01.Exercise02
3 (Function)Tutorial.Chapter02.Exercise01
hPutDocGrin.Pretty
hsepGrin.Pretty
-------------------------------------------------------------------------------- /docs/grin-0.1.0.0/doc-index-I.html: -------------------------------------------------------------------------------- 1 | grin-0.1.0.0 (Index - I)

grin-0.1.0.0

Index - I

inCacheGrin.Interpreter.Abstract.Base
indentGrin.Pretty
inlineEvalTutorial.Chapter03.Exercise01
insert 
1 (Function)Grin.Interpreter.Store
2 (Function)Grin.Interpreter.Env
insertCacheGrin.Interpreter.Abstract.Base
insertsGrin.Interpreter.Env
intGrin.Pretty
integerGrin.Pretty
Interpreter 
1 (Type/Class)Grin.Interpreter.Base
2 (Type/Class)Tutorial.Chapter02.Exercise01
interpreterTutorial.Chapter01.Exercise02
InterpretExternalTutorial.Chapter01.Exercise02
IsExpGrin.GExp
isExternal 
1 (Function)Grin.Interpreter.Base
2 (Function)Tutorial.Chapter01.Exercise02
3 (Function)Tutorial.Chapter02.Exercise01
isExternalNameGrin.Exp
-------------------------------------------------------------------------------- /docs/grin-0.1.0.0/doc-index-K.html: -------------------------------------------------------------------------------- 1 | grin-0.1.0.0 (Index - K)

grin-0.1.0.0

Index - K

keywordGrin.Pretty
keywordRGrin.Pretty
knownExternalsTutorial.Chapter01.Exercise02
-------------------------------------------------------------------------------- /docs/grin-0.1.0.0/doc-index-L.html: -------------------------------------------------------------------------------- 1 | grin-0.1.0.0 (Index - L)

grin-0.1.0.0

Index - L

langleGrin.Pretty
lbraceGrin.Pretty
lbracketGrin.Pretty
lineGrin.Pretty
linebreakGrin.Pretty
listGrin.Pretty
LitPatGrin.Exp, Grin.GExp
Loc 
1 (Type/Class)Grin.TypeEnv, Grin.GExp
2 (Type/Class)Grin.Interpreter.Abstract.Base
3 (Data Constructor)Grin.Interpreter.Abstract.Base
4 (Type/Class)Grin.Interpreter.Definitional
5 (Data Constructor)Grin.Interpreter.Definitional
6 (Type/Class)Grin.CheatSheet
localCacheInGrin.Interpreter.Abstract.Interpreter
localEnv 
1 (Function)Grin.Interpreter.Base
2 (Function)Tutorial.Chapter01.Exercise02
3 (Function)Tutorial.Chapter02.Exercise01
locationGrin.TypeEnv, Grin.GExp
locationsGrin.TypeEnv, Grin.GExp
locsToLocationGrin.Interpreter.Abstract.TypeInference
lookup 
1 (Function)Grin.Interpreter.Store
2 (Function)Grin.Interpreter.Env
lookupFun 
1 (Function)Grin.Interpreter.Base
2 (Function)Tutorial.Chapter01.Exercise02
3 (Function)Tutorial.Chapter02.Exercise01
lparenGrin.Pretty
-------------------------------------------------------------------------------- /docs/grin-0.1.0.0/doc-index-M.html: -------------------------------------------------------------------------------- 1 | grin-0.1.0.0 (Index - M)

grin-0.1.0.0

Index - M

magentaGrin.Pretty
matchingAltTutorial.Chapter03.Exercise02
mkNameGrin.Value, Grin.GExp
mlfpGrin.Interpreter.Abstract.Interpreter
-------------------------------------------------------------------------------- /docs/grin-0.1.0.0/doc-index-N.html: -------------------------------------------------------------------------------- 1 | grin-0.1.0.0 (Index - N)

grin-0.1.0.0

Index - N

NTutorial.Chapter01.Exercise02
Name 
1 (Type/Class)Grin.Value, Grin.GExp
2 (Type/Class)Grin.CheatSheet
nameStringGrin.Value, Grin.GExp
nestGrin.Pretty
nestingGrin.Pretty
NMGrin.Value, Grin.GExp
nMapGrin.Value, Grin.GExp
Node 
1 (Type/Class)Grin.Value, Grin.GExp
2 (Data Constructor)Grin.Value, Grin.GExp
3 (Type/Class)Grin.Interpreter.Abstract.Base
4 (Data Constructor)Grin.Interpreter.Abstract.Base
5 (Type/Class)Grin.Interpreter.Definitional
6 (Data Constructor)Grin.Interpreter.Definitional
7 (Type/Class)Tutorial.Chapter01.Exercise02
8 (Data Constructor)Tutorial.Chapter01.Exercise02
9 (Type/Class)Grin.CheatSheet
NodePatGrin.Exp, Grin.GExp
NodeSetGrin.TypeEnv, Grin.GExp
nodeSetGrin.TypeEnv, Grin.GExp
NTGrin.Interpreter.Abstract.Base
-------------------------------------------------------------------------------- /docs/grin-0.1.0.0/doc-index-O.html: -------------------------------------------------------------------------------- 1 | grin-0.1.0.0 (Index - O)

grin-0.1.0.0

Index - O

onblackGrin.Pretty
onblueGrin.Pretty
oncyanGrin.Pretty
ondullblackGrin.Pretty
ondullblueGrin.Pretty
ondullcyanGrin.Pretty
ondullgreenGrin.Pretty
ondullmagentaGrin.Pretty
ondullredGrin.Pretty
ondullwhiteGrin.Pretty
ondullyellowGrin.Pretty
ongreenGrin.Pretty
onmagentaGrin.Pretty
onredGrin.Pretty
onwhiteGrin.Pretty
onyellowGrin.Pretty
-------------------------------------------------------------------------------- /docs/grin-0.1.0.0/doc-index-P.html: -------------------------------------------------------------------------------- 1 | grin-0.1.0.0 (Index - P)

grin-0.1.0.0

Index - P

PGrin.Value, Grin.GExp
parensGrin.Pretty
plainGrin.Pretty
PP 
1 (Type/Class)Grin.Pretty
2 (Data Constructor)Grin.Pretty
PrettyGrin.Pretty
prettyGrin.Pretty
prettyExternalsGrin.Exp
prettyFunctionGrin.Pretty
prettyHighlightExternalsGrin.Exp
prettyKeyValueGrin.Pretty
prettyListGrin.Pretty
prettyNodeGrin.TypeEnv, Grin.GExp
prettyProgramGrin.Exp
PrgGrin.GExp
PrimTutorial.Chapter01.Exercise02
printGrinGrin.Exp
Program 
1 (Data Constructor)Grin.Exp
2 (Type/Class)Grin.Exp
3 (Data Constructor)Grin.GExp
ProgramFGrin.Exp
programToDefsGrin.Exp
punctuateGrin.Pretty
PureGrin.GExp
putCacheOutGrin.Interpreter.Abstract.Interpreter
putDocGrin.Pretty
putStoreGrin.Interpreter.Abstract.Interpreter
-------------------------------------------------------------------------------- /docs/grin-0.1.0.0/doc-index-R.html: -------------------------------------------------------------------------------- 1 | grin-0.1.0.0 (Index - R)

grin-0.1.0.0

Index - R

rangleGrin.Pretty
rationalGrin.Pretty
rbraceGrin.Pretty
rbracketGrin.Pretty
redGrin.Pretty
removeTheRedundantDefaultTutorial.Chapter03.Exercise02
renameVarsTutorial.Chapter03.Exercise01
renderCompactGrin.Pretty
RenderingOptionGrin.Exp
renderPrettyGrin.Pretty
renderSmartGrin.Pretty
rparenGrin.Pretty
runAbstractTGrin.Interpreter.Abstract.Base
runDefinitionalTGrin.Interpreter.Definitional
-------------------------------------------------------------------------------- /docs/grin-0.1.0.0/doc-index-T.html: -------------------------------------------------------------------------------- 1 | grin-0.1.0.0 (Index - T)

grin-0.1.0.0

Index - T

T 
1 (Type/Class)Grin.Interpreter.Abstract.Base
2 (Type/Class)Grin.CheatSheet
Tag 
1 (Type/Class)Grin.Value, Grin.GExp
2 (Data Constructor)Grin.Value, Grin.GExp
3 (Type/Class)Grin.CheatSheet
tagTutorial.Chapter01.Exercise02
tagNameGrin.Value, Grin.GExp
TagTypeGrin.Value, Grin.GExp
tagTypeGrin.Value, Grin.GExp
tests 
1 (Function)Grin.Interpreter.Definitional
2 (Function)Grin.Interpreter.Abstract.TypeInference
textGrin.Pretty
tToTypeGrin.Interpreter.Abstract.TypeInference
tupledGrin.Pretty
TyGrin.TypeEnv, Grin.GExp
TyConGrin.TypeEnv, Grin.GExp
TypeGrin.TypeEnv, Grin.GExp
TypeEnv 
1 (Type/Class)Grin.TypeEnv, Grin.GExp
2 (Data Constructor)Grin.TypeEnv, Grin.GExp
3 (Type/Class)Grin.Interpreter.Abstract.Base
4 (Data Constructor)Grin.Interpreter.Abstract.Base
5 (Type/Class)Grin.CheatSheet
typeInference 
1 (Function)Grin.Interpreter.Abstract.TypeInference
2 (Function)Tutorial.Chapter02.Exercise02
typeOfSimpleValueGrin.Interpreter.Abstract.Base
typeOfValueGrin.Interpreter.Abstract.TypeInference
TySimpleGrin.TypeEnv, Grin.GExp
TyVarGrin.TypeEnv, Grin.GExp
T_BoolGrin.TypeEnv, Grin.GExp
T_CharGrin.TypeEnv, Grin.GExp
T_FloatGrin.TypeEnv, Grin.GExp
T_Int64Grin.TypeEnv, Grin.GExp
T_LocationGrin.TypeEnv, Grin.GExp
T_NodeSetGrin.TypeEnv, Grin.GExp
T_SimpleTypeGrin.TypeEnv, Grin.GExp
T_UnitGrin.TypeEnv, Grin.GExp
T_Word64Grin.TypeEnv, Grin.GExp
-------------------------------------------------------------------------------- /docs/grin-0.1.0.0/doc-index-U.html: -------------------------------------------------------------------------------- 1 | grin-0.1.0.0 (Index - U)

grin-0.1.0.0

Index - U

underlineGrin.Pretty
unifyNodeSetGrin.Interpreter.Abstract.TypeInference
unifySimpleTypeGrin.Interpreter.Abstract.TypeInference
unifyTypeGrin.Interpreter.Abstract.TypeInference
unifyTypesGrin.Interpreter.Abstract.TypeInference
UnitTutorial.Chapter01.Exercise02
unit 
1 (Function)Grin.Interpreter.Base
2 (Function)Tutorial.Chapter01.Exercise02
3 (Function)Tutorial.Chapter02.Exercise01
UpdateGrin.GExp
updateCacheOutGrin.Interpreter.Abstract.Interpreter
UTGrin.Interpreter.Abstract.Base
-------------------------------------------------------------------------------- /docs/grin-0.1.0.0/doc-index-V.html: -------------------------------------------------------------------------------- 1 | grin-0.1.0.0 (Index - V)

grin-0.1.0.0

Index - V

Val 
1 (Data Constructor)Grin.Value, Grin.GExp
2 (Type/Class)Grin.Interpreter.Base
3 (Type/Class)Tutorial.Chapter02.Exercise01
val2addr 
1 (Function)Grin.Interpreter.Base
2 (Function)Tutorial.Chapter01.Exercise02
3 (Function)Tutorial.Chapter02.Exercise01
val2heapVal 
1 (Function)Grin.Interpreter.Base
2 (Function)Tutorial.Chapter01.Exercise02
3 (Function)Tutorial.Chapter02.Exercise01
Value 
1 (Type/Class)Grin.Value, Grin.GExp
2 (Type/Class)Tutorial.Chapter01.Exercise02
3 (Type/Class)Grin.CheatSheet
value 
1 (Function)Grin.Interpreter.Base
2 (Function)Tutorial.Chapter01.Exercise02
3 (Function)Tutorial.Chapter02.Exercise01
valueOfTutorial.Chapter01.Exercise02
VarGrin.Value, Grin.GExp
variableGrin.TypeEnv, Grin.GExp
VarOrValue 
1 (Type/Class)Grin.Value, Grin.GExp
2 (Type/Class)Grin.CheatSheet
varToVariableGrin.Interpreter.Abstract.TypeInference
vcatGrin.Pretty
VNodeGrin.Value, Grin.GExp
VPrimGrin.Value, Grin.GExp
vsepGrin.Pretty
-------------------------------------------------------------------------------- /docs/grin-0.1.0.0/doc-index-W.html: -------------------------------------------------------------------------------- 1 | grin-0.1.0.0 (Index - W)

grin-0.1.0.0

Index - W

whiteGrin.Pretty
widthGrin.Pretty
WithExternalsGrin.Exp
WPP 
1 (Type/Class)Grin.Pretty
2 (Data Constructor)Grin.Pretty
-------------------------------------------------------------------------------- /docs/grin-0.1.0.0/doc-index-Y.html: -------------------------------------------------------------------------------- 1 | grin-0.1.0.0 (Index - Y)

grin-0.1.0.0

Index - Y

yellowGrin.Pretty
-------------------------------------------------------------------------------- /docs/grin-0.1.0.0/doc-index.html: -------------------------------------------------------------------------------- 1 | grin-0.1.0.0 (Index)

grin-0.1.0.0

-------------------------------------------------------------------------------- /docs/grin-0.1.0.0/grin.haddock: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/andorp/mini-grin/3d7bf702edc235ccc9b700ba6bad5f02085b5aa4/docs/grin-0.1.0.0/grin.haddock -------------------------------------------------------------------------------- /docs/grin-0.1.0.0/hslogo-16.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/andorp/mini-grin/3d7bf702edc235ccc9b700ba6bad5f02085b5aa4/docs/grin-0.1.0.0/hslogo-16.png -------------------------------------------------------------------------------- /docs/grin-0.1.0.0/index.html: -------------------------------------------------------------------------------- 1 | grin-0.1.0.0

grin-0.1.0.0

grin-0.1.0.0

 

Signatures

Modules

-------------------------------------------------------------------------------- /docs/grin-0.1.0.0/meta.json: -------------------------------------------------------------------------------- 1 | {"haddock_version":"2.22.0","quickjump_version":1} -------------------------------------------------------------------------------- /docs/grin-0.1.0.0/minus.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/andorp/mini-grin/3d7bf702edc235ccc9b700ba6bad5f02085b5aa4/docs/grin-0.1.0.0/minus.gif -------------------------------------------------------------------------------- /docs/grin-0.1.0.0/plus.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/andorp/mini-grin/3d7bf702edc235ccc9b700ba6bad5f02085b5aa4/docs/grin-0.1.0.0/plus.gif -------------------------------------------------------------------------------- /docs/grin-0.1.0.0/quick-jump.css: -------------------------------------------------------------------------------- 1 | /* @group Search box layout */ 2 | 3 | #search { 4 | position: fixed; 5 | top: 3.2em; 6 | bottom: 0; 7 | left: calc(50% - 22em); 8 | width: 44em; 9 | z-index: 1000; 10 | pointer-events: none; 11 | overflow-y: auto; 12 | } 13 | 14 | #search.hidden { 15 | display: none; 16 | } 17 | 18 | #search-form, #search-results { 19 | box-shadow: 2px 2px 6px rgb(199, 204, 208); 20 | pointer-events: all; 21 | } 22 | 23 | #search-form input { 24 | font-size: 1.25em; line-height: 2.3em; height: 2.4em; 25 | display: block; 26 | box-sizing: border-box; 27 | width: 100%; 28 | margin: 0; 29 | padding: 0 0.75em; 30 | border: 0.05em solid rgb(151, 179, 202); 31 | } 32 | 33 | #search input:focus { 34 | outline: none; 35 | } 36 | 37 | #search p.error { 38 | color: rgb(107, 24, 24); 39 | font-weight: bold; 40 | } 41 | 42 | #search-results { 43 | box-sizing: border-box; 44 | border: 0.05em solid #b2d5fb; 45 | background: #e8f3ff; 46 | } 47 | 48 | #search-form input + #search-results { 49 | border-top: none; 50 | top: 3em; 51 | max-height: calc(100% - 3em); 52 | } 53 | 54 | /* @end */ 55 | 56 | /* @group search results */ 57 | 58 | #search-results > ul { 59 | margin: 0; 60 | list-style: none; 61 | } 62 | 63 | #search-results > ul > li, 64 | #search-results > p, 65 | #search-results > table { 66 | padding: 0.5em 1em; 67 | margin: 0; 68 | } 69 | 70 | #search-results > ul > li { 71 | border-bottom: 1px solid #b2d5fb; 72 | } 73 | 74 | #search-results > ul > li > ul { 75 | list-style: none; 76 | } 77 | 78 | .search-module h4 { 79 | margin: 0; 80 | } 81 | 82 | .search-module > ul { 83 | margin: 0.5em 0 0.5em 2em; 84 | } 85 | 86 | .search-module > ul > li > a[href] { 87 | display: block; 88 | color: inherit; 89 | padding: 0.25em 0.5em; 90 | } 91 | 92 | .search-module > ul > li > a[href].active-link { 93 | background: #faf9dc; 94 | } 95 | 96 | .search-module a[href]:hover { 97 | text-decoration: none; 98 | } 99 | 100 | .search-result a a { 101 | pointer-events: none; 102 | } 103 | 104 | .search-result ul.subs { 105 | display: inline-block; 106 | margin: 0; padding: 0; 107 | } 108 | 109 | .search-result ul.subs li { 110 | display: none; 111 | } 112 | 113 | .search-result ul.subs::after { 114 | display: inline-block; 115 | content: "..."; 116 | color: rgb(78,98,114); 117 | margin: 0 0.25em; 118 | } 119 | 120 | .more-results { 121 | color: rgb(99, 141, 173); 122 | position: relative; 123 | } 124 | 125 | .more-results::before { 126 | content: "+"; 127 | display: inline-block; 128 | color: #b2d5fb; 129 | font-weight: bold; 130 | font-size: 1.25em; line-height: inherit; 131 | position: absolute; 132 | left: -1em; 133 | } 134 | 135 | /* @end */ 136 | 137 | /* @group Keyboard shortcuts table */ 138 | 139 | .keyboard-shortcuts { 140 | line-height: 1.6em; 141 | } 142 | 143 | .keyboard-shortcuts th { 144 | color: rgb(78,98,114); 145 | } 146 | 147 | .keyboard-shortcuts td:first-child, 148 | .keyboard-shortcuts th:first-child { 149 | text-align: right; 150 | padding-right: 0.6em; 151 | } 152 | 153 | .key { 154 | display: inline-block; 155 | font-size: 0.9em; 156 | min-width: 0.8em; line-height: 1.2em; 157 | text-align: center; 158 | background: #b2d5fb; 159 | border: 1px solid #74a3d6; 160 | padding: 0 0.2em; 161 | margin: 0 0.1em; 162 | } 163 | 164 | /* @end */ 165 | -------------------------------------------------------------------------------- /docs/grin-0.1.0.0/src/Data.Functor.FoldableM.html: -------------------------------------------------------------------------------- 1 |
{-# LANGUAGE FlexibleContexts #-}
 2 | module Data.Functor.FoldableM where
 3 | 
 4 | import Control.Monad ((<=<))
 5 | import Data.Functor.Foldable
 6 | 
 7 | {-
 8 | anaM :: (Monad m, Traversable (Base t), Corecursive t)
 9 |      => (a -> m (Base t a)) -> a -> m t
10 | anaM coalg = a where
11 |      a = (pure . embed) <=< traverse a <=< coalg
12 | -}
13 | 
14 | -- | apoM is the monadic counterpart of the apomorphism.
15 | -- Exercise: Read the definition of the ana and apo
16 | -- http://hackage.haskell.org/package/recursion-schemes-5.1.3/docs/src/Data.Functor.Foldable.html#ana
17 | -- http://hackage.haskell.org/package/recursion-schemes-5.1.3/docs/src/Data.Functor.Foldable.html#apo
18 | --
19 | -- In general apo is an extended anamorphism. Anamoprhism builds up an expression tree, using
20 | -- a seed and a function that creates a new layer of the tree. Anamorphism builds the tree from
21 | -- top to bottom.
22 | --
23 | -- The apomorphism, has the ability to generate a subtree in one go and stop the recursion there.
24 | --
25 | -- apoM is the Monadic variant, which can have some side effect meanwhile the generation of the
26 | -- next layer happens.
27 | apoM
28 |   :: (Monad m, Traversable (Base t), Corecursive t)
29 |   => (a -> m (Base t (Either t a))) -> a -> m t
30 | apoM coalg = a where
31 |   a = (pure . embed) <=< traverse f <=< coalg
32 |   f = either pure a
33 | 
-------------------------------------------------------------------------------- /docs/grin-0.1.0.0/src/highlight.js: -------------------------------------------------------------------------------- 1 | 2 | var highlight = function (on) { 3 | return function () { 4 | var links = document.getElementsByTagName('a'); 5 | for (var i = 0; i < links.length; i++) { 6 | var that = links[i]; 7 | 8 | if (this.href != that.href) { 9 | continue; 10 | } 11 | 12 | if (on) { 13 | that.classList.add("hover-highlight"); 14 | } else { 15 | that.classList.remove("hover-highlight"); 16 | } 17 | } 18 | } 19 | }; 20 | 21 | window.onload = function () { 22 | var links = document.getElementsByTagName('a'); 23 | for (var i = 0; i < links.length; i++) { 24 | links[i].onmouseover = highlight(true); 25 | links[i].onmouseout = highlight(false); 26 | } 27 | }; 28 | -------------------------------------------------------------------------------- /docs/grin-0.1.0.0/src/style.css: -------------------------------------------------------------------------------- 1 | body { 2 | background-color: #fdf6e3; 3 | } 4 | 5 | .hs-identifier { 6 | color: #073642; 7 | } 8 | 9 | .hs-identifier.hs-var { 10 | } 11 | 12 | .hs-identifier.hs-type { 13 | color: #5f5faf; 14 | } 15 | 16 | .hs-keyword { 17 | color: #af005f; 18 | } 19 | 20 | .hs-string, .hs-char { 21 | color: #cb4b16; 22 | } 23 | 24 | .hs-number { 25 | color: #268bd2; 26 | } 27 | 28 | .hs-operator { 29 | color: #d33682; 30 | } 31 | 32 | .hs-glyph, .hs-special { 33 | color: #dc322f; 34 | } 35 | 36 | .hs-comment { 37 | color: #8a8a8a; 38 | } 39 | 40 | .hs-pragma { 41 | color: #2aa198; 42 | } 43 | 44 | .hs-cpp { 45 | color: #859900; 46 | } 47 | 48 | a:link, a:visited { 49 | text-decoration: none; 50 | border-bottom: 1px solid #eee8d5; 51 | } 52 | 53 | a:hover, a.hover-highlight { 54 | background-color: #eee8d5; 55 | } 56 | -------------------------------------------------------------------------------- /docs/grin-0.1.0.0/synopsis.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/andorp/mini-grin/3d7bf702edc235ccc9b700ba6bad5f02085b5aa4/docs/grin-0.1.0.0/synopsis.png -------------------------------------------------------------------------------- /docs/index.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 |

Redirecting to CheatSheet

8 | 9 | 10 | -------------------------------------------------------------------------------- /grin/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2017, Andor Pénzes, Csaba Hruska, Péter Podlovics 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 Andor Pénzes, Csaba Hruska, Péter Podlovics 17 | nor the names of other contributors may be used to endorse or 18 | promote products derived from this software without specific 19 | prior written permission. 20 | 21 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 24 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 25 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 26 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 27 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 28 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 29 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 30 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 31 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 32 | -------------------------------------------------------------------------------- /grin/app/GrinCLI.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | main :: IO () 4 | main = pure () 5 | 6 | -------------------------------------------------------------------------------- /grin/grin.cabal: -------------------------------------------------------------------------------- 1 | name: grin 2 | version: 0.1.0.0 3 | homepage: https://github.com/andorp/mini-grin 4 | license: BSD3 5 | license-file: LICENSE 6 | author: Andor Penzes, Csaba Hruska, Peter Podlovics 7 | maintainer: andor.penzes@gmail.com 8 | copyright: 2017 Andor Penzes, Csaba Hruska, Peter Podlovics 9 | category: Compiler 10 | build-type: Simple 11 | cabal-version: >=1.10 12 | 13 | library 14 | hs-source-dirs: src 15 | default-extensions: OverloadedStrings 16 | ghc-options: -Wall -Wno-orphans 17 | exposed-modules: 18 | Data.Functor.FoldableM 19 | Grin.CheatSheet 20 | Grin.Value 21 | Grin.TypeEnv 22 | Grin.Exp 23 | Grin.GExp 24 | Grin.GExpToExp 25 | Grin.Examples 26 | Grin.Pretty 27 | Grin.Interpreter.Env 28 | Grin.Interpreter.Store 29 | Grin.Interpreter.Base 30 | Grin.Interpreter.Definitional 31 | Grin.Interpreter.Abstract.Base 32 | Grin.Interpreter.Abstract.Interpreter 33 | Grin.Interpreter.Abstract.TypeInference 34 | Tutorial.Chapter01.Exercise01 35 | Tutorial.Chapter01.Exercise02 36 | Tutorial.Chapter02.Exercise01 37 | Tutorial.Chapter02.Exercise02 38 | Tutorial.Chapter03.Exercise01 39 | Tutorial.Chapter03.Exercise02 40 | 41 | build-depends: 42 | base >=4.11, 43 | containers, 44 | mtl, 45 | vector, 46 | deepseq, 47 | recursion-schemes, 48 | ansi-wl-pprint, 49 | bytestring, 50 | transformers, 51 | microlens, 52 | microlens-mtl, 53 | microlens-th, 54 | microlens-platform, 55 | text, 56 | functor-infix, 57 | binary, 58 | logict 59 | 60 | default-language: Haskell2010 61 | 62 | executable grin 63 | hs-source-dirs: app 64 | main-is: GrinCLI.hs 65 | ghc-options: -threaded -rtsopts -with-rtsopts=-N 66 | build-depends: base >=4.11 67 | , grin 68 | , transformers 69 | 70 | default-language: Haskell2010 71 | 72 | test-suite grin-test 73 | type: exitcode-stdio-1.0 74 | hs-source-dirs: test 75 | main-is: Spec.hs 76 | default-extensions: OverloadedStrings 77 | build-depends: base >=4.11 78 | , hspec 79 | , hspec-core 80 | , hspec-discover 81 | , hspec-expectations 82 | , transformers 83 | , containers 84 | , grin 85 | other-modules: 86 | Tutorial.Chapter01.Exercise01Spec 87 | Tutorial.Chapter01.Exercise02Spec 88 | Tutorial.Chapter02.Exercise01Spec 89 | Tutorial.Chapter02.Exercise02Spec 90 | Tutorial.Chapter03.Exercise01Spec 91 | Tutorial.Chapter03.Exercise02Spec 92 | 93 | default-language: Haskell2010 94 | 95 | source-repository head 96 | type: git 97 | location: https://github.com/andorp/mini-grin 98 | -------------------------------------------------------------------------------- /grin/src/Data/Functor/FoldableM.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleContexts #-} 2 | module Data.Functor.FoldableM where 3 | 4 | import Control.Monad ((<=<)) 5 | import Data.Functor.Foldable 6 | 7 | {- 8 | anaM :: (Monad m, Traversable (Base t), Corecursive t) 9 | => (a -> m (Base t a)) -> a -> m t 10 | anaM coalg = a where 11 | a = (pure . embed) <=< traverse a <=< coalg 12 | -} 13 | 14 | -- | apoM is the monadic counterpart of the apomorphism. 15 | -- Exercise: Read the definition of the ana and apo 16 | -- http://hackage.haskell.org/package/recursion-schemes-5.1.3/docs/src/Data.Functor.Foldable.html#ana 17 | -- http://hackage.haskell.org/package/recursion-schemes-5.1.3/docs/src/Data.Functor.Foldable.html#apo 18 | -- 19 | -- In general apo is an extended anamorphism. Anamoprhism builds up an expression tree, using 20 | -- a seed and a function that creates a new layer of the tree. Anamorphism builds the tree from 21 | -- top to bottom. 22 | -- 23 | -- The apomorphism, has the ability to generate a subtree in one go and stop the recursion there. 24 | -- 25 | -- apoM is the Monadic variant, which can have some side effect meanwhile the generation of the 26 | -- next layer happens. 27 | apoM 28 | :: (Monad m, Traversable (Base t), Corecursive t) 29 | => (a -> m (Base t (Either t a))) -> a -> m t 30 | apoM coalg = a where 31 | a = (pure . embed) <=< traverse f <=< coalg 32 | f = either pure a 33 | -------------------------------------------------------------------------------- /grin/src/Grin/CheatSheet.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ConstraintKinds #-} 2 | module Grin.CheatSheet where 3 | 4 | import qualified Grin.Value 5 | import qualified Grin.Exp 6 | import qualified Grin.GExp 7 | import qualified Grin.Interpreter.Env 8 | import qualified Grin.Interpreter.Store 9 | import qualified Tutorial.Chapter01.Exercise02 10 | import qualified Grin.Interpreter.Abstract.Base 11 | 12 | 13 | -- * Prelude 14 | -- 15 | -- $prelude 16 | -- === Introduction: 17 | -- https://github.com/grin-compiler/presentations/blob/master/2018/haskell-exchange-2018/Grin-HaskellX2018.pdf 18 | -- 19 | -- === What is GRIN 20 | -- GRIN stands for Graph Reduction Intermediate Notation, and is 21 | -- a compiler back end for functional languages. As its name 22 | -- suggests, GRIN can be used to express graph reduction semantics 23 | -- and hence can be used to compile functional languages. 24 | -- 25 | -- In GRIN, a node in the graph is represented as a C-stlye struct. 26 | -- The Heap can only contain Node values and nothing else. 27 | -- These Node values stored on the Heap are the nodes of the functional program's 28 | -- graph. The reduction of this graph is done through the primitive 29 | -- heap operations of GRIN (store, fetch, update). 30 | -- 31 | -- === Could you tell it again? 32 | -- GRIN is a very simple C like language: 33 | -- * C without pointer arithmetic 34 | -- * C without loops 35 | -- * C without types 36 | -- * Structs called Nodes have a fixed structure, a tag and some non-named arguments 37 | -- * Switch can match on Nodes 38 | -- * GRIN codes must be well-formed 39 | -- 40 | -- === How to run the tests 41 | -- > stack ghci --test 42 | -- > :l grin/test/Tutorial/Chapter01/Exercise01Spec.hs 43 | -- > hspec spec 44 | -- 45 | -- OR 46 | -- 47 | -- > stack test --file-watch 48 | 49 | -- * Chapter 01 / Exercise 01 50 | -- 51 | -- $c01e01 52 | -- === Original Syntax 53 | -- https://nbviewer.jupyter.org/github/grin-compiler/grin/blob/master/papers/boquist.pdf#page=44 54 | -- 55 | -- === Sequencing of GRIN opeartions 56 | -- https://nbviewer.jupyter.org/github/grin-compiler/grin/blob/master/papers/boquist.pdf#page=46 57 | -- 58 | -- === Link GADT syntax 59 | -- https://en.wikibooks.org/wiki/Haskell/GADT#GADTs 60 | -- 61 | -- === Exercise 62 | -- Implement 'Tutorial.Chapter01.Exercise01.convertGExpToExp' 63 | -- TODO: Program Graph of SumSimple 64 | 65 | type Name = Grin.Value.Name 66 | type Tag = Grin.Value.Tag 67 | type SimpleValue = Grin.Value.SimpleValue 68 | type Node = Grin.Value.Node 69 | type Value = Grin.Value.Value 70 | type VarOrValue = Grin.Value.VarOrValue 71 | 72 | type External = Grin.Exp.External 73 | type CPat = Grin.Exp.CPat 74 | type BPat = Grin.Exp.BPat 75 | 76 | type ExpCtx = Grin.GExp.ExpCtx 77 | type GExp = Grin.GExp.Exp 78 | 79 | type Exp = Grin.Exp.Exp 80 | 81 | 82 | -- * Chapter 01 / Exercise 02 83 | -- 84 | -- $c01e02 85 | -- === Semantics 86 | -- * https://nbviewer.jupyter.org/github/grin-compiler/grin/blob/master/papers/boquist.pdf#page=52 87 | -- * https://nbviewer.jupyter.org/github/grin-compiler/grin/blob/master/papers/boquist.pdf#page=53 88 | -- * https://nbviewer.jupyter.org/github/grin-compiler/grin/blob/master/papers/boquist.pdf#page=55 89 | -- 90 | -- === Exercise 91 | -- Read the module for exercises "Tutorial.Chapter01.Exercise02" 92 | 93 | type Env = Grin.Interpreter.Env.Env 94 | type Store = Grin.Interpreter.Store.Store 95 | type C01E02_Value = Tutorial.Chapter01.Exercise02.Value 96 | type C01E02_Node= Tutorial.Chapter01.Exercise02.Node 97 | type C01E02_SValue = Tutorial.Chapter01.Exercise02.SValue 98 | type C01E02_Address = Tutorial.Chapter01.Exercise02.Address 99 | type C01E02_InterpretExternal = Tutorial.Chapter01.Exercise02.InterpretExternal 100 | type C01E02_Functions = Tutorial.Chapter01.Exercise02.Functions 101 | type C01E02_Definitional = Tutorial.Chapter01.Exercise02.Definitional 102 | 103 | -- * Interlude: Intermediate language to compile from Lambda Calculus to GRIN 104 | -- 105 | -- $interlude1 106 | -- 107 | -- === Lambda as an intermediate language 108 | -- https://nbviewer.jupyter.org/github/grin-compiler/grin/blob/master/papers/boquist.pdf#page=65 109 | -- 110 | -- === Code generation from Lambda 111 | -- https://nbviewer.jupyter.org/github/grin-compiler/grin/blob/master/papers/boquist.pdf#page=64 112 | 113 | -- * Chapter 02 / Exercise 01 114 | -- 115 | -- $c02e1 116 | -- === From Machines to Compositional Evaluators 117 | -- https://plum-umd.github.io/abstracting-definitional-interpreters/#%28part._s~3aaam%29 118 | -- 119 | -- === Exercise 120 | -- Review the "Tutorial.Chapter02.Exercise01" module 121 | 122 | -- * Chapter 02 / Exercise 02 123 | -- 124 | -- $c02e02 125 | -- === Abstracting Closures 126 | -- https://plum-umd.github.io/abstracting-definitional-interpreters/#%28part._s~3aabstracting-closures%29 127 | -- 128 | -- === Exercise 129 | -- Review the "Tutorial.Chapter02.Exercise02" module and solve the exercises 130 | 131 | type AbstractT = Grin.Interpreter.Abstract.Base.AbstractT 132 | type Cache = Grin.Interpreter.Abstract.Base.Cache 133 | type TypeEnv = Grin.Interpreter.Abstract.Base.TypeEnv 134 | type T = Grin.Interpreter.Abstract.Base.T 135 | type ST = Grin.Interpreter.Abstract.Base.ST 136 | type Loc = Grin.Interpreter.Abstract.Base.Loc 137 | type AbsStore = Grin.Interpreter.Abstract.Base.AbsStore 138 | type AbsEnv = Grin.Interpreter.Abstract.Base.AbsEnv 139 | type AbsState = Grin.Interpreter.Abstract.Base.AbsState 140 | type C02E02_Node = Grin.Interpreter.Abstract.Base.Node 141 | 142 | -- * Interlude: Connection between pointer analysis, type systems and abstract interpretations 143 | -- 144 | -- $interlude2 145 | -- The original version of this tutorial meant to use a constraint solver for solving the type 146 | -- equations, but after I decided to give a go with the abstract interpretation. 147 | 148 | -- * Chapter 03 / Exercise 01 149 | -- 150 | -- $c03e01 151 | -- 152 | -- === Exercise 153 | -- Fill out the missing pieces in "Tutorial.Chapter03.Exercise01" 154 | 155 | -- * Chapter 03 / Exercise 02 156 | -- 157 | -- $c0302 158 | -- 159 | -- === Exercise 160 | -- Solve the exercises in "Tutorial.Chapter03.Exercise02" 161 | 162 | -- * Epilogue: Possible futures of the Whole Program Analysis 163 | -- 164 | -- $epilogue 165 | -- === Discussion about: 166 | -- * Incremental Whole Program Analysis 167 | -- * Module Whole Program Analysis 168 | -- * Link time optimisations 169 | -------------------------------------------------------------------------------- /grin/src/Grin/Exp.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveDataTypeable, DeriveGeneric, DeriveAnyClass, DeriveFunctor, TypeFamilies #-} 2 | {-# LANGUAGE DeriveFoldable, DeriveTraversable, PatternSynonyms #-} 3 | {-# LANGUAGE TemplateHaskell, StandaloneDeriving, OverloadedStrings #-} 4 | {-# LANGUAGE LambdaCase, RecordWildCards #-} 5 | module Grin.Exp 6 | ( module Grin.Exp 7 | ) where 8 | 9 | import Data.Functor.Foldable 10 | import Data.Functor.Foldable.TH 11 | import Grin.Pretty 12 | import Grin.TypeEnv 13 | import Grin.Value 14 | import Prelude hiding (exp) 15 | import Data.Map (Map, fromList) 16 | 17 | 18 | -- * GRIN Expression 19 | 20 | type SimpleExp = Exp -- Meant to be SApp, SPure, SStore, SFetch, SUpdate constructors 21 | type Alt = Exp -- Meant to be the Alt constructor 22 | type Def = Exp -- Meant to be the Def constructor 23 | type Program = Exp -- Meant to be the Program constructor 24 | 25 | data Exp 26 | = Program [External] [Def] 27 | | Def Name [Name] Exp 28 | -- Exp 29 | | EBind Exp BPat Exp 30 | | ECase Name [Alt] 31 | -- Simple Exp 32 | | SApp Name [Name] 33 | | SPure VarOrValue 34 | | SStore Name -- Variable should hold only nodes 35 | | SFetch Name -- Variable should hold only locations 36 | | SUpdate Name Name -- The variables in order should hold only location and node 37 | -- Alt 38 | | Alt Name CPat Exp -- The name for the alt serves as a unique program name for the 39 | -- program point which is represented by the Alt itself 40 | | Block Exp -- Block plays a role in transformations. When a transformation needs to 41 | -- replace a simple Expression with a complex Bind one, the Block constructor 42 | -- comes into the picture. 43 | deriving (Eq, Ord, Show) 44 | 45 | -- * Externals 46 | 47 | data External 48 | = External 49 | { eName :: Name 50 | , eRetType :: Ty 51 | , eArgsType :: [Ty] 52 | , eEffectful :: Bool 53 | } 54 | deriving (Eq, Ord, Show) 55 | 56 | isExternalName :: [External] -> Name -> Bool 57 | isExternalName es n = n `Prelude.elem` (eName <$> es) 58 | 59 | -- * Case Pattern 60 | 61 | -- | Case patterns that can be found in the Alt expressions. 62 | data CPat 63 | = NodePat Tag [Name] 64 | | LitPat SimpleValue 65 | | DefaultPat 66 | deriving (Eq, Show, Ord) 67 | 68 | -- * Bind Pattern 69 | 70 | -- | Bind patterns that can be found in the EBind epxressions. 71 | data BPat 72 | = BNodePat Name Tag [Name] -- ^ var@(Ctag var1 .. varn) 73 | | BVar Name -- ^ var 74 | deriving (Eq, Show, Ord) 75 | 76 | externals :: Exp -> [External] 77 | externals = \case 78 | Program es _ -> es 79 | _ -> [] 80 | 81 | -- * Programs 82 | 83 | programToDefs :: Program -> Map Name Exp 84 | programToDefs = \case 85 | (Program _ defs) -> fromList ((\d@(Def n _ _) -> (n,d)) <$> defs) 86 | _ -> mempty 87 | 88 | 89 | -- * Template Haskell 90 | 91 | makeBaseFunctor ''Exp 92 | 93 | deriving instance Show a => Show (ExpF a) 94 | deriving instance Eq a => Eq (ExpF a) 95 | deriving instance Ord a => Ord (ExpF a) 96 | 97 | -- * Pretty 98 | 99 | instance Pretty Exp where 100 | pretty = prettyProgram WithExternals 101 | 102 | instance Pretty CPat where 103 | pretty = \case 104 | NodePat tag vars -> parens $ hsep (pretty tag : fmap pretty vars) 105 | LitPat lit -> pretty lit 106 | DefaultPat -> keyword "#default" 107 | 108 | instance Pretty BPat where 109 | pretty = \case 110 | BNodePat name tag args -> pretty name <> text "@" <> (parens $ hsep (pretty tag : fmap pretty args)) 111 | BVar name -> pretty name 112 | 113 | prettyExternals :: [External] -> Doc 114 | prettyExternals exts = vcat (map prettyExt exts) where 115 | prettyExt External{..} = prettyFunction (eName, (eRetType, eArgsType)) 116 | 117 | instance Pretty Ty where 118 | pretty = \case 119 | TyCon name tys -> braces . hsep $ (green $ pretty name) : fmap pretty tys 120 | TyVar name -> text "%" <> cyan (pretty name) 121 | TySimple st -> pretty st 122 | 123 | data RenderingOption 124 | = Simple 125 | | WithExternals 126 | deriving (Eq, Ord, Show, Read) 127 | 128 | prettyProgram :: RenderingOption -> Exp -> Doc 129 | prettyProgram Simple (Program exts e) = prettyHighlightExternals exts (Program [] e) 130 | prettyProgram WithExternals p@(Program exts _) = prettyHighlightExternals exts p 131 | prettyProgram _ p = prettyHighlightExternals [] p 132 | 133 | -- | Print a given expression with highlighted external functions. 134 | prettyHighlightExternals :: [External] -> Exp -> Doc 135 | prettyHighlightExternals exts = cata folder where 136 | folder = \case 137 | ProgramF es defs -> vcat (prettyExternals es : defs) 138 | DefF name args exp -> hsep (pretty name : fmap pretty args) <+> text "=" <$$> indent 2 exp <> line 139 | -- Exp 140 | EBindF simpleexp lpat exp -> pretty lpat <+> text "<-" <+> simpleexp <$$> exp 141 | ECaseF val alts -> keyword "case" <+> pretty val <+> keyword "of" <$$> indent 2 (vsep alts) 142 | -- Simple Expr 143 | SAppF name args -> hsep (((if isExternalName exts name then dullyellow else cyan) $ pretty name) : text "$" : fmap pretty args) 144 | SPureF val -> keyword "pure" <+> pretty val 145 | SStoreF val -> keywordR "store" <+> pretty val 146 | SFetchF name -> keywordR "fetch" <+> pretty name 147 | SUpdateF name val -> keywordR "update" <+> pretty name <+> pretty val 148 | -- Alt 149 | AltF name cpat exp -> pretty name <> text "@" <> pretty cpat <+> text "->" <$$> indent 2 exp 150 | -- Block 151 | BlockF exp -> text "do" <$$> indent 2 exp 152 | 153 | printGrin :: Exp -> IO () 154 | printGrin = putStrLn . showWide . pretty 155 | -------------------------------------------------------------------------------- /grin/src/Grin/GExp.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds, GADTs, KindSignatures, PolyKinds, TypeFamilies, TypeOperators, RankNTypes, LambdaCase, ConstraintKinds, UndecidableInstances #-} 2 | module Grin.GExp 3 | ( module Grin.GExp 4 | , module Grin.Exp 5 | , module Grin.Value 6 | , module Grin.TypeEnv 7 | ) where 8 | 9 | import Data.Kind (Constraint) 10 | import Grin.Exp (BPat(..), CPat(..), External(..)) 11 | import Grin.Value 12 | import Grin.TypeEnv 13 | import GHC.TypeLits 14 | 15 | 16 | data ExpCtx 17 | = Simple -- Simple Expressions 18 | | Bind_ -- Expressions 19 | | Case_ -- Case Expression 20 | | Alt_ -- Alternative of a case 21 | | Def_ -- Function definitions 22 | | Prg -- Program definition 23 | 24 | data Exp (ctx :: ExpCtx) where 25 | 26 | Program 27 | :: [External] 28 | -> [Exp 'Def_] -- ^ definitions 29 | -> Exp 'Prg 30 | 31 | Def 32 | :: Name 33 | -> [Name] -- ^ arguments 34 | -> Exp 'Bind_ 35 | -> Exp 'Def_ 36 | 37 | App 38 | :: Name 39 | -> [Name] -- ^ arguments 40 | -> Exp 'Simple 41 | 42 | Pure 43 | :: VarOrValue 44 | -> Exp 'Simple 45 | 46 | Store 47 | :: Name 48 | -> Exp 'Simple 49 | 50 | Fetch 51 | :: Name 52 | -> Exp 'Simple 53 | 54 | Update 55 | :: Name -- ^ reference to update 56 | -> Name -- ^ new value 57 | -> Exp 'Simple 58 | 59 | Alt 60 | :: Name 61 | -> CPat 62 | -> Exp 'Bind_ -- ^ continuation 63 | -> Exp 'Alt_ 64 | 65 | Case 66 | :: Name -- ^ scrutinee 67 | -> [Exp 'Alt_] -- ^ possible alternatives of a case 68 | -> Exp 'Case_ 69 | 70 | -- | 71 | -- > Ebind lhs bpat rhs 72 | -- corresponds to 73 | -- > lhs >>= \bpat -> rhs 74 | Bind 75 | :: (IsExp lhs ['Simple, 'Case_], IsExp rhs ['Simple, 'Case_, 'Bind_]) 76 | => Exp lhs 77 | -> BPat 78 | -> Exp rhs 79 | -> Exp 'Bind_ 80 | 81 | 82 | type IsExp c cs = Elem c cs cs 83 | 84 | type family Elem (c :: ExpCtx) (xs :: [ExpCtx]) (cs :: [ExpCtx]) :: Constraint where 85 | Elem c xs (c : _) = () 86 | Elem c xs (d : cs) = Elem c xs cs 87 | Elem c xs '[] = TypeError ('Text "Expected expression type " ':<>: 'ShowType xs 88 | ':$$: 89 | 'Text "but got " ':<>: 'ShowType c) 90 | -------------------------------------------------------------------------------- /grin/src/Grin/GExpToExp.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE RankNTypes, LambdaCase, GADTs #-} 2 | module Grin.GExpToExp where 3 | 4 | import Grin.GExp 5 | import qualified Grin.Exp as Grin 6 | 7 | 8 | gexpToExp :: forall ctx . Exp ctx -> Grin.Exp 9 | gexpToExp = \case 10 | Program exts defs -> Grin.Program exts (gexpToExp <$> defs) 11 | Def n ps body -> Grin.Def n ps $ gexpToExp body 12 | App n ps -> Grin.SApp n ps 13 | Pure v -> Grin.SPure v 14 | Store n -> Grin.SStore n 15 | Fetch n -> Grin.SFetch n 16 | Update n v -> Grin.SUpdate n v 17 | Alt n c b -> Grin.Alt n c $ gexpToExp b 18 | Case n alts -> Grin.ECase n (gexpToExp <$> alts) 19 | Bind lhs v rhs -> Grin.EBind (gexpToExp lhs) v (gexpToExp rhs) 20 | -------------------------------------------------------------------------------- /grin/src/Grin/Interpreter/Abstract/TypeInference.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell, GeneralizedNewtypeDeriving, TypeFamilies, InstanceSigs, LambdaCase #-} 2 | {-# LANGUAGE MultiParamTypeClasses, RankNTypes, ScopedTypeVariables, RecordWildCards #-} 3 | module Grin.Interpreter.Abstract.TypeInference where 4 | 5 | import Control.Applicative (Alternative(..)) 6 | import Control.Monad (forM_, msum) 7 | import Control.Monad (when) 8 | import Control.Monad.Fail (MonadFail(..)) 9 | import Control.Monad.IO.Class (MonadIO(..)) 10 | import Control.Monad.Logic hiding (fail) 11 | import Data.Function (fix) 12 | import Data.Maybe (fromJust) 13 | import Data.Maybe (isNothing) 14 | import Grin.Exp (Program, eName, externals, Exp(SApp)) 15 | import Grin.TypeEnv hiding (TypeEnv(..), Loc) 16 | import Grin.Value (Name, SimpleValue) 17 | import Grin.Interpreter.Base (baseEval) 18 | import Grin.Pretty hiding (SChar) 19 | import Prelude hiding (fail) 20 | import Grin.GExpToExp (gexpToExp) 21 | 22 | import Grin.Interpreter.Store (Store(..)) 23 | import Grin.Interpreter.Env (Env(..)) 24 | import qualified Data.List as List (nub) 25 | import qualified Data.Map.Strict as Map 26 | import qualified Data.Set as Set; import Data.Set (Set) 27 | import qualified Grin.TypeEnv as Grin 28 | import qualified Grin.Examples as Examples 29 | 30 | import Grin.Interpreter.Abstract.Base 31 | import Grin.Interpreter.Abstract.Interpreter 32 | 33 | 34 | -- * Tests 35 | 36 | tests :: IO () 37 | tests = do 38 | print =<< (PP <$> (typeInference $ gexpToExp $ Examples.add)) 39 | print =<< (PP <$> (typeInference $ gexpToExp $ Examples.fact)) 40 | print =<< (PP <$> (typeInference $ gexpToExp $ Examples.sumSimple)) 41 | 42 | typeInference :: (Monad m, MonadFail m, MonadIO m) => Program -> m Grin.TypeEnv 43 | typeInference = fmap (calcTypeEnv . fst) . abstractEval 44 | 45 | abstractEval :: (Monad m, MonadFail m, MonadIO m) => Program -> m (TypeEnv, Cache) 46 | abstractEval prog = do 47 | let ops = [ ("prim_int_add", prim_int_add) 48 | , ("prim_int_sub", prim_int_sub) 49 | , ("prim_int_mul", prim_int_mul) 50 | , ("prim_int_print", prim_int_print) 51 | , ("prim_int_eq", prim_int_eq) 52 | , ("prim_int_gt", prim_int_gt) 53 | ] 54 | let opsMap = Map.fromList ops 55 | forM_ exts $ \ext -> do 56 | when (isNothing (Map.lookup (eName ext) opsMap)) $ 57 | fail $ "Missing external: " ++ show (eName ext) 58 | (\(_,tc,_) -> tc) <$> runAbstractT prog ops (fixCache (fix (evalCache baseEval)) (SApp "main" [])) 59 | where 60 | exts = externals prog 61 | prim_int_add = (ST ST_Int64, [ST ST_Int64, ST ST_Int64]) 62 | prim_int_sub = (ST ST_Int64, [ST ST_Int64, ST ST_Int64]) 63 | prim_int_mul = (ST ST_Int64, [ST ST_Int64, ST ST_Int64]) 64 | prim_int_eq = (ST ST_Bool, [ST ST_Int64, ST ST_Int64]) 65 | prim_int_gt = (ST ST_Bool, [ST ST_Int64, ST ST_Int64]) 66 | prim_int_print = (UT, [ST ST_Int64]) 67 | 68 | 69 | -- * Convert Abstract.TypeEnv to Grin.TypeEnv 70 | 71 | tToType :: Map.Map Loc Int -> T -> Type 72 | tToType ml = \case 73 | UT -> T_SimpleType $ T_Unit 74 | ST s -> T_SimpleType $ stToSimpleType ml s 75 | NT (Node t ps) -> T_NodeSet $ Map.singleton t (stToSimpleType ml <$> ps) 76 | 77 | typeOfValue :: Grin.Value.SimpleValue -> Type 78 | typeOfValue = tToType mempty . typeOfSimpleValue 79 | 80 | stToSimpleType :: Map.Map Loc Int -> ST -> SimpleType 81 | stToSimpleType ml = \case 82 | ST_Int64 -> T_Int64 83 | ST_Word64 -> T_Word64 84 | ST_Float -> T_Float 85 | ST_Bool -> T_Bool 86 | ST_Char -> T_Char 87 | ST_Loc l -> T_Location [ml Map.! l] 88 | 89 | locsToLocation :: Store Loc (Set Node) -> (Map.Map Loc Int, Map.Map Int NodeSet) 90 | locsToLocation (Store m0) = (locToHeap, storeToHeap m0) 91 | where 92 | locToHeap = Map.fromList $ zip (Map.keys m0) [0..] 93 | 94 | storeToHeap :: Map.Map Loc (Set Node) -> Map.Map Int NodeSet 95 | storeToHeap = Map.map (Set.foldl' (flip insertNode) mempty) . Map.mapKeys (locToHeap Map.!) 96 | 97 | insertNode :: Node -> NodeSet -> NodeSet 98 | insertNode (Node t ps) = flip Map.alter t $ \case 99 | Nothing -> Just (stToSimpleType locToHeap <$> ps) 100 | Just ps0 -> Just $ zipWith (\p0 p1 -> if p0 /= p1 then error $ show (p0,p1) else p0) ps0 (stToSimpleType locToHeap <$> ps) 101 | 102 | applyIfBoth :: (Applicative f, Alternative f) => (a -> a -> a) -> f a -> f a -> f a 103 | applyIfBoth f a b = (f <$> a <*> b) <|> a <|> b 104 | 105 | unifyNodeSet :: NodeSet -> NodeSet -> Maybe NodeSet 106 | unifyNodeSet ns0 ns1 = sequence $ Map.unionWith unifyParams (Map.map Just ns0) (Map.map Just ns1) 107 | where 108 | unifyParams :: Maybe [SimpleType] -> Maybe [SimpleType] -> Maybe [SimpleType] 109 | unifyParams ms0 ms1 = msum 110 | [ do s0 <- ms0 111 | s1 <- ms1 112 | zipWithM unifySimpleType s0 s1 113 | , ms0 114 | , ms1 115 | ] 116 | 117 | unifySimpleType :: SimpleType -> SimpleType -> Maybe SimpleType 118 | unifySimpleType t1 t2 = case (t1,t2) of 119 | (T_Location l1, T_Location l2) -> Just $ T_Location (List.nub $ l1 ++ l2) 120 | (st1, st2) | st1 == st2 -> Just st2 121 | | otherwise -> Nothing 122 | 123 | unifyType :: Type -> Type -> Maybe Type 124 | unifyType t1 t2 = case (t1,t2) of 125 | (T_NodeSet n1, T_NodeSet n2) -> T_NodeSet <$> unifyNodeSet n1 n2 126 | (T_SimpleType st1, T_SimpleType st2) -> T_SimpleType <$> unifySimpleType st1 st2 127 | _ -> Nothing 128 | 129 | funcToFunctions :: Map.Map Loc Int -> Map.Map Name FunctionT -> Map.Map Name (Type, [Type]) 130 | funcToFunctions ml = Map.map 131 | (\(FunctionT (r,ps)) 132 | -> ( fromJust $ unifyTypes $ Set.map (tToType ml) r 133 | , fromJust $ sequence $ fmap (unifyTypes . Set.map (tToType ml)) ps 134 | ) 135 | ) 136 | 137 | varToVariable :: Map.Map Loc Int -> Env (Set T) -> Map.Map Name Type 138 | varToVariable ml (Env m) = Map.map (fromJust . unifyTypes . Set.map (tToType ml)) m 139 | 140 | unifyTypes :: Set Type -> Maybe Type 141 | unifyTypes = unifyTypes' . Set.toList where 142 | unifyTypes' [] = Nothing 143 | unifyTypes' (t:ts) = foldM unifyType t ts 144 | 145 | calcTypeEnv :: TypeEnv -> Grin.TypeEnv 146 | calcTypeEnv TypeEnv{..} = Grin.TypeEnv 147 | { Grin._location = locationNodeSet 148 | , Grin._variable = varToVariable locToHeap _variable 149 | , Grin._function = funcToFunctions locToHeap _function 150 | } 151 | where 152 | (locToHeap, locationNodeSet) = locsToLocation _heap 153 | -------------------------------------------------------------------------------- /grin/src/Grin/Interpreter/Base.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE LambdaCase, GeneralizedNewtypeDeriving, InstanceSigs, TypeFamilies, TemplateHaskell, ScopedTypeVariables, DataKinds #-} 2 | module Grin.Interpreter.Base 3 | ( module Grin.Interpreter.Base 4 | ) where 5 | 6 | import Control.Monad.Fail 7 | import Control.Monad.Trans (MonadIO) 8 | import Data.Function (fix) 9 | import Grin.Exp 10 | import Grin.Value hiding (Val) 11 | 12 | import Grin.Interpreter.Env (Env) 13 | import qualified Grin.Interpreter.Env as Env 14 | import qualified Grin.Value as Grin 15 | 16 | 17 | -- * Interpreter 18 | 19 | eval :: (Interpreter m, MonadIO m, Show v, v ~ Val m) => Exp -> m v 20 | eval = fix baseEval 21 | 22 | -- Open recursion and monadic interpreter. 23 | baseEval :: (MonadIO m, Interpreter m, a ~ Addr m, v ~ Val m, Show v) 24 | => (Exp -> m (Val m)) -> Exp -> m (Val m) 25 | baseEval ev0 = \case 26 | SPure (Grin.Val v) -> value v 27 | SPure (Var n) -> do 28 | p <- askEnv 29 | pure $ Env.lookup p n 30 | 31 | SApp fn ps -> do 32 | p <- askEnv 33 | vs <- pure $ map (Env.lookup p) ps 34 | ex <- isExternal fn 35 | (if ex then external else funCall ev0) fn vs 36 | 37 | SFetch n -> do 38 | p <- askEnv 39 | let v = Env.lookup p n 40 | fetchStore v 41 | 42 | SUpdate nl nn -> do 43 | p <- askEnv 44 | let vl = Env.lookup p nl 45 | let vn = Env.lookup p nn 46 | extStore vl vn 47 | unit 48 | 49 | ECase n alts -> do 50 | p <- askEnv 51 | v <- pure $ Env.lookup p n 52 | -- Select the alternative and continue the evaluation 53 | evalCase ev0 v alts 54 | 55 | EBind (SStore n) (BVar l) rhs -> do 56 | p <- askEnv 57 | let v = Env.lookup p n 58 | a <- allocStore l 59 | extStore a v 60 | let p' = Env.insert l a p 61 | localEnv p' (ev0 rhs) 62 | 63 | EBind lhs (BVar n) rhs -> do 64 | v <- ev0 lhs 65 | p <- askEnv 66 | let p' = Env.insert n v p 67 | localEnv p' (ev0 rhs) 68 | 69 | EBind lhs (BNodePat n t@(Tag{}) vs) rhs -> do 70 | v <- ev0 lhs 71 | p <- askEnv 72 | p' <- flip Env.inserts p <$> bindPattern v (t,vs) 73 | let p'' = Env.insert n v p' 74 | localEnv p'' (ev0 rhs) 75 | 76 | Alt _name _pat body -> do 77 | ev0 body 78 | 79 | overGenerative -> error $ show overGenerative 80 | 81 | -- Type class 82 | 83 | class (Monad m, MonadFail m) => Interpreter m where 84 | type Val m :: * -- Values that can be placed in registers/variables 85 | type HeapVal m :: * -- Values for the Store, Fetch, Update parameters 86 | type Addr m :: * -- A type to represent an Address 87 | 88 | -- Conversions, but m type is needed for type inference 89 | value :: Grin.Value -> m (Val m) -- Value of the given literal 90 | val2addr :: Val m -> m (Addr m) -- 91 | addr2val :: Addr m -> m (Val m) 92 | heapVal2val :: HeapVal m -> m (Val m) 93 | val2heapVal :: Val m -> m (HeapVal m) 94 | unit :: m (Val m) -- The unit value 95 | bindPattern :: Val m -> (Tag, [Name]) -> m [(Name, Val m)] 96 | 97 | -- Non-pure 98 | 99 | -- | Return the computational environment 100 | askEnv :: m (Env (Val m)) 101 | -- | Set the local environment 102 | localEnv :: Env (Val m) -> m (Val m) -> m (Val m) 103 | lookupFun :: Name -> m Exp 104 | isExternal :: Name -> m Bool 105 | external :: Name -> [Val m] -> m (Val m) 106 | 107 | -- Control-flow 108 | evalCase :: (Exp -> m (Val m)) -> Val m -> [Alt] -> m (Val m) 109 | funCall :: (Exp -> m (Val m)) -> Name -> [Val m] -> m (Val m) 110 | 111 | -- Store 112 | allocStore :: Name -> m (Val m) 113 | fetchStore :: Val m -> m (Val m) -- TODO: Change this to Addr m?? 114 | extStore :: Val m -> Val m -> m () -- 115 | -------------------------------------------------------------------------------- /grin/src/Grin/Interpreter/Env.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveFunctor #-} 2 | module Grin.Interpreter.Env where 3 | 4 | import Data.List (foldl') 5 | import Data.Maybe (fromMaybe) 6 | import Grin.Pretty 7 | import Grin.Value 8 | import qualified Data.Map.Strict as Map 9 | 10 | -- * Env 11 | 12 | -- | Environment mapping names to abstract values. 13 | newtype Env v = Env (Map.Map Name v) 14 | deriving (Eq, Show, Ord, Functor) 15 | 16 | empty :: Env v 17 | empty = Env mempty 18 | 19 | lookup :: (Env v) -> Name -> v 20 | lookup (Env m) n = fromMaybe (error $ "Missing:" ++ show n) $ Map.lookup n m 21 | 22 | insert :: Name -> v -> Env v -> Env v 23 | insert n v (Env m) = Env $ Map.insert n v m 24 | 25 | inserts :: [(Name, v)] -> Env v -> Env v 26 | inserts vs (Env m) = Env $ foldl' (\n (k,v) -> Map.insert k v n) m vs 27 | 28 | -- Explicit instance!! different from default 29 | instance (Semigroup v) => Semigroup (Env v) where 30 | Env m1 <> Env m2 = Env (Map.unionWith (<>) m1 m2) 31 | 32 | instance (Semigroup v) => Monoid (Env v) where 33 | mempty = Env mempty 34 | 35 | instance (Pretty v) => Pretty (Env v) where 36 | pretty (Env m) = prettyKeyValue (Map.toList m) 37 | -------------------------------------------------------------------------------- /grin/src/Grin/Interpreter/Store.hs: -------------------------------------------------------------------------------- 1 | module Grin.Interpreter.Store where 2 | 3 | import Data.Maybe (fromMaybe) 4 | import Grin.Pretty 5 | import qualified Data.Map.Strict as Map 6 | 7 | -- * Store 8 | 9 | -- | Store maps addresses to abstract values. 10 | newtype Store a v = Store (Map.Map a v) 11 | deriving (Eq, Ord, Show) 12 | 13 | empty :: (Ord a) => Store a v 14 | empty = Store mempty 15 | 16 | lookup :: (Ord a) => a -> Store a v-> v 17 | lookup a (Store m) = fromMaybe (error "Store; missing") $ Map.lookup a m 18 | 19 | insert :: (Ord a) => a -> v -> Store a v -> Store a v 20 | insert a v (Store m) = Store (Map.insert a v m) 21 | 22 | size :: Store a v -> Int 23 | size (Store m) = Map.size m 24 | 25 | instance (Ord a, Semigroup v) => Semigroup (Store a v) where 26 | (Store ma) <> (Store mb) = Store (Map.unionWith (<>) ma mb) 27 | 28 | instance (Ord a, Monoid v) => Monoid (Store a v) where 29 | mempty = Store mempty 30 | 31 | instance (Pretty a, Pretty v) => Pretty (Store a v) where 32 | pretty (Store m) = prettyKeyValue (Map.toList m) 33 | -------------------------------------------------------------------------------- /grin/src/Grin/Pretty.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE LambdaCase, RecordWildCards, OverloadedStrings #-} 2 | module Grin.Pretty 3 | ( PP(..) 4 | , WPP(..) 5 | , showWidth 6 | , showWide 7 | , prettyKeyValue 8 | , prettyFunction 9 | , keywordR 10 | , keyword 11 | , module Text.PrettyPrint.ANSI.Leijen 12 | ) where 13 | 14 | import Data.Set (Set) 15 | import Prelude hiding (exp) 16 | import Text.PrettyPrint.ANSI.Leijen hiding ((<$>)) 17 | import qualified Data.Set as Set 18 | 19 | 20 | showWidth :: Int -> Doc -> String 21 | showWidth w x = displayS (renderPretty 0.4 w x) "" 22 | 23 | showWide :: Doc -> String 24 | showWide = showWidth 156 25 | 26 | -- plain wrappers ; remove colors 27 | 28 | -- Pretty Show instance wrapper ; i.e. useful for hspec tests 29 | newtype PP a = PP a deriving Eq 30 | instance Pretty a => Show (PP a ) where 31 | show (PP a) = showWide . plain . pretty $ a 32 | 33 | -- Wide pretty printing, useful for reparsing pretty-printed ASTs 34 | newtype WPP a = WPP a deriving Eq 35 | instance Pretty a => Show (WPP a) where 36 | show (WPP a) = showWide . plain . pretty $ a 37 | 38 | 39 | keyword :: String -> Doc 40 | keyword = yellow . text 41 | 42 | keywordR :: String -> Doc 43 | keywordR = red . text 44 | 45 | -- generic ; used by HPTResult and TypeEnv 46 | 47 | instance Pretty a => Pretty (Set a) where 48 | pretty s = encloseSep lbrace rbrace comma (map pretty $ Set.toList s) 49 | 50 | prettyKeyValue :: (Pretty k, Pretty v) => [(k,v)] -> Doc 51 | prettyKeyValue kvList = vsep [fill 6 (pretty k) <+> text "->" <+> pretty v | (k,v) <- kvList] 52 | 53 | --prettyBracedList :: [Doc] -> Doc 54 | --prettyBracedList = encloseSep lbrace rbrace comma 55 | 56 | --prettySimplePair :: (Pretty a, Pretty b) => (a, b) -> Doc 57 | --prettySimplePair (x, y) = pretty x <> pretty y 58 | 59 | prettyFunction :: (Pretty a, Pretty name) => (name, (a, [a])) -> Doc 60 | prettyFunction (name, (ret, args)) = pretty name <> align (encloseSep (text " :: ") empty (text " -> ") (map pretty $ args ++ [ret])) 61 | -------------------------------------------------------------------------------- /grin/src/Grin/TypeEnv.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE LambdaCase, TemplateHaskell, RecordWildCards #-} 2 | module Grin.TypeEnv where 3 | 4 | import Prelude hiding (exp) 5 | 6 | import Data.Function (on) 7 | import Data.List (sortBy) 8 | import Data.Map 9 | import Grin.Pretty 10 | import Grin.Value 11 | import Lens.Micro.Platform 12 | import qualified Data.Map.Strict as Map 13 | 14 | 15 | 16 | type Loc = Int 17 | 18 | data SimpleType 19 | = T_Int64 20 | | T_Word64 21 | | T_Float 22 | | T_Bool 23 | | T_Char 24 | 25 | | T_Location {_locations :: [Loc]} 26 | | T_Unit 27 | deriving (Eq, Ord, Show) 28 | 29 | type NodeSet = Map Tag [SimpleType] 30 | 31 | data Type 32 | = T_SimpleType {_simpleType :: SimpleType} 33 | | T_NodeSet {_nodeSet :: NodeSet} 34 | deriving (Eq, Ord, Show) 35 | 36 | data TypeEnv 37 | = TypeEnv 38 | { _location :: Map Int NodeSet 39 | , _variable :: Map Name Type 40 | , _function :: Map Name (Type, [Type]) 41 | } 42 | deriving (Eq, Show) 43 | 44 | data Ty 45 | = TyCon Name [Ty] 46 | | TyVar Name 47 | | TySimple SimpleType 48 | deriving (Eq, Ord, Show) 49 | 50 | emptyTypeEnv :: TypeEnv 51 | emptyTypeEnv = TypeEnv mempty mempty mempty 52 | 53 | -- * Template Haskell 54 | 55 | makeLenses ''TypeEnv 56 | makeLenses ''Type 57 | makeLenses ''SimpleType 58 | 59 | instance Pretty SimpleType where 60 | pretty = \case 61 | T_Location l -> encloseSep lbrace rbrace comma $ fmap (cyan . int) l 62 | ty -> red $ text $ show ty 63 | 64 | prettyNode :: (Tag, [SimpleType]) -> Doc 65 | prettyNode (tag, args) = pretty tag <> list (fmap pretty args) 66 | 67 | instance Pretty Type where 68 | pretty = \case 69 | T_SimpleType ty -> pretty ty 70 | T_NodeSet ns -> encloseSep lbrace rbrace comma (fmap prettyNode (Map.toList ns)) 71 | 72 | instance Pretty TypeEnv where 73 | pretty TypeEnv{..} = vsep 74 | [ yellow (text "Location") <$$> indent 4 (prettyKeyValue $ sortBy (compare `on` fst) $ Map.toList $ Map.map T_NodeSet _location) 75 | , yellow (text "Variable") <$$> indent 4 (prettyKeyValue $ Map.toList _variable) 76 | , yellow (text "Function") <$$> indent 4 (vsep $ fmap prettyFunction $ Map.toList _function) 77 | ] 78 | 79 | -------------------------------------------------------------------------------- /grin/src/Grin/Value.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveDataTypeable, DeriveGeneric, DeriveAnyClass, DeriveFunctor, TypeFamilies #-} 2 | {-# LANGUAGE DeriveFoldable, DeriveTraversable, PatternSynonyms #-} 3 | {-# LANGUAGE TemplateHaskell, StandaloneDeriving, OverloadedStrings #-} 4 | {-# LANGUAGE LambdaCase #-} 5 | module Grin.Value where 6 | 7 | import Data.Binary 8 | import Data.Data 9 | import Data.Int 10 | import Data.String 11 | import Data.Text (Text, unpack) 12 | import GHC.Generics (Generic) 13 | import Text.Printf 14 | import Grin.Pretty hiding (SChar) 15 | 16 | 17 | data Name = NM { getName :: !Text } 18 | deriving (Generic, Data, Eq, Ord) 19 | 20 | mkName :: String -> Name 21 | mkName = fromString 22 | 23 | instance Show Name where 24 | show (NM nm) = show nm 25 | 26 | nMap :: (Text -> Text) -> Name -> Name 27 | nMap f (NM n) = NM (f n) 28 | 29 | instance Semigroup Name where (NM n1) <> (NM n2) = NM (n1 <> n2) 30 | instance Monoid Name where mempty = NM mempty 31 | instance IsString Name where fromString = NM . fromString 32 | instance PrintfArg Name where formatArg = formatString . Data.Text.unpack . getName 33 | 34 | nameString :: Name -> String 35 | nameString (NM n) = Data.Text.unpack n 36 | 37 | -- * GRIN Tag 38 | 39 | data TagType = C | F | P Int {-missing parameter count-} 40 | deriving (Generic, Data, Eq, Ord, Show) 41 | 42 | data Tag = Tag { tagType :: TagType, tagName :: Name } 43 | deriving (Generic, Data, Eq, Ord, Show) 44 | 45 | -- * GRIN Value 46 | 47 | data SimpleValue 48 | = SInt64 Int64 49 | | SWord64 Word64 50 | | SFloat Float 51 | | SBool Bool 52 | | SChar Char 53 | deriving (Generic, Data, Eq, Ord, Show) 54 | 55 | -- | Complete node 56 | data Node = Node Tag [Name] 57 | deriving (Generic, Data, Eq, Ord, Show) 58 | 59 | data Value 60 | = VNode Node 61 | | VPrim SimpleValue 62 | deriving (Generic, Data, Eq, Ord, Show) 63 | 64 | data VarOrValue 65 | = Var Name 66 | | Val Value 67 | deriving (Generic, Data, Eq, Ord, Show) 68 | 69 | instance Pretty Node where 70 | pretty (Node tag args) = parens $ hsep (pretty tag : fmap pretty args) 71 | 72 | instance Pretty Name where 73 | pretty = text . nameString 74 | 75 | instance Pretty Value where 76 | pretty = \case 77 | VNode node -> pretty node 78 | VPrim sval -> pretty sval 79 | 80 | instance Pretty VarOrValue where 81 | pretty = \case 82 | Var n -> pretty n 83 | Val v -> pretty v 84 | 85 | instance Pretty SimpleValue where 86 | pretty = \case 87 | SInt64 a -> integer $ fromIntegral a 88 | SWord64 a -> integer (fromIntegral a) <> text "u" 89 | SFloat a -> float a 90 | SBool a -> text "#" <> text (show a) 91 | SChar a -> text "#" <> text (show a) 92 | 93 | instance Pretty TagType where 94 | pretty = green . \case 95 | C -> text "C" 96 | F -> text "F" 97 | P i -> text "P" <> int i 98 | 99 | instance Pretty Tag where 100 | pretty (Tag tagtype name) = pretty tagtype <> pretty name 101 | 102 | -------------------------------------------------------------------------------- /grin/src/Tutorial/Chapter01/Exercise01.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE RankNTypes #-} 2 | {-# LANGUAGE GADTs #-} 3 | {-# LANGUAGE LambdaCase #-} 4 | module Tutorial.Chapter01.Exercise01 where 5 | 6 | import qualified Grin.Exp as E (Exp(..)) 7 | import Grin.GExp (Exp(..)) 8 | 9 | {- 10 | The GRIN is a simple language. GRIN programs consist of 11 | * creating values via Pure or funtion application App 12 | * binding values to variables 13 | * branching control flow via case expressions 14 | * manipulating the heap through certain heap operations 15 | 16 | Only structured/boxed values can be stored on the heap, 17 | these are called Node values. 18 | 19 | There three drifferent heap operations: 20 | * Store a Node value on the heap 21 | * Fetch a Node value from the heap 22 | * Update a Node value on the heap through a pointer 23 | 24 | Motivation: 25 | It is good to have a type safe GADT representation of the 26 | GRIN language which restricts some constructions, 27 | but it is easier to handle a simple ADT represented 28 | program in transformation and analyses. 29 | 30 | Exercise: 31 | Open the Grin.Examples module and take a look at the 32 | examples to build an intuition about the GRIN language 33 | and about the GADT represented syntax. 34 | 35 | Exercise: 36 | Check the cheatsheet about the GRIN values. 37 | Check the cheatsheet about the GRIN patterns. 38 | Open the Grin.Exp module and check the Exp datatype. 39 | Open the Grin.GExp module and check the GExp datatype. 40 | 41 | Exercise: 42 | Complete the definition above. 43 | 44 | Exercise: 45 | Which of constructor of the Exp is not covered by the GExp constructors, why? 46 | -} 47 | 48 | convertGExpToExp :: forall ctx . Exp ctx -> E.Exp 49 | convertGExpToExp = \case 50 | Program exts defs -> E.Program exts (map convertGExpToExp defs) 51 | 52 | -- Exercise: Map the Def constructor to its E.Exp counterpart. 53 | Def n ps body -> undefined 54 | 55 | Pure v -> E.SPure v 56 | 57 | -- Exercise: Check what kind of values can be stored on the heap? 58 | Store n -> E.SStore n 59 | 60 | -- Exercise: Map the Fetch constructor to its E.Exp counterpart. 61 | Fetch n -> undefined 62 | 63 | -- Exercise: Map the Update constructor to its E.Exp counterpart. 64 | Update n v -> undefined 65 | 66 | -- Exercise: Map the App constructor to its E.Exp counterpart. 67 | App n ps -> undefined 68 | 69 | -- Exercise: Turn the body of the alt to an E.Exp 70 | Alt n c b -> E.Alt n c undefined 71 | 72 | -- Exercise: Turn the Case constructor to its E.Exp counterpart. 73 | Case n alts -> undefined 74 | 75 | -- Exercise: Check what kind of syntactical construction is the Bind 76 | -- and convert the lhs and rhs to E.Exp, also use the pattern 77 | Bind lhs pat rhs -> E.EBind undefined undefined undefined 78 | -------------------------------------------------------------------------------- /grin/src/Tutorial/Chapter02/Exercise01.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE LambdaCase, TypeFamilies #-} 2 | module Tutorial.Chapter02.Exercise01 where 3 | 4 | import Control.Monad (void) 5 | import Control.Monad.Fail (MonadFail) 6 | import Control.Monad.Trans (MonadIO) 7 | import Grin.Exp (Exp(..), Alt, BPat(..)) 8 | import Grin.Value hiding (Val) 9 | 10 | import Grin.Interpreter.Env (Env) 11 | import qualified Grin.Interpreter.Env as Env 12 | import qualified Grin.Value as Grin 13 | 14 | import Tutorial.Chapter01.Exercise02 (Definitional(..)) 15 | import qualified Tutorial.Chapter01.Exercise02 as Definitional 16 | 17 | 18 | {- 19 | Motivation: 20 | The talk is based on the Abstracting Definitional Interpreters [1]. 21 | 22 | In this paper they claim that the same structure for the definitional 23 | interpreter can be reused to create abstract interpreters which 24 | are some form of inference. We will see that type inference 25 | can be encoded using abstract interpretation. 26 | 27 | The main motivation here is to understand how the abstraction of 28 | the definitional interpreter can be achieved. 29 | 30 | The paper uses open recursion technique to make possible to inject 31 | different aspects of the recursive calls. 32 | 33 | This approach is also used in the `semantic` framework by github [2]. 34 | 35 | [1] https://plum-umd.github.io/abstracting-definitional-interpreters/ 36 | [2] https://github.com/github/semantic 37 | 38 | Exercise: 39 | Read the "2 From Machines to Compositional Evaluators" 40 | https://plum-umd.github.io/abstracting-definitional-interpreters/#%28part._s~3aaam%29 41 | 42 | Although GRIN is not a higher-order lanuage, we use the AAM approach. 43 | 44 | Exercise: 45 | Find the difference between the interpreter from the previous exercise. 46 | -} 47 | 48 | -- | The interpreter is written in an open recursive style; 49 | -- the evaluator does not call itself recursively, instead it takes as an argument 50 | -- a function ev (the argument) is called instead of self-recursion. 51 | -- This is a standard encoding for recursive functions in a setting without recursive binding. 52 | -- It is up to an external function, such as the Y-combinator, to close the recursive loop. 53 | -- This open recursive form is crucial because it allows intercepting recursive calls 54 | -- to perform “deep” instrumentation of the interpreter. 55 | 56 | eval :: (MonadIO m, Interpreter m) 57 | => (Exp -> m (Val m)) -> Exp -> m (Val m) 58 | eval ev = \case 59 | SPure (Grin.Val l) -> value l 60 | SPure (Var n) -> do 61 | p <- askEnv 62 | pure $ Env.lookup p n 63 | 64 | SApp fn ps -> do 65 | p <- askEnv 66 | vs <- pure $ map (Env.lookup p) ps 67 | op <- isExternal fn 68 | (if op then external else funCall ev) fn vs 69 | 70 | SFetch n -> do 71 | p <- askEnv 72 | let v = Env.lookup p n 73 | fetchStore v 74 | 75 | SUpdate nl nn -> do 76 | p <- askEnv 77 | let vl = Env.lookup p nl 78 | let vn = Env.lookup p nn 79 | extStore vl vn 80 | unit 81 | 82 | ECase n alts -> do 83 | p <- askEnv 84 | v <- pure $ Env.lookup p n 85 | -- Select the alternative and continue the evaluation 86 | evalCase ev v alts 87 | 88 | EBind (SStore n) (BVar l) rhs -> do 89 | p <- askEnv 90 | let v = Env.lookup p n 91 | a <- allocStore l 92 | extStore a v 93 | let p' = Env.insert l a p 94 | localEnv p' (ev rhs) 95 | 96 | EBind lhs (BVar n) rhs -> do 97 | v <- ev lhs 98 | p <- askEnv 99 | let p' = Env.insert n v p 100 | localEnv p' (ev rhs) 101 | 102 | EBind lhs (BNodePat n t@(Tag{}) vs) rhs -> do 103 | v <- ev lhs 104 | p <- askEnv 105 | p' <- flip Env.inserts p <$> bindPattern v (t,vs) 106 | let p'' = Env.insert n v p' 107 | localEnv p'' (ev rhs) 108 | 109 | Alt _n _pat body -> do 110 | ev body 111 | 112 | overGenerative -> error $ show overGenerative 113 | 114 | {- 115 | Solution: 116 | The differences are, the open recursion style and the application of the typeclass. 117 | -} 118 | 119 | {- 120 | Exercise: 121 | Discuss with somebody why the associated types are necessary, in this formalism? 122 | Diccuss why is necessary to include the 'm' type in the type of the return values. 123 | Understand the type signatures. 124 | -} 125 | class (Monad m, MonadFail m) => Interpreter m where 126 | type Val m :: * -- Values that can be placed in registers/variables 127 | type HeapVal m :: * -- Values for the Store, Fetch, Update parameters 128 | type Addr m :: * -- A type to represent an Address 129 | 130 | -- Conversions, but m type is needed for type inference 131 | value :: Grin.Value -> m (Val m) -- Value of the given literal 132 | val2addr :: Val m -> m (Addr m) -- Convert a value to an Address value 133 | addr2val :: Addr m -> m (Val m) -- Convert an address value to a Value 134 | heapVal2val :: HeapVal m -> m (Val m) -- Convert a heap value to a value to be able to assign it to a register 135 | val2heapVal :: Val m -> m (HeapVal m) -- Convert a value to a heap value to be able to store it on the Heap 136 | unit :: m (Val m) -- The unit value 137 | bindPattern :: Val m -> (Tag, [Name]) -> m [(Name, Val m)] -- Create a list of bindings matching the value of the given and variable-names 138 | 139 | -- | Return the computational environment 140 | askEnv :: m (Env (Val m)) 141 | -- | Set the local environment 142 | localEnv :: Env (Val m) -> m (Val m) -> m (Val m) -- Set the local environment to the given one 143 | lookupFun :: Name -> m Exp -- Lookup up a function definition 144 | isExternal :: Name -> m Bool -- Check if the given name refers to an external function 145 | external :: Name -> [Val m] -> m (Val m) -- Evaluate the external function 146 | 147 | -- Control-flow 148 | evalCase :: (Exp -> m (Val m)) -> Val m -> [Alt] -> m (Val m) -- Select an alternative based on the given value and evaluate it 149 | funCall :: (Exp -> m (Val m)) -> Name -> [Val m] -> m (Val m) -- Lookup a function and apply to the parameters 150 | 151 | -- Store 152 | allocStore :: Name -> m (Val m) -- Allocate a new heap location 153 | fetchStore :: Val m -> m (Val m) -- Fetch the Heap value stored in the heap location 154 | extStore :: Val m -> Val m -> m () -- Extend the heap location with the given store 155 | 156 | {- 157 | After all the previous implementation of the interpreter can be reused in the 158 | Interpreter typeclass... 159 | -} 160 | 161 | instance (MonadIO m, Monad m, MonadFail m) => Interpreter (Definitional m) where 162 | type Val (Definitional m) = Definitional.Value 163 | type HeapVal (Definitional m) = Definitional.Node 164 | type Addr (Definitional m) = Definitional.Address 165 | 166 | value = Definitional.value 167 | val2addr = Definitional.val2addr 168 | addr2val = Definitional.addr2val 169 | heapVal2val = Definitional.heapVal2val 170 | val2heapVal = Definitional.val2heapVal 171 | unit = Definitional.unit 172 | bindPattern = Definitional.bindPattern 173 | 174 | askEnv = Definitional.askEnv 175 | localEnv = Definitional.localEnv 176 | lookupFun = Definitional.lookupFun 177 | isExternal = Definitional.isExternal 178 | external = Definitional.external 179 | 180 | evalCase = Definitional.evalCase 181 | funCall = Definitional.funCall 182 | 183 | allocStore = Definitional.allocStore 184 | fetchStore = Definitional.fetchStore 185 | extStore = Definitional.extStore 186 | -------------------------------------------------------------------------------- /grin/src/Tutorial/Chapter02/Exercise02.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE LambdaCase, TypeFamilies, InstanceSigs #-} 2 | module Tutorial.Chapter02.Exercise02 where 3 | 4 | import Control.Monad (when) 5 | import Control.Monad.Fail (MonadFail(..)) 6 | import Control.Monad.IO.Class (MonadIO(..)) 7 | import Control.Monad.Logic hiding (fail) 8 | import Control.Monad.Reader (MonadReader(..)) 9 | import Control.Monad.State (MonadState(..), modify) 10 | import Data.Maybe (fromMaybe, fromJust, isNothing) 11 | import Data.Function (fix) 12 | import Grin.Exp (Exp(..), CPat(..), Alt, Program, externals, eName) 13 | import qualified Grin.TypeEnv as Grin 14 | import Grin.Value hiding (Val, Node) 15 | import Lens.Micro.Platform 16 | import Prelude hiding (fail) 17 | import Data.Maybe (mapMaybe) 18 | 19 | import Grin.Interpreter.Env (Env) 20 | import Grin.Interpreter.Store (Store(..)) 21 | import qualified Grin.Interpreter.Env as Env 22 | import qualified Grin.Interpreter.Store as Store 23 | import qualified Data.Map.Strict as Map 24 | import qualified Data.Set as Set; import Data.Set (Set) 25 | import qualified Grin.Value as Grin 26 | 27 | import Grin.Interpreter.Abstract.Base 28 | ( AbstractT(..), Cache, TypeEnv, T(..), ST(..), Loc(..), AbsStore(..), AbsEnv(..), AbsState(..), Node(..) 29 | , runAbstractT, absStr, absEnv, forMonadPlus, typeOfSimpleValue 30 | ) 31 | import Grin.Interpreter.Abstract.Interpreter 32 | ( evalCache, fixCache, collectFunctionType, collectEnv 33 | ) 34 | import Grin.Interpreter.Abstract.TypeInference (calcTypeEnv) 35 | 36 | import Tutorial.Chapter02.Exercise01 as Exercise 37 | 38 | 39 | 40 | {- 41 | Exercise: 42 | Read the 'Abstracting Closures' from 43 | https://plum-umd.github.io/abstracting-definitional-interpreters/#%28part._s~3aabstracting-closures%29 44 | 45 | Despite the Chapter 3.3 describes how to store closures, in GRIN there is no such thing. The take-away 46 | from that chapter is that the heap now should contain a Set of Node values, which are joined when 47 | the non-deterministic choice happen in the control flow. 48 | 49 | Exercise: Read Chatper 3.2.1 50 | https://nbviewer.jupyter.org/github/grin-compiler/grin/blob/master/papers/boquist.pdf#page=83 51 | 52 | Exercise: 53 | Read the Grin.Interpreter.Abstract.Base module 54 | 55 | One simple abstract interpretation of a GRIN program is the type inference, of the GRIN variables, functions, 56 | and Heap locations. 57 | -} 58 | 59 | 60 | instance (Monad m, MonadIO m, MonadFail m) => Exercise.Interpreter (AbstractT m) where 61 | type Val (AbstractT m) = T 62 | type HeapVal (AbstractT m) = Node 63 | type Addr (AbstractT m) = Loc 64 | 65 | -- As you remember, the Abstract store can hold a Set of Nodes. The interpretation of 66 | -- the Fetch operation is to retrieve the 'Set Node' and continue the rest of the 67 | -- computation one by one, to achieve this we need to use the Non-Det monad, which 68 | -- is implemented in the LogicT monad. 69 | fetchStore :: T -> AbstractT m T 70 | fetchStore v = do 71 | AbsState s <- get 72 | a <- val2addr v 73 | forMonadPlus (Set.toList $ Store.lookup a s) heapVal2val 74 | 75 | bindPattern :: T -> (Tag, [Name]) -> AbstractT m [(Name, T)] 76 | bindPattern t (tag,ps) = 77 | -- Exercise: Similar to the bindPattern in the definitional interpreter 78 | -- match the tag from the value with the names and return the association list. 79 | -- If the tag doesn't match use the mzero instead of throwing an error. 80 | undefined 81 | 82 | evalCase :: (Exp -> AbstractT m T) -> T -> [Alt] -> AbstractT m T 83 | evalCase ev0 v alts = 84 | -- Exercise: Similar to the definitional interpreter, filter out 85 | -- the matching alts. Using the forMonadPlus operator for all the 86 | -- matchin ones extend the environment if necessary and evaluate the 87 | -- body of the alt 88 | undefined 89 | 90 | extStore :: T -> T -> AbstractT m () 91 | extStore v0 v1 = do 92 | a <- val2addr v0 93 | n <- val2heapVal v1 94 | let changeElem Nothing = Just (Set.singleton n) 95 | changeElem (Just m) = Just (Set.insert n m) 96 | AbstractT $ (modify (over absStr (\(Store m) -> Store (Map.alter changeElem a m)))) 97 | 98 | localEnv :: Env T -> AbstractT m T -> AbstractT m T 99 | localEnv env m = do 100 | collectEnv env 101 | local (absEnv .~ env) m 102 | 103 | 104 | value :: Grin.Value -> AbstractT m T 105 | value = \case 106 | (Grin.VNode (Grin.Node tag ps)) -> do 107 | p <- askEnv 108 | ts <- pure $ map (Env.lookup p) ps 109 | pure $ NT $ Node tag $ map (\case 110 | ST t -> t 111 | other -> error $ unwords ["value", show other] -- TODO: Include type error 112 | ) ts 113 | (Grin.VPrim l) -> pure $ typeOfSimpleValue l 114 | 115 | val2addr :: T -> AbstractT m Loc 116 | val2addr = \case 117 | ST (ST_Loc l) -> pure l 118 | other -> error $ unwords ["val2addr", show other] 119 | 120 | addr2val :: Loc -> AbstractT m T 121 | addr2val l = pure $ ST $ ST_Loc l 122 | 123 | val2heapVal :: T -> AbstractT m Node 124 | val2heapVal = \case 125 | NT n -> pure n 126 | other -> error $ unwords ["val2heapVal", show other] 127 | 128 | heapVal2val :: Node -> AbstractT m T 129 | heapVal2val = pure . NT 130 | 131 | unit :: AbstractT m T 132 | unit = pure UT 133 | 134 | askEnv :: AbstractT m (Env T) 135 | askEnv = _absEnv <$> ask 136 | 137 | lookupFun :: Name -> AbstractT m Exp 138 | lookupFun fn = (fromMaybe (error $ unwords ["lookupFun", nameString fn]) . Map.lookup fn . _absFun) <$> ask 139 | 140 | isExternal :: Name -> AbstractT m Bool 141 | isExternal n = (Map.member n . _absExt) <$> ask 142 | 143 | external :: Name -> [T] -> AbstractT m T 144 | external n ps = do 145 | -- Exercise: 146 | -- Lookup the environment, check if the given parameters has the same type if not throw an 'error' 147 | -- If they have the same type than return the return type of the external. 148 | -- Use the collectFunctionType to register the learn types of the function 149 | undefined 150 | 151 | funCall :: (Exp -> AbstractT m T) -> Name -> [T] -> AbstractT m T 152 | funCall ev0 fn vs = do 153 | -- Exercise: 154 | -- Lookup the (Def _ ps body) constructor of the function, create a new environment binding its 155 | -- arguments to the given values to call with, after the return of the function register its 156 | -- type with the collectFunctionType 157 | undefined 158 | 159 | allocStore :: Name -> AbstractT m T 160 | allocStore name = pure $ ST $ ST_Loc $ Loc name 161 | 162 | -- * Implemented type inference 163 | 164 | typeInference :: (Monad m, MonadFail m, MonadIO m) => Program -> m Grin.TypeEnv 165 | typeInference = fmap (calcTypeEnv . fst) . evalAbstract 166 | 167 | evalAbstract :: (Monad m, MonadFail m, MonadIO m) => Program -> m (TypeEnv, Cache) 168 | evalAbstract prog = do 169 | let ops = [ ("prim_int_add", prim_int_add) 170 | , ("prim_int_sub", prim_int_sub) 171 | , ("prim_int_mul", prim_int_mul) 172 | , ("prim_int_print", prim_int_print) 173 | , ("prim_int_eq", prim_int_eq) 174 | , ("prim_int_gt", prim_int_gt) 175 | ] 176 | let opsMap = Map.fromList ops 177 | forM_ exts $ \ext -> do 178 | when (isNothing (Map.lookup (eName ext) opsMap)) $ 179 | fail $ "Missing external: " ++ show (eName ext) 180 | (\(_,tc,_) -> tc) <$> runAbstractT prog ops (fixCache (fix (evalCache Exercise.eval)) (SApp "main" [])) 181 | where 182 | exts = externals prog 183 | prim_int_add = (ST ST_Int64, [ST ST_Int64, ST ST_Int64]) 184 | prim_int_sub = (ST ST_Int64, [ST ST_Int64, ST ST_Int64]) 185 | prim_int_mul = (ST ST_Int64, [ST ST_Int64, ST ST_Int64]) 186 | prim_int_eq = (ST ST_Bool, [ST ST_Int64, ST ST_Int64]) 187 | prim_int_gt = (ST ST_Bool, [ST ST_Int64, ST ST_Int64]) 188 | prim_int_print = (UT, [ST ST_Int64]) 189 | -------------------------------------------------------------------------------- /grin/src/Tutorial/Chapter03/Exercise01.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE LambdaCase, ScopedTypeVariables, TypeFamilies #-} 2 | module Tutorial.Chapter03.Exercise01 where 3 | 4 | import Data.Functor.Foldable (cata, hylo, embed, project) 5 | import Data.Functor.FoldableM 6 | import Control.Monad.State.Strict 7 | 8 | import Grin.Value (Name, VarOrValue(..), Value(..), Node(..), mkName) 9 | import Grin.Exp 10 | import qualified Data.Map as Map 11 | 12 | 13 | -- Exercise: 14 | -- Read the Chapter 4.2.1 about this transformation: 15 | -- https://nbviewer.jupyter.org/github/grin-compiler/grin/blob/master/papers/boquist.pdf#page=100 16 | 17 | -- Exercise: 18 | -- Open the Data.Functor.Foldable library and read the Recursive, Corecursive typeclass, cata, ana function. 19 | -- http://hackage.haskell.org/package/recursion-schemes-5.1.3/docs/src/Data.Functor.Foldable.html#Recursive 20 | -- http://hackage.haskell.org/package/recursion-schemes-5.1.3/docs/src/Data.Functor.Foldable.html#Corecursive 21 | 22 | -- Hint: 23 | -- The Data.Functor.Foldable library creates the Base Functor data type with template Haskell. 24 | -- Turning every constuctor to a Functor, based on the recursive instance of the type in the constructor. 25 | -- E.g: ((Def Name [Name] Exp) :: Exp) will be turned into ((DefF Name [Name] r) :: ExpF r) 26 | 27 | -- Rename Vars uses the cata from the Recursive type class, where the information we build up from 28 | -- the buttom to top is the Exp AST itself, instead of another type. This way we can write program 29 | -- transformations easily, without applying the recursion boilerplate, that could be errorprone. 30 | renameVars :: Name -> Name -> Int -> Exp -> Exp 31 | renameVars ep arg i = cata $ \case 32 | -- Exercise: Undestand, how the BaseFunctor like EBindF plays a role in this expression. 33 | -- Exercise: Read all the constructors above 34 | EBindF lhs (BVar n) rhs -> EBind lhs (BVar (new n)) rhs 35 | EBindF lhs (BNodePat n t as) rhs -> EBind lhs (BNodePat (new n) t (map new as)) rhs 36 | 37 | SPureF (Var n) -> SPure (Var (new n)) 38 | SPureF (Val (VPrim vp)) -> SPure (Val (VPrim vp)) 39 | SPureF (Val (VNode (Node t ns))) -> SPure (Val (VNode (Node t (map new ns)))) 40 | 41 | SStoreF n -> SStore (new n) 42 | SFetchF n -> SFetch (new n) 43 | SUpdateF n1 n2 -> SUpdate (new n1) (new n2) 44 | SAppF f as -> SApp f (map new as) 45 | -- Hint: Alts are already computed in the previous steps of the recursion 46 | -- Same applies to the rest of the instances where we have a 'body' 47 | ECaseF n (alts :: [Exp]) -> ECase (new n) alts 48 | AltF n DefaultPat body -> Alt (new n) DefaultPat body 49 | AltF n (LitPat l) body -> Alt (new n) (LitPat l) body 50 | AltF n (NodePat t as) body -> Alt (new n) (NodePat t (map new as)) body 51 | BlockF body -> Block body 52 | other -> error $ show other -- This function shouldn't be applied defs and above 53 | where 54 | -- Replace the original e1 argument with the actual call parameter in 55 | -- the call side. 56 | new n | n == ep = arg 57 | | otherwise = n <> (mkName $ show i) 58 | 59 | 60 | -- Exercise: Open the Data.Functor.FoldableM module and read the description of the apoM function. 61 | -- FoldableM is part of this repository. 62 | -- 63 | -- InlineEval uses an integer index to generate new names during the inline-ing. 64 | inlineEval :: Exp -> Exp 65 | inlineEval prog 66 | = bindNormalisation -- This is a helper which removes the inserted blocks. 67 | $ flip evalState (0 :: Int) -- 0 eval inlined so far. 68 | $ flip apoM prog $ \case 69 | -- Filter out the eval function from the final result. 70 | -- NOTE: Don't forget, we now build the tree from top to botton, thus 71 | -- the inlining mechanist won't run on the eval, as eval wont be part of 72 | -- the definition in the next recursive step. 73 | Program exts defs -> pure $ ProgramF exts $ map Right $ filter notEval defs 74 | 75 | -- As we use recursion schemes, we need to tackle down the interesting 76 | -- constructors. Which are the application of the eval function, in some 77 | -- expression. 78 | 79 | -- Inline the body replacing the name of the variables with a given index. 80 | SApp "eval" [arg] -> BlockF <$> inlineBody arg 81 | 82 | -- Exercise: Find out which function to use from the Data.Functor.Foldable library to 83 | other -> pure $ fmap Right $ undefined other 84 | -- complete the definition. Why? 85 | where 86 | -- Find eval 87 | (Def "eval" [v] b) = (programToDefs prog) Map.! "eval" 88 | 89 | notEval _ = False 90 | -- Exercise: Rewrite notEval to return False on the eval 91 | 92 | inlineBody arg = do 93 | i <- get 94 | modify succ 95 | -- If the apoM gets a Left value it stops the recursion on that branch 96 | -- and just returns the computed value. In this case, we compute the 97 | -- inlined body of the eval. 98 | pure $ Left $ renameVars v arg i b 99 | 100 | -- * Helper 101 | 102 | bindNormalisation :: Exp -> Exp 103 | bindNormalisation = hylo alg coalg where 104 | alg :: ExpF Exp -> Exp 105 | alg (BlockF e) = e 106 | alg e = embed e 107 | 108 | coalg :: Exp -> ExpF Exp 109 | coalg (EBind lhs1 pat1 rhs1) 110 | | EBind lhs2 pat2 rhs2 <- rmBlocks lhs1 111 | = BlockF $ EBind lhs2 pat2 (EBind (Block rhs2) pat1 rhs1) 112 | coalg e = project e 113 | 114 | rmBlocks :: Exp -> Exp 115 | rmBlocks (Block e) = rmBlocks e 116 | rmBlocks e = e 117 | -------------------------------------------------------------------------------- /grin/src/Tutorial/Chapter03/Exercise02.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE LambdaCase #-} 2 | module Tutorial.Chapter03.Exercise02 where 3 | 4 | import Grin.Exp 5 | import Grin.TypeEnv 6 | import Data.Functor.Foldable 7 | import Lens.Micro ((^.)) 8 | import Grin.Interpreter.Abstract.Base hiding (TypeEnv) 9 | import Grin.Interpreter.Abstract.TypeInference (typeOfValue) 10 | import Data.Maybe (mapMaybe) 11 | 12 | import qualified Data.Set as Set 13 | import qualified Data.Map.Strict as Map hiding (filter) 14 | 15 | {- 16 | Sparse case optimisation is a very powerful optimisation, which removes the 17 | unnecessary case alternatives. 18 | 19 | Exercise: 20 | Read the Chapter 4.3.6 21 | https://nbviewer.jupyter.org/github/grin-compiler/grin/blob/master/papers/boquist.pdf#page=143 22 | -} 23 | 24 | -- | Sparse case optimisation uses ana to transform the program from top to down. 25 | -- It checks if the given alterntive can be removed. The alternative can be removed 26 | -- if it does not match any of the Nodes in the type associated with the variable. 27 | -- Literal matching alternatives must be kept. 28 | sparseCaseOptimisation :: TypeEnv -> Exp -> Exp 29 | sparseCaseOptimisation te = ana $ \case 30 | ECase n alts -> 31 | let ty = (te ^. variable) Map.! n 32 | in ECaseF n $ 33 | filter (\(Alt _ cpat _) -> matchingAlt ty cpat) $ removeTheRedundantDefault ty alts 34 | -- Exercise: Use the function from the Data.Functor.Foldable library 35 | other -> undefined other 36 | 37 | 38 | -- | Returns True if the given pattern can be matched with the type of the scrutinee 39 | matchingAlt :: Type -> CPat -> Bool 40 | matchingAlt _ DefaultPat = True 41 | matchingAlt (T_SimpleType _) (NodePat{}) = False 42 | matchingAlt (T_NodeSet{}) (LitPat{}) = False 43 | -- Exercise: The type of the literal should match the simple type 44 | matchingAlt (T_SimpleType st) (LitPat l) = undefined 45 | -- Exercise: The tag from the pattern should be present in the NodeSet. 46 | matchingAlt (T_NodeSet ns) (NodePat t ps) = undefined 47 | 48 | -- | Remove the redundant detault 49 | removeTheRedundantDefault :: Type -> [Alt] -> [Alt] 50 | -- As we erase the actual value of the primitive, we can not be sure, of the 51 | -- Default pattern is redunant, thus it must be kept. 52 | removeTheRedundantDefault (T_SimpleType{}) alts = alts 53 | 54 | -- Exercise: If every element from the nodeset is covered by the alts 55 | -- and there is a DefaultPat, it can be removed as it redundant 56 | -- at it will never be accessed. 57 | removeTheRedundantDefault (T_NodeSet ns) alts = undefined 58 | -------------------------------------------------------------------------------- /grin/test/Spec.hs: -------------------------------------------------------------------------------- 1 | -- file test/Spec.hs 2 | {-# OPTIONS_GHC -F -pgmF hspec-discover #-} 3 | -------------------------------------------------------------------------------- /grin/test/Tutorial/Chapter01/Exercise01Spec.hs: -------------------------------------------------------------------------------- 1 | module Tutorial.Chapter01.Exercise01Spec where 2 | 3 | import Grin.Exp 4 | import Grin.Value 5 | import Grin.TypeEnv 6 | import qualified Grin.Examples as Examples 7 | 8 | import Tutorial.Chapter01.Exercise01 9 | 10 | import Test.Hspec 11 | 12 | 13 | main :: IO () 14 | main = hspec spec 15 | 16 | spec :: Spec 17 | spec = do 18 | describe "GExp to Exp" $ do 19 | it "works for Add" $ do 20 | (convertGExpToExp Examples.add) `shouldBe` add 21 | 22 | it "works for Fact" $ do 23 | (convertGExpToExp Examples.fact) `shouldBe` fact 24 | 25 | it "works for Sum" $ do 26 | (convertGExpToExp Examples.sumSimple) `shouldBe` sumSimple 27 | 28 | -- * Test data 29 | 30 | add :: Program 31 | add = 32 | Program 33 | [ External "prim_int_add" (TySimple T_Int64) [TySimple T_Int64, TySimple T_Int64] False 34 | ] 35 | [ Def "add" ["s1", "s2"] $ 36 | EBind (SApp "prim_int_add" ["s1", "s2"]) (BVar "s3") $ 37 | SPure (Var "s3") 38 | , Def "main" [] $ 39 | EBind (SPure (Val (VPrim(SInt64 10)))) (BVar "m1") $ 40 | EBind (SPure (Val (VPrim(SInt64 20)))) (BVar "m2") $ 41 | SApp "add" ["m1", "m2"] 42 | ] 43 | 44 | fact :: Program 45 | fact = 46 | Program 47 | [ External "prim_int_sub" (TySimple T_Int64) [TySimple T_Int64, TySimple T_Int64] False 48 | , External "prim_int_mul" (TySimple T_Int64) [TySimple T_Int64, TySimple T_Int64] False 49 | , External "prim_int_eq" (TySimple T_Bool) [TySimple T_Int64, TySimple T_Int64] False 50 | , External "prim_int_print" (TySimple T_Unit) [TySimple T_Int64, TySimple T_Int64] True 51 | ] 52 | [ Def "fact" ["f1"] $ 53 | EBind (SPure (Val (VPrim (SInt64 0)))) (BVar "f2") $ 54 | EBind (SApp "prim_int_eq" ["f1", "f2"]) (BVar "f3") $ 55 | ECase "f3" 56 | [ Alt "alt1" (LitPat (SBool True)) $ 57 | EBind (SPure (Val (VPrim (SInt64 1)))) (BVar "f7") $ 58 | SPure (Var "f7") 59 | , Alt "alt2" (LitPat (SBool False)) $ 60 | EBind (SPure (Val (VPrim(SInt64 1)))) (BVar "f4") $ 61 | EBind (SApp "prim_int_sub" ["f1", "f4"]) (BVar "f5") $ 62 | EBind (SApp "fact" ["f5"]) (BVar "f6") $ 63 | SApp "prim_int_mul" ["f1", "f6"] 64 | ] 65 | , Def "main" [] $ 66 | EBind (SPure (Val (VPrim (SInt64 10)))) (BVar "m1") $ 67 | EBind (SApp "fact" ["m1"]) (BVar "m2") $ 68 | EBind (SApp "prim_int_print" ["m2"]) (BVar "pip1") $ 69 | SPure (Var "m2") 70 | ] 71 | 72 | sumSimple :: Program 73 | sumSimple = 74 | Program 75 | [ External "prim_int_add" (TySimple T_Int64) [TySimple T_Int64, TySimple T_Int64] False 76 | , External "prim_int_sub" (TySimple T_Int64) [TySimple T_Int64, TySimple T_Int64] False 77 | , External "prim_int_eq" (TySimple T_Bool) [TySimple T_Int64, TySimple T_Int64] False 78 | , External "prim_int_gt" (TySimple T_Bool) [TySimple T_Int64, TySimple T_Int64] False 79 | , External "prim_int_print" (TySimple T_Unit) [TySimple T_Int64, TySimple T_Int64] True 80 | ] 81 | [ Def "main" [] $ 82 | EBind (SPure (Val (VPrim (SInt64 1)))) (BVar "m1") $ 83 | EBind (SPure (Val (VPrim (SInt64 100)))) (BVar "m2") $ 84 | EBind (SPure (Val (VNode (Node (Tag C "Int") ["m1"])))) (BVar "m3") $ 85 | EBind (SPure (Val (VNode (Node (Tag C "Int") ["m2"])))) (BVar "m4") $ 86 | EBind (SStore "m3") (BVar "m5") $ 87 | EBind (SStore "m4") (BVar "m6") $ 88 | EBind (SPure (Val (VNode (Node (Tag F "upto") ["m5", "m6"])))) (BVar "m7") $ 89 | EBind (SStore "m7") (BVar "m8") $ 90 | EBind (SPure (Val (VNode (Node (Tag F "sum") ["m8"])))) (BVar "m9") $ 91 | EBind (SStore "m9") (BVar "m10") $ 92 | EBind (SApp "eval" ["m10"]) (BNodePat "p1" (Tag C "Int") ["m11"]) $ 93 | SApp "prim_int_print" ["m11"] 94 | , Def "upto" ["u1", "u2"] $ 95 | EBind (SApp "eval" ["u1"]) (BNodePat "p2" (Tag C "Int") ["u3"]) $ 96 | EBind (SApp "eval" ["u2"]) (BNodePat "p3" (Tag C "Int") ["u4"]) $ 97 | EBind (SApp "prim_int_gt" ["u3", "u4"]) (BVar "u5") $ 98 | ECase "u5" 99 | [ Alt "alt1" (LitPat (SBool True)) $ 100 | EBind (SPure (Val (VNode (Node (Tag C "Nil") [])))) (BVar "u12") $ 101 | SPure (Var "u12") 102 | , Alt "alt2" (LitPat (SBool False)) $ 103 | EBind (SPure (Val (VPrim(SInt64 1)))) (BVar "u6") $ 104 | EBind (SApp "prim_int_add" ["u3", "u6"]) (BVar "u7") $ 105 | EBind (SPure (Val (VNode (Node (Tag C "Int") ["u7"])))) (BVar "u8") $ 106 | EBind (SStore "u8") (BVar "u9") $ 107 | EBind (SPure (Val (VNode (Node (Tag F "upto") ["u9", "u2"])))) (BVar "u10") $ 108 | EBind (SStore "u10") (BVar "u11") $ 109 | SPure (Val (VNode (Node (Tag C "Cons") ["u1", "u11"]))) 110 | ] 111 | , Def "sum" ["s1"] $ 112 | EBind (SApp "eval" ["s1"]) (BVar "s2") $ 113 | ECase "s2" 114 | [ Alt "alt3" (NodePat (Tag C "Nil") []) $ 115 | EBind (SPure (Val (VPrim(SInt64 0)))) (BVar "s3") $ 116 | SPure (Val (VNode (Node (Tag C "Int") ["s3"]))) 117 | , Alt "alt4" (NodePat (Tag C "Cons") ["s5", "s6"]) $ 118 | EBind (SApp "eval" ["s5"]) (BNodePat "p4" (Tag C "Int") ["s7"]) $ 119 | EBind (SApp "sum" ["s6"]) (BNodePat "p5" (Tag C "Int") ["s8"]) $ 120 | EBind (SApp "prim_int_add" ["s7", "s8"]) (BVar "s9") $ 121 | SPure (Val (VNode (Node (Tag C "Int") ["s9"]))) 122 | ] 123 | , Def "eval" ["e1"] $ 124 | EBind (SFetch "e1") (BVar "e2") $ 125 | ECase "e2" 126 | [ Alt "alt5" (NodePat (Tag C "Int") ["e3"]) $ 127 | EBind (SPure (Val (VNode (Node (Tag C "Int") ["e3"])))) (BVar "e11") $ 128 | SPure (Var "e11") 129 | , Alt "alt6" (NodePat (Tag C "Nil") []) $ 130 | EBind (SPure (Val (VNode (Node (Tag C "Nil") [])))) (BVar "e12") $ 131 | SPure (Var "e12") 132 | , Alt "alt7" (NodePat (Tag C "Cons") ["e4", "e5"]) $ 133 | EBind (SPure (Val (VNode (Node (Tag C "Cons") ["e4", "e5"])))) (BVar "e13") $ 134 | SPure (Var "e13") 135 | , Alt "alt8" (NodePat (Tag F "upto") ["e6", "e7"]) $ 136 | EBind (SApp "upto" ["e6", "e7"]) (BVar "e8") $ 137 | EBind (SUpdate "e1" "e8") (BVar "up1") $ 138 | SPure (Var "e8") 139 | , Alt "alt9" (NodePat (Tag F "sum") ["e9"]) $ 140 | EBind (SApp "sum" ["e9"]) (BVar "e10") $ 141 | EBind (SUpdate "e1" "e10") (BVar "up2") $ 142 | SPure (Var "e10") 143 | ] 144 | ] 145 | -------------------------------------------------------------------------------- /grin/test/Tutorial/Chapter01/Exercise02Spec.hs: -------------------------------------------------------------------------------- 1 | module Tutorial.Chapter01.Exercise02Spec where 2 | 3 | import Tutorial.Chapter01.Exercise01 (convertGExpToExp) 4 | import Tutorial.Chapter01.Exercise02 5 | import Test.Hspec 6 | import Grin.Examples as Examples 7 | 8 | 9 | main :: IO () 10 | main = hspec spec 11 | 12 | spec :: Spec 13 | spec = do 14 | describe "Simple interpreter" $ do 15 | it "works for add" $ do 16 | res <- interpreter knownExternals $ convertGExpToExp Examples.add 17 | res `shouldBe` (Prim $ SInt64 30) 18 | 19 | it "works for fact" $ do 20 | res <- interpreter knownExternals $ convertGExpToExp Examples.fact 21 | res `shouldBe` (Prim $ SInt64 3628800) 22 | 23 | it "works for sumSimple" $ do 24 | res <- interpreter knownExternals $ convertGExpToExp Examples.sumSimple 25 | res `shouldBe` Unit 26 | 27 | -- * Test data 28 | -------------------------------------------------------------------------------- /grin/test/Tutorial/Chapter02/Exercise01Spec.hs: -------------------------------------------------------------------------------- 1 | module Tutorial.Chapter02.Exercise01Spec where 2 | 3 | import Tutorial.Chapter02.Exercise01() 4 | import Test.Hspec 5 | 6 | spec :: Spec 7 | spec = pure () 8 | -------------------------------------------------------------------------------- /grin/test/Tutorial/Chapter02/Exercise02Spec.hs: -------------------------------------------------------------------------------- 1 | module Tutorial.Chapter02.Exercise02Spec where 2 | 3 | import Test.Hspec 4 | import Tutorial.Chapter01.Exercise01 (convertGExpToExp) 5 | import Tutorial.Chapter02.Exercise02 as Exercise 6 | import Grin.Examples 7 | import Grin.Pretty 8 | import qualified Grin.Interpreter.Abstract.TypeInference as Solution 9 | 10 | 11 | 12 | spec :: Spec 13 | spec = do 14 | it "Works for add" $ do 15 | let prog = convertGExpToExp add 16 | expected <- Solution.typeInference prog 17 | result <- Exercise.typeInference prog 18 | (PP result) `shouldBe` (PP expected) 19 | 20 | it "Works for fact" $ do 21 | let prog = convertGExpToExp fact 22 | expected <- Solution.typeInference prog 23 | result <- Exercise.typeInference prog 24 | (PP result) `shouldBe` (PP expected) 25 | 26 | it "Works for sumSimple" $ do 27 | let prog = convertGExpToExp sumSimple 28 | expected <- Solution.typeInference prog 29 | result <- Exercise.typeInference prog 30 | (PP result) `shouldBe` (PP expected) 31 | -------------------------------------------------------------------------------- /grin/test/Tutorial/Chapter03/Exercise01Spec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | module Tutorial.Chapter03.Exercise01Spec where 3 | 4 | import Tutorial.Chapter01.Exercise02 (interpreter, knownExternals) 5 | import Tutorial.Chapter03.Exercise01 6 | import Test.Hspec 7 | import Grin.Exp (programToDefs) 8 | import Grin.GExp 9 | import Grin.GExpToExp 10 | import qualified Data.Map as Map 11 | -- import Grin.Pretty (PP(..)) 12 | 13 | 14 | spec :: Spec 15 | spec = do 16 | it "Inlive eval works for a simple function" $ do 17 | let ex = gexpToExp evalExp 18 | -- print $ PP ex 19 | let expInlinedEval = inlineEval ex 20 | -- print $ PP expInlinedEval 21 | resBefore <- interpreter knownExternals ex 22 | resAfter <- interpreter knownExternals expInlinedEval 23 | let defs = programToDefs expInlinedEval 24 | defs `shouldNotSatisfy` (Map.member "eval") 25 | resBefore `shouldBe` resAfter 26 | 27 | evalExp :: Exp 'Prg 28 | evalExp = 29 | Program 30 | [ External "prim_int_add" (TySimple T_Int64) [TySimple T_Int64, TySimple T_Int64] False 31 | ] 32 | [ Def "main" [] $ 33 | Bind (Pure (Val (VPrim (SInt64 10)))) (BVar "m1") $ 34 | Bind (Pure (Val (VNode (Node (Tag C "Int") ["m1"])))) (BVar "m2") $ 35 | Bind (Store "m2") (BVar "m3") $ 36 | Bind (Pure (Val (VPrim (SInt64 20)))) (BVar "m4") $ 37 | Bind (Pure (Val (VNode (Node (Tag C "Int") ["m4"])))) (BVar "m5") $ 38 | Bind (Store "m5") (BVar "m6") $ 39 | Bind (Pure (Val (VNode (Node (Tag F "add") ["m3", "m6"])))) (BVar "m7") $ 40 | Bind (Store "m7") (BVar "m8") $ 41 | Bind (App ("eval") ["m8"]) (BVar "m9") $ 42 | Pure (Var "m9") 43 | 44 | , Def "add" ["a1", "a2"] $ 45 | Bind (App "eval" ["a1"]) (BNodePat "p1" (Tag C "Int") ["a3"]) $ 46 | Bind (App "eval" ["a2"]) (BNodePat "p2" (Tag C "Int") ["a4"]) $ 47 | Bind (App "prim_int_add" ["a3", "a4"]) (BVar "a5") $ 48 | Bind (Pure (Val (VNode (Node (Tag C "Int") ["a5"])))) (BVar "a6") $ 49 | Pure (Var "a6") 50 | 51 | , Def "eval" ["e1"] $ 52 | Bind (Fetch "e1") (BVar "e2") $ 53 | Case "e2" 54 | [ Alt "alt1" (NodePat (Tag C "Int") ["e3"]) $ 55 | Bind (Pure (Val (VNode (Node (Tag C "Int") ["e3"])))) (BVar "e4") $ 56 | Pure (Var "e4") 57 | , Alt "alt2" (NodePat (Tag F "add") ["e5", "e6"]) $ 58 | Bind (App "add" ["e5", "e6"]) (BVar "e7") $ 59 | Bind (Update "e1" "e7") (BVar "up1") $ 60 | Pure (Var "e7") 61 | ] 62 | ] 63 | -------------------------------------------------------------------------------- /grin/test/Tutorial/Chapter03/Exercise02Spec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | module Tutorial.Chapter03.Exercise02Spec where 3 | 4 | import Test.Hspec hiding (before, after) 5 | import Grin.GExp 6 | import Grin.GExpToExp 7 | import Grin.Pretty (PP(..)) 8 | import Tutorial.Chapter01.Exercise01 (convertGExpToExp) 9 | import Tutorial.Chapter01.Exercise02 (interpreter, knownExternals) 10 | import Tutorial.Chapter02.Exercise02 (typeInference) 11 | import Tutorial.Chapter03.Exercise01 (inlineEval) 12 | import Tutorial.Chapter03.Exercise02 13 | 14 | import Tutorial.Chapter03.Exercise01Spec (evalExp) 15 | 16 | 17 | spec :: Spec 18 | spec = do 19 | it "removes non necessary alternatives" $ do 20 | let beforeExp = convertGExpToExp before 21 | print $ PP beforeExp 22 | typeEnv <- typeInference beforeExp 23 | print $ PP typeEnv 24 | let result = sparseCaseOptimisation typeEnv beforeExp 25 | let expected = convertGExpToExp after 26 | print $ PP result 27 | result `shouldBe` expected 28 | 29 | it "removes the non-neccary cases of inlined evals" $ do 30 | let ex = gexpToExp evalExp 31 | resBefore <- interpreter knownExternals ex 32 | 33 | let expInlinedEval = inlineEval ex 34 | print $ PP expInlinedEval 35 | typeEnv <- typeInference expInlinedEval 36 | print $ PP typeEnv 37 | let expSparseCase = sparseCaseOptimisation typeEnv expInlinedEval 38 | print $ PP expSparseCase 39 | 40 | resAfter <- interpreter knownExternals expSparseCase 41 | resBefore `shouldBe` resAfter 42 | 43 | 44 | -- * Test data 45 | 46 | before :: Exp 'Prg 47 | before = Program 48 | [] 49 | [Def "main" [] $ 50 | Bind (Pure (Val (VPrim (SInt64 1)))) (BVar "m1") $ 51 | Bind (Pure (Val (VNode (Node (Tag C "Index") ["m1"])))) (BVar "m2") $ 52 | Case "m2" 53 | [ Alt "alt1" (NodePat (Tag C "None") []) $ 54 | Bind (Pure (Val (VPrim (SInt64 0)))) (BVar "m3") $ 55 | Pure (Var "m3") 56 | , Alt "alt2" (NodePat (Tag C "Index") ["m4"]) $ 57 | Bind (Pure (Var "m4")) (BVar "m5") $ 58 | Pure (Var "m5") 59 | , Alt "alt3" DefaultPat $ 60 | Bind (Pure (Val (VPrim (SInt64 1)))) (BVar "m6") $ 61 | Pure (Var "m6") 62 | ] 63 | ] 64 | 65 | after :: Exp 'Prg 66 | after = Program 67 | [] 68 | [Def "main" [] $ 69 | Bind (Pure (Val (VPrim (SInt64 1)))) (BVar "m1") $ 70 | Bind (Pure (Val (VNode (Node (Tag C "Index") ["m1"])))) (BVar "m2") $ 71 | Case "m2" 72 | [ Alt "alt2" (NodePat (Tag C "Index") ["m4"]) $ 73 | Bind (Pure (Var "m4")) (BVar "m5") $ 74 | Pure (Var "m5") 75 | ] 76 | ] 77 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | resolver: lts-14.0 2 | 3 | # due to functor-infix 4 | allow-newer: true 5 | 6 | packages: 7 | - 'grin' 8 | 9 | extra-deps: 10 | # - monad-gen-0.3.0.1 11 | - functor-infix-0.0.5 12 | # - QuickCheck-GenT-0.2.0 13 | # - megaparsec-6.5.0 14 | # - neat-interpolation-0.3.2.2 15 | # - set-extra-1.4.1 16 | # - llvm-hs-pretty-0.6.1.0 17 | # - github: csabahruska/llvm-hs 18 | # commit: 868e23a13942703255979369defdb49ac57b6866 19 | # subdirs: 20 | # - llvm-hs 21 | # - llvm-hs-pure 22 | 23 | #flags: 24 | # llvm-hs: 25 | # shared-llvm: true 26 | 27 | #build: 28 | # test-arguments: 29 | # additional-args: 30 | # - "--seed=11010" 31 | --------------------------------------------------------------------------------