Skip to content
This repository was archived by the owner on Aug 3, 2024. It is now read-only.

Backport #1238 (linear types) to ghc-9.0 #1314

Merged
merged 1 commit into from
Feb 7, 2021
Merged

Backport #1238 (linear types) to ghc-9.0 #1314

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
14 changes: 11 additions & 3 deletions haddock-api/src/Haddock/Backends/LaTeX.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -1072,9 +1072,13 @@ ppr_mono_ty (HsForAllTy _ tele ty) unicode
ppr_mono_ty (HsQualTy _ ctxt ty) unicode
= sep [ ppLContext ctxt unicode
, ppr_mono_lty ty unicode ]
ppr_mono_ty (HsFunTy _ _ ty1 ty2) u
ppr_mono_ty (HsFunTy _ mult ty1 ty2) u
= sep [ ppr_mono_lty ty1 u
, arrow u <+> ppr_mono_lty ty2 u ]
, arr <+> ppr_mono_lty ty2 u ]
where arr = case mult of
HsLinearArrow _ -> lollipop u
HsUnrestrictedArrow _ -> arrow u
HsExplicitMult _ m -> multAnnotation <> ppr_mono_lty m u <+> arrow u

ppr_mono_ty (HsBangTy _ b ty) u = ppBang b <> ppLParendType u ty
ppr_mono_ty (HsTyVar _ NotPromoted (L _ name)) _ = ppDocName name
Expand Down Expand Up @@ -1363,14 +1367,18 @@ quote :: LaTeX -> LaTeX
quote doc = text "\\begin{quote}" $$ doc $$ text "\\end{quote}"


dcolon, arrow, darrow, forallSymbol, starSymbol, atSign :: Bool -> LaTeX
dcolon, arrow, lollipop, darrow, forallSymbol, starSymbol, atSign :: Bool -> LaTeX
dcolon unicode = text (if unicode then "∷" else "::")
arrow unicode = text (if unicode then "→" else "->")
lollipop unicode = text (if unicode then "⊸" else "%1 ->")
darrow unicode = text (if unicode then "⇒" else "=>")
forallSymbol unicode = text (if unicode then "∀" else "forall")
starSymbol unicode = text (if unicode then "★" else "*")
atSign unicode = text (if unicode then "@" else "@")

multAnnotation :: LaTeX
multAnnotation = text "%"

dot :: LaTeX
dot = char '.'

Expand Down
9 changes: 7 additions & 2 deletions haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -1213,10 +1213,15 @@ ppr_mono_ty (HsTyVar _ prom (L _ name)) _ q _
| otherwise = ppDocName q Prefix True name
ppr_mono_ty (HsStarTy _ isUni) u _ _ =
toHtml (if u || isUni then "★" else "*")
ppr_mono_ty (HsFunTy _ _ ty1 ty2) u q e =
ppr_mono_ty (HsFunTy _ mult ty1 ty2) u q e =
hsep [ ppr_mono_lty ty1 u q HideEmptyContexts
, arrow u <+> ppr_mono_lty ty2 u q e
, arr <+> ppr_mono_lty ty2 u q e
]
where arr = case mult of
HsLinearArrow _ -> lollipop u
HsUnrestrictedArrow _ -> arrow u
HsExplicitMult _ m -> multAnnotation <> ppr_mono_lty m u q e <+> arrow u

ppr_mono_ty (HsTupleTy _ con tys) u q _ =
tupleParens con (map (ppLType u q HideEmptyContexts) tys)
ppr_mono_ty (HsSumTy _ tys) u q _ =
Expand Down
9 changes: 7 additions & 2 deletions haddock-api/src/Haddock/Backends/Xhtml/Utils.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -21,7 +21,8 @@ module Haddock.Backends.Xhtml.Utils (
keyword, punctuate,

braces, brackets, pabrackets, parens, parenList, ubxParenList, ubxSumList,
arrow, comma, dcolon, dot, darrow, equals, forallSymbol, quote, promoQuote,
arrow, lollipop, comma, dcolon, dot, darrow, equals, forallSymbol, quote, promoQuote,
multAnnotation,
atSign,

hsep, vcat,
Expand Down Expand Up @@ -187,13 +188,17 @@ ubxparens :: Html -> Html
ubxparens h = toHtml "(#" <+> h <+> toHtml "#)"


dcolon, arrow, darrow, forallSymbol, atSign :: Bool -> Html
dcolon, arrow, lollipop, darrow, forallSymbol, atSign :: Bool -> Html
dcolon unicode = toHtml (if unicode then "∷" else "::")
arrow unicode = toHtml (if unicode then "→" else "->")
lollipop unicode = toHtml (if unicode then "⊸" else "%1 ->")
darrow unicode = toHtml (if unicode then "⇒" else "=>")
forallSymbol unicode = if unicode then toHtml "∀" else keyword "forall"
atSign unicode = toHtml (if unicode then "@" else "@")

multAnnotation :: Html
multAnnotation = toHtml "%"

dot :: Html
dot = toHtml "."

Expand Down
108 changes: 108 additions & 0 deletions html-test/ref/LinearTypes.html
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,108 @@
<html xmlns="http://www.w3.org/1999/xhtml"
><head
><meta http-equiv="Content-Type" content="text/html; charset=UTF-8"
/><meta name="viewport" content="width=device-width, initial-scale=1"
/><title
>LinearTypes</title
><link href="#" rel="stylesheet" type="text/css" title="Linuwial"
/><link rel="stylesheet" type="text/css" href="#"
/><link rel="stylesheet" type="text/css" href="#"
/><script src="haddock-bundle.min.js" async="async" type="text/javascript"
></script
><script type="text/x-mathjax-config"
>MathJax.Hub.Config({ tex2jax: { processClass: "mathjax", ignoreClass: ".*" } });</script
><script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/MathJax.js?config=TeX-AMS-MML_HTMLorMML" type="text/javascript"
></script
></head
><body
><div id="package-header"
><span class="caption empty"
>&nbsp;</span
><ul class="links" id="page-menu"
><li
><a href="#"
>Contents</a
></li
><li
><a href="#"
>Index</a
></li
></ul
></div
><div id="content"
><div id="module-header"
><table class="info"
><tr
><th
>Safe Haskell</th
><td
>Safe-Inferred</td
></tr
></table
><p class="caption"
>LinearTypes</p
></div
><div id="synopsis"
><details id="syn"
><summary
>Synopsis</summary
><ul class="details-toggle" data-details-id="syn"
><li class="src short"
><a href="#"
>unrestricted</a
> :: a -&gt; b</li
><li class="src short"
><a href="#"
>linear</a
> :: a %1 -&gt; b</li
><li class="src short"
><a href="#"
>poly</a
> :: a %m -&gt; b</li
></ul
></details
></div
><div id="interface"
><h1
>Documentation</h1
><div class="top"
><p class="src"
><a id="v:unrestricted" class="def"
>unrestricted</a
> :: a -&gt; b <a href="#" class="selflink"
>#</a
></p
><div class="doc"
><p
>Does something unrestricted.</p
></div
></div
><div class="top"
><p class="src"
><a id="v:linear" class="def"
>linear</a
> :: a %1 -&gt; b <a href="#" class="selflink"
>#</a
></p
><div class="doc"
><p
>Does something linear.</p
></div
></div
><div class="top"
><p class="src"
><a id="v:poly" class="def"
>poly</a
> :: a %m -&gt; b <a href="#" class="selflink"
>#</a
></p
><div class="doc"
><p
>Does something polymorphic.</p
></div
></div
></div
></div
></body
></html
>
14 changes: 14 additions & 0 deletions html-test/src/LinearTypes.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,14 @@
{-# LANGUAGE LinearTypes #-}
module LinearTypes where

-- | Does something unrestricted.
unrestricted :: a -> b
unrestricted = undefined

-- | Does something linear.
linear :: a %1 -> b
linear = linear

-- | Does something polymorphic.
poly :: a %m -> b
poly = poly
30 changes: 30 additions & 0 deletions latex-test/ref/LinearTypes/LinearTypes.tex
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,30 @@
\haddockmoduleheading{LinearTypes}
\label{module:LinearTypes}
\haddockbeginheader
{\haddockverb\begin{verbatim}
module LinearTypes (
unrestricted, linear, poly
) where\end{verbatim}}
\haddockendheader

\begin{haddockdesc}
\item[\begin{tabular}{@{}l}
unrestricted :: a -> b
\end{tabular}]
{\haddockbegindoc
Does something unrestricted.\par}
\end{haddockdesc}
\begin{haddockdesc}
\item[\begin{tabular}{@{}l}
linear :: a {\char '45}1 -> b
\end{tabular}]
{\haddockbegindoc
Does something linear.\par}
\end{haddockdesc}
\begin{haddockdesc}
\item[\begin{tabular}{@{}l}
poly :: a {\char '45}m -> b
\end{tabular}]
{\haddockbegindoc
Does something polymorphic.\par}
\end{haddockdesc}
57 changes: 57 additions & 0 deletions latex-test/ref/LinearTypes/haddock.sty
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,57 @@
% Default Haddock style definitions. To use your own style, invoke
% Haddock with the option --latex-style=mystyle.

\usepackage{tabulary} % see below

% make hyperlinks in the PDF, and add an expandabale index
\usepackage[pdftex,bookmarks=true]{hyperref}

\newenvironment{haddocktitle}
{\begin{center}\bgroup\large\bfseries}
{\egroup\end{center}}
\newenvironment{haddockprologue}{\vspace{1in}}{}

\newcommand{\haddockmoduleheading}[1]{\chapter{\texttt{#1}}}

\newcommand{\haddockbeginheader}{\hrulefill}
\newcommand{\haddockendheader}{\noindent\hrulefill}

% a little gap before the ``Methods'' header
\newcommand{\haddockpremethods}{\vspace{2ex}}

% inserted before \\begin{verbatim}
\newcommand{\haddockverb}{\small}

% an identifier: add an index entry
\newcommand{\haddockid}[1]{\haddocktt{#1}\index{#1@\texttt{#1}}}

% The tabulary environment lets us have a column that takes up ``the
% rest of the space''. Unfortunately it doesn't allow
% the \end{tabulary} to be in the expansion of a macro, it must appear
% literally in the document text, so Haddock inserts
% the \end{tabulary} itself.
\newcommand{\haddockbeginconstrs}{\begin{tabulary}{\linewidth}{@{}llJ@{}}}
\newcommand{\haddockbeginargs}{\begin{tabulary}{\linewidth}{@{}llJ@{}}}

\newcommand{\haddocktt}[1]{{\small \texttt{#1}}}
\newcommand{\haddockdecltt}[1]{{\small\bfseries \texttt{#1}}}

\makeatletter
\newenvironment{haddockdesc}
{\list{}{\labelwidth\z@ \itemindent-\leftmargin
\let\makelabel\haddocklabel}}
{\endlist}
\newcommand*\haddocklabel[1]{\hspace\labelsep\haddockdecltt{#1}}
\makeatother

% after a declaration, start a new line for the documentation.
% Otherwise, the documentation starts right after the declaration,
% because we're using the list environment and the declaration is the
% ``label''. I tried making this newline part of the label, but
% couldn't get that to work reliably (the space seemed to stretch
% sometimes).
\newcommand{\haddockbegindoc}{\hfill\\[1ex]}

% spacing between paragraphs and no \parindent looks better
\parskip=10pt plus2pt minus2pt
\setlength{\parindent}{0cm}
11 changes: 11 additions & 0 deletions latex-test/ref/LinearTypes/main.tex
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,11 @@
\documentclass{book}
\usepackage{haddock}
\begin{document}
\begin{titlepage}
\begin{haddocktitle}

\end{haddocktitle}
\end{titlepage}
\tableofcontents
\input{LinearTypes}
\end{document}
14 changes: 14 additions & 0 deletions latex-test/src/LinearTypes/LinearTypes.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,14 @@
{-# LANGUAGE LinearTypes #-}
module LinearTypes where

-- | Does something unrestricted.
unrestricted :: a -> b
unrestricted = undefined

-- | Does something linear.
linear :: a %1 -> b
linear = linear

-- | Does something polymorphic.
poly :: a %m -> b
poly = poly