├── .gitignore ├── Makefile ├── README.md ├── code ├── State.hs ├── ehop2022.links ├── state.ml ├── unix-huawei2022.links ├── unix-msr2022.links ├── unix-nuprl2022.links ├── unix-plug2020.links ├── unix-tutorial.links ├── unix.links └── unix2.links ├── macros.tex ├── pkgs ├── mathpartir.sty └── mathwidth.sty ├── slides ├── Makefile ├── viva.bib └── viva.tex ├── thesis.bib └── thesis.tex /.gitignore: -------------------------------------------------------------------------------- 1 | ## Core latex/pdflatex auxiliary files: 2 | *.aux 3 | *.lof 4 | *.log 5 | *.lot 6 | *.fls 7 | *.out 8 | *.toc 9 | *.fmt 10 | *.fot 11 | *.cb 12 | *.cb2 13 | .*.lb 14 | 15 | ## Intermediate documents: 16 | *.dvi 17 | *.xdv 18 | *-converted-to.* 19 | # these rules might exclude image files for figures etc. 20 | # *.ps 21 | # *.eps 22 | # *.pdf 23 | 24 | ## Generated if empty string is given at "Please type another file name for output:" 25 | .pdf 26 | 27 | ## Bibliography auxiliary files (bibtex/biblatex/biber): 28 | *.bbl 29 | *.bcf 30 | *.blg 31 | *-blx.aux 32 | *-blx.bib 33 | *.run.xml 34 | 35 | ## Build tool auxiliary files: 36 | *.fdb_latexmk 37 | *.synctex 38 | *.synctex(busy) 39 | *.synctex.gz 40 | *.synctex.gz(busy) 41 | *.pdfsync 42 | 43 | ## Auxiliary and intermediate files from other packages: 44 | # algorithms 45 | *.alg 46 | *.loa 47 | 48 | # achemso 49 | acs-*.bib 50 | 51 | # amsthm 52 | *.thm 53 | 54 | # beamer 55 | *.nav 56 | *.pre 57 | *.snm 58 | *.vrb 59 | 60 | # changes 61 | *.soc 62 | 63 | # cprotect 64 | *.cpt 65 | 66 | # elsarticle (documentclass of Elsevier journals) 67 | *.spl 68 | 69 | # endnotes 70 | *.ent 71 | 72 | # fixme 73 | *.lox 74 | 75 | # feynmf/feynmp 76 | *.mf 77 | *.mp 78 | *.t[1-9] 79 | *.t[1-9][0-9] 80 | *.tfm 81 | 82 | #(r)(e)ledmac/(r)(e)ledpar 83 | *.end 84 | *.?end 85 | *.[1-9] 86 | *.[1-9][0-9] 87 | *.[1-9][0-9][0-9] 88 | *.[1-9]R 89 | *.[1-9][0-9]R 90 | *.[1-9][0-9][0-9]R 91 | *.eledsec[1-9] 92 | *.eledsec[1-9]R 93 | *.eledsec[1-9][0-9] 94 | *.eledsec[1-9][0-9]R 95 | *.eledsec[1-9][0-9][0-9] 96 | *.eledsec[1-9][0-9][0-9]R 97 | 98 | # glossaries 99 | *.acn 100 | *.acr 101 | *.glg 102 | *.glo 103 | *.gls 104 | *.glsdefs 105 | 106 | # gnuplottex 107 | *-gnuplottex-* 108 | 109 | # gregoriotex 110 | *.gaux 111 | *.gtex 112 | 113 | # htlatex 114 | *.4ct 115 | *.4tc 116 | *.idv 117 | *.lg 118 | *.trc 119 | *.xref 120 | 121 | # hyperref 122 | *.brf 123 | 124 | # knitr 125 | *-concordance.tex 126 | # TODO Comment the next line if you want to keep your tikz graphics files 127 | *.tikz 128 | *-tikzDictionary 129 | 130 | # listings 131 | *.lol 132 | 133 | # makeidx 134 | *.idx 135 | *.ilg 136 | *.ind 137 | *.ist 138 | 139 | # minitoc 140 | *.maf 141 | *.mlf 142 | *.mlt 143 | *.mtc[0-9]* 144 | *.slf[0-9]* 145 | *.slt[0-9]* 146 | *.stc[0-9]* 147 | 148 | # minted 149 | _minted* 150 | *.pyg 151 | 152 | # morewrites 153 | *.mw 154 | 155 | # nomencl 156 | *.nlg 157 | *.nlo 158 | *.nls 159 | 160 | # pax 161 | *.pax 162 | 163 | # pdfpcnotes 164 | *.pdfpc 165 | 166 | # sagetex 167 | *.sagetex.sage 168 | *.sagetex.py 169 | *.sagetex.scmd 170 | 171 | # scrwfile 172 | *.wrt 173 | 174 | # sympy 175 | *.sout 176 | *.sympy 177 | sympy-plots-for-*.tex/ 178 | 179 | # pdfcomment 180 | *.upa 181 | *.upb 182 | 183 | # pythontex 184 | *.pytxcode 185 | pythontex-files-*/ 186 | 187 | # thmtools 188 | *.loe 189 | 190 | # TikZ & PGF 191 | *.dpth 192 | *.md5 193 | *.auxlock 194 | 195 | # todonotes 196 | *.tdo 197 | 198 | # easy-todo 199 | *.lod 200 | 201 | # xmpincl 202 | *.xmpi 203 | 204 | # xindy 205 | *.xdy 206 | 207 | # xypic precompiled matrices 208 | *.xyc 209 | 210 | # endfloat 211 | *.ttt 212 | *.fff 213 | 214 | # Latexian 215 | TSWLatexianTemp* 216 | 217 | ## Editors: 218 | # WinEdt 219 | *.bak 220 | *.sav 221 | 222 | # Texpad 223 | .texpadtmp 224 | 225 | # Kile 226 | *.backup 227 | 228 | # KBibTeX 229 | *~[0-9]* 230 | 231 | # auto folder when using emacs and auctex 232 | ./auto/* 233 | *.el 234 | 235 | # expex forward references with \gathertags 236 | *-tags.tex 237 | 238 | # standalone packages 239 | *.sta 240 | 241 | # generated if using elsarticle.cls 242 | *.spl 243 | 244 | # ignore temporaries 245 | *~ 246 | \#* 247 | 248 | # Do not add build target. 249 | thesis.pdf -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | TEXC=pdflatex 2 | CFLAGS=-interaction=nonstopmode -halt-on-error -file-line-error 3 | BIBC=bibtex 4 | PAPER=thesis 5 | BIBLIO=$(PAPER) 6 | LATEST_COMMIT=$(shell git log --format="%h" -n 1) 7 | 8 | all: $(PAPER).pdf 9 | draft: $(PAPER).pdf-draft 10 | 11 | $(PAPER).aux: $(PAPER).tex 12 | $(TEXC) $(CFLAGS) $(PAPER) 13 | 14 | $(BIBLIO).bbl: $(PAPER).aux $(BIBLIO).bib 15 | $(BIBC) $(PAPER) 16 | 17 | $(PAPER).pdf: $(PAPER).aux $(BIBLIO).bbl 18 | $(TEXC) $(CFLAGS) $(PAPER) 19 | $(TEXC) $(CFLAGS) $(PAPER) 20 | 21 | $(PAPER).pdf-draft: CFLAGS:=$(CFLAGS) "\def\DRAFT{$(LATEST_COMMIT)}\input{$(PAPER)}" 22 | $(PAPER).pdf-draft: all 23 | mv $(PAPER).pdf $(PAPER)-draft.pdf 24 | tar cf thesis-draft.tar.gz $(PAPER)-draft.pdf 25 | 26 | clean: 27 | rm -f *.log *.aux *.toc *.out 28 | rm -f *.bbl *.blg *.fls *.xml 29 | rm -f *.fdb_latexmk *.vtc *.cut 30 | rm -f $(PAPER).pdf camera-ready.pdf submission.pdf 31 | rm -f *.o *.cmx *.cmo 32 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Foundations for programming and implementing effect handlers 2 | 3 | A copy of my dissertation can be [downloaded via my 4 | website](https://dhil.net/research/papers/thesis.pdf). 5 | 6 | ---- 7 | 8 | Submitted on May 30, 2021. Examined on August 13, 2021. 9 | 10 | The board of examiners were 11 | 12 | * [Andrew Kennedy](https://github.com/andrewjkennedy) (Facebook London) 13 | * [Edwin Brady](https://www.type-driven.org.uk/edwinb/) (University of St Andrews) 14 | * [Ohad Kammar](http://denotational.co.uk/) (The University of Edinburgh) 15 | * [Stephen Gilmore](https://homepages.inf.ed.ac.uk/stg/) (The University of Edinburgh) 16 | 17 | ## Thesis structure 18 | 19 | The dissertation is structured as follows. 20 | 21 | ### Introduction 22 | 23 | * Chapter 1 puts forth an argument for why effect handlers 24 | matter. Following this argument it provides a basic introduction to 25 | several different approaches to effectful programming through the 26 | lens of the state effect. In addition, it also declares the scope 27 | and contributions of the dissertation, and discusses some related 28 | work. 29 | 30 | ### Programming 31 | 32 | * Chapter 2 illustrates effect handler oriented programming by 33 | example by implementing a small operating system dubbed Tiny UNIX, 34 | which captures some essential traits of Ritchie and Thompson's 35 | UNIX. The implementation starts with a basic notion of file i/o, 36 | and then, it evolves into a feature-rich operating system with full 37 | file i/o, multiple user environments, multi-tasking, and more, by 38 | composing ever more effect handlers. 39 | 40 | * Chapter 3 introduces a polymorphic fine-grain call-by-value core 41 | calculus, λb, which makes key use of Rémy-style row 42 | polymorphism to implement polymorphic variants, structural records, 43 | and a structural effect system. The calculus distils the essence of 44 | the core of the Links programming language. The chapter also 45 | presents three extensions of λb, which are λh 46 | that adds deep handlers, λ† that adds shallow handlers, 47 | and λ‡ that adds parameterised handlers. 48 | 49 | ### Implementation 50 | 51 | * Chapter 4 develops a higher-order continuation passing style 52 | translation for effect handlers through a series of step-wise 53 | refinements of an initial standard continuation passing style 54 | translation for λb. Each refinement slightly modifies 55 | the notion of continuation employed by the translation. The 56 | development ultimately leads to the key invention of generalised 57 | continuation, which is used to give a continuation passing style 58 | semantics to deep, shallow, and parameterised handlers. 59 | 60 | * Chapter 5 demonstrates an application of generalised continuations 61 | to abstract machine as we plug generalised continuations into 62 | Felleisen and Friedman's CEK machine to obtain an adequate abstract 63 | runtime with simultaneous support for deep, shallow, and 64 | parameterised handlers. 65 | 66 | ### Expressiveness 67 | 68 | * Chapter 6 shows that deep, shallow, and parameterised notions of 69 | handlers can simulate one another up to specific notions of 70 | administrative reduction. 71 | 72 | * Chapter 7 studies the fundamental efficiency of effect handlers. In 73 | this chapter, we show that effect handlers enable an asymptotic 74 | improvement in runtime complexity for a certain class of 75 | functions. Specifically, we consider the *generic count* problem 76 | using a pure PCF-like base language λb→ (a 77 | simply typed variation of λb) and its extension with 78 | effect handlers λh→. We show that 79 | λh→ admits an asymptotically more efficient 80 | implementation of generic count than any λb→ 81 | implementation. 82 | 83 | ### Conclusions 84 | * Chapter 8 concludes and discusses future work. 85 | 86 | ### Appendices 87 | 88 | * Appendix A contains a literature survey of continuations and 89 | first-class control. I classify continuations according to their 90 | operational behaviour and provide an overview of the various 91 | first-class sequential control operators that appear in the 92 | literature. The application spectrum of continuations is discussed 93 | as well as implementation strategies for first-class control. 94 | * Appendix B contains a proof that shows the `Get-get` equation for 95 | state is redundant. 96 | * Appendix C contains the proof details and gadgetry for the 97 | complexity of the effectful generic count program. 98 | * Appendix D provides a sample implementation of the Berger count 99 | program and discusses it in more detail. 100 | 101 | ## Building 102 | 103 | To build the dissertation you need the [Informatics thesis LaTeX 104 | class](https://github.com/dhil/inf-thesis-latex-cls) with the 105 | University of Edinburgh crests. Invoking `make` on the command line 106 | ought to produce a PDF copy of the dissertation named `thesis.pdf`, 107 | e.g. 108 | 109 | ```shell 110 | $ make 111 | ``` 112 | 113 | ## Timeline 114 | 115 | I submitted my thesis on May 30, 2021. It was examined on August 13, 116 | 2021, where I received pass with minor corrections. The revised thesis 117 | was submitted on December 22, 2021. It was approved on March 118 | 14, 2022. The final revision was submitted on March 23, 2022. I 119 | received my PhD award letter on March 24, 2022. My graduation 120 | ceremony took place in McEwan Hall on July 11, 2022. 121 | -------------------------------------------------------------------------------- /code/State.hs: -------------------------------------------------------------------------------- 1 | {- A Haskell version of the companion code for "State of effectful programming". 2 | Tested with GHCi 8.6.5. -} 3 | import Control.Monad.ST (runST) 4 | import Data.STRef (newSTRef, readSTRef, writeSTRef) 5 | -- State monad 6 | newtype State s a = State { runState :: s -> (a,s) } 7 | 8 | -- | State is a functor 9 | instance Functor (State s) where 10 | fmap f m = State (\st -> let (x, st') = runState m st in 11 | (f x, st')) 12 | 13 | -- | State is an applicative functor 14 | instance Applicative (State s) where 15 | pure x = State (\st -> (x, st)) 16 | m1 <*> m2 = State (\st -> let (f, st') = runState m1 st in 17 | runState (fmap f m2) st') 18 | 19 | -- | State is a monad 20 | instance Monad (State s) where 21 | return = pure 22 | m >>= k = State (\st -> let (x, st') = runState m st in 23 | runState (k x) st') 24 | 25 | -- | State operations 26 | get :: () -> State s s 27 | get () = State (\st -> (st, st)) 28 | 29 | put :: s -> State s () 30 | put st = State (\st' -> ((), st)) 31 | 32 | -- Continuation monad 33 | newtype Cont r a = Cont { runCont :: (a -> r) -> r } 34 | 35 | -- | Cont is a functor 36 | instance Functor (Cont r) where 37 | fmap f k = Cont (\g -> runCont k (\x -> g (f x))) 38 | 39 | -- | Cont is an applicative functor 40 | instance Applicative (Cont r) where 41 | pure x = Cont (\k -> k x) 42 | k <*> k' = Cont (\r -> runCont k 43 | (\k'' -> runCont k' 44 | (\x -> r (k'' x)))) 45 | 46 | -- | Cont is a monad 47 | instance Monad (Cont r) where 48 | return = pure 49 | m >>= k = Cont (\k' -> runCont m 50 | (\x -> runCont (k x) 51 | (\y -> k' y))) 52 | 53 | -- | State operations 54 | 55 | getk :: () -> Cont (State s a) s 56 | getk () = Cont (\k -> State (\st -> runState (k st) st)) 57 | 58 | putk :: s -> Cont (State s a) () 59 | putk st' = Cont (\k -> State (\st -> runState (k ()) st')) 60 | 61 | -- Free monad 62 | data Free f a = Return a 63 | | Op (f (Free f a)) 64 | 65 | -- | Free is a functor 66 | instance Functor f => Functor (Free f) where 67 | fmap f (Return x) = Return (f x) 68 | fmap f (Op y) = Op (fmap (fmap f) y) 69 | 70 | -- | Free is an applicative functor 71 | instance Functor f => Applicative (Free f) where 72 | pure = Return 73 | (Return f) <*> xs = fmap f xs 74 | (Op f) <*> xs = Op (fmap (\g -> g <*> xs) f) 75 | 76 | -- | Free is a monad 77 | instance Functor f => Monad (Free f) where 78 | return = Return 79 | (Return x) >>= k = k x 80 | (Op y) >>= k = Op (fmap (\m' -> m' >>= k) y) 81 | 82 | -- | Auxiliary function for constructing operation nodes 83 | do' :: Functor f => f a -> Free f a 84 | do' op = Op (fmap Return op) 85 | 86 | -- Instantiate Free with state 87 | data FreeState s r = Get (s -> r) 88 | | Put s (() -> r) 89 | 90 | -- | FreeState is a functor 91 | instance Functor (FreeState s) where 92 | fmap f (Get k) = Get (\st -> f (k st)) 93 | fmap f (Put st' k) = Put st' (\() -> f (k ())) 94 | 95 | -- | State operations 96 | get' :: () -> Free (FreeState s) s 97 | get' () = do' (Get (\x -> x)) 98 | 99 | put' :: s -> Free (FreeState s) () 100 | put' st = do' (Put st (\() -> ())) 101 | 102 | -- | State handler 103 | runState' :: s -> Free (FreeState s) a -> (a, s) 104 | runState' st0 (Op (Get k)) = runState' st0 (k st0) 105 | runState' st0 (Op (Put st k)) = runState' st (k ()) 106 | runState' st0 (Return x) = (x, st0) 107 | 108 | -- Generic state example 109 | incrEven :: Monad m => (() -> m Int, Int -> m ()) -> () -> m Bool 110 | incrEven (get, put) () = get () >>= (\st -> put (1 + st) >>= (\() -> return (even st))) 111 | 112 | runExamples :: Int -> [(String, (Bool, Int))] 113 | runExamples st0 = map (\(s, f) -> (s, f st0)) examples 114 | where examples = [ ("builtin state", \st -> runST $ do 115 | st' <- newSTRef st 116 | v <- readSTRef st' 117 | writeSTRef st' (v + 1) 118 | v' <- readSTRef st' 119 | return (even v, v')) 120 | , ("pure state passing", \st -> (even st, st + 1)) 121 | , ("state monad", \st -> runState (incrEven (get, put) ()) st) 122 | , ("continuation monad", \st -> runState (runCont (incrEven (getk, putk) ()) 123 | (\x -> State (\st -> (x, st)))) st) 124 | , ("free monad", \st -> runState' st (incrEven (get', put') ())) ] 125 | -------------------------------------------------------------------------------- /code/state.ml: -------------------------------------------------------------------------------- 1 | (* Companion for "State of effectful programming" 2 | Tested with OCaml 4.10.0+multicore. *) 3 | 4 | (* Generic direct-style incr_even *) 5 | let even : int -> bool 6 | = fun n -> n mod 2 = 0 7 | 8 | let incr_even : (unit -> int) * (int -> unit) -> unit -> bool 9 | = fun (get, put) () -> 10 | let st = get () in 11 | put (1 + st); 12 | even st 13 | 14 | (* Delimited control *) 15 | module Prompt : sig 16 | type 'a t 17 | val make : unit -> 'a t 18 | val reify : 'a t -> (('b -> 'a) -> 'a) -> 'b 19 | val install : 'a t -> (unit -> 'a) -> 'a 20 | end = struct 21 | type 'a t = { 22 | install : (unit -> 'a) -> 'a; 23 | reify : 'b. (('b -> 'a) -> 'a) -> 'b 24 | } 25 | 26 | let make (type a) () = 27 | let module M = struct 28 | effect Prompt : (('b -> a) -> a) -> 'b 29 | end 30 | in 31 | let reify f = perform (M.Prompt f) in 32 | let install f = 33 | match f () with 34 | | x -> x 35 | | effect (M.Prompt f) k -> f (continue k) 36 | in 37 | { install; reify } 38 | 39 | let install { install; _ } = install 40 | let reify { reify; _ } = reify 41 | let resume k v = continue k v 42 | end 43 | 44 | module type CTRL = sig 45 | type ans 46 | val reset : (unit -> ans) -> ans 47 | val shift : (('a -> ans) -> ans) -> 'a 48 | end 49 | 50 | module Ctrl(R : sig type ans end) : sig 51 | include CTRL with type ans = R.ans 52 | end = struct 53 | type ans = R.ans 54 | 55 | let p : ans Prompt.t = Prompt.make () 56 | 57 | let reset m = 58 | Prompt.install p m 59 | 60 | let shift f = 61 | Prompt.reify p 62 | (fun k -> 63 | Prompt.install p 64 | (fun () -> 65 | f (fun x -> 66 | Prompt.install p 67 | (fun () -> k x)))) 68 | end 69 | 70 | module CtrlState 71 | (S : sig type s end) 72 | (R : sig type ans end): sig 73 | type s = S.s 74 | type ans = s -> R.ans * s 75 | 76 | val get : unit -> s 77 | val put : s -> unit 78 | 79 | val run : (unit -> R.ans) -> ans 80 | end = struct 81 | type s = S.s 82 | type ans = s -> R.ans * s 83 | module Ctrl = Ctrl(struct type nonrec ans = ans end) 84 | 85 | let get () = Ctrl.shift (fun k -> fun st -> k st st) 86 | let put st' = Ctrl.shift (fun k -> fun st -> k () st') 87 | 88 | let run m = 89 | Ctrl.reset 90 | (fun () -> 91 | let x = m () in 92 | fun st -> (x, st)) 93 | end 94 | 95 | module CtrlIntState = CtrlState(struct type s = int end)(struct type ans = bool end) 96 | 97 | (* Monadic programming *) 98 | module type MONAD = sig 99 | type 'a t 100 | val return : 'a -> 'a t 101 | val (>>=) : 'a t -> ('a -> 'b t) -> 'b t 102 | end 103 | 104 | (** State monad **) 105 | module type STATE_MONAD = sig 106 | type ans 107 | type s 108 | include MONAD 109 | 110 | val get : unit -> s t 111 | val put : s -> unit t 112 | val run : (unit -> ans t) -> s -> ans * s 113 | end 114 | 115 | module StateMonad(S : sig type s end)(R : sig type ans end): sig 116 | include STATE_MONAD with type s = S.s 117 | and type ans = R.ans 118 | end = struct 119 | type ans = R.ans 120 | type s = S.s 121 | type 'a t = s -> 'a * s 122 | 123 | let return : 'a -> 'a t 124 | = fun x -> fun st -> (x, st) 125 | 126 | let (>>=) : 'a t -> ('a -> 'b t) -> 'b t 127 | = fun m k -> fun st -> 128 | let (x, st') = m st in 129 | k x st' 130 | 131 | let get : unit -> s t 132 | = fun () st -> (st, st) 133 | 134 | let put : s -> unit t 135 | = fun st st' -> ((), st) 136 | 137 | let run : (unit -> ans t) -> s -> ans * s 138 | = fun m st -> m () st 139 | end 140 | 141 | module IntStateMonad = StateMonad(struct type s = int end)(struct type ans = bool end) 142 | 143 | (** Continuation monad **) 144 | module type CONTINUATION_MONAD = sig 145 | type r 146 | include MONAD with type 'a t = ('a -> r) -> r 147 | end 148 | 149 | module ContinuationMonad(R : sig type ans end): sig 150 | include CONTINUATION_MONAD with type r = R.ans 151 | end = struct 152 | type r = R.ans 153 | type 'a t = ('a -> r) -> r 154 | 155 | let return : 'a -> 'a t 156 | = fun x -> fun k -> k x 157 | 158 | let (>>=) : 'a t -> ('a -> 'b t) -> 'b t 159 | = fun m k -> fun c -> 160 | m (fun x -> k x c) 161 | end 162 | 163 | module ContinuationStateMonad 164 | (S : sig type s end) 165 | (R : sig type ans end): sig 166 | type s = S.s 167 | type ans = R.ans 168 | include CONTINUATION_MONAD with type r = s -> ans * s 169 | 170 | val get : unit -> s t 171 | val put : s -> unit t 172 | val run : (unit -> ans t) -> s -> ans * s 173 | end = struct 174 | type s = S.s 175 | type ans = R.ans 176 | module ContinuationMonad : CONTINUATION_MONAD with type r = s -> ans * s 177 | = ContinuationMonad(struct type nonrec ans = s -> ans * s end) 178 | include ContinuationMonad 179 | 180 | let get : unit -> s t 181 | = fun () -> fun k -> fun st -> k st st 182 | 183 | let put : s -> unit t 184 | = fun st' -> fun k -> fun st -> k () st' 185 | 186 | let run : (unit -> R.ans t) -> s -> R.ans * s = 187 | fun m st -> m () (fun x -> fun st -> (x, st)) st 188 | end 189 | 190 | module ContinuationIntStateMonad 191 | = ContinuationStateMonad(struct type s = int end)(struct type ans = bool end) 192 | 193 | (** Free monad **) 194 | module type FUNCTOR = sig 195 | type 'a t 196 | val fmap : ('a -> 'b) -> 'a t -> 'b t 197 | end 198 | 199 | module type FREE_MONAD = sig 200 | type 'a op 201 | type 'a free = Return of 'a 202 | | Op of 'a free op 203 | 204 | include MONAD with type 'a t = 'a free 205 | 206 | val do' : 'a op -> 'a free 207 | end 208 | 209 | module FreeMonad(F : FUNCTOR) : sig 210 | include FREE_MONAD with type 'a op = 'a F.t 211 | end = struct 212 | type 'a op = 'a F.t 213 | type 'a free = Return of 'a 214 | | Op of 'a free F.t 215 | 216 | type 'a t = 'a free 217 | 218 | let return : 'a -> 'a t 219 | = fun x -> Return x 220 | 221 | let rec (>>=) : 'a t -> ('a -> 'b t) -> 'b t 222 | = fun m k -> 223 | match m with 224 | | Return x -> k x 225 | | Op y -> Op (F.fmap (fun m' -> m' >>= k) y) 226 | 227 | let do' : 'a F.t -> 'a free 228 | = fun op -> Op (F.fmap (fun x -> Return x) op) 229 | end 230 | 231 | module type FREE_STATE = sig 232 | type s 233 | type 'r opsig = Get of (s -> 'r) 234 | | Put of s * (unit -> 'r) 235 | include FUNCTOR with type 'r t = 'r opsig 236 | end 237 | 238 | module FreeState(S : sig type s end) = struct 239 | type s = S.s 240 | type 'r opsig = Get of (s -> 'r) 241 | | Put of s * (unit -> 'r) 242 | type 'r t = 'r opsig 243 | 244 | let fmap : ('a -> 'b) -> 'a t -> 'b t 245 | = fun f op -> 246 | match op with 247 | | Get k -> Get (fun st -> f (k st)) 248 | | Put (st', k) -> Put (st', fun st -> f (k ())) 249 | end 250 | 251 | module FreeIntStateMonad: sig 252 | include STATE_MONAD with type s = int 253 | and type ans = bool 254 | end = struct 255 | 256 | module rec FreeIntState : FREE_STATE with type s = int 257 | = FreeState(struct type s = int end) 258 | and FreeIntStateMonad : FREE_MONAD with type 'r op = 'r FreeIntState.opsig 259 | = FreeMonad(FreeIntState) 260 | 261 | open FreeIntState 262 | include FreeIntStateMonad 263 | 264 | type s = int 265 | type ans = bool 266 | 267 | let get : unit -> s t 268 | = fun () -> do' (Get (fun st -> st)) 269 | 270 | let put : s -> unit t 271 | = fun st -> do' (Put (st, fun () -> ())) 272 | 273 | let rec run : (unit -> ans t) -> s -> ans * s 274 | = fun m st -> 275 | match m () with 276 | | Return x -> (x, st) 277 | | Op (Get k) -> run (fun () -> k st) st 278 | | Op (Put (st', k)) -> run k st' 279 | end 280 | 281 | (** Monadic reflection **) 282 | module Reflect 283 | (M : MONAD) 284 | (R : sig type ans end): sig 285 | type ans = R.ans 286 | 287 | val reify : (unit -> ans) -> ans M.t 288 | val reflect : 'a M.t -> 'a 289 | 290 | end = struct 291 | type ans = R.ans 292 | effect Reflect : 'a M.t -> 'a 293 | 294 | let reify : (unit -> ans) -> ans M.t 295 | = fun f -> 296 | let open M in 297 | match f () with 298 | | x -> return x 299 | | effect (Reflect m) k -> m >>= (continue k) 300 | 301 | let reflect : 'a M.t -> 'a 302 | = fun m -> 303 | perform (Reflect m) 304 | end 305 | 306 | module ReflectIntStateMonad 307 | = Reflect(IntStateMonad)(struct type ans = bool end) 308 | 309 | module ReflectIntState = struct 310 | open ReflectIntStateMonad 311 | 312 | let get : unit -> int 313 | = fun () -> reflect (IntStateMonad.get ()) 314 | 315 | let put : int -> unit 316 | = fun st -> reflect (IntStateMonad.put st) 317 | 318 | let run : (unit -> bool) -> int -> bool * int 319 | = fun m st -> IntStateMonad.run (fun () -> reify m) st 320 | end 321 | 322 | (* Generic monadic incr_even *) 323 | module MonadExample(T : STATE_MONAD with type s = int) = struct 324 | let incr_even : unit -> bool T.t 325 | = fun () -> 326 | let open T in 327 | (get ()) >>= (fun st -> put (1 + st) 328 | >>= (fun () -> return (even st))) 329 | end 330 | 331 | (** Effect handlers **) 332 | module type STATE_HANDLER = sig 333 | type s 334 | 335 | val get : unit -> s 336 | val put : s -> unit 337 | val run : (unit -> 'a) -> s -> 'a * s 338 | end 339 | 340 | module StateHandler(S : sig type s end) : STATE_HANDLER with type s = S.s = struct 341 | type s = S.s 342 | 343 | effect Put : s -> unit 344 | let put st = perform (Put st) 345 | 346 | effect Get : unit -> s 347 | let get () = perform (Get ()) 348 | 349 | let run 350 | = fun m st -> 351 | let f = match m () with 352 | | x -> (fun st -> (x, st)) 353 | | effect (Put st') k -> (fun st -> continue k () st') 354 | | effect (Get ()) k -> (fun st -> continue k st st) 355 | in f st 356 | end 357 | 358 | module IntStateHandler = StateHandler(struct type s = int end) 359 | 360 | let run_examples () = 361 | let examples = [ 362 | "builtin", (fun st -> 363 | let st = ref st in let v = !st in st := 1 + v; (even v, !st)); 364 | "pure state passing", (fun st -> (even st, 1 + st)); 365 | "shift/reset", (fun st -> 366 | CtrlIntState.run (incr_even CtrlIntState.(get, put)) st); 367 | "state monad", (fun st -> 368 | let module MonadStateExample = MonadExample(IntStateMonad) in 369 | IntStateMonad.run MonadStateExample.incr_even st); 370 | "continuation monad", (fun st -> 371 | let module ContinuationMonadExample = MonadExample(ContinuationIntStateMonad) in 372 | ContinuationIntStateMonad.run ContinuationMonadExample.incr_even st); 373 | "free monad", (fun st -> 374 | let module FreeMonadExample = MonadExample(FreeIntStateMonad) in 375 | FreeIntStateMonad.run FreeMonadExample.incr_even st); 376 | "monadic reflection", (fun st -> 377 | ReflectIntState.run (incr_even ReflectIntState.(get, put)) st); 378 | "state handler", (fun st -> 379 | IntStateHandler.run (incr_even IntStateHandler.(get, put)) st) ] 380 | in 381 | List.map (fun (s, f) -> (s, f 4)) examples 382 | (* module IntStateMRefl : MREFL with type ans := bool and type 'a t = 'a IntState.t 383 | * = MRefl(struct type ans = bool end)(IntState) 384 | * 385 | * let get () = IntStateMRefl.reflect (IntState.get ()) 386 | * let put st = IntStateMRefl.reflect (IntState.put st) 387 | * let run m st = IntState.run (IntStateMRefl.reify m) st 388 | * 389 | * let even : int -> bool 390 | * = fun n -> n mod 2 = 0 391 | * 392 | * let incr_even : unit -> bool 393 | * = fun () -> 394 | * let st = get () in 395 | * put (1 + st); 396 | * even st *) 397 | -------------------------------------------------------------------------------- /code/unix-huawei2022.links: -------------------------------------------------------------------------------- 1 | # DISCLAIMER: THIS MODULE REQUIRES A SPECIAL BRANCH OF LINKS TO 2 | # COMPILE: https://github.com/dhil/links/tree/multi-line-comments 3 | # commit ddcc02d3 as the effect patterns are not yet available in 4 | # master (you'll find that everything is implemented twice in this 5 | # file, once with the "new" syntax, which is shadowed by an 6 | # implementation using the "old" syntax). 7 | 8 | ## Prelude 9 | typename Option(a) = [|None|Some:a|]; 10 | 11 | sig todo : (String) ~> a 12 | fun todo(s) { error("TODO: " ^^ s) } 13 | 14 | sig fail : () {Fail:Zero |_}-> a 15 | fun fail() { switch (do Fail) { } } 16 | 17 | sig lookup : (a, [(a, b)]) {Fail:Zero |_}~> b 18 | fun lookup(k, kvs) { 19 | switch (kvs) { 20 | case [] -> fail() 21 | case (k', v) :: kvs' -> 22 | if (k == k') v 23 | else lookup(k, kvs') 24 | } 25 | } 26 | 27 | sig modify : (a, b, [(a, b)]) ~> [(a, b)] 28 | fun modify(k, v, kvs) { 29 | switch (kvs) { 30 | case [] -> [] 31 | case (k', v') :: kvs' -> 32 | if (k == k') (k, v) :: kvs' 33 | else (k', v') :: modify(k, v, kvs') 34 | } 35 | } 36 | 37 | sig remove : (a, [(a, b)]) ~> [(a, b)] 38 | fun remove(k, kvs) { 39 | switch (kvs) { 40 | case [] -> [] 41 | case (k', v') :: kvs' -> 42 | if (k == k') kvs' 43 | else (k', v') :: remove(k, kvs') 44 | } 45 | } 46 | 47 | sig has : (a, [(a, b)]) ~> Bool 48 | fun has(k, kvs) { 49 | switch (kvs) { 50 | case [] -> false 51 | case (k', _) :: kvs' -> 52 | k == k' || has(k, kvs') 53 | } 54 | } 55 | 56 | #! 57 | # 58 | # Composing UNIX with Effect Handlers 59 | # An Introduction to Effect Handler Oriented Programming 60 | # Daniel Hillerström 61 | # Laboratory for Foundations of Computer Science 62 | # The University of Edinburgh, Scotland, UK 63 | # 64 | # Huawei Research Centre Zürich, Switzerland 65 | # October 13, 2022 66 | # 67 | # https://dhil.net/research/ 68 | # 69 | #? 70 | 71 | #! 72 | # 73 | # Effect handler oriented programming (EHOP) 74 | # 75 | # Key characteristics 76 | # - Extensive use of effect handlers 77 | # - High-degree of modularity 78 | # - Extremely compositional 79 | # 80 | # Some languages that support EHOP: 81 | # C/C++, Eff, Haskell, Koka, Links, Pyro, OCaml, Unison, Wasm 82 | # 83 | #? 84 | 85 | #! 86 | # 87 | # What is an effect handler? 88 | # 89 | # Operational interpretation <--- THIS TALK 90 | # Resumeable exceptions 91 | # Programmable and composable operating systems 92 | # 93 | # Software engineering interpretation 94 | # Builders for monads (monads as a design pattern) 95 | # 96 | # Functional programming interpretation 97 | # Folds over computation trees 98 | # Free interpreters 99 | # 100 | # Mathematical interpretation 101 | # Homomorphisms between free algebraic models 102 | # 103 | #? 104 | 105 | #! 106 | # 107 | # Objectives of this talk 108 | # 109 | # - Demonstrate the versatility of effect handler oriented programming 110 | # - Explain Ritchie & Thompson's (1974) UNIX as the combination of 111 | # textbook effects 112 | # + Exceptions: Process termination 113 | # + Dynamic binding: User environments 114 | # + Nondeterminism: Time-sharing 115 | # + State: File system 116 | # + ... 117 | # 118 | #? 119 | 120 | #! 121 | # 122 | # This talk at glance 123 | # 124 | # A model of UNIX with 125 | # * support for multiple users, 126 | # * time-sharing amongst processes, 127 | # * and a file system. 128 | # 129 | # Self-imposed constraints 130 | # * Interface cannot be changed 131 | # * Everything has to be definable in the calculus 132 | # 133 | # Disclaimer: We'll make some gross simplifications. A richer model of 134 | # UNIX can be found in my PhD dissertation 135 | # 136 | # (the idea of using delimited control to model operating systems is 137 | # not new, see e.g. Kiselyov and Shan (2007), Wand (1980)) 138 | # 139 | #? 140 | 141 | # 142 | # 143 | # The key idea 144 | # 145 | # *System calls* are an interface, implemented by an *operating system* 146 | # 147 | # *Effectful operations* are an interface, implemented by an *effect handler* 148 | # 149 | # 150 | 151 | # 152 | # 153 | # The key idea 154 | # 155 | # *System calls* are an interface, implemented by an *operating system* 156 | # = = 157 | # *Effectful operations* are an interface, implemented by an *effect handler* 158 | # 159 | # 160 | 161 | # 162 | # 163 | # What is an operating system? (very abstractly) 164 | # 165 | # An operating system responds to a collection of system calls 166 | # 167 | # Example tasks: 168 | # - Signalling errors 169 | # - Scheduling processes 170 | # - Reading/writing I/O 171 | # 172 | 173 | # 174 | # 175 | # What is an effect handler? (very abstractly) 176 | # 177 | # An effect handler responds a collection of abstract operation calls 178 | # 179 | # Example tasks: 180 | # - Signalling errors 181 | # - Scheduling processes 182 | # - Reading/writing I/O 183 | # 184 | # 185 | # 186 | # 187 | # 188 | # 189 | 190 | # 191 | # 192 | # What is an effect handler? (very abstractly) 193 | # 194 | # An effect handler responds a collection of abstract operation calls 195 | # 196 | # Example tasks: 197 | # - Signalling errors 198 | # - Scheduling processes 199 | # - Reading/writing I/O 200 | # 201 | # Thus an effect handler is an operating system (credit James McKinna) 202 | # (Kiselyov and Shan (2007) used delimited continuations to model 203 | # operating systems) 204 | # 205 | # 206 | 207 | 208 | # 209 | # 210 | # Objectives of this talk 211 | # 212 | # - Demonstrate the versatility of handlers 213 | # - Explain operating systems as the combination of 214 | # + Exceptions 215 | # + Dynamic binding 216 | # + Nondeterminism 217 | # + State 218 | # 219 | # 220 | 221 | # 222 | # 223 | # What is UNIX? 224 | # 225 | # UNIX is an operating system designed by Ritchie and Thompson (1974) 226 | # 227 | # Components 228 | # - Commands (system calls) 229 | # + I/O interaction, user session login, inter-process 230 | # communication, etc 231 | # - Kernel (interpreter) 232 | # + Handling of I/O, managing user sessions, scheduling of 233 | # processes 234 | # - Development environment 235 | # + Compiler tool-chains (e.g. `cc`) 236 | # - Documentation 237 | # + manual pages (e.g. `man`) 238 | # 239 | # 240 | 241 | # 242 | # 243 | # Key characteristics of UNIX (Ritchie & Thompson, 1974) 244 | # 245 | # - Support for multiple user sessions 246 | # - Time-sharing between processes 247 | # - "Everything is a file" 248 | # 249 | # 250 | 251 | #{ 252 | #! 253 | # 254 | # Basic I/O: Performing writes 255 | # 256 | typename File = String; 257 | typename FileDescr = Int; 258 | 259 | sig stdout : FileDescr 260 | var stdout = 1; 261 | 262 | sig echo : (String) {Write:(FileDescr, String) -> ()}-> () 263 | fun echo(cs) { do Write(stdout, cs) } 264 | #? 265 | #} 266 | 267 | typename File = String; 268 | typename FileDescr = Int; 269 | 270 | sig stdout : FileDescr 271 | var stdout = 1; 272 | 273 | sig echo : (String) {Write:(FileDescr, String) -> () |%}-> () 274 | fun echo(cs) { do Write(stdout, cs) } 275 | 276 | 277 | #{ 278 | #! 279 | # 280 | # Basic I/O: Handling writes 281 | # 282 | sig basicIO : ( () {Write:(FileDescr, String) -> ()}-> a ) -> (a, File) 283 | fun basicIO(m) { 284 | handle(m()) { 285 | case ans -> (ans, "") 286 | case (resume : (()) -> (a, File) )> -> 287 | var (ans, file) = resume(()); 288 | (ans, file ++ cs) 289 | } 290 | } 291 | #? 292 | #} 293 | 294 | sig basicIO : ( () {Write:(FileDescr, String) -> () |%}-> a ) { |%}-> (a, File) 295 | fun basicIO(m) { 296 | handle(m()) { 297 | case Return(ans) -> (ans, "") 298 | case Write(_, cs, resume) -> 299 | var (ans, file) = resume(()); 300 | (ans, cs ^^ file) 301 | } 302 | } 303 | 304 | #{ 305 | #! 306 | # 307 | # Basic I/O: Example 308 | # 309 | sig example0 : () -> ((), File) 310 | fun example0() { 311 | basicIO(fun() { 312 | echo("Hello"); echo("World") 313 | }) 314 | } 315 | #? 316 | #} 317 | 318 | sig example0 : () { |%}-> ((), File) 319 | fun example0() { 320 | basicIO(fun() { 321 | echo("Hello"); echo("World") 322 | }) 323 | } 324 | 325 | 326 | # 327 | # 328 | # Dynamic semantics of handlers 329 | # 330 | # (ret) handle(V) { case x -> N case ... } 331 | # ~> N[V/x] 332 | # 333 | # (op) handle(E[do Op(V)]) { case r> -> N case ... } 334 | # ~> N[V/p 335 | # ,fun(x){ handle(E[x]) { case r> -> N case ... }}/r] 336 | # (if Op \notin E) 337 | # 338 | # 339 | 340 | #{ 341 | #! 342 | # 343 | # Exceptions: Premature exits 344 | # 345 | sig exit : (Int) {Exit:(Int) -> Zero}-> a 346 | fun exit(n) { switch (do Exit(n)) { } } 347 | #? 348 | #} 349 | 350 | sig exit : (Int) {Exit:(Int) -> Zero |%}-> a 351 | fun exit(n) { switch (do Exit(n)) { } } 352 | 353 | 354 | #{ 355 | #! 356 | # 357 | # Handling exits 358 | # 359 | sig status : (() {Exit:(Int) -> Zero}-> a) -> Int 360 | fun status(m) { 361 | handle(m()) { 362 | case ans -> 0 363 | case -> n 364 | } 365 | } 366 | #? 367 | #} 368 | 369 | sig status : (() {Exit:(Int) -> Zero |%}-> a) { |%}-> Int 370 | fun status(m) { 371 | handle(m()) { 372 | case Return(_) -> 0 373 | case Exit(n, _) -> n 374 | } 375 | } 376 | 377 | #{ 378 | #! 379 | # 380 | # Handling exits: Example 381 | # 382 | sig example1 : () -> (Int, File) 383 | fun example1() { 384 | basicIO(fun() { 385 | status(fun() { 386 | echo("dead"); exit(1); echo("code") 387 | }) 388 | }) 389 | } 390 | #? 391 | #} 392 | 393 | sig example1 : () { |%}-> (Int, File) 394 | fun example1() { 395 | basicIO(fun() { 396 | status(fun() { 397 | echo("dead"); exit(1); echo("code") 398 | }) 399 | }) 400 | } 401 | 402 | #{ 403 | #! 404 | # 405 | # Does the ordering of handlers matter? 406 | # 407 | sig example1' : () -> Int 408 | fun example1'() { 409 | status(fun() { 410 | basicIO(fun() { 411 | echo("dead"); exit(1); echo("code") 412 | }) 413 | }) 414 | } 415 | #? 416 | #} 417 | 418 | sig example1' : () { |%}-> Int 419 | fun example1'() { 420 | status(fun() { 421 | basicIO(fun() { 422 | echo("dead"); exit(1); echo("code") 423 | }) 424 | }) 425 | } 426 | 427 | #{ 428 | #! 429 | # 430 | # Dynamic binding: User-specific environments (1) 431 | # 432 | typename User = [|Alice|Bob|Root|]; 433 | 434 | sig whoami : () {Ask:String}-> String 435 | fun whoami() { do Ask } 436 | #? 437 | #} 438 | 439 | typename User = [|Alice|Bob|Root|]; 440 | 441 | sig whoami : () {Ask:String |%}-> String 442 | fun whoami() { do Ask } 443 | 444 | #{ 445 | #! 446 | # 447 | # Dynamic binding: User-specific environments (2) 448 | # 449 | sig env : (User, () {Ask:String}-> a) -> a 450 | fun env(user, m) { 451 | handle(m()) { 452 | case ans -> ans 453 | case resume> -> 454 | switch (user) { 455 | case Alice -> resume("alice") 456 | case Bob -> resume("bob") 457 | case Root -> resume("root") 458 | } 459 | } 460 | } 461 | 462 | 463 | sig example2 : () -> String 464 | fun example2() { 465 | env(Root, whoami) 466 | } 467 | #? 468 | #} 469 | 470 | sig env : (User, () {Ask:String |%}-> a) { |%}-> a 471 | fun env(user, m) { 472 | handle(m()) { 473 | case Return(x) -> x 474 | case Ask(resume) -> 475 | switch (user) { 476 | case Alice -> resume("alice") 477 | case Bob -> resume("bob") 478 | case Root -> resume("root") 479 | } 480 | } 481 | } 482 | 483 | 484 | sig example2 : () { |%}-> String 485 | fun example2() { 486 | env(Root, whoami) 487 | } 488 | 489 | #! 490 | # 491 | # Aside: Dynamic binding with delimited continuations 492 | # 493 | # The idea of dynamic binding dates back to at least McCarthy (1960) 494 | # 495 | # Kiselyov, Shan, and Sabry (2006) demonstrated dynamic binding can be 496 | # simulated with delimited continuations 497 | # 498 | #? 499 | 500 | #{ 501 | #! 502 | # 503 | # User session management 504 | # 505 | sig su : (User) {Su:(User) -> ()}-> () 506 | fun su(user) { do Su(user) } 507 | 508 | sig sessionmgr : (User, () {Ask:String, Su:(User) -> ()}-> a) -> a 509 | fun sessionmgr(user, m) { 510 | env(user, fun() { 511 | handle(m()) { 512 | case ans -> ans 513 | case resume> -> 514 | env(user', fun() { resume(()) }) 515 | } 516 | }) 517 | } 518 | #? 519 | #} 520 | 521 | sig su : (User) {Su:(User) -> () |%}-> () 522 | fun su(user) { do Su(user) } 523 | 524 | sig sessionmgr : (User, () {Ask:String, Su:(User) -> () |%}-> a) { |%}-> a 525 | fun sessionmgr(user, m) { 526 | env(user, fun() { 527 | handle(m()) { 528 | case Return(ans) -> ans 529 | case Su(user', resume) -> 530 | env(user', fun() { resume(()) }) 531 | } 532 | }) 533 | } 534 | 535 | #{ 536 | #! 537 | # 538 | # Multiple user sessions example 539 | # 540 | sig example3 : () -> (Int, File) 541 | fun example3() { 542 | basicIO(fun() { 543 | sessionmgr(Root, fun() { 544 | status(fun() { 545 | su(Alice); echo(whoami()); echo(" "); 546 | su(Bob); echo(whoami()); echo(" "); 547 | su(Root); echo(whoami()) 548 | }) 549 | }) 550 | }) 551 | } 552 | #? 553 | #} 554 | 555 | sig example3 : () { |%}-> (Int, File) 556 | fun example3() { 557 | basicIO(fun() { 558 | sessionmgr(Root, fun() { 559 | status(fun() { 560 | su(Alice); echo(whoami()); echo(" "); 561 | su(Bob); echo(whoami()); echo(" "); 562 | su(Root); echo(whoami()) 563 | }) 564 | }) 565 | }) 566 | } 567 | 568 | #! 569 | # 570 | # Nondeterminism: Multi-tasking (1) 571 | # 572 | # From the man pages. 573 | # 574 | # Description 575 | # fork() creates a new process by duplicating the calling process. The 576 | # new process is referred to as the child process. The calling process 577 | # is referred to as the parent process. 578 | # 579 | # Return value 580 | # On success, the PID of the child process is returned in the parent, 581 | # and 0 is returned in the child. 582 | # 583 | #? 584 | 585 | #! 586 | # 587 | # Nondeterminism: Multi-tasking (2) 588 | # 589 | # Fork idiom 590 | # 591 | # if (fork() > 0) parent's code 592 | # else child's code 593 | # 594 | # Let's simplify fork such that it returns a boolean: true for parent, 595 | # false for child. 596 | # 597 | #? 598 | 599 | #{ 600 | #! 601 | # 602 | # Nondeterminism: Multi-tasking (3) 603 | # 604 | sig fork : () {Fork:Bool}-> Bool 605 | fun fork() { do Fork } 606 | 607 | sig nondet : (() {Fork:Bool}-> a) -> [a] 608 | fun nondet(m) { 609 | handle(m()) { 610 | case ans -> [ans] 611 | case resume> -> resume(true) ++ resume(false) 612 | } 613 | } 614 | #? 615 | #} 616 | 617 | sig fork : () {Fork:Bool |_}-> Bool 618 | fun fork() { do Fork } 619 | 620 | sig nondet : (() {Fork:Bool |%}-> a) { |%}-> [a] 621 | fun nondet(m) { 622 | handle(m()) { 623 | case Return(ans) -> [ans] 624 | case Fork(resume) -> resume(true) ++ resume(false) 625 | } 626 | } 627 | 628 | #{ 629 | #! 630 | # 631 | # Nondeterminism: Example (1) 632 | # 633 | sig ritchie : () {Write:(FileDescr, String) -> ()}-> () 634 | fun ritchie() { 635 | echo("UNIX is basically "); 636 | echo("a simple operating system, "); 637 | echo("but "); 638 | echo("you have to be a genius to understand the simplicity.\n") 639 | } 640 | 641 | sig hamlet : () {Write:(FileDescr, String) -> ()}-> () 642 | fun hamlet() { 643 | echo("To be, or not to be,\n"); 644 | echo("that is the question:\n"); 645 | echo("Whether 'tis nobler in the mind to suffer\n") 646 | } 647 | #? 648 | #} 649 | sig ritchie : () {Write:(FileDescr, String) -> () |%}-> () 650 | fun ritchie() { 651 | echo("UNIX is basically "); 652 | echo("a simple operating system, "); 653 | echo("but "); 654 | echo("you have to be a genius to understand the simplicity.\n") 655 | } 656 | 657 | sig hamlet : () {Write:(FileDescr, String) -> () |%}-> () 658 | fun hamlet() { 659 | echo("To be, or not to be,\n"); 660 | echo("that is the question:\n"); 661 | echo("Whether 'tis nobler in the mind to suffer\n") 662 | } 663 | 664 | #{ 665 | #! 666 | # 667 | # Nondeterminism: Example (2) 668 | # 669 | sig example4 : () -> ([Int], File) 670 | fun example4() { 671 | basicIO(fun() { 672 | nondet(fun() { 673 | sessionmgr(Root, fun() { 674 | status(fun() { 675 | if (fork()) { 676 | su(Alice); 677 | ritchie() 678 | } else { 679 | su(Bob); 680 | hamlet() 681 | } 682 | }) 683 | }) 684 | }) 685 | }) 686 | } 687 | #? 688 | #} 689 | 690 | sig example4 : () { |%}-> ([Int], File) 691 | fun example4() { 692 | basicIO(fun() { 693 | nondet(fun() { 694 | sessionmgr(Root, fun() { 695 | status(fun() { 696 | if (fork()) { 697 | su(Alice); 698 | ritchie() 699 | } else { 700 | su(Bob); 701 | hamlet() 702 | } 703 | }) 704 | }) 705 | }) 706 | }) 707 | } 708 | 709 | # 710 | # 711 | # Mathematically well-founded nondeterminism 712 | # 713 | # The handler `nondet` is _exactly_ the handler Plotkin and Pretnar (2013) 714 | # give for nondeterminism 715 | # It satisfies the usual (semi-lattice) equations for nondeterministic choice, i.e. 716 | # 717 | # if (fork()) M else M = M 718 | # if (fork()) M else N = if (fork()) N else M 719 | # if (fork()) L else { if (fork()) M else N } = if (fork()) { if (fork()) L else M } else N 720 | # 721 | # 722 | 723 | #{ 724 | #! 725 | # 726 | # Interrupting processes 727 | # 728 | sig interrupt : () {Interrupt:()}-> () 729 | fun interrupt() { do Interrupt } 730 | 731 | # Process reification 732 | typename Pstate(a::Type, e::Eff) 733 | = [|Done:a 734 | |Paused:() -e-> Pstate(a, e)|]; 735 | 736 | 737 | sig reifyProcess : (() {Interrupt:() |e}-> a) -e-> Pstate(a, e) 738 | fun reifyProcess(m) { 739 | handle(m()) { 740 | case ans -> Done(ans) 741 | case resume> -> Paused(fun() { resume(()) }) 742 | } 743 | } 744 | #? 745 | #} 746 | 747 | sig interrupt : () {Interrupt:() |%}-> () 748 | fun interrupt() { do Interrupt } 749 | 750 | typename Pstate(a,e::Eff) 751 | = forall q::Presence. 752 | [|Done:a 753 | |Paused:() {Interrupt{q} |e}-> Pstate(a, { |e})|]; 754 | 755 | 756 | sig reifyProcess : (() {Interrupt:() |%}-> a) { |%}-> Pstate(a, { |%}) 757 | fun reifyProcess(m) { 758 | handle(m()) { 759 | case Return(ans) -> Done(ans) 760 | case Interrupt(resume) -> Paused(fun() { resume(()) }) 761 | } 762 | } 763 | 764 | #{ 765 | #! 766 | # 767 | # Time-sharing via interrupts 768 | # 769 | sig schedule : ([Pstate(a, {Fork:Bool})]) -> [a] 770 | fun schedule(ps) { 771 | fun schedule(ps, done) { 772 | switch (ps) { 773 | case [] -> done 774 | case Done(res) :: ps' -> 775 | schedule(ps', res :: done) 776 | case Paused(resume) :: ps' -> 777 | schedule(ps' ++ nondet(resume), done) 778 | } 779 | } 780 | schedule(ps, []) 781 | } 782 | 783 | sig timeshare : (() {Fork:Bool,Interrupt:()}-> a) -> [a] 784 | fun timeshare(m) { 785 | var p = Paused(fun() { reifyProcess(m) }); 786 | schedule([p]) 787 | } 788 | #? 789 | #} 790 | 791 | sig schedule : ([Pstate(a, { Fork:Bool |%})]) { |%}~> [a] 792 | fun schedule(ps) { 793 | fun schedule(ps, done) { 794 | switch (ps) { 795 | case [] -> done 796 | case Done(res) :: ps' -> 797 | schedule(ps', res :: done) 798 | case Paused(resume) :: ps' -> 799 | schedule(ps' ++ nondet(resume), done) 800 | } 801 | } 802 | schedule(ps, []) 803 | } 804 | 805 | sig timeshare : (() {Fork:Bool,Interrupt:() |%}-> a) { |%}-> [a] 806 | fun timeshare(m) { 807 | var p = Paused(fun() { reifyProcess(m) }); 808 | schedule([p]) 809 | } 810 | 811 | #{ 812 | #! 813 | # 814 | # Injecting interrupts 815 | # 816 | # First idea: external source injects interrupts (Ahman and Pretnar (2021)) 817 | # 818 | # Second idea: bundle interrupts with other operations 819 | sig echo' : (FileDescr,String) {Interrupt:(), Write:(FileDescr,String) -> ()}-> () 820 | fun echo'(fd, cs) { interrupt(); do Write(fd, cs) } 821 | # 822 | # Third idea: overload interpretations of operations 823 | sig interruptWrite : (() {Write:(FileDescr,String) -> ()}-> a) 824 | {Interrupt:(),Write:(FileDescr,String) -> ()}-> a 825 | fun interruptWrite(m) { 826 | handle(m()) { 827 | case ans -> ans 828 | case resume> -> 829 | interrupt(); resume(do Write(fd, cs)) 830 | } 831 | } 832 | #? 833 | #} 834 | 835 | sig interruptWrite : (() {Write:(FileDescr,String) -> () |%}-> a) 836 | {Write:(FileDescr,String) -> () |%}-> a 837 | fun interruptWrite(m) { 838 | handle(m()) { 839 | case Return(res) -> res 840 | case Write(fd, cs, resume) -> 841 | interrupt(); resume(do Write(fd, cs)) 842 | } 843 | } 844 | 845 | #{ 846 | #! 847 | # 848 | # Time-sharing example 849 | # 850 | sig example5 : () -> ([Int], File) 851 | fun example5() { 852 | basicIO(fun() { 853 | timeshare(fun() { 854 | interruptWrite(fun() { 855 | sessionmgr(Root, fun() { 856 | status(fun() { 857 | if (fork()) { 858 | su(Alice); 859 | ritchie() 860 | } else { 861 | su(Bob); 862 | hamlet() 863 | } 864 | }) 865 | }) 866 | }) 867 | }) 868 | }) 869 | } 870 | #? 871 | #} 872 | sig example5 : () { |%}-> ([Int], File) 873 | fun example5() { 874 | basicIO(fun() { 875 | timeshare(fun() { 876 | interruptWrite(fun() { 877 | sessionmgr(Root, fun() { 878 | status(fun() { 879 | if (fork()) { 880 | su(Alice); 881 | ritchie() 882 | } else { 883 | su(Bob); 884 | hamlet() 885 | } 886 | }) 887 | }) 888 | }) 889 | }) 890 | }) 891 | } 892 | 893 | #{ 894 | #! 895 | # 896 | # State: File I/O 897 | # 898 | # Generic state handling 899 | sig get : () {Get:s}-> s 900 | fun get() { do Get } 901 | 902 | sig put : (s) {Put:(s) -> ()}-> () 903 | fun put(st) { do Put(st) } 904 | 905 | sig runState : (s, () {Get:() -> s,Put:(s) -> ()}-> a) -> (a, s) 906 | fun runState(st0, m) { 907 | var f = handle(m()) { 908 | case ans -> fun(st) { (ans, st) } 909 | case resume> -> fun(st) { resume(st)(st) } 910 | case resume> -> fun(_) { resume(())(st') } 911 | }; 912 | f(st0) 913 | } 914 | #? 915 | #} 916 | 917 | sig get : () {Get:s |_}-> s 918 | fun get() { do Get } 919 | 920 | sig put : (s) {Put:(s) -> () |_}-> () 921 | fun put(st) { do Put(st) } 922 | 923 | sig runState : (s, () {Get:() -> s,Put:(s) -> () |%}-> a) { |%}-> (a, s) 924 | fun runState(st0, m) { 925 | var f = handle(m()) { 926 | case Return(x) -> fun(st) { (x, st) } 927 | case Get(resume) -> fun(st) { resume(st)(st) } 928 | case Put(st',resume) -> fun(_) { resume(())(st') } 929 | }; 930 | f(st0) 931 | } 932 | 933 | #{ 934 | #! 935 | # 936 | # State: Example 937 | # 938 | sig incr : () {Get:Int,Put:(Int) -> ()}-> () 939 | fun incr() { put(get() + 1) } 940 | 941 | sig example6 : () -> ((), Int) 942 | fun example6() { 943 | runState(41, incr) 944 | } 945 | #? 946 | #} 947 | 948 | sig incr : () {Get:Int,Put:(Int) -> () |%}-> () 949 | fun incr() { put(get() + 1) } 950 | 951 | sig example6 : () { |%}-> ((), Int) 952 | fun example6() { 953 | runState(41, incr) 954 | } 955 | 956 | #! 957 | # 958 | # Basic Serial File System (BSFS) 959 | # 960 | # Directory I-List Data region 961 | # +----------------+ +-------+ +--------------------------+ 962 | # | "hamlet" |------> | 2 |---> | "To be, or not to be..." | 963 | # +----------------+ / +-------+ +--------------------------+ 964 | # | "richtie.txt" |------> | 1 |---> | "UNIX is basically..." | 965 | # +----------------+ / +-------+ +--------------------------+ 966 | # | ... | | | ... | | ... | 967 | # +----------------+ | +-------+ +--------------------------+ 968 | # | "stdout" |------> | 1 |---> | "" | 969 | # +----------------+ | +-------+ +--------------------------+ 970 | # | ... | / 971 | # +----------------+ / 972 | # | "act3" |--- 973 | # +----------------+ 974 | # 975 | # Simplifications: 976 | # - Operating directly on inode pointers 977 | # - Reads and writes will be serial 978 | # 979 | #? 980 | 981 | #{ 982 | #! 983 | # 984 | # BSFS structures 985 | # 986 | typename INode = (loc:Int,lno:Int); 987 | typename IList = [(Int, INode)]; # INode index -> INode 988 | typename Directory = [(String, Int)]; # Filename -> INode index 989 | typename DataRegion = [(Int, File)]; # Loc -> File 990 | 991 | typename FileSystem = (dir:Directory,dregion:DataRegion,inodes:IList 992 | ,lnext:Int ,inext:Int ); 993 | 994 | sig fsys0 : FileSystem 995 | var fsys0 = ( dir = [("stdout", 0)] 996 | , inodes = [(0, (loc=0, lno=1))] 997 | , dregion = [(0, "")] 998 | , lnext = 1, inext = 1 ); 999 | 1000 | 1001 | # Utility functions 1002 | sig lookup : (a, [(a, b)]) {Fail:Zero}-> b 1003 | var lookup = lookup; 1004 | 1005 | sig withDefault : (a, () {Fail:Zero}-> a) -> a 1006 | fun withDefault(d, m) { 1007 | handle(m()) { 1008 | case ans -> ans 1009 | case -> d 1010 | } 1011 | } 1012 | #? 1013 | #} 1014 | 1015 | typename INode = (loc:Int,lno:Int); 1016 | typename IList = [(Int, INode)]; # INode index -> INode 1017 | typename Directory = [(String, Int)]; # Filename -> INode index 1018 | typename DataRegion = [(Int, File)]; # Loc -> File 1019 | 1020 | typename FileSystem = (dir:Directory,dregion:DataRegion,inodes:IList 1021 | ,lnext:Int ,inext:Int ); 1022 | 1023 | sig fsys0 : FileSystem 1024 | var fsys0 = ( dir = [("stdout", 0)] 1025 | , inodes = [(0, (loc=0, lno=1))] 1026 | , dregion = [(0, "")] 1027 | , lnext = 1, inext = 1 ); 1028 | 1029 | 1030 | # Utility functions 1031 | sig lookup : (a, [(a, b)]) {Fail:Zero |%}-> b 1032 | var lookup = lookup; 1033 | 1034 | sig withDefault : (a, () {Fail:Zero |%}-> a) { |%}-> a 1035 | fun withDefault(x', m) { 1036 | handle(m()) { 1037 | case Return(x) -> x 1038 | case Fail(_) -> x' 1039 | } 1040 | } 1041 | 1042 | sig fwrite : (Int, String, FileSystem) {Fail:Zero |%}-> FileSystem 1043 | fun fwrite(ino, cs, fsys) { 1044 | var inode = lookup(ino, fsys.inodes); 1045 | var file = lookup(inode.loc, fsys.dregion); 1046 | var file' = file ^^ cs; 1047 | (fsys with dregion = modify(inode.loc, file', fsys.dregion)) 1048 | } 1049 | 1050 | sig fread : (Int, FileSystem) {Fail:Zero |%}-> String 1051 | fun fread(ino, fsys) { 1052 | var inode = lookup(ino, fsys.inodes); 1053 | lookup(inode.loc, fsys.dregion) 1054 | } 1055 | 1056 | #{ 1057 | #! 1058 | # 1059 | # Handling BSFS operations: file reading and writing 1060 | # 1061 | sig fwrite : (FileDescr, String, FileSystem) {Fail:Zero}-> FileSystem 1062 | var fwrite = fwrite; 1063 | sig fread : (FileDescr, FileSystem) {Fail:Zero}-> String 1064 | var fread = fread; 1065 | 1066 | sig fileRW : ( () { Read :(FileDescr) -> Option(String) 1067 | , Write:(FileDescr, String) -> () }-> a ) 1068 | {Get:FileSystem,Put:(FileSystem) -> ()}-> a 1069 | fun fileRW(m) { 1070 | handle(m()) { 1071 | case ans -> ans 1072 | case resume> -> 1073 | var cs = withDefault(None, fun() { 1074 | Some(fread(fd, get())) 1075 | }); resume(cs) 1076 | case resume> -> 1077 | withDefault((), fun() { 1078 | var fsys = fwrite(fd, cs, get()); 1079 | put(fsys) 1080 | }); resume(()) 1081 | } 1082 | } 1083 | #? 1084 | #} 1085 | 1086 | sig fileRW : ( () { Read :(FileDescr) -> Option(String) 1087 | , Write:(FileDescr, String) -> () |%}-> a ) 1088 | {Get:FileSystem,Put:(FileSystem) -> () |%}-> a 1089 | fun fileRW(m) { 1090 | handle(m()) { 1091 | case Return(ans) -> ans 1092 | case Read(fd, resume) -> 1093 | var cs = withDefault(None, fun() { 1094 | Some(fread(fd, get())) 1095 | }); resume(cs) 1096 | case Write(fd, cs, resume) -> 1097 | withDefault((), fun() { 1098 | var fsys = fwrite(fd, cs, get()); 1099 | put(fsys) 1100 | }); resume(()) 1101 | } 1102 | } 1103 | 1104 | sig fopen : (String, FileSystem) {Fail:Zero |%}-> FileDescr 1105 | fun fopen(fname, fsys) { lookup(fname, fsys.dir) } 1106 | 1107 | sig fcreate : (String, FileSystem) {Fail:Zero |%}-> (FileDescr, FileSystem) 1108 | fun fcreate(fname, fsys) { 1109 | if (has(fname, fsys.dir)) { 1110 | var ino = fopen(fname, fsys); 1111 | # Truncate file 1112 | var inode = lookup(ino, fsys.inodes); 1113 | var dregion = modify(inode.loc, "", fsys.dregion); 1114 | (ino, (fsys with =dregion)) 1115 | } else { 1116 | var loc = fsys.lnext; 1117 | var dregion = (loc, "") :: fsys.dregion; 1118 | 1119 | var ino = fsys.inext; 1120 | var inode = (loc=loc,lno=1); 1121 | var inodes = (ino, inode) :: fsys.inodes; 1122 | 1123 | var dir = (fname, ino) :: fsys.dir; 1124 | (ino, (=dir, =dregion, =inodes, lnext=loc+1, inext=ino+1)) 1125 | } 1126 | } 1127 | 1128 | #{ 1129 | #! 1130 | # 1131 | # BSFS operation: file opening and creation 1132 | # 1133 | sig fopen : (String, FileSystem) {Fail:Zero}-> FileDescr 1134 | var fopen = fopen; 1135 | sig fcreate : (String, FileSystem) {Fail:Zero}-> (FileDescr, FileSystem) 1136 | var fcreate = fcreate; 1137 | 1138 | sig fileOC : ( () { Open :(String) -> Option(FileDescr) 1139 | , Create:(String) -> Option(FileDescr) }-> a ) 1140 | {Get:FileSystem,Put:(FileSystem) -> () }-> a 1141 | fun fileOC(m) { 1142 | handle(m()) { 1143 | case ans -> ans 1144 | case resume> -> 1145 | var fd = withDefault(None, fun() { 1146 | Some(fopen(fname, get())) 1147 | }); resume(fd) 1148 | case resume> -> 1149 | var fd = withDefault(None, fun() { 1150 | var (fd, fsys) = fcreate(fname, get()); 1151 | put(fsys); Some(fd) 1152 | }); resume(fd) 1153 | } 1154 | } 1155 | #? 1156 | #} 1157 | 1158 | sig fileOC : ( () { Open :(String) -> Option(FileDescr) 1159 | , Create:(String) -> Option(FileDescr) |%}-> a ) 1160 | {Get:FileSystem,Put:(FileSystem) -> () |%}-> a 1161 | fun fileOC(m) { 1162 | handle(m()) { 1163 | case Return(ans) -> ans 1164 | case Open(fname, resume) -> 1165 | var fd = withDefault(None, fun() { 1166 | Some(fopen(fname, get())) 1167 | }); resume(fd) 1168 | case Create(fname, resume) -> 1169 | var fd = withDefault(None, fun() { 1170 | var (fd, fsys) = fcreate(fname, get()); 1171 | put(fsys); Some(fd) 1172 | }); resume(fd) 1173 | } 1174 | } 1175 | 1176 | #{ 1177 | #! 1178 | # 1179 | # BSFS version 0 1180 | # 1181 | sig bsfs0 : ( () { Open :(String) -> Option(FileDescr) 1182 | , Create:(String) -> Option(FileDescr) 1183 | , Read :(FileDescr) -> Option(String) 1184 | , Write:(FileDescr, String) -> () }-> a ) 1185 | {Get:FileSystem,Put:(FileSystem) -> ()}-> a 1186 | fun bsfs0(m) { 1187 | fileOC(fun() { 1188 | fileRW(m) 1189 | }) 1190 | } 1191 | #? 1192 | #} 1193 | 1194 | sig bsfs0 : ( () { Open :(String) -> Option(FileDescr) 1195 | , Create:(String) -> Option(FileDescr) 1196 | , Read :(FileDescr) -> Option(String) 1197 | , Write:(FileDescr, String) -> () |%}-> a ) 1198 | {Get:FileSystem,Put:(FileSystem) -> () |%}-> a 1199 | fun bsfs0(m) { 1200 | fileOC(fun() { 1201 | fileRW(m) 1202 | }) 1203 | } 1204 | 1205 | #{ 1206 | #! 1207 | # 1208 | # Stream redirection 1209 | # 1210 | sig > : (() -> a, String) 1211 | { Create:(String) -> Option(FileDescr) 1212 | , Exit : (Int) -> Zero 1213 | , Write :(FileDescr,String) -> () }-> a 1214 | op f > fname { 1215 | var fd = switch (do Create(fname)) { 1216 | case None -> exit(-1) 1217 | case Some(fd) -> fd 1218 | }; handle(f()) { 1219 | case ans -> ans 1220 | case resume> -> 1221 | resume(do Write(fd, cs)) 1222 | } 1223 | } 1224 | #? 1225 | #} 1226 | 1227 | sig >- : (() { |%}-> a, String) 1228 | { Create:(String) -> Option(FileDescr) 1229 | , Exit : (Int) -> Zero 1230 | , Write :(FileDescr,String) -> () |%}-> a 1231 | op f >- fname { 1232 | var fd = switch (do Create(fname)) { 1233 | case None -> exit(-1) 1234 | case Some(fd) -> fd 1235 | }; handle(f()) { 1236 | case Return(x) -> x 1237 | case Write(_, cs, resume) -> 1238 | resume(do Write(fd, cs)) 1239 | } 1240 | } 1241 | 1242 | #{ 1243 | #! 1244 | # 1245 | # Crude copy 1246 | # 1247 | sig ccp : (String, String) { Create:(String) -> Option(FileDescr) 1248 | , Exit :(Int) -> Zero 1249 | , Read :(FileDescr) -> Option(String) 1250 | , Open :(String) -> Option(FileDescr) 1251 | , Write :(FileDescr,String) -> () }-> () 1252 | fun ccp(src, dst) { 1253 | var srcfd = switch (do Open(src)) { 1254 | case None -> exit(-1) 1255 | case Some(fd) -> fd 1256 | }; 1257 | switch (do Read(srcfd)) { 1258 | case None -> exit(-1) 1259 | case Some(cs) -> fun() {echo(cs)} > dst 1260 | } 1261 | } 1262 | #? 1263 | #} 1264 | 1265 | sig ccp : (String, String) { Create:(String) -> Option(FileDescr) 1266 | , Exit :(Int) -> Zero 1267 | , Read :(FileDescr) -> Option(String) 1268 | , Open :(String) -> Option(FileDescr) 1269 | , Write :(FileDescr,String) -> () |%}-> () 1270 | fun ccp(src, dst) { 1271 | var srcfd = switch (do Open(src)) { 1272 | case None -> exit(-1) 1273 | case Some(fd) -> fd 1274 | }; 1275 | switch (do Read(srcfd)) { 1276 | case None -> exit(-1) 1277 | case Some(cs) -> fun() {echo(cs)} >- dst 1278 | } 1279 | } 1280 | 1281 | #{ 1282 | #! 1283 | # 1284 | # Plugging everything together 1285 | # 1286 | sig example7 : () -> ([Int], FileSystem) 1287 | fun example7() { 1288 | runState(fsys0, fun() { 1289 | bsfs0(fun() { 1290 | timeshare(fun() { 1291 | interruptWrite(fun() { 1292 | sessionmgr(Root, fun() { 1293 | status(fun() { 1294 | if (fork()) { 1295 | su(Alice); 1296 | ritchie > "ritchie.txt" 1297 | } else { 1298 | su(Bob); 1299 | hamlet > "hamlet"; 1300 | ccp("hamlet", "act3") 1301 | } 1302 | }) 1303 | }) 1304 | }) 1305 | }) 1306 | }) 1307 | }) 1308 | } 1309 | #? 1310 | #} 1311 | 1312 | sig example7 : () { |%}-> ([Int], FileSystem) 1313 | fun example7() { 1314 | runState(fsys0, fun() { 1315 | bsfs0(fun() { 1316 | timeshare(fun() { 1317 | interruptWrite(fun() { 1318 | sessionmgr(Root, fun() { 1319 | status(fun() { 1320 | if (fork()) { 1321 | su(Alice); 1322 | ritchie >- "ritchie.txt" 1323 | } else { 1324 | su(Bob); 1325 | hamlet >- "hamlet"; 1326 | ccp("hamlet", "act3") 1327 | } 1328 | }) 1329 | }) 1330 | }) 1331 | }) 1332 | }) 1333 | }) 1334 | } 1335 | 1336 | #! 1337 | # 1338 | # Conclusion 1339 | # 1340 | # + Effect handlers are a versatile programming abstraction 1341 | # + Possible to retrofit legacy code with new functionality 1342 | # + Operating systems can be explained in terms of handlers 1343 | # + "Every problem can be solved by adding another handler" 1344 | # 1345 | # See my PhD dissertation[1] for an implementation of UNIX fork, usage of 1346 | # shallow handlers to implement a more UNIX-y shell environment. 1347 | # 1348 | # [1] "Foundations for Programming and Implementing Effect Handlers", 1349 | # Daniel Hillerström, PhD dissertation, The University of 1350 | # Edinburgh, Scotland, UK, 2021. 1351 | # 1352 | #? 1353 | -------------------------------------------------------------------------------- /code/unix-nuprl2022.links: -------------------------------------------------------------------------------- 1 | # DISCLAIMER: THIS MODULE REQUIRES A SPECIAL BRANCH OF LINKS TO 2 | # COMPILE: https://github.com/dhil/links/tree/multi-line-comments 3 | # commit ddcc02d3 as the effect patterns are not yet available in 4 | # master (you'll find that everything is implemented twice in this 5 | # file, once with the "new" syntax, which is shadowed by an 6 | # implementation using the "old" syntax). 7 | 8 | ## Prelude 9 | typename Option(a) = [|None|Some:a|]; 10 | 11 | sig todo : (String) ~> a 12 | fun todo(s) { error("TODO: " ^^ s) } 13 | 14 | sig fail : () {Fail:Zero |_}-> a 15 | fun fail() { switch (do Fail) { } } 16 | 17 | sig lookup : (a, [(a, b)]) {Fail:Zero |_}~> b 18 | fun lookup(k, kvs) { 19 | switch (kvs) { 20 | case [] -> fail() 21 | case (k', v) :: kvs' -> 22 | if (k == k') v 23 | else lookup(k, kvs') 24 | } 25 | } 26 | 27 | sig modify : (a, b, [(a, b)]) ~> [(a, b)] 28 | fun modify(k, v, kvs) { 29 | switch (kvs) { 30 | case [] -> [] 31 | case (k', v') :: kvs' -> 32 | if (k == k') (k, v) :: kvs' 33 | else (k', v') :: modify(k, v, kvs') 34 | } 35 | } 36 | 37 | sig remove : (a, [(a, b)]) ~> [(a, b)] 38 | fun remove(k, kvs) { 39 | switch (kvs) { 40 | case [] -> [] 41 | case (k', v') :: kvs' -> 42 | if (k == k') kvs' 43 | else (k', v') :: remove(k, kvs') 44 | } 45 | } 46 | 47 | sig has : (a, [(a, b)]) ~> Bool 48 | fun has(k, kvs) { 49 | switch (kvs) { 50 | case [] -> false 51 | case (k', _) :: kvs' -> 52 | k == k' || has(k, kvs') 53 | } 54 | } 55 | 56 | #! 57 | # 58 | # Composing UNIX with Effect Handlers 59 | # An Introduction to Effect Handler Oriented Programming 60 | # Daniel Hillerström 61 | # Laboratory for Foundations of Computer Science 62 | # The University of Edinburgh, Scotland, UK 63 | # 64 | # Programming Research Lab, Northeastern University 65 | # November 2, 2022 66 | # 67 | # https://dhil.net/research/ 68 | # 69 | #? 70 | 71 | #! 72 | # 73 | # Effect handler oriented programming (EHOP) 74 | # 75 | # Key characteristics 76 | # - Extensive use of effect handlers 77 | # - High-degree of modularity 78 | # - Extremely compositional 79 | # 80 | # Some languages that support EHOP: 81 | # C/C++, Eff, Haskell, Koka, Links, Pyro, OCaml, Unison, Wasm 82 | # 83 | #? 84 | 85 | #! 86 | # 87 | # What is an effect handler? 88 | # 89 | # Operational interpretation <--- THIS TALK 90 | # Resumeable exceptions 91 | # Programmable and composable operating systems 92 | # 93 | # Software engineering interpretation 94 | # Builders for monads (monads as a design pattern) 95 | # 96 | # Functional programming interpretation 97 | # Folds over computation trees 98 | # Free interpreters 99 | # 100 | # Mathematical interpretation 101 | # Homomorphisms between free algebraic models 102 | # 103 | #? 104 | 105 | #! 106 | # 107 | # Objectives of this talk 108 | # 109 | # - Demonstrate the versatility of effect handler oriented programming 110 | # - Explain Ritchie & Thompson's (1974) UNIX as the combination of 111 | # textbook effects 112 | # + Exceptions: Process termination 113 | # + Dynamic binding: User environments 114 | # + Nondeterminism: Time-sharing 115 | # + State: File system 116 | # + ... 117 | # 118 | #? 119 | 120 | #! 121 | # 122 | # This talk at glance 123 | # 124 | # A model of UNIX with 125 | # * support for multiple users, 126 | # * time-sharing amongst processes, 127 | # * and a file system. 128 | # 129 | # Self-imposed constraints 130 | # * Interface cannot be changed 131 | # * Everything has to be definable in the calculus 132 | # 133 | # Disclaimer: We'll make some gross simplifications. A richer model of 134 | # UNIX can be found in my PhD dissertation 135 | # 136 | # (the idea of using delimited control to model operating systems is 137 | # not new, see e.g. Kiselyov and Shan (2007), Wand (1980)) 138 | # 139 | #? 140 | 141 | #! 142 | # 143 | # The key idea 144 | # 145 | # *System calls* are an interface, implemented by an *operating system* 146 | # 147 | # *Effectful operations* are an interface, implemented by an *effect handler* 148 | # 149 | #? 150 | 151 | #! 152 | # 153 | # The key idea 154 | # 155 | # *System calls* are an interface, implemented by an *operating system* 156 | # = = 157 | # *Effectful operations* are an interface, implemented by an *effect handler* 158 | # 159 | #? 160 | 161 | # 162 | # 163 | # What is an operating system? (very abstractly) 164 | # 165 | # An operating system responds to a collection of system calls 166 | # 167 | # Example tasks: 168 | # - Signalling errors 169 | # - Scheduling processes 170 | # - Reading/writing I/O 171 | # 172 | 173 | # 174 | # 175 | # What is an effect handler? (very abstractly) 176 | # 177 | # An effect handler responds a collection of abstract operation calls 178 | # 179 | # Example tasks: 180 | # - Signalling errors 181 | # - Scheduling processes 182 | # - Reading/writing I/O 183 | # 184 | # 185 | # 186 | # 187 | # 188 | # 189 | 190 | # 191 | # 192 | # What is an effect handler? (very abstractly) 193 | # 194 | # An effect handler responds a collection of abstract operation calls 195 | # 196 | # Example tasks: 197 | # - Signalling errors 198 | # - Scheduling processes 199 | # - Reading/writing I/O 200 | # 201 | # Thus an effect handler is an operating system (credit James McKinna) 202 | # (Kiselyov and Shan (2007) used delimited continuations to model 203 | # operating systems) 204 | # 205 | # 206 | 207 | 208 | # 209 | # 210 | # Objectives of this talk 211 | # 212 | # - Demonstrate the versatility of handlers 213 | # - Explain operating systems as the combination of 214 | # + Exceptions 215 | # + Dynamic binding 216 | # + Nondeterminism 217 | # + State 218 | # 219 | # 220 | 221 | # 222 | # 223 | # What is UNIX? 224 | # 225 | # UNIX is an operating system designed by Ritchie and Thompson (1974) 226 | # 227 | # Components 228 | # - Commands (system calls) 229 | # + I/O interaction, user session login, inter-process 230 | # communication, etc 231 | # - Kernel (interpreter) 232 | # + Handling of I/O, managing user sessions, scheduling of 233 | # processes 234 | # - Development environment 235 | # + Compiler tool-chains (e.g. `cc`) 236 | # - Documentation 237 | # + manual pages (e.g. `man`) 238 | # 239 | # 240 | 241 | # 242 | # 243 | # Key characteristics of UNIX (Ritchie & Thompson, 1974) 244 | # 245 | # - Support for multiple user sessions 246 | # - Time-sharing between processes 247 | # - "Everything is a file" 248 | # 249 | # 250 | 251 | #{ 252 | #! 253 | # 254 | # Basic I/O: Performing writes 255 | # 256 | typename File = String; 257 | typename FileDescr = Int; 258 | 259 | sig stdout : FileDescr 260 | var stdout = 1; 261 | 262 | sig echo : (String) {Write:(FileDescr, String) -> ()}-> () 263 | fun echo(cs) { do Write(stdout, cs) } 264 | #? 265 | #} 266 | 267 | typename File = String; 268 | typename FileDescr = Int; 269 | 270 | sig stdout : FileDescr 271 | var stdout = 1; 272 | 273 | sig echo : (String) {Write:(FileDescr, String) -> () |%}-> () 274 | fun echo(cs) { do Write(stdout, cs) } 275 | 276 | 277 | #{ 278 | #! 279 | # 280 | # Basic I/O: Handling writes 281 | # 282 | sig basicIO : ( () {Write:(FileDescr, String) -> ()}-> a ) -> (a, File) 283 | fun basicIO(m) { 284 | handle( m() ) { 285 | case ans -> (ans, "") 286 | case (resume : (()) -> (a, File))> -> 287 | var (ans, file) = resume(()); 288 | (ans, cs ++ file) 289 | } 290 | } 291 | #? 292 | #} 293 | 294 | sig basicIO : ( () {Write:(FileDescr, String) -> () |%}-> a ) { |%}-> (a, File) 295 | fun basicIO(m) { 296 | handle(m()) { 297 | case Return(ans) -> (ans, "") 298 | case Write(_, cs, resume) -> 299 | var (ans, file) = resume(()); 300 | (ans, cs ^^ file) 301 | } 302 | } 303 | 304 | #{ 305 | #! 306 | # 307 | # Basic I/O: Example 308 | # 309 | sig example0 : () -> ((), File) 310 | fun example0() { 311 | basicIO(fun() { 312 | echo("Hello"); echo("World") 313 | }) 314 | } 315 | #? 316 | #} 317 | 318 | sig example0 : () { |%}-> ((), File) 319 | fun example0() { 320 | basicIO(fun() { 321 | echo("Hello"); echo("World") 322 | }) 323 | } 324 | 325 | 326 | # 327 | # 328 | # Dynamic semantics of handlers 329 | # 330 | # (ret) handle(V) { case x -> N case ... } 331 | # ~> N[V/x] 332 | # 333 | # (op) handle(E[do Op(V)]) { case r> -> N case ... } 334 | # ~> N[V/p 335 | # ,fun(x){ handle(E[x]) { case r> -> N case ... }}/r] 336 | # (if Op \notin E) 337 | # 338 | # 339 | 340 | #{ 341 | #! 342 | # 343 | # Exceptions: Premature exits 344 | # 345 | sig exit : (Int) {Exit:(Int) -> Zero}-> a 346 | fun exit(n) { switch (do Exit(n)) { } } 347 | #? 348 | #} 349 | 350 | sig exit : (Int) {Exit:(Int) -> Zero |%}-> a 351 | fun exit(n) { switch (do Exit(n)) { } } 352 | 353 | 354 | #{ 355 | #! 356 | # 357 | # Handling exits 358 | # 359 | sig status : (() {Exit:(Int) -> Zero}-> a) -> Int 360 | fun status(m) { 361 | handle(m()) { 362 | case ans -> 0 363 | case -> n 364 | } 365 | } 366 | #? 367 | #} 368 | 369 | sig status : (() {Exit:(Int) -> Zero |%}-> a) { |%}-> Int 370 | fun status(m) { 371 | handle(m()) { 372 | case Return(_) -> 0 373 | case Exit(n, _) -> n 374 | } 375 | } 376 | 377 | #{ 378 | #! 379 | # 380 | # Handling exits: Example 381 | # 382 | sig example1 : () -> (Int, File) 383 | fun example1() { 384 | basicIO(fun() { 385 | status(fun() { 386 | echo("dead"); exit(1); echo("code") 387 | }) 388 | }) 389 | } 390 | #? 391 | #} 392 | 393 | sig example1 : () { |%}-> (Int, File) 394 | fun example1() { 395 | basicIO(fun() { 396 | status(fun() { 397 | echo("dead"); exit(1); echo("code") 398 | }) 399 | }) 400 | } 401 | 402 | #{ 403 | #! 404 | # 405 | # Does the ordering of handlers matter? 406 | # 407 | sig example1' : () -> Int 408 | fun example1'() { 409 | status(fun() { 410 | basicIO(fun() { 411 | echo("dead"); exit(1); echo("code") 412 | }) 413 | }) 414 | } 415 | #? 416 | #} 417 | 418 | sig example1' : () { |%}-> Int 419 | fun example1'() { 420 | status(fun() { 421 | basicIO(fun() { 422 | echo("dead"); exit(1); echo("code") 423 | }) 424 | }) 425 | } 426 | 427 | #{ 428 | #! 429 | # 430 | # Dynamic binding: User-specific environments (1) 431 | # 432 | typename User = [|Alice|Bob|Root|]; 433 | 434 | sig whoami : () {Ask:String}-> String 435 | fun whoami() { do Ask } 436 | #? 437 | #} 438 | 439 | typename User = [|Alice|Bob|Root|]; 440 | 441 | sig whoami : () {Ask:String |%}-> String 442 | fun whoami() { do Ask } 443 | 444 | #{ 445 | #! 446 | # 447 | # Dynamic binding: User-specific environments (2) 448 | # 449 | sig env : (User, () {Ask:String}-> a) -> a 450 | fun env(user, m) { 451 | handle(m()) { 452 | case ans -> ans 453 | case resume> -> 454 | switch (user) { 455 | case Alice -> resume("alice") 456 | case Bob -> resume("bob") 457 | case Root -> resume("root") 458 | } 459 | } 460 | } 461 | 462 | 463 | sig example2 : () -> String 464 | fun example2() { 465 | env(Root, whoami) 466 | } 467 | #? 468 | #} 469 | 470 | sig env : (User, () {Ask:String |%}-> a) { |%}-> a 471 | fun env(user, m) { 472 | handle(m()) { 473 | case Return(x) -> x 474 | case Ask(resume) -> 475 | switch (user) { 476 | case Alice -> resume("alice") 477 | case Bob -> resume("bob") 478 | case Root -> resume("root") 479 | } 480 | } 481 | } 482 | 483 | 484 | sig example2 : () { |%}-> String 485 | fun example2() { 486 | env(Root, whoami) 487 | } 488 | 489 | #! 490 | # 491 | # Aside: Dynamic binding with delimited continuations 492 | # 493 | # The idea of dynamic binding dates back to at least McCarthy (1960) 494 | # 495 | # Kiselyov, Shan, and Sabry (2006) demonstrated dynamic binding can be 496 | # simulated with delimited continuations 497 | # 498 | #? 499 | 500 | #{ 501 | #! 502 | # 503 | # User session management 504 | # 505 | sig su : (User) {Su:(User) -> ()}-> () 506 | fun su(user) { do Su(user) } 507 | 508 | sig sessionmgr : (User, () {Ask:String, Su:(User) -> ()}-> a) -> a 509 | fun sessionmgr(user, m) { 510 | env(user, fun() { 511 | handle(m()) { 512 | case ans -> ans 513 | case resume> -> 514 | env(user', fun() { resume(()) }) 515 | } 516 | }) 517 | } 518 | #? 519 | #} 520 | 521 | sig su : (User) {Su:(User) -> () |%}-> () 522 | fun su(user) { do Su(user) } 523 | 524 | sig sessionmgr : (User, () {Ask:String, Su:(User) -> () |%}-> a) { |%}-> a 525 | fun sessionmgr(user, m) { 526 | env(user, fun() { 527 | handle(m()) { 528 | case Return(ans) -> ans 529 | case Su(user', resume) -> 530 | env(user', fun() { resume(()) }) 531 | } 532 | }) 533 | } 534 | 535 | #{ 536 | #! 537 | # 538 | # Multiple user sessions example 539 | # 540 | sig example3 : () -> (Int, File) 541 | fun example3() { 542 | basicIO(fun() { 543 | sessionmgr(Root, fun() { 544 | status(fun() { 545 | su(Alice); echo(whoami()); echo(" "); 546 | su(Bob); echo(whoami()); echo(" "); 547 | su(Root); echo(whoami()) 548 | }) 549 | }) 550 | }) 551 | } 552 | #? 553 | #} 554 | 555 | sig example3 : () { |%}-> (Int, File) 556 | fun example3() { 557 | basicIO(fun() { 558 | sessionmgr(Root, fun() { 559 | status(fun() { 560 | su(Alice); echo(whoami()); echo(" "); 561 | su(Bob); echo(whoami()); echo(" "); 562 | su(Root); echo(whoami()) 563 | }) 564 | }) 565 | }) 566 | } 567 | 568 | #! 569 | # 570 | # Nondeterminism: Multi-tasking (1) 571 | # 572 | # From the man pages. 573 | # 574 | # Description 575 | # fork() creates a new process by duplicating the calling process. The 576 | # new process is referred to as the child process. The calling process 577 | # is referred to as the parent process. 578 | # 579 | # Return value 580 | # On success, the PID of the child process is returned in the parent, 581 | # and 0 is returned in the child. 582 | # 583 | #? 584 | 585 | #! 586 | # 587 | # Nondeterminism: Multi-tasking (2) 588 | # 589 | # Fork idiom 590 | # 591 | # if (fork() > 0) parent's code 592 | # else child's code 593 | # 594 | # Let's simplify fork such that it returns a boolean: true for parent, 595 | # false for child. 596 | # 597 | #? 598 | 599 | #{ 600 | #! 601 | # 602 | # Nondeterminism: Multi-tasking (3) 603 | # 604 | sig fork : () {Fork:Bool}-> Bool 605 | fun fork() { do Fork } 606 | 607 | sig nondet : (() {Fork:Bool}-> a) -> [a] 608 | fun nondet(m) { 609 | handle(m()) { 610 | case ans -> [ans] 611 | case resume> -> resume(true) ++ resume(false) 612 | } 613 | } 614 | #? 615 | #} 616 | 617 | sig fork : () {Fork:Bool |_}-> Bool 618 | fun fork() { do Fork } 619 | 620 | sig nondet : (() {Fork:Bool |%}-> a) { |%}-> [a] 621 | fun nondet(m) { 622 | handle(m()) { 623 | case Return(ans) -> [ans] 624 | case Fork(resume) -> resume(true) ++ resume(false) 625 | } 626 | } 627 | 628 | #{ 629 | #! 630 | # 631 | # Nondeterminism: Example (1) 632 | # 633 | sig ritchie : () {Write:(FileDescr, String) -> ()}-> () 634 | fun ritchie() { 635 | echo("UNIX is basically "); 636 | echo("a simple operating system, "); 637 | echo("but "); 638 | echo("you have to be a genius to understand the simplicity.\n") 639 | } 640 | 641 | sig hamlet : () {Write:(FileDescr, String) -> ()}-> () 642 | fun hamlet() { 643 | echo("To be, or not to be,\n"); 644 | echo("that is the question:\n"); 645 | echo("Whether 'tis nobler in the mind to suffer\n") 646 | } 647 | #? 648 | #} 649 | sig ritchie : () {Write:(FileDescr, String) -> () |%}-> () 650 | fun ritchie() { 651 | echo("UNIX is basically "); 652 | echo("a simple operating system, "); 653 | echo("but "); 654 | echo("you have to be a genius to understand the simplicity.\n") 655 | } 656 | 657 | sig hamlet : () {Write:(FileDescr, String) -> () |%}-> () 658 | fun hamlet() { 659 | echo("To be, or not to be,\n"); 660 | echo("that is the question:\n"); 661 | echo("Whether 'tis nobler in the mind to suffer\n") 662 | } 663 | 664 | #{ 665 | #! 666 | # 667 | # Nondeterminism: Example (2) 668 | # 669 | sig example4 : () -> ([Int], File) 670 | fun example4() { 671 | basicIO(fun() { 672 | nondet(fun() { 673 | sessionmgr(Root, fun() { 674 | status(fun() { 675 | if (fork()) { 676 | su(Alice); 677 | ritchie() 678 | } else { 679 | su(Bob); 680 | hamlet() 681 | } 682 | }) 683 | }) 684 | }) 685 | }) 686 | } 687 | #? 688 | #} 689 | 690 | sig example4 : () { |%}-> ([Int], File) 691 | fun example4() { 692 | basicIO(fun() { 693 | nondet(fun() { 694 | sessionmgr(Root, fun() { 695 | status(fun() { 696 | if (fork()) { 697 | su(Alice); 698 | ritchie() 699 | } else { 700 | su(Bob); 701 | hamlet() 702 | } 703 | }) 704 | }) 705 | }) 706 | }) 707 | } 708 | 709 | # 710 | # 711 | # Mathematically well-founded nondeterminism 712 | # 713 | # The handler `nondet` is _exactly_ the handler Plotkin and Pretnar (2013) 714 | # give for nondeterminism 715 | # It satisfies the usual (semi-lattice) equations for nondeterministic choice, i.e. 716 | # 717 | # if (fork()) M else M = M 718 | # if (fork()) M else N = if (fork()) N else M 719 | # if (fork()) L else { if (fork()) M else N } = if (fork()) { if (fork()) L else M } else N 720 | # 721 | # 722 | 723 | #{ 724 | #! 725 | # 726 | # Interrupting processes 727 | # 728 | sig interrupt : () {Interrupt:()}-> () 729 | fun interrupt() { do Interrupt } 730 | 731 | # Process reification 732 | typename Pstate(a::Type, e::Eff) 733 | = [|Done:a 734 | |Paused:() -e-> Pstate(a, e)|]; 735 | 736 | 737 | sig reifyProcess : (() {Interrupt:() |e}-> a) -e-> Pstate(a, e) 738 | fun reifyProcess(m) { 739 | handle(m()) { 740 | case ans -> Done(ans) 741 | case resume> -> Paused(fun() { resume(()) }) 742 | } 743 | } 744 | #? 745 | #} 746 | 747 | sig interrupt : () {Interrupt:() |%}-> () 748 | fun interrupt() { do Interrupt } 749 | 750 | typename Pstate(a,e::Eff) 751 | = forall q::Presence. 752 | [|Done:a 753 | |Paused:() {Interrupt{q} |e}-> Pstate(a, { |e})|]; 754 | 755 | 756 | sig reifyProcess : (() {Interrupt:() |%}-> a) { |%}-> Pstate(a, { |%}) 757 | fun reifyProcess(m) { 758 | handle(m()) { 759 | case Return(ans) -> Done(ans) 760 | case Interrupt(resume) -> Paused(fun() { resume(()) }) 761 | } 762 | } 763 | 764 | #{ 765 | #! 766 | # 767 | # Time-sharing via interrupts 768 | # 769 | sig schedule : ([Pstate(a, {Fork:Bool})]) -> [a] 770 | fun schedule(ps) { 771 | fun schedule(ps, done) { 772 | switch (ps) { 773 | case [] -> done 774 | case Done(res) :: ps' -> 775 | schedule(ps', res :: done) 776 | case Paused(resume) :: ps' -> 777 | schedule(ps' ++ nondet(resume), done) 778 | } 779 | } 780 | schedule(ps, []) 781 | } 782 | 783 | sig timeshare : (() {Fork:Bool,Interrupt:()}-> a) -> [a] 784 | fun timeshare(m) { 785 | var p = Paused(fun() { reifyProcess(m) }); 786 | schedule([p]) 787 | } 788 | #? 789 | #} 790 | 791 | sig schedule : ([Pstate(a, { Fork:Bool |%})]) { |%}~> [a] 792 | fun schedule(ps) { 793 | fun schedule(ps, done) { 794 | switch (ps) { 795 | case [] -> done 796 | case Done(res) :: ps' -> 797 | schedule(ps', res :: done) 798 | case Paused(resume) :: ps' -> 799 | schedule(ps' ++ nondet(resume), done) 800 | } 801 | } 802 | schedule(ps, []) 803 | } 804 | 805 | sig timeshare : (() {Fork:Bool,Interrupt:() |%}-> a) { |%}-> [a] 806 | fun timeshare(m) { 807 | var p = Paused(fun() { reifyProcess(m) }); 808 | schedule([p]) 809 | } 810 | 811 | #{ 812 | #! 813 | # 814 | # Injecting interrupts 815 | # 816 | # First idea: external source injects interrupts (Ahman and Pretnar (2021)) 817 | # 818 | # Second idea: bundle interrupts with other operations 819 | sig echo' : (FileDescr,String) {Interrupt:(), Write:(FileDescr,String) -> ()}-> () 820 | fun echo'(fd, cs) { interrupt(); do Write(fd, cs) } 821 | # 822 | # Third idea: overload interpretations of operations 823 | sig interruptWrite : (() {Write:(FileDescr,String) -> ()}-> a) 824 | {Interrupt:(),Write:(FileDescr,String) -> ()}-> a 825 | fun interruptWrite(m) { 826 | handle(m()) { 827 | case ans -> ans 828 | case resume> -> 829 | interrupt(); resume(do Write(fd, cs)) 830 | } 831 | } 832 | #? 833 | #} 834 | 835 | sig interruptWrite : (() {Write:(FileDescr,String) -> () |%}-> a) 836 | {Write:(FileDescr,String) -> () |%}-> a 837 | fun interruptWrite(m) { 838 | handle(m()) { 839 | case Return(res) -> res 840 | case Write(fd, cs, resume) -> 841 | interrupt(); resume(do Write(fd, cs)) 842 | } 843 | } 844 | 845 | #{ 846 | #! 847 | # 848 | # Time-sharing example 849 | # 850 | sig example5 : () -> ([Int], File) 851 | fun example5() { 852 | basicIO(fun() { 853 | timeshare(fun() { 854 | interruptWrite(fun() { 855 | sessionmgr(Root, fun() { 856 | status(fun() { 857 | if (fork()) { 858 | su(Alice); 859 | ritchie() 860 | } else { 861 | su(Bob); 862 | hamlet() 863 | } 864 | }) 865 | }) 866 | }) 867 | }) 868 | }) 869 | } 870 | #? 871 | #} 872 | sig example5 : () { |%}-> ([Int], File) 873 | fun example5() { 874 | basicIO(fun() { 875 | timeshare(fun() { 876 | interruptWrite(fun() { 877 | sessionmgr(Root, fun() { 878 | status(fun() { 879 | if (fork()) { 880 | su(Alice); 881 | ritchie() 882 | } else { 883 | su(Bob); 884 | hamlet() 885 | } 886 | }) 887 | }) 888 | }) 889 | }) 890 | }) 891 | } 892 | 893 | #{ 894 | #! 895 | # 896 | # State: File I/O 897 | # 898 | # Generic state handling 899 | sig get : () {Get:s}-> s 900 | fun get() { do Get } 901 | 902 | sig put : (s) {Put:(s) -> ()}-> () 903 | fun put(st) { do Put(st) } 904 | 905 | sig runState : (s, () {Get:() -> s,Put:(s) -> ()}-> a) -> (a, s) 906 | fun runState(st0, m) { 907 | var f = handle(m()) { 908 | case ans -> fun(st) { (ans, st) } 909 | case resume> -> fun(st) { resume(st)(st) } 910 | case resume> -> fun(_) { resume(())(st') } 911 | }; 912 | f(st0) 913 | } 914 | #? 915 | #} 916 | 917 | sig get : () {Get:s |_}-> s 918 | fun get() { do Get } 919 | 920 | sig put : (s) {Put:(s) -> () |_}-> () 921 | fun put(st) { do Put(st) } 922 | 923 | sig runState : (s, () {Get:() -> s,Put:(s) -> () |%}-> a) { |%}-> (a, s) 924 | fun runState(st0, m) { 925 | var f = handle(m()) { 926 | case Return(x) -> fun(st) { (x, st) } 927 | case Get(resume) -> fun(st) { resume(st)(st) } 928 | case Put(st',resume) -> fun(_) { resume(())(st') } 929 | }; 930 | f(st0) 931 | } 932 | 933 | #{ 934 | #! 935 | # 936 | # State: Example 937 | # 938 | sig incr : () {Get:Int,Put:(Int) -> ()}-> () 939 | fun incr() { put(get() + 1) } 940 | 941 | sig example6 : () -> ((), Int) 942 | fun example6() { 943 | runState(41, incr) 944 | } 945 | #? 946 | #} 947 | 948 | sig incr : () {Get:Int,Put:(Int) -> () |%}-> () 949 | fun incr() { put(get() + 1) } 950 | 951 | sig example6 : () { |%}-> ((), Int) 952 | fun example6() { 953 | runState(41, incr) 954 | } 955 | 956 | #! 957 | # 958 | # Basic Serial File System (BSFS) 959 | # 960 | # Directory I-List Data region 961 | # +----------------+ +-------+ +--------------------------+ 962 | # | "hamlet" |------> | 2 |---> | "To be, or not to be..." | 963 | # +----------------+ / +-------+ +--------------------------+ 964 | # | "richtie.txt" |------> | 1 |---> | "UNIX is basically..." | 965 | # +----------------+ / +-------+ +--------------------------+ 966 | # | ... | | | ... | | ... | 967 | # +----------------+ | +-------+ +--------------------------+ 968 | # | "stdout" |------> | 1 |---> | "" | 969 | # +----------------+ | +-------+ +--------------------------+ 970 | # | ... | / 971 | # +----------------+ / 972 | # | "act3" |--- 973 | # +----------------+ 974 | # 975 | # Simplifications: 976 | # - Operating directly on inode pointers 977 | # - Reads and writes will be serial 978 | # 979 | #? 980 | 981 | #{ 982 | #! 983 | # 984 | # BSFS structures 985 | # 986 | typename INode = (loc:Int,lno:Int); 987 | typename IList = [(Int, INode)]; # INode index -> INode 988 | typename Directory = [(String, Int)]; # Filename -> INode index 989 | typename DataRegion = [(Int, File)]; # Loc -> File 990 | 991 | typename FileSystem = (dir:Directory,dregion:DataRegion,inodes:IList 992 | ,lnext:Int ,inext:Int ); 993 | 994 | sig fsys0 : FileSystem 995 | var fsys0 = ( dir = [("stdout", 0)] 996 | , inodes = [(0, (loc=0, lno=1))] 997 | , dregion = [(0, "")] 998 | , lnext = 1, inext = 1 ); 999 | 1000 | 1001 | # Utility functions 1002 | sig lookup : (a, [(a, b)]) {Fail:Zero}-> b 1003 | var lookup = lookup; 1004 | 1005 | sig withDefault : (a, () {Fail:Zero}-> a) -> a 1006 | fun withDefault(d, m) { 1007 | handle(m()) { 1008 | case ans -> ans 1009 | case -> d 1010 | } 1011 | } 1012 | #? 1013 | #} 1014 | 1015 | typename INode = (loc:Int,lno:Int); 1016 | typename IList = [(Int, INode)]; # INode index -> INode 1017 | typename Directory = [(String, Int)]; # Filename -> INode index 1018 | typename DataRegion = [(Int, File)]; # Loc -> File 1019 | 1020 | typename FileSystem = (dir:Directory,dregion:DataRegion,inodes:IList 1021 | ,lnext:Int ,inext:Int ); 1022 | 1023 | sig fsys0 : FileSystem 1024 | var fsys0 = ( dir = [("stdout", 0)] 1025 | , inodes = [(0, (loc=0, lno=1))] 1026 | , dregion = [(0, "")] 1027 | , lnext = 1, inext = 1 ); 1028 | 1029 | 1030 | # Utility functions 1031 | sig lookup : (a, [(a, b)]) {Fail:Zero |%}-> b 1032 | var lookup = lookup; 1033 | 1034 | sig withDefault : (a, () {Fail:Zero |%}-> a) { |%}-> a 1035 | fun withDefault(x', m) { 1036 | handle(m()) { 1037 | case Return(x) -> x 1038 | case Fail(_) -> x' 1039 | } 1040 | } 1041 | 1042 | sig fwrite : (Int, String, FileSystem) {Fail:Zero |%}-> FileSystem 1043 | fun fwrite(ino, cs, fsys) { 1044 | var inode = lookup(ino, fsys.inodes); 1045 | var file = lookup(inode.loc, fsys.dregion); 1046 | var file' = file ^^ cs; 1047 | (fsys with dregion = modify(inode.loc, file', fsys.dregion)) 1048 | } 1049 | 1050 | sig fread : (Int, FileSystem) {Fail:Zero |%}-> String 1051 | fun fread(ino, fsys) { 1052 | var inode = lookup(ino, fsys.inodes); 1053 | lookup(inode.loc, fsys.dregion) 1054 | } 1055 | 1056 | #{ 1057 | #! 1058 | # 1059 | # Handling BSFS operations: file reading and writing 1060 | # 1061 | sig fwrite : (FileDescr, String, FileSystem) {Fail:Zero}-> FileSystem 1062 | var fwrite = fwrite; 1063 | sig fread : (FileDescr, FileSystem) {Fail:Zero}-> String 1064 | var fread = fread; 1065 | 1066 | sig fileRW : ( () { Read :(FileDescr) -> Option(String) 1067 | , Write:(FileDescr, String) -> () }-> a ) 1068 | {Get:FileSystem,Put:(FileSystem) -> ()}-> a 1069 | fun fileRW(m) { 1070 | handle(m()) { 1071 | case ans -> ans 1072 | case resume> -> 1073 | var cs = withDefault(None, fun() { 1074 | Some(fread(fd, get())) 1075 | }); resume(cs) 1076 | case resume> -> 1077 | withDefault((), fun() { 1078 | var fsys = fwrite(fd, cs, get()); 1079 | put(fsys) 1080 | }); resume(()) 1081 | } 1082 | } 1083 | #? 1084 | #} 1085 | 1086 | sig fileRW : ( () { Read :(FileDescr) -> Option(String) 1087 | , Write:(FileDescr, String) -> () |%}-> a ) 1088 | {Get:FileSystem,Put:(FileSystem) -> () |%}-> a 1089 | fun fileRW(m) { 1090 | handle(m()) { 1091 | case Return(ans) -> ans 1092 | case Read(fd, resume) -> 1093 | var cs = withDefault(None, fun() { 1094 | Some(fread(fd, get())) 1095 | }); resume(cs) 1096 | case Write(fd, cs, resume) -> 1097 | withDefault((), fun() { 1098 | var fsys = fwrite(fd, cs, get()); 1099 | put(fsys) 1100 | }); resume(()) 1101 | } 1102 | } 1103 | 1104 | sig fopen : (String, FileSystem) {Fail:Zero |%}-> FileDescr 1105 | fun fopen(fname, fsys) { lookup(fname, fsys.dir) } 1106 | 1107 | sig fcreate : (String, FileSystem) {Fail:Zero |%}-> (FileDescr, FileSystem) 1108 | fun fcreate(fname, fsys) { 1109 | if (has(fname, fsys.dir)) { 1110 | var ino = fopen(fname, fsys); 1111 | # Truncate file 1112 | var inode = lookup(ino, fsys.inodes); 1113 | var dregion = modify(inode.loc, "", fsys.dregion); 1114 | (ino, (fsys with =dregion)) 1115 | } else { 1116 | var loc = fsys.lnext; 1117 | var dregion = (loc, "") :: fsys.dregion; 1118 | 1119 | var ino = fsys.inext; 1120 | var inode = (loc=loc,lno=1); 1121 | var inodes = (ino, inode) :: fsys.inodes; 1122 | 1123 | var dir = (fname, ino) :: fsys.dir; 1124 | (ino, (=dir, =dregion, =inodes, lnext=loc+1, inext=ino+1)) 1125 | } 1126 | } 1127 | 1128 | #{ 1129 | #! 1130 | # 1131 | # BSFS operation: file opening and creation 1132 | # 1133 | sig fopen : (String, FileSystem) {Fail:Zero}-> FileDescr 1134 | var fopen = fopen; 1135 | sig fcreate : (String, FileSystem) {Fail:Zero}-> (FileDescr, FileSystem) 1136 | var fcreate = fcreate; 1137 | 1138 | sig fileOC : ( () { Open :(String) -> Option(FileDescr) 1139 | , Create:(String) -> Option(FileDescr) }-> a ) 1140 | {Get:FileSystem,Put:(FileSystem) -> () }-> a 1141 | fun fileOC(m) { 1142 | handle(m()) { 1143 | case ans -> ans 1144 | case resume> -> 1145 | var fd = withDefault(None, fun() { 1146 | Some(fopen(fname, get())) 1147 | }); resume(fd) 1148 | case resume> -> 1149 | var fd = withDefault(None, fun() { 1150 | var (fd, fsys) = fcreate(fname, get()); 1151 | put(fsys); Some(fd) 1152 | }); resume(fd) 1153 | } 1154 | } 1155 | #? 1156 | #} 1157 | 1158 | sig fileOC : ( () { Open :(String) -> Option(FileDescr) 1159 | , Create:(String) -> Option(FileDescr) |%}-> a ) 1160 | {Get:FileSystem,Put:(FileSystem) -> () |%}-> a 1161 | fun fileOC(m) { 1162 | handle(m()) { 1163 | case Return(ans) -> ans 1164 | case Open(fname, resume) -> 1165 | var fd = withDefault(None, fun() { 1166 | Some(fopen(fname, get())) 1167 | }); resume(fd) 1168 | case Create(fname, resume) -> 1169 | var fd = withDefault(None, fun() { 1170 | var (fd, fsys) = fcreate(fname, get()); 1171 | put(fsys); Some(fd) 1172 | }); resume(fd) 1173 | } 1174 | } 1175 | 1176 | #{ 1177 | #! 1178 | # 1179 | # BSFS version 0 1180 | # 1181 | sig bsfs0 : ( () { Open :(String) -> Option(FileDescr) 1182 | , Create:(String) -> Option(FileDescr) 1183 | , Read :(FileDescr) -> Option(String) 1184 | , Write:(FileDescr, String) -> () }-> a ) 1185 | {Get:FileSystem,Put:(FileSystem) -> ()}-> a 1186 | fun bsfs0(m) { 1187 | fileOC(fun() { 1188 | fileRW(m) 1189 | }) 1190 | } 1191 | #? 1192 | #} 1193 | 1194 | sig bsfs0 : ( () { Open :(String) -> Option(FileDescr) 1195 | , Create:(String) -> Option(FileDescr) 1196 | , Read :(FileDescr) -> Option(String) 1197 | , Write:(FileDescr, String) -> () |%}-> a ) 1198 | {Get:FileSystem,Put:(FileSystem) -> () |%}-> a 1199 | fun bsfs0(m) { 1200 | fileOC(fun() { 1201 | fileRW(m) 1202 | }) 1203 | } 1204 | 1205 | #{ 1206 | #! 1207 | # 1208 | # Stream redirection 1209 | # 1210 | sig > : (() -> a, String) 1211 | { Create:(String) -> Option(FileDescr) 1212 | , Exit : (Int) -> Zero 1213 | , Write :(FileDescr,String) -> () }-> a 1214 | op f > fname { 1215 | var fd = switch (do Create(fname)) { 1216 | case None -> exit(-1) 1217 | case Some(fd) -> fd 1218 | }; handle(f()) { 1219 | case ans -> ans 1220 | case resume> -> 1221 | resume(do Write(fd, cs)) 1222 | } 1223 | } 1224 | #? 1225 | #} 1226 | 1227 | sig >- : (() { |%}-> a, String) 1228 | { Create:(String) -> Option(FileDescr) 1229 | , Exit : (Int) -> Zero 1230 | , Write :(FileDescr,String) -> () |%}-> a 1231 | op f >- fname { 1232 | var fd = switch (do Create(fname)) { 1233 | case None -> exit(-1) 1234 | case Some(fd) -> fd 1235 | }; handle(f()) { 1236 | case Return(x) -> x 1237 | case Write(_, cs, resume) -> 1238 | resume(do Write(fd, cs)) 1239 | } 1240 | } 1241 | 1242 | #{ 1243 | #! 1244 | # 1245 | # Crude copy 1246 | # 1247 | sig ccp : (String, String) { Create:(String) -> Option(FileDescr) 1248 | , Exit :(Int) -> Zero 1249 | , Read :(FileDescr) -> Option(String) 1250 | , Open :(String) -> Option(FileDescr) 1251 | , Write :(FileDescr,String) -> () }-> () 1252 | fun ccp(src, dst) { 1253 | var srcfd = switch (do Open(src)) { 1254 | case None -> exit(-1) 1255 | case Some(fd) -> fd 1256 | }; 1257 | switch (do Read(srcfd)) { 1258 | case None -> exit(-1) 1259 | case Some(cs) -> fun() {echo(cs)} > dst 1260 | } 1261 | } 1262 | #? 1263 | #} 1264 | 1265 | sig ccp : (String, String) { Create:(String) -> Option(FileDescr) 1266 | , Exit :(Int) -> Zero 1267 | , Read :(FileDescr) -> Option(String) 1268 | , Open :(String) -> Option(FileDescr) 1269 | , Write :(FileDescr,String) -> () |%}-> () 1270 | fun ccp(src, dst) { 1271 | var srcfd = switch (do Open(src)) { 1272 | case None -> exit(-1) 1273 | case Some(fd) -> fd 1274 | }; 1275 | switch (do Read(srcfd)) { 1276 | case None -> exit(-1) 1277 | case Some(cs) -> fun() {echo(cs)} >- dst 1278 | } 1279 | } 1280 | 1281 | #{ 1282 | #! 1283 | # 1284 | # Plugging everything together 1285 | # 1286 | sig example7 : () -> ([Int], FileSystem) 1287 | fun example7() { 1288 | runState(fsys0, fun() { 1289 | bsfs0(fun() { 1290 | timeshare(fun() { 1291 | interruptWrite(fun() { 1292 | sessionmgr(Root, fun() { 1293 | status(fun() { 1294 | if (fork()) { 1295 | su(Alice); 1296 | ritchie > "ritchie.txt" 1297 | } else { 1298 | su(Bob); 1299 | hamlet > "hamlet"; 1300 | ccp("hamlet", "act3") 1301 | } 1302 | }) 1303 | }) 1304 | }) 1305 | }) 1306 | }) 1307 | }) 1308 | } 1309 | #? 1310 | #} 1311 | 1312 | sig example7 : () { |%}-> ([Int], FileSystem) 1313 | fun example7() { 1314 | runState(fsys0, fun() { 1315 | bsfs0(fun() { 1316 | timeshare(fun() { 1317 | interruptWrite(fun() { 1318 | sessionmgr(Root, fun() { 1319 | status(fun() { 1320 | if (fork()) { 1321 | su(Alice); 1322 | ritchie >- "ritchie.txt" 1323 | } else { 1324 | su(Bob); 1325 | hamlet >- "hamlet"; 1326 | ccp("hamlet", "act3") 1327 | } 1328 | }) 1329 | }) 1330 | }) 1331 | }) 1332 | }) 1333 | }) 1334 | } 1335 | 1336 | #! 1337 | # 1338 | # Conclusion 1339 | # 1340 | # + Effect handlers are a versatile programming abstraction 1341 | # + Possible to retrofit legacy code with new functionality 1342 | # + Operating systems can be explained in terms of handlers 1343 | # + "Every problem can be solved by adding another handler" 1344 | # 1345 | # See my PhD dissertation[1] for an implementation of UNIX fork, usage of 1346 | # shallow handlers to implement a more UNIX-y shell environment. 1347 | # 1348 | # [1] "Foundations for Programming and Implementing Effect Handlers", 1349 | # Daniel Hillerström, PhD dissertation, The University of 1350 | # Edinburgh, Scotland, UK, 2021. 1351 | # 1352 | #? 1353 | -------------------------------------------------------------------------------- /code/unix-plug2020.links: -------------------------------------------------------------------------------- 1 | ## Prelude 2 | typename Option(a) = [|None|Some:a|]; 3 | 4 | sig todo : (String) ~> a 5 | fun todo(s) { error("TODO: " ^^ s) } 6 | 7 | sig fail : () {Fail:Zero |_}-> a 8 | fun fail() { switch (do Fail) { } } 9 | 10 | sig lookup : (a, [(a, b)]) {Fail:Zero |_}~> b 11 | fun lookup(k, kvs) { 12 | switch (kvs) { 13 | case [] -> fail() 14 | case (k', v) :: kvs' -> 15 | if (k == k') v 16 | else lookup(k, kvs') 17 | } 18 | } 19 | 20 | sig modify : (a, b, [(a, b)]) ~> [(a, b)] 21 | fun modify(k, v, kvs) { 22 | switch (kvs) { 23 | case [] -> [] 24 | case (k', v') :: kvs' -> 25 | if (k == k') (k, v) :: kvs' 26 | else (k', v') :: modify(k, v, kvs') 27 | } 28 | } 29 | 30 | sig remove : (a, [(a, b)]) ~> [(a, b)] 31 | fun remove(k, kvs) { 32 | switch (kvs) { 33 | case [] -> [] 34 | case (k', v') :: kvs' -> 35 | if (k == k') kvs' 36 | else (k', v') :: remove(k, kvs') 37 | } 38 | } 39 | 40 | sig has : (a, [(a, b)]) ~> Bool 41 | fun has(k, kvs) { 42 | switch (kvs) { 43 | case [] -> false 44 | case (k', _) :: kvs' -> 45 | k == k' || has(k, kvs') 46 | } 47 | } 48 | 49 | #! 50 | # 51 | # UNIX in 50 lines of code or less 52 | # Daniel Hillerström 53 | # Laboratory for Foundations of Computer Science 54 | # The University of Edinburgh 55 | # 56 | # PLUG talk 57 | # University of Glasgow 58 | # December 8, 2020 59 | # 60 | # https://dhil.net/research/ 61 | # 62 | #? 63 | 64 | #! 65 | # 66 | # What is an operating system? (very abstractly) 67 | # 68 | # An operating system responds to a collection of system calls 69 | # 70 | # Example tasks: 71 | # - Signalling errors 72 | # - Scheduling processes 73 | # - Reading/writing I/O 74 | #? 75 | 76 | #! 77 | # 78 | # What is an effect handler? (very abstractly) 79 | # 80 | # An effect handler responds a collection of abstract operation calls 81 | # 82 | # Example tasks: 83 | # - Signalling errors 84 | # - Scheduling processes 85 | # - Reading/writing I/O 86 | # 87 | # 88 | # 89 | # 90 | # 91 | #? 92 | 93 | #! 94 | # 95 | # What is an effect handler? (very abstractly) 96 | # 97 | # An effect handler responds a collection of abstract operation calls 98 | # 99 | # Example tasks: 100 | # - Signalling errors 101 | # - Scheduling processes 102 | # - Reading/writing I/O 103 | # 104 | # Thus an effect handler is an operating system (credit James McKinna) 105 | # (Kiselyov and Shan (2007) used delimited continuations to model 106 | # operating systems) 107 | # 108 | #? 109 | 110 | #! 111 | # 112 | # Objectives of this talk 113 | # 114 | # - Demonstrate the versatility of handlers 115 | # - Explain operating systems as the combination of 116 | # + Exceptions 117 | # + Dynamic binding 118 | # + Nondeterminism 119 | # + State 120 | # 121 | #? 122 | 123 | # 124 | # 125 | # What is UNIX? 126 | # 127 | # UNIX is an operating system designed by Ritchie and Thompson (1974) 128 | # 129 | # Components 130 | # - Commands (system calls) 131 | # + I/O interaction, user session management, inter-process 132 | # communication, etc 133 | # - Kernel (interpreter) 134 | # + Handling of I/O, managing user sessions, scheduling of 135 | # processes 136 | # - Development environment 137 | # + Compiler tool-chains (e.g. `cc`) 138 | # - Documentation 139 | # + manual pages (e.g. `man`) 140 | # 141 | # 142 | 143 | #! 144 | # 145 | # Key characteristics of UNIX (Ritchie & Thompson, 1974) 146 | # 147 | # - Support for multiple user sessions 148 | # - Time-sharing between processes 149 | # - "Everything is a file" 150 | # 151 | #? 152 | 153 | #! 154 | # 155 | # Basic I/O: Performing writes 156 | # 157 | typename File = String; 158 | typename FileDescr = Int; 159 | 160 | sig stdout : FileDescr 161 | var stdout = 1; 162 | 163 | sig echo : (String) {Write:(FileDescr,String) -> () |%}-> () 164 | fun echo(cs) { todo("implement echo") } 165 | #? 166 | 167 | #! 168 | # 169 | # Basic I/O: Handling writes 170 | # 171 | sig basicIO : ( () {Write:(FileDescr,String) -> () |%}-> a ) { |%}-> (a, File) 172 | fun basicIO(m) { 173 | todo("implement basicIO") 174 | } 175 | #? 176 | 177 | #! 178 | # 179 | # Basic I/O: Example 180 | # 181 | sig example0 : () { |%}-> ((), File) 182 | fun example0() { 183 | basicIO(fun() { 184 | echo("Hello"); echo("World") 185 | }) 186 | } 187 | #? 188 | 189 | #! 190 | # 191 | # Dynamic semantics of handlers 192 | # 193 | # (ret) handle(V) { case Return(x) -> N case ... } 194 | # ~> N[V/x] 195 | # 196 | # (op) handle(E[do Op(V)]) { case Op(p,r) -> N case ... } 197 | # ~> N[V/p 198 | # ,fun(x){ handle(E[x]) { case Op(p,r) -> N case ... }}/r] 199 | # (if Op \notin E) 200 | # 201 | #? 202 | 203 | #! 204 | # 205 | # Exceptions: Premature exits 206 | # 207 | sig exit : (Int) {Exit:(Int) -> Zero |%}-> a 208 | fun exit(n) { todo("implement exit") } 209 | #? 210 | 211 | #! 212 | # 213 | # Handling exits 214 | # 215 | sig status : (() {Exit:(Int) -> Zero |%}-> a) { |%}-> Int 216 | fun status(m) { 217 | todo("implement status") 218 | } 219 | #? 220 | 221 | #! 222 | # 223 | # Handling exits: Example 224 | # 225 | sig example1 : () { |%}-> (Int, File) 226 | fun example1() { 227 | basicIO(fun() { 228 | status(fun() { 229 | echo("dead"); exit(1); echo("code") 230 | }) 231 | }) 232 | } 233 | #? 234 | 235 | #! 236 | # 237 | # Dynamic binding: User-specific environments (1) 238 | # 239 | typename User = [|Alice|Bob|Root|]; 240 | 241 | sig whoami : () {Ask:String |%}-> String 242 | fun whoami() { do Ask } 243 | #? 244 | 245 | #! 246 | # 247 | # Dynamic binding: User-specific environments (2) 248 | # 249 | sig env : (User, () {Ask:String |%}-> a) { |%}-> a 250 | fun env(user, m) { 251 | handle(m()) { 252 | case Return(x) -> x 253 | case Ask(resume) -> 254 | switch (user) { 255 | case Alice -> resume("alice") 256 | case Bob -> resume("bob") 257 | case Root -> resume("root") 258 | } 259 | } 260 | } 261 | 262 | 263 | sig example2 : () { |%}-> String 264 | fun example2() { 265 | env(Root, whoami) 266 | } 267 | #? 268 | 269 | #! 270 | # 271 | # Aside: Dynamic binding with delimited continuations 272 | # 273 | # The idea of dynamic binding dates back to at least McCarthy (1960) 274 | # 275 | # Kiselyov, Shan, and Sabry (2006) demonstrated dynamic binding can be 276 | # simulated with delimited continuations 277 | # 278 | #? 279 | 280 | #! 281 | # 282 | # User session management 283 | # 284 | sig su : (User) {Su:(User) -> () |%}-> () 285 | fun su(user) { do Su(user) } 286 | 287 | sig sessionmgr : (User, () {Ask:String, Su:(User) -> () |%}-> a) { |%}-> a 288 | fun sessionmgr(user, m) { 289 | env(user, fun() { 290 | handle(m()) { 291 | case Return(x) -> x 292 | case Su(user', resume) -> 293 | env(user', fun() { resume(()) }) 294 | } 295 | }) 296 | } 297 | #? 298 | 299 | #! 300 | # 301 | # Multiple user sessions example 302 | # 303 | sig example3 : () { |%}-> (Int, File) 304 | fun example3() { 305 | basicIO(fun() { 306 | sessionmgr(Root, fun() { 307 | status(fun() { 308 | su(Alice); echo(whoami()); echo(" "); 309 | su(Bob); echo(whoami()); echo(" "); 310 | su(Root); echo(whoami()) 311 | }) 312 | }) 313 | }) 314 | } 315 | #? 316 | 317 | #! 318 | # 319 | # Nondeterminism: Multi-tasking (1) 320 | # 321 | # From the man pages. 322 | # 323 | # Description 324 | # fork() creates a new process by duplicating the calling process. The 325 | # new process is referred to as the child process. The calling process 326 | # is referred to as the parent process. 327 | # 328 | # Return value 329 | # On success, the PID of the child process is returned in the parent, 330 | # and 0 is returned in the child. 331 | # 332 | #? 333 | 334 | #! 335 | # 336 | # Nondeterminism: Multi-tasking (2) 337 | # 338 | sig fork : () {Fork:Bool |_}-> Bool 339 | fun fork() { do Fork } 340 | 341 | sig nondet : (() {Fork:Bool |%}-> a) { |%}-> [a] 342 | fun nondet(m) { 343 | handle(m()) { 344 | case Return(ans) -> todo("implement Return case") 345 | case Fork(resume) -> todo("implement Fork case") 346 | } 347 | } 348 | #? 349 | 350 | #! 351 | # 352 | # Nondeterminism: Example (1) 353 | # 354 | sig ritchie : () {Write:(FileDescr, String) -> () |%}-> () 355 | fun ritchie() { 356 | echo("UNIX is basically "); 357 | echo("a simple operating system, "); 358 | echo("but "); 359 | echo("you have to be a genius to understand the simplicity.\n") 360 | } 361 | 362 | sig hamlet : () {Write:(FileDescr, String) -> () |%}-> () 363 | fun hamlet() { 364 | echo("To be, or not to be,\n"); 365 | echo("that is the question:\n"); 366 | echo("Whether 'tis nobler in the mind to suffer\n") 367 | } 368 | #? 369 | 370 | #! 371 | # 372 | # Nondeterminism: Example (2) 373 | # 374 | sig example4 : () { |%}-> ([Int], File) 375 | fun example4() { 376 | basicIO(fun() { 377 | nondet(fun() { 378 | sessionmgr(Root, fun() { 379 | status(fun() { 380 | if (fork()) { 381 | su(Alice); 382 | ritchie() 383 | } else { 384 | su(Bob); 385 | hamlet() 386 | } 387 | }) 388 | }) 389 | }) 390 | }) 391 | } 392 | #? 393 | 394 | # 395 | # 396 | # Mathematically well-founded nondeterminism 397 | # 398 | # The handler `nondet` is _exactly_ the handler Plotkin and Pretnar (2013) 399 | # give for nondeterminism 400 | # It satisfies the usual (semi-lattice) equations for nondeterministic choice, i.e. 401 | # 402 | # if (fork()) M else M = M 403 | # if (fork()) M else N = if (fork()) N else M 404 | # if (fork()) L else { if (fork()) M else N } = if (fork()) { if (fork()) L else M } else N 405 | # 406 | # 407 | 408 | #! 409 | # 410 | # Interrupting processes 411 | # 412 | sig interrupt : () {Interrupt:() |%}-> () 413 | fun interrupt() { do Interrupt } 414 | 415 | # Process reification 416 | typename Pstate(a,e::Eff) 417 | = forall q::Presence. 418 | [|Done:a 419 | |Paused:() {Interrupt{q} |e}-> Pstate(a, { |e})|]; 420 | 421 | 422 | sig reifyProcess : (() {Interrupt:() |%}-> a) { |%}-> Pstate(a, { |%}) 423 | fun reifyProcess(m) { 424 | handle(m()) { 425 | case Return(ans) -> Done(ans) 426 | case Interrupt(resume) -> Paused(fun() { resume(()) }) 427 | } 428 | } 429 | #? 430 | 431 | #! 432 | # 433 | # Time-sharing via interrupts 434 | # 435 | sig schedule : ([Pstate(a, { Fork:Bool |%})]) { |%}~> [a] 436 | fun schedule(ps) { 437 | fun schedule(ps, done) { 438 | switch (ps) { 439 | case [] -> done 440 | case Done(res) :: ps' -> 441 | schedule(ps', res :: done) 442 | case Paused(resume) :: ps' -> 443 | schedule(ps' ++ nondet(resume), done) 444 | } 445 | } 446 | schedule(ps, []) 447 | } 448 | 449 | sig timeshare : (() {Fork:Bool,Interrupt:() |%}-> a) { |%}-> [a] 450 | fun timeshare(m) { 451 | var p = Paused(fun() { reifyProcess(m) }); 452 | schedule([p]) 453 | } 454 | #? 455 | 456 | #! 457 | # 458 | # Injecting interrupts 459 | # 460 | # First idea: external source injects interrupts (Ahman and Pretnar (2021)) 461 | # 462 | # Second idea: bundle interrupts with other operations 463 | sig echo' : (FileDescr,String) {Interrupt:(), Write:(FileDescr,String) -> () |%}-> () 464 | fun echo'(fd, cs) { interrupt(); do Write(fd, cs) } 465 | # 466 | # Third idea: overload interpretations of operations 467 | sig interruptWrite : (() {Write:(FileDescr,String) -> () |%}-> a) 468 | {Write:(FileDescr,String) -> () |%}-> a 469 | fun interruptWrite(m) { 470 | handle(m()) { 471 | case Return(res) -> res 472 | case Write(fd, cs, resume) -> 473 | interrupt(); resume(do Write(fd, cs)) 474 | } 475 | } 476 | #? 477 | 478 | #! 479 | # 480 | # Time-sharing example 481 | # 482 | sig example5 : () { |%}-> ([Int], File) 483 | fun example5() { 484 | basicIO(fun() { 485 | timeshare(fun() { 486 | interruptWrite(fun() { 487 | sessionmgr(Root, fun() { 488 | status(fun() { 489 | if (fork()) { 490 | su(Alice); 491 | ritchie() 492 | } else { 493 | su(Bob); 494 | hamlet() 495 | } 496 | }) 497 | }) 498 | }) 499 | }) 500 | }) 501 | } 502 | #? 503 | 504 | #! 505 | # 506 | # State: File I/O 507 | # 508 | # Generic state handling 509 | sig get : () {Get:s |_}-> s 510 | fun get() { do Get } 511 | 512 | sig put : (s) {Put:(s) -> () |_}-> () 513 | fun put(st) { do Put(st) } 514 | 515 | sig runState : (s, () {Get:() -> s,Put:(s) -> () |%}-> a) { |%}-> (a, s) 516 | fun runState(st0, m) { 517 | var f = handle(m()) { 518 | case Return(x) -> fun(st) { (x, st) } 519 | case Get(resume) -> fun(st) { resume(st)(st) } 520 | case Put(st',resume) -> fun(_) { resume(())(st') } 521 | }; 522 | f(st0) 523 | } 524 | #? 525 | 526 | #! 527 | # 528 | # State: Example 529 | # 530 | sig incr : () {Get:Int,Put:(Int) -> () |%}-> () 531 | fun incr() { put(get() + 1) } 532 | 533 | sig example6 : () { |%}-> ((), Int) 534 | fun example6() { 535 | runState(41, incr) 536 | } 537 | #? 538 | 539 | #! 540 | # 541 | # Basic Serial File System 542 | # 543 | # Directory I-List Data region 544 | # +----------------+ +-------+ +--------------------------+ 545 | # | "hamlet" |------> | 2 |---> | "To be, or not to be..." | 546 | # +----------------+ / +-------+ +--------------------------+ 547 | # | "richtie.txt" |------> | 1 |---> | "UNIX is basically..." | 548 | # +----------------+ / +-------+ +--------------------------+ 549 | # | ... | | | ... | | ... | 550 | # +----------------+ | +-------+ +--------------------------+ 551 | # | "stdout" |------> | 1 |---> | "" | 552 | # +----------------+ | +-------+ +--------------------------+ 553 | # | ... | / 554 | # +----------------+ / 555 | # | "act3" |--- 556 | # +----------------+ 557 | # 558 | # Simplifications: 559 | # - Operating directly on inode pointers 560 | # - Reads and writes will be serial 561 | # 562 | #? 563 | 564 | #! 565 | # 566 | # BSFS structures 567 | # 568 | typename INode = (loc:Int,lno:Int); 569 | typename IList = [(Int, INode)]; # INode index -> INode 570 | typename Directory = [(String, Int)]; # Filename -> INode index 571 | typename DataRegion = [(Int, File)]; # Loc -> File 572 | 573 | typename FileSystem = (dir:Directory,dregion:DataRegion,inodes:IList 574 | ,lnext:Int ,inext:Int ); 575 | 576 | sig fsys0 : FileSystem 577 | var fsys0 = ( dir = [("stdout", 0)] 578 | , inodes = [(0, (loc=0, lno=1))] 579 | , dregion = [(0, "")] 580 | , lnext = 1, inext = 1 ); 581 | 582 | 583 | # Utility functions 584 | sig lookup : (a, [(a, b)]) {Fail:Zero |%}-> b 585 | var lookup = lookup; 586 | 587 | sig withDefault : (a, () {Fail:Zero |%}-> a) { |%}-> a 588 | fun withDefault(x', m) { 589 | handle(m()) { 590 | case Return(x) -> x 591 | case Fail(_) -> x' 592 | } 593 | } 594 | #? 595 | 596 | sig fwrite : (Int, String, FileSystem) {Fail:Zero |%}-> FileSystem 597 | fun fwrite(ino, cs, fsys) { 598 | var inode = lookup(ino, fsys.inodes); 599 | var file = lookup(inode.loc, fsys.dregion); 600 | var file' = file ^^ cs; 601 | (fsys with dregion = modify(inode.loc, file', fsys.dregion)) 602 | } 603 | 604 | sig fread : (Int, FileSystem) {Fail:Zero |%}-> String 605 | fun fread(ino, fsys) { 606 | var inode = lookup(ino, fsys.inodes); 607 | lookup(inode.loc, fsys.dregion) 608 | } 609 | 610 | #! 611 | # 612 | # Handling BSFS operations: file reading and writing 613 | # 614 | sig fwrite : (FileDescr, String, FileSystem) {Fail:Zero |%}-> FileSystem 615 | var fwrite = fwrite; 616 | sig fread : (FileDescr, FileSystem) {Fail:Zero |%}-> String 617 | var fread = fread; 618 | 619 | sig fileRW : ( () { Read :(FileDescr) -> Option(String) 620 | , Write:(FileDescr, String) -> () |%}-> a ) 621 | {Get:FileSystem,Put:(FileSystem) -> () |%}-> a 622 | fun fileRW(m) { 623 | handle(m()) { 624 | case Return(ans) -> ans 625 | case Read(fd, resume) -> 626 | var cs = withDefault(None, fun() { 627 | Some(fread(fd, get())) 628 | }); resume(cs) 629 | case Write(fd, cs, resume) -> 630 | withDefault((), fun() { 631 | var fsys = fwrite(fd, cs, get()); 632 | put(fsys) 633 | }); resume(()) 634 | } 635 | } 636 | #? 637 | 638 | sig fopen : (String, FileSystem) {Fail:Zero |%}-> FileDescr 639 | fun fopen(fname, fsys) { lookup(fname, fsys.dir) } 640 | 641 | sig fcreate : (String, FileSystem) {Fail:Zero |%}-> (FileDescr, FileSystem) 642 | fun fcreate(fname, fsys) { 643 | if (has(fname, fsys.dir)) { 644 | var ino = fopen(fname, fsys); 645 | # Truncate file 646 | var inode = lookup(ino, fsys.inodes); 647 | var dregion = modify(inode.loc, "", fsys.dregion); 648 | (ino, (fsys with =dregion)) 649 | } else { 650 | var loc = fsys.lnext; 651 | var dregion = (loc, "") :: fsys.dregion; 652 | 653 | var ino = fsys.inext; 654 | var inode = (loc=loc,lno=1); 655 | var inodes = (ino, inode) :: fsys.inodes; 656 | 657 | var dir = (fname, ino) :: fsys.dir; 658 | (ino, (=dir, =dregion, =inodes, lnext=loc+1, inext=ino+1)) 659 | } 660 | } 661 | 662 | #! 663 | # 664 | # BSFS operation: file opening and creation 665 | # 666 | sig fopen : (String, FileSystem) {Fail:Zero |%}-> FileDescr 667 | var fopen = fopen; 668 | sig fcreate : (String, FileSystem) {Fail:Zero |%}-> (FileDescr, FileSystem) 669 | var fcreate = fcreate; 670 | 671 | sig fileOC : ( () { Open :(String) -> Option(FileDescr) 672 | , Create:(String) -> Option(FileDescr) |%}-> a ) 673 | {Get:FileSystem,Put:(FileSystem) -> () |%}-> a 674 | fun fileOC(m) { 675 | handle(m()) { 676 | case Return(ans) -> ans 677 | case Open(fname, resume) -> 678 | var fd = withDefault(None, fun() { 679 | Some(fopen(fname, get())) 680 | }); resume(fd) 681 | case Create(fname, resume) -> 682 | var fd = withDefault(None, fun() { 683 | var (fd, fsys) = fcreate(fname, get()); 684 | put(fsys); Some(fd) 685 | }); resume(fd) 686 | } 687 | } 688 | #? 689 | 690 | #! 691 | # 692 | # BSFS version 0 693 | # 694 | sig bsfs0 : ( () { Open :(String) -> Option(FileDescr) 695 | , Create:(String) -> Option(FileDescr) 696 | , Read :(FileDescr) -> Option(String) 697 | , Write:(FileDescr, String) -> () |%}-> a ) 698 | {Get:FileSystem,Put:(FileSystem) -> () |%}-> a 699 | fun bsfs0(m) { 700 | fileOC(fun() { 701 | fileRW(m) 702 | }) 703 | } 704 | #? 705 | 706 | #! 707 | # 708 | # Stream redirection 709 | # 710 | sig >- : (() { |%}-> a, String) 711 | { Create:(String) -> Option(FileDescr) 712 | , Exit : (Int) -> Zero 713 | , Write :(FileDescr,String) -> () |%}-> a 714 | op f >- fname { 715 | var fd = switch (do Create(fname)) { 716 | case None -> exit(-1) 717 | case Some(fd) -> fd 718 | }; handle(f()) { 719 | case Return(x) -> x 720 | case Write(_, cs, resume) -> 721 | resume(do Write(fd, cs)) 722 | } 723 | } 724 | #? 725 | 726 | #! 727 | # 728 | # Crude copy 729 | # 730 | sig ccp : (String, String) { Create:(String) -> Option(FileDescr) 731 | , Exit :(Int) -> Zero 732 | , Read :(FileDescr) -> Option(String) 733 | , Open :(String) -> Option(FileDescr) 734 | , Write :(FileDescr,String) -> () |%}-> () 735 | fun ccp(src, dst) { 736 | var srcfd = switch (do Open(src)) { 737 | case None -> exit(-1) 738 | case Some(fd) -> fd 739 | }; 740 | switch (do Read(srcfd)) { 741 | case None -> exit(-1) 742 | case Some(cs) -> fun() {echo(cs)} >- dst 743 | } 744 | } 745 | #? 746 | 747 | #! 748 | # 749 | # Plugging everything together 750 | # 751 | sig example7 : () { |%}-> ([Int], FileSystem) 752 | fun example7() { 753 | runState(fsys0, fun() { 754 | bsfs0(fun() { 755 | timeshare(fun() { 756 | sessionmgr(Root, fun() { 757 | status(fun() { 758 | if (fork()) { 759 | su(Alice); 760 | ritchie >- "ritchie.txt" 761 | } else { 762 | su(Bob); 763 | hamlet >- "hamlet"; 764 | ccp("hamlet", "act3") 765 | } 766 | }) 767 | }) 768 | }) 769 | }) 770 | }) 771 | } 772 | #? 773 | 774 | #! 775 | # 776 | # Conclusion 777 | # 778 | # Effect handlers are a versatile programming abstraction 779 | # Operating systems can be explained in terms of handlers 780 | # "Every problem can be solved by adding another handler" 781 | # 782 | #? 783 | -------------------------------------------------------------------------------- /code/unix.links: -------------------------------------------------------------------------------- 1 | # Tiny UNIX in Links. 2 | 3 | ## 4 | ## Functional utils 5 | ## 6 | typename Option(a) = [|None|Some:a|]; 7 | 8 | sig modify : (a, b, [(a, b)]) ~> [(a, b)] 9 | fun modify(x, y, xs) { 10 | switch (xs) { 11 | case [] -> [] 12 | case (x', y') :: xs' -> 13 | if (x == x') (x, y) :: xs' 14 | else (x', y') :: modify(x, y, xs') 15 | } 16 | } 17 | 18 | ### 19 | ### Generic queue 20 | ### 21 | module Queue { 22 | typename T(a) = (front:[a], rear:[a]); 23 | 24 | sig empty : T(a) 25 | var empty = (front=[], rear=[]); 26 | 27 | sig enqueue : (a, T(a)) -> T(a) 28 | fun enqueue(x, q) { 29 | (q with rear = x :: q.rear) 30 | } 31 | 32 | sig dequeue : (T(a)) ~> (Option(a), T(a)) 33 | fun dequeue(q) { 34 | switch(q.front) { 35 | case [] -> 36 | switch (q.rear) { 37 | case [] -> (None, q) 38 | case rear -> dequeue((front=reverse(rear),rear=[])) 39 | } 40 | case x :: xs -> (Some(x), (q with front = xs)) 41 | } 42 | } 43 | 44 | sig singleton : (a) -> T(a) 45 | fun singleton(x) { enqueue(x, empty) } 46 | } 47 | 48 | ## 49 | ## Environment 50 | ## 51 | sig getenv : (String) {Getenv:(String) -> String |_}-> String 52 | fun getenv(s) { do Getenv(s) } 53 | 54 | sig environment : ([(String,String)], () {Getenv:(String) -> String |e}~> a) {Getenv{_} |e}~> a 55 | fun environment(env', m) { 56 | handle(m()) { 57 | case Return(x) -> x 58 | case Getenv(s, resume) -> 59 | switch (lookup(s, env')) { 60 | case Nothing -> resume("") 61 | case Just(s') -> resume(s') 62 | } 63 | } 64 | } 65 | 66 | typename Environment = [(String, String)]; 67 | 68 | ## 69 | ## User management 70 | ## 71 | typename User = [|Root|Alice|Bob|]; 72 | typename EnvironmentStore = [(User, Environment)]; 73 | 74 | sig envs : [(User, Environment)] 75 | var envs = [ (Root , [("USER", "root") , ("UID", "0")]) 76 | , (Alice, [("USER", "alice"), ("UID", "1")]) 77 | , (Bob , [("USER", "bob") , ("UID", "2")]) 78 | ]; 79 | 80 | sig envOf : (User, [(User, Environment)]) ~> Environment 81 | fun envOf(user, envs) { 82 | switch (envs) { 83 | case [] -> error("No environment") # TODO: could interpret as something "fun" such as a kernel panic. 84 | case (user', env) :: envs -> 85 | if (user == user') env 86 | else envOf(user, envs) 87 | } 88 | } 89 | 90 | sig su : (User) {Su:(User) -> () |_}-> () 91 | fun su(user) { do Su(user) } 92 | 93 | sig usermgr : (User, EnvironmentStore, Comp(a, {Getenv:(String) -> String,Su:(User) -> () |e})) {Getenv{_},Su{_} |e}~> a 94 | fun usermgr(user, envs, m) { 95 | environment(envOf(user, envs), fun() { 96 | handle(m()) { 97 | case Su(user, resume) -> 98 | environment(envOf(user, envs), fun(){ resume(()) }) 99 | } 100 | }) 101 | } 102 | 103 | ## 104 | ## Basic IO 105 | ## 106 | typename FileDescr = Int; 107 | typename FileCursor = Int; 108 | 109 | module File { 110 | typename T = [String]; 111 | 112 | sig empty : T 113 | var empty = []; 114 | 115 | sig read : (FileCursor, T) ~> Option(String) 116 | fun read(start, file) { 117 | switch (drop(start, file)) { 118 | case [] -> None 119 | case x :: _ -> Some(x) 120 | } 121 | } 122 | 123 | sig write : (String, FileCursor, T) ~> T 124 | fun write(contents, fptr, file) { 125 | take(fptr, file) ++ [contents] ++ drop(fptr, file) 126 | } 127 | } 128 | 129 | sig stdout : FileDescr 130 | var stdout = 1; 131 | 132 | sig puts : (FileDescr,String) {Puts:(FileDescr,String) -> () |_}-> () 133 | fun puts(fd, s) { do Puts(fd, s) } 134 | 135 | sig basicIO : (Comp(a, {Puts:(FileDescr,String) -> () |e})) {Puts{_} |e}~> File.T 136 | fun basicIO(m) { 137 | handle(m()) { 138 | case Return(_) -> [] 139 | case Puts(_, s, resume) -> s :: resume(()) 140 | } 141 | } 142 | 143 | ## 144 | ## Generic state handling. 145 | ## 146 | sig get : () {Get:s |_}-> s 147 | fun get() { do Get } 148 | 149 | sig put : (s) {Put:(s) -> () |_}-> () 150 | fun put(st) { do Put(st) } 151 | 152 | sig runState : (s, Comp(a, {Get:() -> s,Put:(s) -> () |e})) {Get{_},Put{_} |e}~> (a, s) 153 | fun runState(st0, m) { 154 | var f = handle(m()) { 155 | case Return(x) -> fun(st) { (x, st) } 156 | case Get(resume) -> fun(st) { resume(st)(st) } 157 | case Put(st,resume) -> fun(_) { resume(())(st) } 158 | }; 159 | f(st0) 160 | } 161 | 162 | ## 163 | ## File IO 164 | ## 165 | sig stdin : FileDescr 166 | var stdin = 0; 167 | sig stderr : FileDescr 168 | var stderr = 2; 169 | 170 | sig eof : String 171 | var eof = "\x00"; 172 | 173 | typename Mode = [|Read|Write|]; 174 | 175 | typename FileDescr = Int; 176 | typename INode = (loc:Option(Int),refc:Int); 177 | 178 | typename INodeTable = [(INode, File.T)]; 179 | typename FileTable = [(Mode, INode)]; 180 | typename 181 | 182 | # sig gets : (FileDescr) {Gets:(FileDescr) -> String |_}-> String 183 | # fun gets(fd) { do Gets(fd) } 184 | 185 | # sig fopen : (Mode, String) {Fopen:(Mode, String) -> FileDescr |_}-> FileDescr 186 | # fun fopen(mode, filename) { do Fopen(mode, filename) } 187 | 188 | # sig fclose : (FileDescr) {Fclose:(FileDescr) -> () |_}-> () 189 | # fun fclose(fd) { do Fclose(fd) } 190 | 191 | # typename File = Queue.T(String); 192 | 193 | # sig emptyFile : File 194 | # var emptyFile = Queue.empty; 195 | 196 | # sig writeFile : (String, File) -> File 197 | # fun writeFile(s, file) { Queue.enqueue(s, file) } 198 | 199 | # sig readFile : (File) ~> (String, File) 200 | # fun readFile(file) { 201 | # switch (Queue.dequeue(file)) { 202 | # case (None, file) -> (eof, file) 203 | # case (Some(s), file) -> (s, file) 204 | # } 205 | # } 206 | 207 | # typename FileTable = [(FileDescr, File)]; 208 | # typename FileStore = [(String, FileDescr)]; 209 | # typename FileSystem = (next:Int,ft:FileTable,fs:FileStore); 210 | 211 | # sig defaultFileSystem : () -> FileSystem 212 | # fun defaultFileSystem() { 213 | # var defaultTable = [ (stdin , emptyFile) 214 | # , (stdout, emptyFile) 215 | # , (stderr, emptyFile) ]; 216 | 217 | # var defaultStore = [ ("stdin" , stdin) 218 | # , ("stdout", stdout) 219 | # , ("stderr", stderr) ]; 220 | 221 | # (next=3,ft=defaultTable,fs=defaultStore) 222 | # } 223 | 224 | # sig lookupFile : (FileDescr, FileSystem) ~> File 225 | # fun lookupFile(fd, fsys) { 226 | # switch (lookup(fd, fsys.ft)) { 227 | # case Nothing -> error("err: No such file(" ^^ intToString(fd) ^^ ")") 228 | # case Just(file) -> file 229 | # } 230 | # } 231 | 232 | # sig replaceFile : (FileDescr, File, FileSystem) ~> FileSystem 233 | # fun replaceFile(fd, file, fsys) { 234 | # var ft = modify(fd, file, fsys.ft); 235 | # (fsys with ft = ft) # TODO handle nonexistent file. 236 | # } 237 | 238 | # sig createFile : (String, FileSystem) -> (FileDescr, FileSystem) 239 | # fun createFile(filename, fsys) { 240 | # var fd = fsys.next; 241 | # (fd, (next = fd + 1, fs = (filename, fd) :: fsys.fs, ft = (fd, emptyFile) :: fsys.ft)) 242 | # } 243 | 244 | # sig openFile : (Mode, String, FileSystem) ~> (FileDescr, FileSystem) 245 | # fun openFile(mode, filename, fsys) { 246 | # var (fd, fsys') = switch (lookup(filename, fsys.fs)) { 247 | # case Nothing -> createFile(filename, fsys) 248 | # case Just(fd) -> (fd, fsys) 249 | # }; 250 | # switch (mode) { 251 | # case Create -> error("erase") 252 | # case Append -> (fd, fsys') 253 | # } 254 | # } 255 | 256 | # sig closeFile : (File) ~> File 257 | # fun closeFile((=front,=rear)) { 258 | # (front=front ++ reverse(rear), rear=[]) 259 | # } 260 | 261 | # sig allowState : (() {Get-,Put- |e}~> a) -> () {Get:s,Put:(s) -> () |e}~> a 262 | # fun allowState(f) { (f : (() {Get:s,Put:(s) -> () |e}~> a) <- (() {Get-,Put- |e}~> a)) } 263 | 264 | # sig fileIO : (Comp(a, {Get-,Put-,Gets:(FileDescr) -> String,Puts:(FileDescr,String) -> (),Fclose:(FileDescr) -> (),Fopen:(Mode,String) -> FileDescr |e})) {Get:() {}-> FileSystem,Put:(FileSystem) -> (),Gets{_},Puts{_},Fclose{_},Fopen{_} |e}~> a 265 | # fun fileIO(m) { 266 | # handle(allowState(m)()) { 267 | # case Gets(fd, resume) -> 268 | # var fsys = get(); 269 | # var (ch, file) = readFile(lookupFile(fd, fsys)); 270 | # put(replaceFile(fd, file, fsys)); resume(ch) 271 | # case Puts(fd, ch, resume) -> 272 | # var fsys = get(); 273 | # var fsys' = replaceFile(fd, writeFile(ch, lookupFile(fd, fsys)), fsys); 274 | # put(fsys'); resume(()) 275 | # case Fopen(mode, filename, resume) -> 276 | # var fsys = get(); 277 | # var (fd, fsys') = openFile(mode, filename, fsys); 278 | # put(fsys'); resume(fd) 279 | # case Fclose(fd, resume) -> 280 | # var fsys = get(); 281 | # var fsys' = replaceFile(fd, closeFile(lookupFile(fd, fsys)), fsys); 282 | # put(fsys'); resume(()) 283 | # } 284 | # } 285 | 286 | # sig redirect : (Comp(a, {Puts:(FileDescr,String) -> () |e}), FileDescr) {Puts:(FileDescr,String) -> () |e}~> a 287 | # fun redirect(m, fd) { 288 | # handle(m()) { 289 | # case Puts(_,s,resume) -> resume(puts(fd, s)) 290 | # } 291 | # } 292 | 293 | ## 294 | ## Processes 295 | ## 296 | sig yield : () {Yield:() |_}-> () 297 | fun yield() { do Yield() } 298 | 299 | sig fork : () {Fork:Bool |_}-> Bool 300 | fun fork() { do Fork } 301 | 302 | mutual { 303 | typename Process(e::Eff) = forall p::Presence,q::Presence. [|R:(()) {Fork{p},Yield{q} |e}~> PList({ |e})|]; 304 | typename PList(e::Eff) = [Process({ |e})]; 305 | } 306 | 307 | sig runNext : (PList({ |e})) {Yield{_},Fork{_} |e}~> () 308 | fun runNext(pending) { 309 | switch (concatMap(fun(R(r)) { r(()) }, pending)) { 310 | case [] -> () 311 | case pending -> runNext(pending) 312 | } 313 | } 314 | 315 | sig timeshare : (Comp(a, {Fork:Bool,Yield:() |e})) {Fork{_},Yield{_} |e}~> PList({ |e}) 316 | fun timeshare(proc) { 317 | handle(proc()) { 318 | case Return(_) -> [] 319 | case Yield(resume) -> [R(resume)] 320 | case Fork(resume) -> 321 | resume(true) ++ resume(false) 322 | } 323 | } 324 | 325 | sig schedule : (Comp(a, {Fork:Bool,Yield:() |e})) {Fork{_},Yield{_} |e}~> () 326 | fun schedule(m) { 327 | runNext(timeshare(m)) 328 | } 329 | 330 | # sig replace : (() {Getenv{p},Exece:(() {Getenv:(String) -> String,Exece{q} |e}~> (), [(String, String)]) -> Zero |e}~> a) {Getenv{p},Exece{q} |e}~> () 331 | # fun replace(proc) { 332 | # handle(proc()) { 333 | # case Return(_) -> () 334 | # case Exece(f, env, _) -> 335 | # environment(env, f) 336 | # } 337 | # } 338 | 339 | ## 340 | ## Utilities 341 | ## 342 | sig echo : (String) {Puts:(FileDescr,String) -> (), Yield:() |_}-> () 343 | fun echo(s) { 344 | yield(); puts(stdout, s) 345 | } 346 | 347 | sig amiroot : () {Getenv:(String) -> String |_}-> Bool 348 | fun amiroot() { getenv("UID") == "0" } 349 | 350 | sig whoami : () {Getenv:(String) -> String |_}-> String 351 | fun whoami() { getenv("USER") } 352 | 353 | ## 354 | ## Example 355 | ## 356 | 357 | # Tags puts with the name of the current user. 358 | # sig provenance : (Comp(a, {Getenv:(String) -> String,Puts:(FileDescr,String) -> () |e})) {Getenv:(String) -> String,Puts:(FileDescr,String) -> () |e}~> a 359 | # fun provenance(m) { 360 | # handle(m()) { 361 | # case Puts(fd, s, resume) -> 362 | # var user = whoami(); 363 | # resume(do Puts(fd, user ^^ "> " ^^ s)) 364 | # } 365 | # } 366 | 367 | # # An example of everything plugged together: a time-shared 'Hello World'. 368 | # sig example : () {Fork:Bool,Getenv:(String) -> String,Su:(User) -> (),Puts:(FileDescr,String) -> (),Yield:() |_}~> () 369 | # fun example() { 370 | # var pid = fork(); 371 | # var () = { 372 | # if (pid) redirect(fun(){puts(stdout, "dummy")}, stderr) 373 | # else if (fork()) su(Alice) 374 | # else su(Bob) 375 | # }; 376 | # var user = whoami(); 377 | # puts(stdout, "Hello World!"); 378 | # var uid = getenv("UID"); 379 | # echo("My UID is " ^^ uid); 380 | # (if (amiroot()) { yield(); echo(user ^^ " is running as root.") } else ()); 381 | # echo("My home dir is /home/" ^^ user) 382 | # } 383 | 384 | # # Wiring of handlers. 385 | # sig init : () {Fork{_},Getenv{_},Su{_},Puts{_},Yield{_} |_}~> [String] 386 | # fun init() { 387 | # basicIO(fun() { 388 | # schedule(fun() { 389 | # usermgr(Root, envs, fun() { 390 | # provenance(example) 391 | # }) 392 | # }) 393 | # }) 394 | # } 395 | 396 | # sig example' : () {Fork:Bool,Fclose:(FileDescr) -> (),Fopen:(Mode,String) -> FileDescr,Getenv:(String) -> String,Su:(User) -> (),Puts:(FileDescr,String) -> (),Yield:() |_}~> () 397 | # fun example'() { 398 | # var pid = fork(); 399 | # var () = { 400 | # if (pid) redirect(fun(){puts(stdout, "dummy")}, stderr) 401 | # else if (fork()) su(Alice) 402 | # else su(Bob) 403 | # }; 404 | # var user = whoami(); 405 | # var fd = fopen(Append, user ^^ ".txt"); 406 | # puts(fd, "Hello World!"); 407 | # var uid = getenv("UID"); 408 | # echo("My UID is " ^^ uid); 409 | # (if (amiroot()) { yield(); echo(user ^^ " is running as root.") } else ()); 410 | # echo("My home dir is /home/" ^^ user); 411 | # fclose(fd) 412 | # } 413 | 414 | 415 | # sig init' : (FileSystem) {Fclose{_},Fopen{_},Fork{_},Get{_},Getenv{_},Gets{_},Put{_},Puts{_},Su{_},Yield{_}|_}~> ((), FileSystem) 416 | # fun init'(fsys) { 417 | # runState(fsys, fun() { 418 | # fileIO(fun() { 419 | # schedule(fun() { 420 | # usermgr(Root, envs, example') 421 | # }) 422 | # }) 423 | # }) 424 | # } 425 | -------------------------------------------------------------------------------- /code/unix2.links: -------------------------------------------------------------------------------- 1 | # Tiny UNIX revision 2. 2 | 3 | typename Option(a) = [|None|Some:a|]; 4 | 5 | sig fail : () {Fail:Zero |_}-> a 6 | fun fail() { switch (do Fail) {} } 7 | 8 | sig optionalise : (Comp(a, {Fail:Zero |e})) {Fail{_} |e}~> Option(a) 9 | fun optionalise(m) { 10 | handle(m()) { 11 | case Return(x) -> Some(x) 12 | case Fail(_) -> None 13 | } 14 | } 15 | 16 | sig withDefault : (a, Comp(a, {Fail:Zero |e})) {Fail{_} |e}~> a 17 | fun withDefault(x', m) { 18 | handle(m()) { 19 | case Return(x) -> x 20 | case Fail(_) -> x' 21 | } 22 | } 23 | 24 | sig lookup : (a, [(a, b)]) {Fail:Zero |_}~> b 25 | fun lookup(k, kvs) { 26 | switch (kvs) { 27 | case [] -> fail() 28 | case (k', v) :: kvs' -> 29 | if (k == k') v 30 | else lookup(k, kvs') 31 | } 32 | } 33 | 34 | sig modify : (a, b, [(a, b)]) ~> [(a, b)] 35 | fun modify(k, v, kvs) { 36 | switch (kvs) { 37 | case [] -> [] 38 | case (k', v') :: kvs' -> 39 | if (k == k') (k, v) :: kvs' 40 | else (k', v') :: modify(k, v, kvs') 41 | } 42 | } 43 | 44 | sig remove : (a, [(a, b)]) ~> [(a, b)] 45 | fun remove(k, kvs) { 46 | switch (kvs) { 47 | case [] -> [] 48 | case (k', v') :: kvs' -> 49 | if (k == k') kvs' 50 | else (k', v') :: remove(k, kvs') 51 | } 52 | } 53 | 54 | sig has : (a, [(a, b)]) ~> Bool 55 | fun has(k, kvs) { 56 | switch (kvs) { 57 | case [] -> false 58 | case (k', _) :: kvs' -> 59 | k == k' || has(k, kvs') 60 | } 61 | } 62 | 63 | ## 64 | ## Basic i/o 65 | ## 66 | typename File = String; 67 | typename FileDescr = Int; 68 | 69 | sig stdout : FileDescr 70 | var stdout = 1; 71 | 72 | sig basicIO : (Comp(a, {Write:(FileDescr,String) -> () |e})) {Write{_} |e}~> (a, File) 73 | fun basicIO(m) { 74 | handle(m()) { 75 | case Return(res) -> (res, "") 76 | case Write(_, s, resume) -> 77 | var (res, file) = resume(()); 78 | (res, s ^^ file) 79 | } 80 | } 81 | 82 | sig echo : (String) {Write:(FileDescr,String) -> () |_}~> () 83 | fun echo(cs) { do Write(stdout,cs) } 84 | 85 | fun example0() { 86 | basicIO(fun() { 87 | echo("Hello"); echo("World") 88 | }) 89 | } 90 | 91 | ## 92 | ## Exceptions: non-local exits 93 | ## 94 | sig exit : (Int) {Exit:(Int) -> Zero |_}-> a 95 | fun exit(n) { switch(do Exit(n)) {} } 96 | 97 | sig status : (Comp(a, {Exit:(Int) -> Zero |e})) {Exit{_} |e}~> Int 98 | fun status(m) { 99 | handle(m()) { 100 | case Return(_) -> 0 101 | case Exit(n, _) -> n 102 | } 103 | } 104 | 105 | fun example1() { 106 | basicIO(fun() { 107 | status(fun() { 108 | echo("dead"); exit(1); echo("code") 109 | }) 110 | }) 111 | } 112 | 113 | ## 114 | ## Dynamic binding: user-specific environments. 115 | ## 116 | typename User = [|Alice|Bob|Root|]; 117 | 118 | sig whoami : () {Ask:String |_}-> String 119 | fun whoami() { do Ask } 120 | 121 | sig env : (User, Comp(a, {Ask:String |e})) {Ask{_} |e}~> a 122 | fun env(user, m) { 123 | handle(m()) { 124 | case Return(x) -> x 125 | case Ask(resume) -> 126 | switch (user) { 127 | case Alice -> resume("alice") 128 | case Bob -> resume("bob") 129 | case Root -> resume("root") 130 | } 131 | } 132 | } 133 | 134 | fun example2() { 135 | env(Root, whoami) 136 | } 137 | 138 | ### 139 | ### Session management. 140 | ### 141 | sig su : (User) {Su:(User) -> () |_}-> () 142 | fun su(user) { do Su(user) } 143 | 144 | sig sessionmgr : (User, Comp(a, {Ask:String,Su:(User) -> () |e})) {Ask{_},Su{_} |e}~> a 145 | fun sessionmgr(user, m) { 146 | env(user, fun() { 147 | handle(m()) { 148 | case Return(x) -> x 149 | case Su(user', resume) -> 150 | env(user', fun() { resume(()) }) 151 | } 152 | }) 153 | } 154 | 155 | fun example3() { 156 | basicIO(fun() { 157 | sessionmgr(Root, fun() { 158 | status(fun() { 159 | su(Alice); echo(whoami()); echo(" "); 160 | su(Bob); echo(whoami()); echo(" "); 161 | su(Root); echo(whoami()) 162 | }) 163 | }) 164 | }) 165 | } 166 | 167 | ## 168 | ## Nondeterminism: time sharing. 169 | ## 170 | sig fork : () {Fork:Bool |_}-> Bool 171 | fun fork() { do Fork } 172 | 173 | sig nondet : (Comp(a, {Fork:Bool |e})) {Fork{_} |e}~> [a] 174 | fun nondet(m) { 175 | handle(m()) { 176 | case Return(res) -> [res] 177 | case Fork(resume) -> resume(true) ++ resume(false) 178 | } 179 | } 180 | 181 | sig interrupt : () {Interrupt:() |_}-> () 182 | fun interrupt() { do Interrupt } 183 | 184 | typename Pstate(a,e::Eff) = forall q::Presence. 185 | [|Done:a 186 | |Paused:() {Interrupt{q} |e}~> Pstate(a, { |e})|]; 187 | 188 | sig slice : (Comp(a, {Interrupt:() |e})) {Interrupt{_} |e}~> Pstate(a, { |e}) 189 | fun slice(m) { 190 | handle(m()) { 191 | case Return(res) -> Done(res) 192 | case Interrupt(resume) -> Paused(fun() { resume(()) }) 193 | } 194 | } 195 | 196 | sig schedule : ([Pstate(a, { Fork:Bool |e})]) {Fork{_},Interrupt{_} |e}~> [a] 197 | fun schedule(ps) { 198 | # sig run : (Pstate (a, { Fork:() {}-> Bool|e })) {Fork{_},Interrupt{_} |e}~> [a] 199 | # fun run(p) { 200 | # switch(p) { 201 | # case Done(res) -> [res] 202 | # case Paused(resume) -> runNext(nondet(resume)) 203 | # } 204 | # } 205 | # concatMap(run, ps) 206 | fun schedule(ps, done) { 207 | switch (ps) { 208 | case [] -> done 209 | case Done(res) :: ps' -> 210 | schedule(ps', res :: done) 211 | case Paused(resume) :: ps' -> 212 | schedule(ps' ++ nondet(resume), done) 213 | } 214 | } 215 | schedule(ps, []) 216 | } 217 | 218 | sig timeshare : (Comp(a, {Fork:Bool,Interrupt:() |e})) {Fork{_},Interrupt{_} |e}~> [a] 219 | fun timeshare(m) { 220 | var p = Paused(fun() { slice(m) }); 221 | schedule([p]) 222 | } 223 | 224 | fun example4() { 225 | basicIO(fun() { 226 | timeshare(fun() { 227 | sessionmgr(Root, fun() { 228 | status(fun() { 229 | var parent = fork(); 230 | (if (parent) su(Alice) else su(Bob)); 231 | echo(whoami() ^^ "> Hello "); 232 | interrupt(); 233 | echo(whoami() ^^ "> Bye "); 234 | interrupt(); 235 | if (parent) exit(0) 236 | else { 237 | var parent = fork(); 238 | interrupt(); 239 | (if (parent) su(Root) 240 | else { 241 | echo(whoami() ^^ "> oops "); 242 | exit(1) 243 | }); 244 | echo(whoami() ^^ "> !! ") 245 | } 246 | }) 247 | }) 248 | }) 249 | }) 250 | } 251 | 252 | fun forktest(n) { 253 | fun loop(i, n) { 254 | if (i >= n) (-1) 255 | else { 256 | var x = fork(); 257 | println("< x = " ^^ (if (x) "true" else "false") ^^ ", i = " ^^ intToString(i)); 258 | ignore(loop(i+1,n)); 259 | println("> x = " ^^ (if (x) "true" else "false") ^^ ", i = " ^^ intToString(i)); 260 | exit(i) 261 | } 262 | } 263 | loop(0, n) 264 | } 265 | 266 | fun test(i) { 267 | if (i == 2) () 268 | else { 269 | println("< i = " ^^ intToString(i)); 270 | var x = fork(); 271 | test(i+1); 272 | println("> i = " ^^ intToString(i)) 273 | } 274 | } 275 | 276 | fun ritchie() { 277 | echo("UNIX is basically "); 278 | echo("a simple operating system, "); 279 | echo("but "); 280 | echo("you have to be a genius to understand the simplicity.\n") 281 | } 282 | 283 | fun hamlet() { 284 | echo("To be, or not to be,\n"); 285 | echo("that is the question:\n"); 286 | echo("Whether 'tis nobler in the mind to suffer\n") 287 | } 288 | 289 | fun example5() { 290 | basicIO(fun() { 291 | nondet(fun() { 292 | sessionmgr(Root, fun() { 293 | status(fun() { 294 | if (fork()) { 295 | su(Alice); 296 | ritchie() 297 | } else { 298 | su(Bob); 299 | hamlet() 300 | } 301 | }) 302 | }) 303 | }) 304 | }) 305 | } 306 | 307 | fun interruptWrite(m) { 308 | handle(m()) { 309 | case Return(res) -> res 310 | case Write(fd, cs, resume) -> 311 | interrupt(); resume(do Write(fd, cs)) 312 | } 313 | } 314 | 315 | fun example5'() { 316 | basicIO(fun() { 317 | timeshare(fun() { 318 | interruptWrite(fun() { 319 | sessionmgr(Root, fun() { 320 | status(fun() { 321 | if (fork()) { 322 | su(Alice); 323 | ritchie() 324 | } else { 325 | su(Bob); 326 | hamlet() 327 | } 328 | }) 329 | }) 330 | }) 331 | }) 332 | }) 333 | } 334 | 335 | ## 336 | ## Generic state handling 337 | ## 338 | sig get : () {Get:s |_}-> s 339 | fun get() { do Get } 340 | 341 | sig put : (s) {Put:(s) -> () |_}-> () 342 | fun put(st) { do Put(st) } 343 | 344 | sig runState : (s, Comp(a, {Get:() -> s,Put:(s) -> () |e})) {Get{_},Put{_} |e}~> (a, s) 345 | fun runState(st0, m) { 346 | var f = handle(m()) { 347 | case Return(x) -> fun(st) { (x, st) } 348 | case Get(resume) -> fun(st) { resume(st)(st) } 349 | case Put(st,resume) -> fun(_) { resume(())(st) } 350 | }; 351 | f(st0) 352 | } 353 | 354 | fun example6() { 355 | runState(0, fun() { 356 | var x = 3; 357 | put(x); 358 | assert(x == get(), "Put;Get"); 359 | var y = get(); 360 | var z = get(); 361 | assert(y == z, "Get;Get"); 362 | put(x+1); 363 | put(x+2); 364 | assert(get() == x + 2, "Put;Put") 365 | }) 366 | } 367 | 368 | ## 369 | ## State: file i/o 370 | ## 371 | typename FilePtr = Option(FileDescr); 372 | 373 | typename INode = (loc:Int,lno:Int); 374 | typename IList = [(Int, INode)]; # INode index -> INode 375 | typename Directory = [(String, Int)]; # Filename -> INode index 376 | typename DataRegion = [(Int, File)]; # Loc -> File 377 | 378 | typename FileSystem = (dir:Directory,dregion:DataRegion,inodes:IList 379 | ,lnext:Int ,inext:Int ); 380 | 381 | sig fsys0 : FileSystem 382 | var fsys0 = (dir = [("stdout", 0)], inodes = [(0, (loc=0, lno=1))], dregion = [(0, "")], lnext = 1, inext = 1); 383 | 384 | sig fopen : (String, FileSystem) {Fail:Zero |_}~> (Int, FileSystem) 385 | fun fopen(fname, fsys) { (lookup(fname, fsys.dir), fsys) } 386 | 387 | sig ftruncate : (Int, FileSystem) {Fail:Zero |_}~> FileSystem 388 | fun ftruncate(ino, fsys) { 389 | var inode = lookup(ino, fsys.inodes); 390 | var dregion = modify(inode.loc, "", fsys.dregion); 391 | (fsys with =dregion) 392 | } 393 | 394 | sig fcreate : (String, FileSystem) {Fail:Zero |_}~> (Int, FileSystem) 395 | fun fcreate(fname, fsys) { 396 | if (has(fname, fsys.dir)) { 397 | var (ino, fsys) = fopen(fname, fsys); 398 | (ino, ftruncate(ino, fsys)) 399 | } else { 400 | var loc = fsys.lnext; 401 | var dregion = (loc, "") :: fsys.dregion; 402 | 403 | var ino = fsys.inext; 404 | var inode = (loc=loc,lno=1); 405 | var inodes = (ino, inode) :: fsys.inodes; 406 | 407 | var dir = (fname, ino) :: fsys.dir; 408 | (ino, (=dir, =dregion, =inodes, lnext=loc+1, inext=ino+1)) 409 | } 410 | } 411 | 412 | sig ftruncate : (Int, FileSystem) {Fail:Zero |_}~> FileSystem 413 | fun ftruncate(ino, fsys) { 414 | var inode = lookup(ino, fsys.inodes); 415 | var dregion = modify(inode.loc, "", fsys.dregion); 416 | (fsys with =dregion) 417 | } 418 | 419 | sig fopen : (String, FileSystem) {Fail:Zero |_}~> Int 420 | fun fopen(fname, fsys) { lookup(fname, fsys.dir) } 421 | 422 | sig fclose : (Int, FileSystem) ~> FileSystem 423 | fun fclose(_, fsys) { fsys } 424 | 425 | sig fwrite : (Int, String, FileSystem) {Fail:Zero |_}~> FileSystem 426 | fun fwrite(ino, cs, fsys) { 427 | var inode = lookup(ino, fsys.inodes); 428 | var file = lookup(inode.loc, fsys.dregion); 429 | var file' = file ^^ cs; 430 | (fsys with dregion = modify(inode.loc, file', fsys.dregion)) 431 | } 432 | 433 | sig fread : (Int, FileSystem) {Fail:Zero |_}~> String 434 | fun fread(ino, fsys) { 435 | var inode = lookup(ino, fsys.inodes); 436 | lookup(inode.loc, fsys.dregion) 437 | } 438 | 439 | sig flink : (String, String, FileSystem) {Fail:Zero |_}~> FileSystem 440 | fun flink(src, dest, fsys) { 441 | var ino = lookup(dest, fsys.dir); 442 | var inode = lookup(ino, fsys.inodes); 443 | var inode' = (inode with lno = inode.lno + 1); 444 | var inodes = modify(ino, inode', fsys.inodes); 445 | 446 | var dir = (src, ino) :: fsys.dir; 447 | (fsys with inodes = inodes, dir = dir) 448 | } 449 | 450 | sig funlink : (String, FileSystem) {Fail:Zero |_}~> FileSystem 451 | fun funlink(fname, fsys) { 452 | var i = lookup(fname, fsys.dir); 453 | var dir = remove(fname, fsys.dir); 454 | 455 | var inode = lookup(i, fsys.inodes); 456 | var inode' = (inode with lno = inode.lno - 1); 457 | 458 | if (inode'.lno > 0) { 459 | var inodes = modify(i, inode', fsys.inodes); 460 | (fsys with inodes = inodes, dir = dir) 461 | } else { 462 | var dregion = remove(inode'.loc, fsys.dregion); 463 | var inodes = remove(i, fsys.inodes); 464 | (fsys with inodes = inodes, dir = dir, dregion = dregion) 465 | } 466 | } 467 | 468 | sig create : (String) {Create:(String) -> FileDescr |_}-> FileDescr 469 | fun create(fname) { do Create(fname) } 470 | 471 | sig truncate : (FileDescr) {Truncate:(FileDescr) -> () |_}-> () 472 | fun truncate(fd) { do Truncate(fd) } 473 | 474 | sig open' : (String) {Open:(String) -> Option(FileDescr) |_}-> Option(FileDescr) 475 | fun open'(fname) { do Open(fname) } 476 | 477 | sig close : (FileDescr) {Close:(FileDescr) -> () |_}-> () 478 | fun close(fd) { do Close(fd) } 479 | 480 | sig write : (FileDescr, String) {Write:(FileDescr, String) -> () |_}-> () 481 | fun write(fd, cs) { do Write(fd, cs) } 482 | 483 | sig read : (FileDescr) {Read:(FileDescr) -> Option(String) |_}-> Option(String) 484 | fun read(fd) { do Read(fd) } 485 | 486 | sig link : (String, String) {Link:(String, String) -> () |_}-> () 487 | fun link(src, dest) { do Link(src, dest) } 488 | 489 | sig unlink : (String) {Unlink:(String) -> () |_}-> () 490 | fun unlink(fname) { do Unlink(fname) } 491 | 492 | sig injectState : (() { |e}~> a) -> () {Get:s,Put:(s) -> () |e}~> a 493 | fun injectState(f) { (f : (() {Get:s,Put:(s) -> () |e}~> a) <- (() { |e}~> a)) } 494 | 495 | sig fileIO : (Comp(a, { #Close:(FileDescr) -> () 496 | Create:(String) -> FileDescr 497 | , Read:(FileDescr) -> Option(String) 498 | , Open:(String) -> Option(FileDescr) 499 | , Truncate:(FileDescr) -> () 500 | , Write:(FileDescr, String) -> () 501 | , Fail{p}|e})) 502 | {Create{_},Read{_},Open{_},Truncate{_},Write{_},Get:FileSystem,Put:(FileSystem) -> (),Fail{p} |e}~> a 503 | fun fileIO(m) { 504 | handle(injectState(m)()) { 505 | case Return(x) -> x 506 | case Create(fname, resume) -> 507 | var ino = withDefault(-1, fun() { 508 | var (ino, fsys) = fcreate(fname, get()); 509 | put(fsys); ino 510 | }); resume(ino) 511 | case Read(ino, resume) -> 512 | var contents = optionalise(fun() { fread(ino, get()) }); 513 | resume(contents) 514 | case Open(fname, resume) -> 515 | var ino = optionalise(fun() { fopen(fname, get()) }); 516 | resume(ino) 517 | case Truncate(ino, resume) -> 518 | withDefault((), fun() { 519 | var fsys = ftruncate(ino, get()); 520 | put(fsys) 521 | }); resume(()) 522 | case Write(ino, cs, resume) -> 523 | withDefault((), fun() { 524 | var fsys = fwrite(ino, cs, get()); 525 | put(fsys) 526 | }); resume(()) 527 | } 528 | } 529 | 530 | fun init(fsys, main) { 531 | runState(fsys, fun() { 532 | fileIO(fun() { 533 | timeshare(fun() { 534 | sessionmgr(Root, fun() { 535 | status(fun() { 536 | if(fork()) exit(0) else main() 537 | }) 538 | }) 539 | }) 540 | }) 541 | }) 542 | } 543 | 544 | ### 545 | ### Stream redirection 546 | ### 547 | sig >> : (Comp(a, { Create: (String) -> FileDescr 548 | , Write:(FileDescr, String) -> () |e}), String) 549 | { Create:(String) -> FileDescr 550 | , Write:(FileDescr, String) -> () |e}~> a 551 | op f >> fname { 552 | var fd = create(fname); 553 | handle(f()) { 554 | case Return(x) -> x 555 | case Write(_, cs, resume) -> 556 | resume(write(fd, cs)) 557 | } 558 | } 559 | 560 | sig >>> : (Comp(a, { Create: (String) -> FileDescr 561 | , Open: (String) -> Option (FileDescr) 562 | , Write:(FileDescr, String) -> () |e}), String) 563 | { Create:(String) -> FileDescr 564 | , Open:(String) -> Option (FileDescr) 565 | , Write:(FileDescr, String) -> () |e}~> () 566 | op f >>> fname { 567 | var fd = switch (open'(fname)) { 568 | case None -> create(fname) 569 | case Some(fd) -> fd 570 | }; 571 | handle(f()) { 572 | case Return(_) -> () 573 | case Write(_, cs, resume) -> 574 | resume(write(fd, cs)) 575 | } 576 | } 577 | 578 | fun example7() { 579 | if (fork()) { 580 | su(Alice); 581 | ritchie >> "ritchie.txt" 582 | } else { 583 | su(Bob); 584 | hamlet >> "hamlet" 585 | } 586 | } 587 | 588 | ### 589 | ### TCP threeway handshake 590 | ### 591 | 592 | sig strsplit : (Char, String) ~> [String] 593 | fun strsplit(c, str) { 594 | fun loop(c, str, i, j) { 595 | if (i >= strlen(str)) [strsub(str, j, i - j)] 596 | else if (charAt(str, i) == c) 597 | strsub(str, j, i - j) :: loop(c, str, i+1, i+1) 598 | else 599 | loop(c,str, i+1, j) 600 | } 601 | loop(c, str, 0, 0) 602 | } 603 | 604 | sig read1 : (FileDescr) {Read:(FileDescr) -> Option(String) |e}-> Option(String) 605 | fun read1(fd) { 606 | switch (read(fd)) { 607 | case Some("") -> None 608 | case x -> x 609 | } 610 | } 611 | 612 | sig truncread : (FileDescr) {Read:(FileDescr) -> Option(String),Truncate:(FileDescr) -> () |_}-> Option(String) 613 | fun truncread(fd) { 614 | var cs = read1(fd); 615 | truncate(fd); cs 616 | } 617 | 618 | sig synced : (Comp(Option(a), {Interrupt:() |e})) {Interrupt:() |e}~> a 619 | fun synced(f) { 620 | switch (f()) { 621 | case None -> interrupt(); synced(f) 622 | case Some(x) -> x 623 | } 624 | } 625 | 626 | sig fail : () {Fail:Zero |_}-> a 627 | fun fail() { switch(do Fail) {} } 628 | 629 | fun tcpclient(seq, inp, out) { 630 | write(out, "SYN " ^^ intToString(seq)); 631 | var resp = synced(fun() { truncread(inp) }); 632 | var [syn, ack] = strsplit(';', resp); 633 | var seqn = stringToInt(strsub(syn, 4, strlen(syn) - 4)); 634 | var ackn = stringToInt(strsub(ack, 4, strlen(ack) - 4)); 635 | if (ackn <> seq + 1) fail() 636 | else write(out, "ACK " ^^ intToString(seqn + 1)) 637 | } 638 | 639 | fun tcpserver(seq, inp, out) { 640 | var req = synced(fun() { truncread(inp) }); 641 | var reqn = stringToInt(strsub(req, 4, strlen(req) - 4)); 642 | var resp = "SYN " ^^ intToString(seq) ^^ ";ACK " ^^ intToString(reqn + 1); 643 | write(out, resp); 644 | var resp' = synced(fun() { truncread(inp) }); 645 | var ackn = stringToInt(strsub(resp', 4, strlen(resp') - 4)); 646 | if (ackn <> seq + 1) fail() 647 | else () 648 | } 649 | 650 | fun performTCP(tcpf, seq, inp, out) { 651 | var fd = create(whoami() ^^ ".log"); 652 | handle(tcpf(seq, inp, out)) { 653 | case Return(_) -> write(fd, "Handshake completed.") 654 | case Fail(_) -> write(fd, "Handshake failed.") 655 | } 656 | } 657 | 658 | fun tcphandshake() { 659 | var (cfd, sfd) = (create("client.sock"), create("server.sock")); 660 | if (fork()) { 661 | su(Alice); 662 | performTCP(tcpclient, 42, cfd, sfd) 663 | } else { 664 | su(Bob); 665 | performTCP(tcpserver, 84, sfd, cfd) 666 | } 667 | } 668 | 669 | fun tcphandshakeFail() { 670 | var (cfd, sfd) = (create("client.sock"), create("server.sock")); 671 | if (fork()) { 672 | su(Alice); 673 | handle(performTCP(tcpclient, 42, cfd, sfd)) { 674 | case Write(fd, cs, resume) -> 675 | resume(if (strsub(cs, 0, 3) == "ACK") write(fd, "ACK 0") 676 | else write(fd, cs)) 677 | } 678 | } else { 679 | su(Bob); 680 | performTCP(tcpserver, 84, sfd, cfd) 681 | } 682 | } 683 | 684 | # 685 | # Grep 686 | # 687 | #sig grep : (String) {Await:Char,Yield:(Char) -> () |_}~> () 688 | fun grep(str) { 689 | var cs = explode(str); 690 | fun match(c,cs) { 691 | switch (cs) { 692 | case c' :: cs' -> 693 | if (c == '\n') fail() 694 | if (c == c') 695 | } 696 | } 697 | } 698 | -------------------------------------------------------------------------------- /macros.tex: -------------------------------------------------------------------------------- 1 | %% 2 | %% Defined-as equality 3 | %% 4 | \newcommand{\defas}[0]{\mathrel{\overset{\makebox[0pt]{\mbox{\normalfont\tiny\text{def}}}}{=}}} 5 | \newcommand{\defnas}[0]{\mathrel{:=}} 6 | \newcommand{\simdefas}[0]{\mathrel{\overset{\makebox[0pt]{\mbox{\normalfont\tiny\text{def}}}}{\simeq}}} 7 | \newcommand{\adef}[0]{\mathrel{\overset{\makebox[0pt]{\mbox{\normalfont\tiny{\text{$\alpha$-def}}}}}{\simeq}}} 8 | 9 | %% 10 | %% Some useful maths abbreviations 11 | %% 12 | \newcommand{\C}{\ensuremath{\mathbb{C}}} 13 | \newcommand{\N}{\ensuremath{\mathbb{N}}} 14 | \newcommand{\R}{\ensuremath{\mathbb{R}}} 15 | \newcommand{\Z}{\ensuremath{\mathbb{Z}}} 16 | \newcommand{\B}{\ensuremath{\mathbb{B}}} 17 | \newcommand{\BB}[1]{\ensuremath{\mathbf{#1}}} 18 | \newcommand{\CC}{\keyw{ctrl}} 19 | % \newcommand{\Delim}[1]{\ensuremath{\langle\!\!\mkern-1.5mu\langle#1\rangle\!\!\mkern-1.5mu\rangle}} 20 | \newcommand{\Delim}[1]{\ensuremath{\keyw{del}.#1}} 21 | \newcommand{\sembr}[1]{\ensuremath{\llbracket #1 \rrbracket}} 22 | \newcommand{\BigO}{\ensuremath{\mathcal{O}}} 23 | \newcommand{\SC}{\ensuremath{\mathsf{S}}} 24 | \newcommand{\ST}{\ensuremath{\mathsf{T}}} 25 | \newcommand{\ar}{\ensuremath{\mathsf{ar}}} 26 | \newcommand{\Tm}{\ensuremath{\mathsf{Tm}}} 27 | \newcommand{\Ty}{\ensuremath{\mathsf{Ty}}} 28 | 29 | %% 30 | %% Partiality 31 | %% 32 | \newcommand{\pto}[0]{\ensuremath{\rightharpoonup}} 33 | 34 | %% 35 | %% Operation arrows 36 | %% 37 | \newcommand{\opto}[0]{\ensuremath{\twoheadrightarrow}} 38 | 39 | %% 40 | %% Calculi names. 41 | %% 42 | \newcommand{\Links}{Links\xspace} 43 | \newcommand{\CoreLinks}{\ensuremath{\mathsf{CoreLinks}}\xspace} 44 | \newcommand{\BCalc}{\ensuremath{\lambda_{\mathsf{b}}}\xspace} 45 | \newcommand{\BCalcRec}{\ensuremath{\lambda_{\mathsf{b}+\mathsf{rec}}}\xspace} 46 | \newcommand{\HCalc}{\ensuremath{\lambda_{\mathsf{h}}}\xspace} 47 | \newcommand{\SCalc}{\ensuremath{\lambda_{\mathsf{h^\dagger}}}\xspace} 48 | \newcommand{\HSCalc}{\ensuremath{\lambda_{\mathsf{h^\delta}}}\xspace} 49 | \newcommand{\EffCalc}{\ensuremath{\lambda_{\mathsf{eff}}}\xspace} 50 | \newcommand{\UCalc}{\ensuremath{\lambda_{\mathsf{u}}}\xspace} 51 | \newcommand{\param}{\ensuremath{\ddagger}} 52 | \newcommand{\HPCalc}{\ensuremath{\lambda_{\mathsf{h^\param}}}\xspace} 53 | \newcommand{\HPCF}{\ensuremath{\lambda^\rightarrow_{\mathsf{h}}}\xspace} 54 | \newcommand{\BPCF}{\ensuremath{\lambda^\rightarrow_{\mathsf{b}}}\xspace} 55 | 56 | %% 57 | %% Calculi terms and types type-setting. 58 | %% 59 | \newcommand{\revto}{\ensuremath{\leftarrow}} 60 | 61 | \newcommand{\dec}[1]{\mathsf{#1}} 62 | \newcommand{\keyw}[1]{\mathbf{#1}} 63 | \newcommand{\Handle}{\keyw{handle}} 64 | \newcommand{\ParamHandle}{\Handle^\param} 65 | \newcommand{\ShallowHandle}{\ensuremath{\keyw{handle}^\dagger}} 66 | \newcommand{\With}{\keyw{with}} 67 | \newcommand{\Let}{\keyw{let}} 68 | \newcommand{\Rec}{\keyw{rec}} 69 | \newcommand{\In}{\keyw{in}} 70 | \newcommand{\Do}{\keyw{do}} 71 | \newcommand{\Return}{\keyw{return}} 72 | \newcommand{\Val}{\keyw{val}} 73 | \newcommand{\Case}{\keyw{case}} 74 | \newcommand{\If}{\keyw{if}} 75 | \newcommand{\Then}{\keyw{then}} 76 | \newcommand{\Else}{\keyw{else}} 77 | \newcommand{\Absurd}{\keyw{absurd}} 78 | \newcommand{\Record}[1]{\ensuremath{\langle #1 \rangle}} 79 | \newcommand{\Op}[1]{\ensuremath{\langle\!\!\langle #1 \rangle\!\!\rangle}} 80 | %\newcommand{\Op}[1]{\ensuremath{\{#1\}}} 81 | \newcommand{\OpCase}[3]{\Op{#1~#2 \opto #3}} 82 | \newcommand{\ExnCase}[2]{\Op{#1~#2}} 83 | \newcommand{\Unit}{\Record{}} 84 | \newcommand{\Inl}{\keyw{inl}} 85 | \newcommand{\Inr}{\keyw{inr}} 86 | \newcommand{\Thunk}{\lambda \Unit.} 87 | \newcommand{\PCFRef}{\dec{Ref}} 88 | \newcommand{\refv}{\keyw{ref}} 89 | 90 | \newcommand{\Pre}[1]{\mathsf{Pre}(#1)} 91 | \newcommand{\Abs}{\mathsf{Abs}} 92 | \newcommand{\Presence}{\mathsf{Presence}} 93 | \newcommand{\Row}{\mathsf{Row}} 94 | \newcommand{\Type}{\mathsf{Type}} 95 | \newcommand{\Ground}{\mathsf{ground}} 96 | 97 | \newcommand{\Comp}{\mathsf{Comp}} 98 | \newcommand{\Effect}{\mathsf{Effect}} 99 | \newcommand{\Handler}{\mathsf{Handler}} 100 | 101 | \newcommand{\ZeroType}{0} 102 | \newcommand{\UnitType}{1} 103 | \newcommand{\One}{1} 104 | \newcommand{\Int}{\mathsf{Int}} 105 | \newcommand{\Float}{\mathsf{Float}} 106 | \newcommand{\Bool}{\mathsf{Bool}} 107 | \newcommand{\List}{\mathsf{List}} 108 | \newcommand{\Nat}{\mathsf{Nat}} 109 | \newcommand{\Choose}{\dec{Choose}} 110 | \newcommand{\Count}{\dec{count}} 111 | \newcommand{\GenericSearch}{\dec{genericSearch}} 112 | \newcommand{\Predicate}{\dec{Predicate}} 113 | \newcommand{\Point}{\dec{Point}} 114 | \newcommand{\Branch}{\dec{Branch}} 115 | \newcommand{\Get}{\dec{Get}} 116 | \newcommand{\Put}{\dec{Put}} 117 | \newcommand{\Zero}{\dec{Zero}} 118 | \newcommand{\Fail}{\dec{Fail}} 119 | \newcommand{\Read}{\dec{Read}} 120 | \newcommand{\Write}{\dec{Write}} 121 | \newcommand{\Char}{\dec{Char}} 122 | \newcommand{\String}{\dec{String}} 123 | 124 | \newcommand{\True}{\mathsf{true}} 125 | \newcommand{\False}{\mathsf{false}} 126 | 127 | \newcommand{\eff}{!} 128 | \newcommand{\typ}[2]{#1 \vdash #2} 129 | \newcommand{\typv}[2]{#1 \vdash #2} 130 | \newcommand{\typc}[3]{#1 \vdash #2 \eff #3} 131 | \newcommand{\Harrow}{\Rightarrow} 132 | 133 | \newcommand{\FTV}{\ensuremath{\mathrm{FTV}}} 134 | \newcommand{\FV}{\ensuremath{\mathrm{FV}}} 135 | 136 | \newcommand{\reducesto}[0]{\ensuremath{\leadsto}} 137 | \newcommand{\areducesto}{\ensuremath{\reducesto_{\textrm{a}}}} 138 | \newcommand{\stepsto}[0]{\ensuremath{\longrightarrow}} 139 | \newcommand{\Stepsto}{\Longrightarrow} 140 | \newcommand{\EC}{\ensuremath{\mathcal{E}}} 141 | 142 | \newcommand{\BL}{\ensuremath{\mathsf{BL}}} 143 | 144 | \newcommand{\dom}{\ensuremath{\mathsf{dom}}} 145 | 146 | \newcommand{\Res}{\keyw{res}} 147 | 148 | \newcommand{\Cong}{\mathrm{cong}} 149 | 150 | \newcommand{\AlgTheory}{\ensuremath{\mathcal{T}}} 151 | 152 | %% Handler projections. 153 | \newcommand{\mret}{\mathrm{ret}} 154 | \newcommand{\mops}{\mathrm{ops}} 155 | \newcommand{\hret}{H^{\mret}} 156 | \newcommand{\hval}{\hret} 157 | \newcommand{\hops}{H^{\mops}} 158 | %\newcommand{\hex}{H^{\mathrm{ex}}} 159 | \newcommand{\hell}{H^{\ell}} 160 | \newcommand{\gell}{\theta^{\ell}} 161 | 162 | \newcommand{\depth}{\delta} 163 | 164 | \newcommand{\alertbox}[2]{{\par\noindent\small\color{red} \framebox{\parbox{\dimexpr\linewidth-2\fboxsep-2\fboxrule}{\textbf{#1:} #2}}}} 165 | \newcommand{\todo}[1]{\alertbox{TODO}{#1}} 166 | \newcommand{\dhil}[1]{\alertbox{Daniel}{#1}} 167 | 168 | %% 169 | %% Labels 170 | %% 171 | \newcommand{\slab}[1]{\ensuremath{\mathsf{#1}}} 172 | \newcommand{\rulelabel}[2]{\ensuremath{\mathsf{#1\textrm{-}#2}}} 173 | \newcommand{\klab}[1]{\rulelabel{K}{#1}} 174 | \newcommand{\semlab}[1]{\rulelabel{S}{#1}} 175 | \newcommand{\usemlab}[1]{\rulelabel{U}{#1}} 176 | \newcommand{\tylab}[1]{\rulelabel{T}{#1}} 177 | \newcommand{\mlab}[1]{\rulelabel{M}{#1}} 178 | \newcommand{\siglab}[1]{\rulelabel{Sig}{#1}} 179 | \newcommand{\rowlab}[1]{\rulelabel{R}{#1}} 180 | 181 | %% 182 | %% Syntactic categories. 183 | %% 184 | \newcommand{\CatName}[1]{\textrm{#1}} 185 | \newcommand{\CompCat}{\CatName{Comp}} 186 | \newcommand{\UCompCat}{\CatName{UComp}} 187 | \newcommand{\UValCat}{\CatName{UVal}} 188 | \newcommand{\SCompCat}{\CatName{SComp}} 189 | \newcommand{\SValCat}{\CatName{SVal}} 190 | \newcommand{\SPatCat}{\CatName{SPat}} 191 | \newcommand{\ValCat}{\CatName{Val}} 192 | \newcommand{\VarCat}{\CatName{Var}} 193 | \newcommand{\ValTypeCat}{\CatName{VType}} 194 | \newcommand{\CompTypeCat}{\CatName{CType}} 195 | \newcommand{\HandlerTypeCat}{\CatName{HType}} 196 | \newcommand{\PresenceCat}{\CatName{Presence}} 197 | \newcommand{\TypeCat}{\CatName{Type}} 198 | \newcommand{\TyVarCat}{\CatName{TVar}} 199 | \newcommand{\KindCat}{\CatName{Kind}} 200 | \newcommand{\RowCat}{\CatName{Row}} 201 | \newcommand{\EffectCat}{\CatName{Effect}} 202 | \newcommand{\TermCat}{\CatName{Term}} 203 | \newcommand{\LabelCat}{\CatName{Label}} 204 | \newcommand{\TyEnvCat}{\CatName{TyEnv}} 205 | \newcommand{\KindEnvCat}{\CatName{KindEnv}} 206 | \newcommand{\EvalCat}{\CatName{Cont}} 207 | \newcommand{\UEvalCat}{\CatName{UCont}} 208 | \newcommand{\HandlerCat}{\CatName{HDef}} 209 | \newcommand{\MConfCat}{\CatName{Conf}} 210 | \newcommand{\MEnvCat}{\CatName{Env}} 211 | \newcommand{\MValCat}{\CatName{Mval}} 212 | \newcommand{\MGContCat}{\CatName{GenCont}} 213 | \newcommand{\MGFrameCat}{\CatName{GenFrame}} 214 | \newcommand{\MPContCat}{\CatName{PureCont}} 215 | \newcommand{\MPFrameCat}{\CatName{PureFrame}} 216 | \newcommand{\MHCloCat}{\CatName{HClo}} 217 | 218 | %% 219 | %% Lindley's array stuff. 220 | %% 221 | \newcommand{\ba}{\begin{array}} 222 | \newcommand{\ea}{\end{array}} 223 | 224 | \newcommand{\bl}{\ba[t]{@{}l@{}}} 225 | \newcommand{\el}{\ea} 226 | 227 | 228 | %% 229 | %% Lindley's syntax, reductions, equations, and derivation environments. 230 | %% 231 | \newenvironment{syntax}{\[\ba{@{}l@{\quad}r@{~}c@{~}l@{}}}{\ea\]\ignorespacesafterend} 232 | \newenvironment{reductions}{\[\ba{@{}l@{\qquad}@{}r@{~~}c@{~~}l@{}}}{\ea\]\ignorespacesafterend} 233 | 234 | \newenvironment{eqs}{\ba{@{}r@{~}c@{~}l@{}}}{\ea} 235 | \newenvironment{equations}{\[\ba{@{}r@{~}c@{~}l@{}}}{\ea\]\ignorespacesafterend} 236 | \newcommand\numberthis{\addtocounter{equation}{1}\tag{$\ast$\theequation}} % Numbering equations 237 | \newenvironment{derivation}{\begin{displaymath}\ba{@{}r@{~}l@{}}}{\ea\end{displaymath}\ignorespacesafterend} 238 | \newcommand{\reason}[1]{\quad (\text{#1})} 239 | 240 | 241 | \newenvironment{smathpar}{\vspace{-3ex}\small\begin{mathpar}}{\end{mathpar}\normalsize\ignorespacesafterend} 242 | 243 | %% 244 | %% Lists 245 | %% 246 | \newcommand{\nil}{\ensuremath{[]}} 247 | \newcommand{\cons}{\ensuremath{::}} 248 | 249 | \newcommand{\concat}{\mathbin{+\!\!+}} 250 | \newcommand{\revconcat}{\mathbin{\widehat{\concat}}} 251 | \newcommand{\snoc}[2]{\ensuremath{#1 \concat [#2]}} 252 | 253 | %% 254 | %% CPS notation 255 | %% 256 | % static / dynamic stuff 257 | \newcommand{\scol}[1]{{\color{blue}#1}} 258 | \newcommand{\dcol}[1]{{\color{red}#1}} 259 | 260 | \newcommand{\static}[1]{\scol{\overline{#1}}} 261 | \newcommand{\dynamic}[1]{\dcol{\underline{#1}}} 262 | \newcommand{\nary}[1]{\overline{#1}} 263 | 264 | \newcommand{\slam}{\static{\lambda}} 265 | \newcommand{\dlam}{\dynamic{\lambda}} 266 | \newcommand{\sapp}{\mathbin{\static{@}}} 267 | \newcommand{\dapp}{\mathbin{\dynamic{@}}} 268 | 269 | \newcommand{\reify}{\mathord{\downarrow}} 270 | \newcommand{\reflect}{\mathord{\uparrow}} 271 | 272 | \newcommand{\scons}{\mathbin{\static{\cons}}} 273 | \newcommand{\dcons}{\mathbin{\dynamic{\cons}}} 274 | 275 | \newcommand{\snil}{\static{\nil}} 276 | \newcommand{\dnil}{\dynamic{\nil}} 277 | 278 | \newcommand{\sRecord}[1]{\static{\langle}#1\static{\rangle}} 279 | \newcommand{\dRecord}[1]{\dynamic{\langle}#1\dynamic{\rangle}} 280 | 281 | \newcommand{\sQ}{\mathcal{Q}} 282 | \newcommand{\sV}{\mathcal{V}} 283 | \newcommand{\sW}{\mathcal{W}} 284 | 285 | \newcommand{\sM}{\mathcal{M}} 286 | \renewcommand{\snil}{\reflect \dnil} 287 | 288 | \newcommand{\cps}[1]{\ensuremath{\llbracket #1 \rrbracket}} 289 | \newcommand{\pcps}[1]{\top\cps{#1}} 290 | 291 | \newcommand{\hforward}{M_{\textrm{forward}}} 292 | \newcommand{\hid}{V_{\textrm{id}}} 293 | 294 | % continuation application 295 | \newcommand{\kapp}{\keyw{app}} 296 | 297 | %%% Continuation names 298 | %%% The following set of macros are a bit more consistent with those 299 | %%% currently used by the abstract machine, and don't use the plural 300 | %%% convention of functional programming. 301 | 302 | % dynamic 303 | \newcommand{\dlf}{f} % let frames 304 | \newcommand{\dlk}{fs} % let continuations 305 | \newcommand{\dhf}{q} % handler frames 306 | \newcommand{\dhk}{ks} % handler continuations 307 | \newcommand{\dhkr}{rs} % reverse handler continuations 308 | \newcommand{\dLet}{\dynamic{\Let}} 309 | \newcommand{\dIn}{\dynamic{\In}} 310 | 311 | % static 312 | \newcommand{\slf}{\phi} % let frames 313 | \newcommand{\slk}{\sigma} % let continuations 314 | \newcommand{\shf}{\theta} % handler frames 315 | \newcommand{\shk}{\kappa} % handler continuations 316 | \newcommand{\sLet}{\static{\Let}} 317 | \newcommand{\sIn}{\static{\In}} 318 | % \newcommand{\sk}{\kappa} 319 | % \newcommand{\sks}{\mathit{\kappa s}} 320 | \newcommand{\sks}{\kappa} 321 | % \newcommand{\sh}{\eta} 322 | \newcommand{\sk}{\theta} 323 | \newcommand{\sh}{\chi} 324 | \newcommand{\sx}{\varepsilon} 325 | 326 | \newcommand{\sP}{\mathcal{P}} 327 | \newcommand{\VS}{VS} 328 | \newcommand{\Vmap}{\keyw{vmap}} 329 | \newcommand{\Vmapsnd}{\keyw{vmapsnd}} 330 | \newcommand{\Fun}{\keyw{fun}} 331 | 332 | % Canonical variables for handler components 333 | \newcommand{\vhret}{h^{\mret}} 334 | \newcommand{\vhops}{h^{\mops}} 335 | \newcommand{\sv}{\chi} 336 | \newcommand{\svhret}{\sv^{\mret}} 337 | \newcommand{\svhops}{\sv^{\mops}} 338 | 339 | % \newcommand{\dk}{\dRecord{fs,\dRecord{\vhret,\vhops}}} 340 | \newcommand{\dk}{k} 341 | 342 | % 343 | \renewcommand{\hid}{V_{\mops}} 344 | \newcommand{\kid}{V_\mathrm{id}} 345 | \newcommand{\rid}{V_{\mret}} 346 | 347 | % Examples 348 | \newcommand{\Pipe}{\dec{pipe}} 349 | \newcommand{\Copipe}{\dec{copipe}} 350 | \newcommand{\Ones}{\dec{ones}} 351 | \newcommand{\Yield}{\dec{Yield}} 352 | \newcommand{\Await}{\dec{Await}} 353 | \newcommand{\AddTwo}{\ensuremath{\dec{add}_2}} 354 | \newcommand{\Option}{\dec{Option}} 355 | \newcommand{\Some}{\dec{Some}} 356 | \newcommand{\None}{\dec{None}} 357 | \newcommand{\Toss}{\dec{Toss}} 358 | \newcommand{\toss}{\dec{toss}} 359 | \newcommand{\Heads}{\dec{Heads}} 360 | \newcommand{\Tails}{\dec{Tails}} 361 | \newcommand{\Exn}{\dec{Exn}} 362 | \newcommand{\fail}{\dec{fail}} 363 | \newcommand{\optionalise}{\dec{optionalise}} 364 | \newcommand{\bind}{\ensuremath{\gg\!=}} 365 | \newcommand{\return}{\dec{Return}} 366 | \newcommand{\faild}{\dec{withDefault}} 367 | \newcommand{\Free}{\dec{Free}} 368 | \newcommand{\FreeState}{\dec{FreeState}} 369 | \newcommand{\OpF}{\dec{Op}} 370 | \newcommand{\DoF}{\dec{do}} 371 | \newcommand{\getF}{\dec{get}} 372 | \newcommand{\putF}{\dec{put}} 373 | \newcommand{\fmap}{\dec{fmap}} 374 | \newcommand{\toggle}{\dec{toggle}} 375 | \newcommand{\incrEven}{\dec{incrEven}} 376 | \newcommand{\even}{\dec{even}} 377 | 378 | % Abstract machine 379 | \newcommand{\cek}[1]{\ensuremath{\langle #1 \rangle}} 380 | % Environments 381 | \newcommand{\env}{\ensuremath{\gamma}} 382 | % restrict an environment 383 | \newcommand{\res}{\backslash} 384 | 385 | % abstract machine translations 386 | \newcommand{\val}[2]{\llbracket #1 \rrbracket #2} 387 | \newcommand{\inv}[1]{\llparenthesis #1 \rrparenthesis} 388 | 389 | % configurations 390 | \newcommand{\conf}{\mathcal{C}} 391 | 392 | % effect sugar 393 | \newcommand{\inward}[1]{\mathcal{I}\sembr{#1}} 394 | \newcommand{\outward}[1]{\mathcal{O}\sembr{#1}} 395 | \newcommand{\xcomp}[1]{\outward{#1}} 396 | \newcommand{\xval}[1]{\outward{#1}} 397 | \newcommand{\xpre}[1]{\outward{#1}} 398 | \newcommand{\xrow}[1]{\outward{#1}} 399 | \newcommand{\xeff}[1]{\outward{#1}} 400 | \newcommand{\pcomp}[1]{\inward{#1}} 401 | \newcommand{\pval}[1]{\inward{#1}} 402 | \newcommand{\ppre}[1]{\inward{#1}} 403 | \newcommand{\prow}[1]{\inward{#1}} 404 | \newcommand{\peff}[1]{\inward{#1}} 405 | \newcommand{\eamb}{\ensuremath{E_{\mathsf{amb}}}} 406 | \newcommand{\trval}[1]{\mathcal{T}\sembr{#1}} 407 | 408 | % UNIX example 409 | \newcommand{\UNIX}{UNIX} 410 | \newcommand{\OSname}[0]{Tiny UNIX} 411 | \newcommand{\exit}{\dec{exit}} 412 | \newcommand{\Exit}{\dec{Exit}} 413 | \newcommand{\Status}{\dec{Status}} 414 | \newcommand{\status}{\dec{status}} 415 | \newcommand{\basicIO}{\dec{basicIO}} 416 | \newcommand{\Putc}{\dec{Putc}} 417 | \newcommand{\putc}{\dec{putc}} 418 | \newcommand{\UFile}{\dec{File}} 419 | \newcommand{\UFD}{\dec{FileDescr}} 420 | \newcommand{\fwrite}{\dec{fwrite}} 421 | \newcommand{\iter}{\dec{iter}} 422 | \newcommand{\map}{\dec{map}} 423 | \newcommand{\stdout}{\dec{stdout}} 424 | \newcommand{\IO}{\dec{IO}} 425 | \newcommand{\BIO}{\dec{BIO}} 426 | \newcommand{\Alice}{\dec{Alice}} 427 | \newcommand{\Bob}{\dec{Bob}} 428 | \newcommand{\Root}{\dec{Root}} 429 | \newcommand{\User}{\dec{User}} 430 | \newcommand{\environment}{\dec{env}} 431 | \newcommand{\EnvE}{\dec{Session}} 432 | \newcommand{\Ask}{\dec{Ask}} 433 | \newcommand{\whoami}{\dec{whoami}} 434 | \newcommand{\Su}{\dec{Su}} 435 | \newcommand{\su}{\dec{su}} 436 | \newcommand{\sessionmgr}{\dec{sessionmgr}} 437 | \newcommand{\echo}{\dec{echo}} 438 | \newcommand{\strlit}[1]{\texttt{"#1"}} 439 | \newcommand{\nondet}{\dec{nondet}} 440 | \newcommand{\Fork}{\dec{Fork}} 441 | \newcommand{\fork}{\dec{fork}} 442 | \newcommand{\Interrupt}{\dec{Interrupt}} 443 | \newcommand{\interrupt}{\dec{interrupt}} 444 | \newcommand{\Pstate}{\dec{Pstate}} 445 | \newcommand{\Done}{\dec{Done}} 446 | \newcommand{\Suspended}{\dec{Paused}} 447 | \newcommand{\slice}{\dec{slice}} 448 | \newcommand{\reifyP}{\dec{reifyProcess}} 449 | \newcommand{\timeshare}{\dec{timeshare}} 450 | \newcommand{\runNext}{\dec{runNext}} 451 | \newcommand{\concatMap}{\dec{concatMap}} 452 | \newcommand{\State}{\dec{State}} 453 | \newcommand{\runState}{\dec{runState}} 454 | \newcommand{\Uget}{\dec{get}} 455 | \newcommand{\Uput}{\dec{put}} 456 | \newcommand{\nl}{\textbackslash{}n} 457 | \newcommand{\quoteRitchie}{\dec{ritchie}} 458 | \newcommand{\quoteHamlet}{\dec{hamlet}} 459 | \newcommand{\Proc}{\dec{Proc}} 460 | \newcommand{\schedule}{\dec{schedule}} 461 | \newcommand{\fsname}{BSFS} 462 | \newcommand{\FileSystem}{\dec{FileSystem}} 463 | \newcommand{\Directory}{\dec{Directory}} 464 | \newcommand{\DataRegion}{\dec{DataRegion}} 465 | \newcommand{\INode}{\dec{INode}} 466 | \newcommand{\IList}{\dec{IList}} 467 | \newcommand{\fileRW}{\dec{fileRW}} 468 | \newcommand{\fileAlloc}{\dec{fileCO}} 469 | \newcommand{\URead}{\dec{Read}} 470 | \newcommand{\UWrite}{\dec{Write}} 471 | \newcommand{\UCreate}{\dec{Create}} 472 | \newcommand{\UOpen}{\dec{Open}} 473 | \newcommand{\fread}{\dec{fread}} 474 | \newcommand{\fcreate}{\dec{fcreate}} 475 | \newcommand{\Ucreate}{\dec{create}} 476 | \newcommand{\redirect}{\texttt{>}} 477 | \newcommand{\fopen}{\dec{fopen}} 478 | \newcommand{\lookup}{\dec{lookup}} 479 | \newcommand{\modify}{\dec{modify}} 480 | \newcommand{\fileIO}{\dec{fileIO}} 481 | \newcommand{\ULink}{\dec{Link}} 482 | \newcommand{\UUnlink}{\dec{Unlink}} 483 | \newcommand{\flink}{\dec{flink}} 484 | \newcommand{\funlink}{\dec{funlink}} 485 | \newcommand{\remove}{\dec{remove}} 486 | \newcommand{\FileLU}{\dec{FileLU}} 487 | \newcommand{\fileLU}{\dec{fileLU}} 488 | \newcommand{\FileIO}{\dec{FileIO}} 489 | \newcommand{\FileRW}{\dec{FileRW}} 490 | \newcommand{\FileCO}{\dec{FileCO}} 491 | \newcommand{\cat}{\dec{cat}} 492 | \newcommand{\head}{\dec{head}} 493 | \newcommand{\grep}{\dec{grep}} 494 | \newcommand{\match}{\dec{match}} 495 | \newcommand{\wc}{\dec{wc}} 496 | \newcommand{\forever}{\dec{forever}} 497 | \newcommand{\textnil}{\textbackslash{}0} 498 | \newcommand{\charlit}[1]{\texttt{'#1'}} 499 | \newcommand{\where}{\keyw{where}} 500 | \newcommand{\intToString}{\dec{intToString}} 501 | \newcommand{\freq}{\dec{freq}} 502 | \newcommand{\paste}{\dec{paste}} 503 | \newcommand{\sed}{\dec{sed}} 504 | \newcommand{\printTable}{\dec{renderTable}} 505 | \newcommand{\timesharee}{\dec{timeshare2}} 506 | \newcommand{\Co}{\dec{Co}} 507 | \newcommand{\UFork}{\dec{UFork}} 508 | \newcommand{\ufork}{\dec{ufork}} 509 | \newcommand{\Wait}{\dec{Wait}} 510 | \newcommand{\scheduler}{\dec{scheduler}} 511 | \newcommand{\Sstate}{\dec{Sstate}} 512 | \newcommand{\Ready}{\dec{Ready}} 513 | \newcommand{\Blocked}{\dec{Blocked}} 514 | \newcommand{\init}{\dec{init}} 515 | \newcommand{\Reader}{\dec{Reader}} 516 | \newcommand{\Other}{\dec{Other}} 517 | 518 | %% 519 | %% Some control operators 520 | %% 521 | \newcommand{\Cupto}{\keyw{cupto}} 522 | \newcommand{\Set}{\keyw{set}} 523 | \newcommand{\newPrompt}{\keyw{newPrompt}} 524 | \newcommand{\Callcc}{\keyw{callcc}} 525 | \newcommand{\Callcomc}{\ensuremath{\keyw{callcomp}}} 526 | \newcommand{\textCallcomc}{callcomp} 527 | \newcommand{\Throw}{\keyw{throw}} 528 | \newcommand{\Continue}{\keyw{resume}} 529 | \newcommand{\Catch}{\keyw{catch}} 530 | \newcommand{\Catchcont}{\keyw{catchcont}} 531 | \newcommand{\Control}{\keyw{control}} 532 | \newcommand{\Prompt}{\#} 533 | \newcommand{\Controlz}{\ensuremath{\keyw{control_0}}} 534 | \newcommand{\Spawn}{\keyw{spawn}} 535 | \newcommand{\Promptz}{\ensuremath{\#_0}} 536 | \newcommand{\Escape}{\keyw{escape}} 537 | \newcommand{\shift}{\keyw{shift}} 538 | \newcommand{\shiftz}{\ensuremath{\keyw{shift_0}}} 539 | \newcommand{\CCpp}{\ensuremath{+\CC+}} 540 | \newcommand{\CCpm}{\ensuremath{+\CC-}} 541 | \newcommand{\CCmp}{\ensuremath{-\CC+}} 542 | \newcommand{\CCmm}{\ensuremath{-\CC-}} 543 | \def\sigh#1{% 544 | \pmb{\left\langle\vphantom{#1}\right.}% 545 | #1% 546 | \pmb{\left.\vphantom{#1}\right\rangle}} 547 | \newcommand{\llambda}{\ensuremath{\pmb{\lambda}}} 548 | \newcommand{\reset}[1]{\pmb{\langle} #1 \pmb{\rangle}} 549 | \newcommand{\resetz}[1]{\pmb{\langle} #1 \pmb{\rangle}_0} 550 | \newcommand{\dollarz}[2]{\ensuremath{\reset{#2 \mid #1}}} 551 | \newcommand{\dollarzh}[2]{\ensuremath{#1\,\$_0#2}} 552 | \newcommand{\fcontrol}{\keyw{fcontrol}} 553 | \newcommand{\fprompt}{\%} 554 | \newcommand{\splitter}{\keyw{splitter}} 555 | \newcommand{\abort}{\keyw{abort}} 556 | \newcommand{\calldc}{\keyw{calldc}} 557 | \newcommand{\J}{\keyw{J}} 558 | \newcommand{\JI}{\keyw{J}\,\keyw{I}} 559 | \newcommand{\FelleisenC}{\ensuremath{\keyw{C}}} 560 | \newcommand{\FelleisenF}{\ensuremath{\keyw{F}}} 561 | \newcommand{\cont}{\keyw{cont}} 562 | \newcommand{\Cont}{\dec{Cont}} 563 | \newcommand{\Algol}{Algol~60} 564 | \newcommand{\qq}[1]{\ensuremath{\ulcorner #1 \urcorner}} 565 | \newcommand{\prompttype}{\dec{Prompt}} 566 | \newcommand{\async}{\keyw{async}} 567 | \newcommand{\await}{\keyw{await}} 568 | 569 | % Language macros 570 | \newcommand{\Frank}{Frank} 571 | \newcommand{\SML}{SML} 572 | \newcommand{\SMLNJ}{\SML{}/NJ} 573 | \newcommand{\OCaml}{OCaml} 574 | 575 | 576 | %% 577 | %% Asymptotic improvement macros 578 | %% 579 | \newcommand{\LLL}{\ensuremath{\mathcal L}} 580 | \newcommand{\naive}{naïve\xspace} 581 | \newcommand{\naively}{naïvely\xspace} 582 | \newcommand{\Naive}{Naïve\xspace} 583 | \newcommand{\sem}[1]{\ensuremath{\pi_{#1}}} 584 | \newcommand{\Iff}{\Leftrightarrow} 585 | \newcommand{\Implies}{\Rightarrow} 586 | \newcommand{\BCalcS}{\ensuremath{\lambda_{\textrm{\normalfont s}}\xspace}} 587 | \newcommand{\BCalcE}{\ensuremath{\lambda_{\textrm{\normalfont e}}\xspace}} 588 | \newcommand{\BCalcSE}{\ensuremath{\lambda_{\textrm{\normalfont se}}\xspace}} 589 | \newcommand{\BSPCF}{\ensuremath{\lambda^\rightarrow_{\textrm{\normalfont s}}\xspace}} 590 | \newcommand{\BEPCF}{\ensuremath{\lambda^\rightarrow_{\textrm{\normalfont e}}\xspace}} 591 | \newcommand{\BSEPCF}{\ensuremath{\lambda^\rightarrow_{\textrm{\normalfont se}}\xspace}} 592 | \newcommand{\IfZero}{\keyw{ifzero}} 593 | \newcommand{\Superpoint}{\lambda\_.\Do\;\Branch~\Unit} 594 | \newcommand{\ECount}{\dec{effcount}} 595 | \newcommand{\Countprog}{K} 596 | \newcommand{\Plus}{\mathsf{Plus}} 597 | \newcommand{\Minus}{\mathsf{Minus}} 598 | \newcommand{\Eq}{\mathsf{Eq}} 599 | \newcommand{\BList}{\mathbb{B}^\ast} 600 | 601 | \newcommand{\CtxCat}{\CatName{Ctx}} 602 | \newcommand{\PureCont}{\mathsf{PureCont}} 603 | 604 | \newcommand{\Addr}{\mathsf{Addr}} 605 | \newcommand{\Lab}{\mathsf{Lab}} 606 | \newcommand{\Env}{\mathsf{Env}} 607 | 608 | \newcommand{\Time}{\dec{DTIME}} 609 | \newcommand{\query}{\mathord{?}} 610 | \newcommand{\ans}{\mathord{!}} 611 | \newcommand{\labs}{\mathsf{labs}} 612 | \newcommand{\steps}{\mathsf{steps}} 613 | 614 | \newcommand{\tree}{\tau} 615 | \newcommand{\tl}{\labs(\tree)} 616 | \newcommand{\ts}{\steps(\tree)} 617 | \newcommand{\T}[1]{\ensuremath{\mathcal{T}_{#1}}} 618 | \newcommand{\Config}{\dec{Config}} 619 | \newcommand{\cekl}{\langle} 620 | \newcommand{\cekr}{\rangle} 621 | 622 | \newcommand{\const}[1]{\ulcorner #1 \urcorner} 623 | \newcommand{\HC}{\ensuremath{\mathcal{H}}} 624 | 625 | \newcommand{\tr}{\mathcal{T}} 626 | \newcommand{\tru}{\mathcal{U}} 627 | \newcommand{\Tree}{\dec{Tree}} 628 | \newcommand{\TimedTree}{\dec{TimedTree}} 629 | \newcommand{\denotep}[1]{\ensuremath{\mathbb{P}\llbracket #1 \rrbracket}} 630 | 631 | \newcommand\ttTwoTree{ 632 | \begin{tikzpicture}[->,>=stealth',level/.style={sibling distance = 4cm/##1, 633 | level distance = 2.0cm}] 634 | \node (root) [opnode] {Branch} 635 | child { node [opnode] {Branch} 636 | child { node [leaf] {$\True$} 637 | edge from parent node[above left] {$\True$} 638 | } 639 | child { node [leaf] {$\True$} 640 | edge from parent node[above right] {$\False$} 641 | } 642 | edge from parent node[above left] {$\True$} 643 | } 644 | child { node [opnode] {Branch} 645 | child { node [leaf] {$\True$} 646 | edge from parent node[above left] {$\True$} 647 | } 648 | child { node [leaf] {$\True$} 649 | edge from parent node[above right] {$\False$} 650 | } 651 | edge from parent node[above right] {$\False$} 652 | } 653 | ; 654 | \end{tikzpicture}} 655 | 656 | 657 | \newcommand{\tossTree}{ 658 | \begin{tikzpicture}[->,>=stealth',level/.style={sibling distance = 2.5cm/##1, 659 | level distance = 1.0cm}] 660 | \node (root) [opnode] {$\dec{Branch}$} 661 | child { node [leaf] {$\dec{Heads}$} 662 | edge from parent node[above left] {$\True$} 663 | } 664 | child { node [leaf] {$\dec{Tails}$} 665 | edge from parent node[above right] {$\False$} 666 | } 667 | ; 668 | \end{tikzpicture}} 669 | 670 | \newenvironment{twoeqs}{\ba[t]{@{}r@{~}c@{~}l@{~}c@{~}r@{~}c@{~}l@{}}}{\ea} 671 | 672 | \newcommand{\compTreeEx}{ 673 | \begin{tikzpicture}[->,>=stealth',level/.style={sibling distance = 2.0cm/##1, 674 | level distance = 2.0cm}] 675 | \node (root) [opnode] {$\getF$} 676 | child { node [yshift=15] {$\dots$} 677 | edge from parent {} 678 | } 679 | child { node [opnode] {$\putF$} 680 | child { node {$\True$} 681 | edge from parent node[left] {$\Unit$} 682 | } 683 | edge from parent node[yshift=5,left] {$-2$} 684 | } 685 | child { node [opnode] {$\putF$} 686 | child { node {$\False$} 687 | edge from parent node[left] {$\Unit$} 688 | } 689 | edge from parent node[yshift=2,left] {$-1$} 690 | } 691 | child { node [opnode] {$\putF$} 692 | child { node {$\True$} 693 | edge from parent node[left] {$\Unit$} 694 | } 695 | edge from parent node[left] {$0$} 696 | } 697 | child { node [opnode] {$\putF$} 698 | child { node {$\False$} 699 | edge from parent node[right] {$\Unit$} 700 | } 701 | edge from parent node[yshift=2,right] {$1$} 702 | } 703 | child { node [opnode] {$\putF$} 704 | child { node {$\True$} 705 | edge from parent node[right] {$\Unit$} 706 | } 707 | edge from parent node[yshift=5,right] {$2$} 708 | } 709 | child { node [yshift=15] {$\dots$} 710 | edge from parent {} 711 | } 712 | ; 713 | \end{tikzpicture}} 714 | 715 | \newcommand{\smath}[1]{\ensuremath{{\scriptstyle #1}}} 716 | 717 | \newcommand{\InfiniteModel}{% 718 | \begin{tikzpicture}[->,>=stealth',level/.style={sibling distance = 3.0cm/##1, 719 | level distance = 1.0cm}] 720 | \node (root) [draw=none] { } 721 | child { node [opnode] {$\smath{\query 0}$} 722 | child { node [opnode] {$\smath{\query 0}$} 723 | child { node [draw=none,rotate=165] {$\vdots$} 724 | edge from parent node { } 725 | } 726 | child { node[leaf] {$\smath{\ans\False}$} 727 | edge from parent node { } 728 | } 729 | edge from parent node { } 730 | } 731 | child { node [leaf] {$\smath{\ans\False}$} 732 | edge from parent node { } 733 | } 734 | edge from parent node { } 735 | } 736 | ; 737 | \end{tikzpicture}} 738 | % 739 | \newcommand{\ShortConjModel}{% 740 | \begin{tikzpicture}[->,>=stealth',level/.style={sibling distance = 3.5cm/##1, 741 | level distance = 1.0cm}] 742 | \node (root) [draw=none] { } 743 | child { node [opnode] {$\smath{\query 0}$} 744 | child { node [opnode] {$\smath{\query 0}$} 745 | child { node [treenode] {$\smath{\ans\True}$} 746 | edge from parent node { } 747 | } 748 | child { node[treenode] {$\smath{\ans\False}$} 749 | edge from parent node { } 750 | } 751 | edge from parent node { } 752 | } 753 | child { node [treenode] {$\smath{\ans\False}$} 754 | edge from parent node { } 755 | } 756 | edge from parent node { } 757 | } 758 | ; 759 | \end{tikzpicture}} 760 | % 761 | 762 | \newcommand{\TTTwoModel}{% 763 | \begin{tikzpicture}[->,>=stealth',level/.style={sibling distance = 8cm/##1, 764 | level distance = 1.5cm}] 765 | \node (root) [draw=none] { } 766 | child { node [opnode] {$\smath{\query 0}$} 767 | child { node [opnode] {$\smath{\query 1}$} 768 | child { node [leaf] {$\smath{\ans\True}$} 769 | edge from parent node { } 770 | } 771 | child { node[leaf] {$\smath{\ans\True}$} 772 | edge from parent node { } 773 | } 774 | edge from parent node { } 775 | } 776 | child { node [opnode] {$\smath{\query 1}$} 777 | child { node [leaf] {$\smath{\ans\True}$} 778 | edge from parent node { } 779 | } 780 | child { node[leaf] {$\smath{\ans\True}$} 781 | edge from parent node { } 782 | } 783 | edge from parent node { } 784 | } 785 | edge from parent node { } 786 | } 787 | ; 788 | \end{tikzpicture}} 789 | % 790 | \newcommand{\XORTwoModel}{% 791 | \begin{tikzpicture}[->,>=stealth',level/.style={sibling distance = 5.5cm/##1, 792 | level distance = 1cm}] 793 | \node (root) [draw=none] { } 794 | child { node [opnode] {$\smath{\query 0}$} 795 | child { node [opnode] {$\smath{\query 1}$} 796 | child { node [treenode] {$\smath{\ans\False}$} 797 | edge from parent node { } 798 | } 799 | child { node[treenode] {$\smath{\ans\True}$} 800 | edge from parent node { } 801 | } 802 | edge from parent node { } 803 | } 804 | child { node [opnode] {$\smath{\query 1}$} 805 | child { node [treenode] {$\smath{\ans\True}$} 806 | edge from parent node { } 807 | } 808 | child { node[treenode] {$\smath{\ans\False}$} 809 | edge from parent node { } 810 | } 811 | edge from parent node { } 812 | } 813 | edge from parent node { } 814 | } 815 | ; 816 | \end{tikzpicture}} 817 | % 818 | \newcommand{\SXORTwoModel}{% 819 | \begin{tikzpicture}[->,>=stealth',level/.style={sibling distance = 2.5cm/##1, 820 | level distance = 1cm}] 821 | \node (root) [opnode] {$\smath{\query 0}$} 822 | child { node [opnode] {$\smath{\query 1}$} 823 | child { node [treenode] {$\smath{\ans\False}$} 824 | edge from parent node { } 825 | } 826 | child { node[treenode] {$\smath{\ans\True}$} 827 | edge from parent node { } 828 | } 829 | edge from parent node { } 830 | } 831 | child { node [opnode] {$\smath{\query 1}$} 832 | child { node [treenode] {$\smath{\ans\True}$} 833 | edge from parent node { } 834 | } 835 | child { node[treenode] {$\smath{\ans\False}$} 836 | edge from parent node { } 837 | } 838 | edge from parent node { } 839 | } 840 | ; 841 | \end{tikzpicture}} 842 | % 843 | \newcommand{\TTZeroModel}{% 844 | \begin{tikzpicture}[->,>=stealth',level/.style={sibling distance = 1cm/##1, 845 | level distance = 1cm}] 846 | \node (root) [draw=none] { } 847 | child { node [treenode] {$\smath{\ans\True}$} 848 | edge from parent node { } 849 | } 850 | ; 851 | \end{tikzpicture}}% -------------------------------------------------------------------------------- /pkgs/mathpartir.sty: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dhil/phd-dissertation/81a4ecec0b6f36375a6abee7377f55723de4b05f/pkgs/mathpartir.sty -------------------------------------------------------------------------------- /pkgs/mathwidth.sty: -------------------------------------------------------------------------------- 1 | \def\fileversion{2e} 2 | \def\filedate{98/11/04} 3 | \NeedsTeXFormat{LaTeX2e} 4 | 5 | \ProvidesPackage{mathwidth}[{% 6 | \filedate\space\fileversion\space mathwidth package}] 7 | 8 | \@ifpackageloaded{lucbr}{}{% 9 | \DeclareMathVersion{hask} 10 | \SetMathAlphabet{\mathrm}{hask}{\encodingdefault}{\rmdefault}{m}{n}% 11 | \SetMathAlphabet{\mathbf}{hask}{\encodingdefault}{\rmdefault}{bx}{n}% 12 | \SetMathAlphabet{\mathsf}{hask}{\encodingdefault}{\sfdefault}{m}{n}% 13 | \DeclareSymbolFont{italics}{\encodingdefault}{\rmdefault}{m}{it}% 14 | \DeclareSymbolFontAlphabet{\mathrm}{operators} 15 | \DeclareSymbolFontAlphabet{\mathit}{letters} 16 | \DeclareSymbolFontAlphabet{\mathcal}{symbols} 17 | \DeclareSymbolFontAlphabet{\haskit}{italics} 18 | \mathversion{hask} 19 | } 20 | 21 | % This next bit looks remarkably similar to part of zed.sty. It's used 22 | % to change the spacing so that identifiers look nicer... 23 | \def\@setmcodes#1#2#3{{\count0=#1 \count1=#3 24 | \loop \global\mathcode\count0=\count1 \ifnum \count0<#2 25 | \advance\count0 by1 \advance\count1 by1 \repeat}} 26 | \@setmcodes{`A}{`Z}{"7\hexnumber@\symitalics41} 27 | \@setmcodes{`a}{`z}{"7\hexnumber@\symitalics61} 28 | 29 | -------------------------------------------------------------------------------- /slides/Makefile: -------------------------------------------------------------------------------- 1 | TEXC=pdflatex 2 | CFLAGS=-interaction=nonstopmode -halt-on-error -file-line-error 3 | BIBC=bibtex 4 | PAPER=viva 5 | BIBLIO=$(PAPER) 6 | LATEST_COMMIT=$(shell git log --format="%h" -n 1) 7 | 8 | all: $(PAPER).pdf 9 | draft: $(PAPER).pdf-draft 10 | 11 | $(PAPER).aux: $(PAPER).tex 12 | $(TEXC) $(CFLAGS) $(PAPER) 13 | 14 | $(BIBLIO).bbl: $(PAPER).aux $(BIBLIO).bib 15 | $(BIBC) $(PAPER) 16 | 17 | $(PAPER).pdf: $(PAPER).aux $(BIBLIO).bbl 18 | $(TEXC) $(CFLAGS) $(PAPER) 19 | $(TEXC) $(CFLAGS) $(PAPER) 20 | 21 | $(PAPER).pdf-draft: CFLAGS:=$(CFLAGS) "\def\DRAFT{$(LATEST_COMMIT)}\input{$(PAPER)}" 22 | $(PAPER).pdf-draft: all 23 | mv $(PAPER).pdf $(PAPER)-draft.pdf 24 | tar cf thesis-draft.tar.gz $(PAPER)-draft.pdf 25 | 26 | clean: 27 | rm -f *.log *.aux *.toc *.out 28 | rm -f *.bbl *.blg *.fls *.xml 29 | rm -f *.nav *.snm 30 | rm -f *.fdb_latexmk *.vtc *.cut 31 | rm -f $(PAPER).pdf camera-ready.pdf submission.pdf 32 | rm -f *.o *.cmx *.cmo 33 | -------------------------------------------------------------------------------- /slides/viva.bib: -------------------------------------------------------------------------------- 1 | @inproceedings{HillerstromL16, 2 | author = {Daniel Hillerstr{\"{o}}m and 3 | Sam Lindley}, 4 | title = {Liberating effects with rows and handlers}, 5 | booktitle = {TyDe@ICFP}, 6 | pages = {15--27}, 7 | publisher = {{ACM}}, 8 | year = {2016} 9 | } 10 | 11 | @inproceedings{HillerstromLAS17, 12 | author = {Daniel Hillerstr{\"{o}}m and 13 | Sam Lindley and 14 | Robert Atkey and 15 | {KC} Sivaramakrishnan}, 16 | title = {Continuation Passing Style for Effect Handlers}, 17 | booktitle = {{FSCD}}, 18 | series = {LIPIcs}, 19 | volume = {84}, 20 | pages = {18:1--18:19}, 21 | OPTpublisher = {Schloss Dagstuhl - Leibniz-Zentrum fuer Informatik}, 22 | year = {2017} 23 | } 24 | 25 | @inproceedings{HillerstromL18, 26 | author = {Daniel Hillerstr{\"{o}}m and 27 | Sam Lindley}, 28 | title = {Shallow Effect Handlers}, 29 | booktitle = {{APLAS}}, 30 | OPTseries = {Lecture Notes in Computer Science}, 31 | series = {{LNCS}}, 32 | volume = {11275}, 33 | pages = {415--435}, 34 | publisher = {Springer}, 35 | year = {2018} 36 | } 37 | 38 | @article{HillerstromLA20, 39 | author = {Daniel Hillerstr{\"{o}}m and 40 | Sam Lindley and 41 | Robert Atkey}, 42 | title = {Effect handlers via generalised continuations}, 43 | journal = {J. Funct. Program.}, 44 | volume = {30}, 45 | pages = {e5}, 46 | year = {2020} 47 | } 48 | 49 | @article{HillerstromLL20, 50 | author = {Daniel Hillerstr{\"{o}}m and 51 | Sam Lindley and 52 | John Longley}, 53 | title = {Effects for Efficiency: Asymptotic Speedup with First-Class Control}, 54 | journal = {Proc. {ACM} Program. Lang.}, 55 | volume = {4}, 56 | number = {{ICFP}}, 57 | pages = {100:1--100:29}, 58 | year = {2020} 59 | } 60 | 61 | # Unix 62 | @article{RitchieT74, 63 | author = {Dennis Ritchie and 64 | Ken Thompson}, 65 | title = {The {UNIX} Time-Sharing System}, 66 | journal = {Commun. {ACM}}, 67 | volume = {17}, 68 | number = {7}, 69 | pages = {365--375}, 70 | year = {1974} 71 | } 72 | 73 | # CEK & C 74 | @InProceedings{FelleisenF86, 75 | title={Control Operators, the {SECD}-machine, and the $\lambda$-Calculus}, 76 | author={Felleisen, Matthias and Friedman, Daniel P.}, 77 | year=1987, 78 | booktitle = {Formal Description of Programming Concepts III}, 79 | OPTbooktitle = {The Proceedings of the Conference on Formal Description of Programming Concepts III, Ebberup, Denmark}, 80 | pages = {193--217}, 81 | OPTpublisher={North Holland} 82 | } -------------------------------------------------------------------------------- /slides/viva.tex: -------------------------------------------------------------------------------- 1 | \documentclass[169,10pt,compress,dvipsnames]{beamer} 2 | %% 3 | %% Slides layout 4 | %% 5 | \beamertemplatenavigationsymbolsempty % hides navigation buttons 6 | \usetheme{Madrid} % standard Madrid theme 7 | \setbeamertemplate{footline}{} % renders the footer empty 8 | % 9 | \setbeamertemplate{bibliography item}{ % this is a hack to prevent Madrid theme + biblatex 10 | \hspace{-0.4cm}\lower3pt\hbox{ % from causing bibliography entries to run over 11 | \pgfuseimage{beamericonarticle} % the slide margins 12 | }} 13 | 14 | %% 15 | %% Packages 16 | %% 17 | \usepackage[utf8]{inputenc} % enable UTF-8 compatible typing 18 | \usepackage{hyperref} % interactive PDF 19 | \usepackage[sort&compress,square,numbers]{natbib} % Bibliography 20 | \usepackage{bibentry} % Print bibliography entries inline. 21 | \makeatletter % Redefine bibentry to omit hyperrefs 22 | \renewcommand\bibentry[1]{\nocite{#1}{\frenchspacing 23 | \@nameuse{BR@r@#1\@extra@b@citeb}}} 24 | \makeatother 25 | \nobibliography* % use the bibliographic data from the standard BibTeX setup. 26 | \usepackage{amsmath,amssymb,mathtools} % maths typesetting 27 | \usepackage{../pkgs/mathpartir} % Inference rules 28 | \usepackage{../pkgs/mathwidth} % renders character sequences nicely in math mode 29 | \usepackage{stmaryrd} % semantic brackets 30 | \usepackage{xspace} % proper spacing for macros in text 31 | 32 | \usepackage[T1]{fontenc} % 8-bit font encoding 33 | % native support for accented characters. 34 | \usepackage[scaled=0.85]{beramono} % smoother typewriter font 35 | \newcommand*{\Scale}[2][4]{\scalebox{#1}{\ensuremath{#2}}}% 36 | 37 | \input{../macros.tex} 38 | 39 | %% 40 | %% Meta information 41 | %% 42 | \author{Daniel Hillerström} 43 | \title{Foundations for Programming and Implementing Effect Handlers} 44 | \institute{The University of Edinburgh, Scotland UK} 45 | \subtitle{PhD viva} 46 | \date{August 13, 2021} 47 | 48 | %% 49 | %% Slides 50 | %% 51 | \begin{document} 52 | 53 | % 54 | % Title slide 55 | % 56 | \begin{frame} 57 | \maketitle 58 | \end{frame} 59 | 60 | % Dissertation overview 61 | \begin{frame} 62 | \frametitle{My dissertation at glance} 63 | 64 | Three main strands of work 65 | 66 | \begin{description} 67 | \item[Programming] Language design and applications of effect handlers. 68 | \item[Implementation] Canonical implementation strategies for effect handlers. 69 | \item[Expressiveness] Exploration of the computational expressiveness of effect handlers. 70 | \end{description} 71 | \end{frame} 72 | 73 | \begin{frame} 74 | \frametitle{Calculi for deep, shallow, and parameterised handlers} 75 | 76 | The calculi capture key aspects of the implementation of effect 77 | handlers in Links. 78 | 79 | \begin{itemize} 80 | \item $\HCalc$ ordinary deep handlers (fold). 81 | \item $\SCalc$ shallow handlers (case-split). 82 | \item $\HPCalc$ parameterised deep handlers (fold+state). 83 | \end{itemize} 84 | 85 | The actual implementation is the union of the three calculi.\\[2em] 86 | 87 | \textbf{Relevant papers} TyDe'16~\cite{HillerstromL16}, 88 | APLAS'18~\cite{HillerstromL18}, JFP'20~\cite{HillerstromLA20}. 89 | \end{frame} 90 | 91 | % UNIX 92 | \begin{frame} 93 | \frametitle{Effect handlers as composable operating systems} 94 | 95 | An interpretation of \citeauthor{RitchieT74}'s 96 | UNIX~\cite{RitchieT74} in terms of effect handlers.\\[2em] 97 | 98 | \[ 99 | \bl 100 | \!\!\!\!\!\!\!\!\!\!\!\!\!\!\!\!\!\!\!\!\!\!\!\!\!\!\!\!\textbf{Basic idea} 101 | \ba[m]{@{\qquad}r@{~}c@{~}l} 102 | \text{\emph{system call}} &\approx& \text{\emph{operation invocation}}\\ 103 | \text{\emph{system call implementation}} &\approx& \text{\emph{operation interpretation}} 104 | \ea 105 | \el 106 | \]\hfill\\[2em] 107 | 108 | \textbf{Key point} Legacy code is modularly retrofitted with functionality. 109 | \end{frame} 110 | 111 | % CPS translation 112 | \begin{frame} 113 | \frametitle{CPS transforms for effect handlers} 114 | 115 | A higher-order CPS transform for effect handlers with generalised 116 | continuations.\\[1em] 117 | 118 | \textbf{Generalised continuation} Structured representation of 119 | delimited continuations.\\[0.5em] 120 | 121 | \[ 122 | \Scale[1.8]{\kappa = \overline{(\sigma, (\hret,\hops))}} 123 | \]\\[1em] 124 | 125 | \textbf{Key point} Separate the \emph{doing} layer ($\sigma$) from the \emph{being} layer ($H$).\\[2em] 126 | 127 | \textbf{Relevant papers} FSCD'17~\cite{HillerstromLAS17}, 128 | APLAS'18~\cite{HillerstromL18}, JFP'20~\cite{HillerstromLA20}. 129 | \end{frame} 130 | 131 | % Abstract machine 132 | \begin{frame} 133 | \frametitle{Abstract machine semantics for effect handlers} 134 | 135 | Plugging generalised continuations into \citeauthor{FelleisenF86}'s 136 | CEK machine~\cite{FelleisenF86} yields a runtime for effect 137 | handlers.\\[2em] 138 | 139 | \[ 140 | \Scale[2]{\cek{C \mid E \mid K = \overline{(\sigma, (H,E))}}} 141 | \]\\[2em] 142 | 143 | \textbf{Relevant papers} TyDe'16~\cite{HillerstromL16}, 144 | JFP'20~\cite{HillerstromLA20}. 145 | 146 | \end{frame} 147 | 148 | % Interdefinability of handlers 149 | \begin{frame} 150 | \frametitle{Interdefinability of effect handlers} 151 | 152 | Deep, shallow, and parameterised handlers are interdefinable 153 | w.r.t. to typability-preserving macro-expressiveness. 154 | 155 | \begin{itemize} 156 | \item Deep as shallow, $\mathcal{D}\llbracket - \rrbracket$, image is computationally lightweight. 157 | \item Shallow as deep, $\mathcal{S}\llbracket - \rrbracket$, image is computationally expensive. 158 | \item Parameterised as deep, $\mathcal{P}\llbracket - \rrbracket$, 159 | image uses explicit state-passing. 160 | \end{itemize} 161 | ~\\[1em] 162 | \textbf{Relevant papers} APLAS'18~\cite{HillerstromL18}, 163 | JFP'20~\cite{HillerstromLA20}. 164 | 165 | \end{frame} 166 | 167 | % Asymptotic speed up with first-class control 168 | \begin{frame} 169 | \frametitle{Asymptotic speed up with effect handlers} 170 | 171 | Effect handlers can make some programs faster! 172 | 173 | \[ 174 | \Count_n : ((\Nat_n \to \Bool) \to \Bool) \to \Nat 175 | \]\\[1em] 176 | % 177 | Using type-respecting expressiveness 178 | \begin{itemize} 179 | \item There \textbf{exists} an implementation of $\Count_n \in \HPCF$ with 180 | effect handlers such that the runtime for every $n$-standard predicate $P$ is 181 | $\Count_n~P = \BigO(2^n)$. 182 | \item \textbf{Forall} implementations of $\Count_n \in \BPCF$ the runtime for every $n$-standard predicate $P$ is $\Count_n~P = \Omega(n2^n)$ 183 | \end{itemize} 184 | ~\\[1em] 185 | \textbf{Relevant paper} ICFP'20~\cite{HillerstromLL20}. 186 | \end{frame} 187 | 188 | % Background 189 | % \begin{frame} 190 | % \frametitle{Continuations literature review} 191 | % \end{frame} 192 | 193 | % 194 | % References 195 | % 196 | \begin{frame}%[allowframebreaks] 197 | \frametitle{References} 198 | \bibliographystyle{plainnat} 199 | \bibliography{\jobname} 200 | \end{frame} 201 | \end{document} --------------------------------------------------------------------------------