├── .gitignore
├── tests
├── record.sml
├── valrec.sml
├── comments.sml
├── type.sml
├── rule.sml
├── functors.sml
├── random.sml
└── fixity.sml
├── lib
├── Fixities.sig
├── ExtractLiteralOld.sml
├── ExtractLiteral.sml
├── lib.sml
└── Fixities.sml
├── parser
├── CommentParser.sig
├── FixityParser.sig
├── FixityParser.sml
└── CommentParser.sml
├── main
├── SmlFormat.sig
└── SmlFormat.sml
├── format
├── Format.sig
└── Format.sml
├── elab
├── Elab.sig
├── ElabAst.sig
├── ElabAst.sml
└── Elab.sml
├── editors
├── vim
│ ├── sml.vim
│ └── lprolog.vim
└── emacs
│ └── smlformat.el
├── sources.cm
├── smlformat
└── README.md
/.gitignore:
--------------------------------------------------------------------------------
1 | */.cm/
2 |
--------------------------------------------------------------------------------
/tests/record.sml:
--------------------------------------------------------------------------------
1 | val { foo : int } = { foo = 10 }
2 |
--------------------------------------------------------------------------------
/tests/valrec.sml:
--------------------------------------------------------------------------------
1 | val rec x : (int -> int) = fn y => 0
2 |
--------------------------------------------------------------------------------
/tests/comments.sml:
--------------------------------------------------------------------------------
1 | (* One comment *)
2 | (* Two comment *)
3 | val x = 10
4 |
--------------------------------------------------------------------------------
/lib/Fixities.sig:
--------------------------------------------------------------------------------
1 | signature FIXITIES = sig
2 | val basis : Fixity.fixity StringMap.map
3 | end
4 |
--------------------------------------------------------------------------------
/parser/CommentParser.sig:
--------------------------------------------------------------------------------
1 | signature COMMENT_PARSER = sig
2 | val parse : string -> (string * int) list IntMap.map
3 | end
4 |
--------------------------------------------------------------------------------
/lib/ExtractLiteralOld.sml:
--------------------------------------------------------------------------------
1 | structure ExtractLiteral = struct
2 | fun extractLiteral n = n
3 | fun extractRealLiteral s = s
4 | end
5 |
--------------------------------------------------------------------------------
/main/SmlFormat.sig:
--------------------------------------------------------------------------------
1 | signature SML_FORMAT = sig
2 | val format : string -> unit
3 | val formatToFile : string -> string -> unit
4 | end
5 |
--------------------------------------------------------------------------------
/lib/ExtractLiteral.sml:
--------------------------------------------------------------------------------
1 | structure ExtractLiteral = struct
2 | fun extractLiteral (_, n) = n
3 | fun extractRealLiteral (s, _) = s
4 | end
5 |
--------------------------------------------------------------------------------
/format/Format.sig:
--------------------------------------------------------------------------------
1 | signature FORMAT = sig
2 | type formatInfo = { indent : int }
3 | val formatDec : formatInfo -> ElabAst.dec -> string
4 | end
5 |
--------------------------------------------------------------------------------
/elab/Elab.sig:
--------------------------------------------------------------------------------
1 | signature ELAB = sig
2 | type conversionInfo =
3 | { sourceMap : SourceMap.sourcemap
4 | , comments : (int * string list) list ref
5 | , fixity : Fixity.fixity StringMap.map ref }
6 |
7 | val elaborate : conversionInfo -> Ast.dec -> ElabAst.dec
8 | end
9 |
--------------------------------------------------------------------------------
/editors/vim/sml.vim:
--------------------------------------------------------------------------------
1 | function! neoformat#formatters#sml#enabled() abort
2 | return ['smlformat']
3 | endfunction
4 |
5 | function! neoformat#formatters#sml#smlformat() abort
6 | return {
7 | \ 'exe': 'smlformat',
8 | \ 'stdin': 1,
9 | \ }
10 | endfunction
11 |
--------------------------------------------------------------------------------
/editors/vim/lprolog.vim:
--------------------------------------------------------------------------------
1 | function! neoformat#formatters#lprolog#enabled() abort
2 | return ['smlformat']
3 | endfunction
4 |
5 | function! neoformat#formatters#lprolog#smlformat() abort
6 | return {
7 | \ 'exe': 'smlformat',
8 | \ 'stdin': 1,
9 | \ }
10 | endfunction
11 |
--------------------------------------------------------------------------------
/parser/FixityParser.sig:
--------------------------------------------------------------------------------
1 | signature FIXITY_PARSER = sig
2 | datatype 'a fixexp =
3 | InfixApp of 'a fixexp * 'a * 'a fixexp
4 | | FlatApp of 'a list
5 |
6 | val map : ('a -> 'b) -> 'a fixexp -> 'b fixexp
7 |
8 | val parse : Fixity.fixity StringMap.map -> Ast.exp Ast.fixitem list -> Ast.exp Ast.fixitem fixexp
9 | end
10 |
--------------------------------------------------------------------------------
/tests/type.sml:
--------------------------------------------------------------------------------
1 | val _ : (int, int) option = SOME 10
2 | val _ : int option = SOME 10
3 | val _ : int = 10
4 | val _ : 'a option = NONE
5 | val _ : (int * int) option = NONE
6 | val _ : {foo : int} = { foo = 10 }
7 | type ('a, 'b) t = 'a list
8 | val _ : ('a, 'b) Foo.t = ()
9 | val _ : int -> int -> int = 10
10 | val _ : (int -> int) -> int = 10
11 |
--------------------------------------------------------------------------------
/lib/lib.sml:
--------------------------------------------------------------------------------
1 | structure IntKey = struct
2 | type ord_key = int
3 | val compare = Int.compare
4 | end
5 |
6 | structure StringKey = struct
7 | type ord_key = string
8 | val compare = String.compare
9 | end
10 |
11 | structure IntSet = SplaySetFn (IntKey)
12 | structure IntMap = SplayMapFn (IntKey)
13 | structure StringMap = SplayMapFn (StringKey)
14 |
--------------------------------------------------------------------------------
/tests/rule.sml:
--------------------------------------------------------------------------------
1 | fun foo x =
2 | case x of
3 | 1 =>
4 | let
5 | val x = "asaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
6 | val y = 100
7 | in
8 | x ^ "\n"
9 | end
10 | | 2 =>
11 | let
12 | val x = "asaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
13 | val y = 100
14 | in
15 | x ^ "\n"
16 | end
17 |
--------------------------------------------------------------------------------
/tests/functors.sml:
--------------------------------------------------------------------------------
1 | functor CurriedPair (M : sig
2 | val x : int
3 | end) = struct
4 | functor Pair (N : sig
5 | val y : int
6 | end) = struct
7 | val e = (M.x, N.y)
8 | end
9 | end
10 |
11 | structure P = CurriedPair (struct
12 | val x = 10
13 | end)
14 |
15 | signature F = sig
16 | type t
17 | end
18 |
19 | functor Foo
20 | (structure M : F
21 | structure N : F) = struct end
22 |
23 | signature Foooo = sig end
24 | structure Fo = struct
25 | type t = int
26 | end
27 |
28 | signature F = sig
29 | type 'a t
30 | type s
31 | end
32 |
33 | signature E = F where type 'a t = int list and s = bool
34 | signature S = sig
35 | type t
36 | type s
37 | type i
38 | sharing type t = s = i
39 | end
40 |
--------------------------------------------------------------------------------
/sources.cm:
--------------------------------------------------------------------------------
1 | group
2 | structure CommentParser
3 | structure ElabAst
4 | structure Elab
5 | structure Format
6 | structure SmlFormat
7 | structure Fixity
8 | structure StringMap
9 | is
10 | $/basis.cm
11 | $/smlnj-lib.cm
12 | $smlnj/viscomp/parser.cm
13 | $smlnj/viscomp/basics.cm
14 |
15 | lib/lib.sml
16 | lib/Fixities.sml
17 | lib/Fixities.sig
18 | #if SMLNJ_MINOR_VERSION >= 83
19 | lib/ExtractLiteral.sml
20 | #else
21 | lib/ExtractLiteralOld.sml
22 | #endif
23 |
24 | parser/CommentParser.sml
25 | parser/CommentParser.sig
26 |
27 | parser/FixityParser.sml
28 | parser/FixityParser.sig
29 |
30 | elab/ElabAst.sml
31 | elab/ElabAst.sig
32 |
33 | elab/Elab.sml
34 | elab/Elab.sig
35 |
36 | format/Format.sml
37 | format/Format.sig
38 |
39 | main/SmlFormat.sml
40 | main/SmlFormat.sig
41 |
--------------------------------------------------------------------------------
/tests/random.sml:
--------------------------------------------------------------------------------
1 | (* Comment *)
2 | val 1 = 1
3 | (* C *)
4 | val 1 = 1
5 |
6 | (* foo *)
7 | val [] = []
8 |
9 | val (1, 1) = (1, 1)
10 | val x =
11 | fn y => y
12 | | x => x
13 |
14 | val [] = List.map ((fn x => x + 1)) []
15 | val _ =
16 | 2 handle Fail "s" => 3
17 | | Size => 4
18 |
19 | val _ =
20 | if true
21 | then
22 | case 2 of
23 | 2 => 2
24 | else true
25 |
26 | val _ =
27 | case 2 of
28 | 1 => ("1" : string)
29 | | 2 =>
30 | "hwhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhh"
31 |
32 | val _ =
33 | let
34 | val foo = 10
35 | in
36 | foo
37 | end
38 |
39 | val z =
40 | "o7yweiauhfsdo8yuiqt4ar98yuitg9p8yugtuarg98yuguyray9guhuyfgur9ap8grua9f8yuguray9f8ughuayrffguo"
41 |
42 | fun foo [] = 0
43 | | foo (x :: xs) = x
44 |
45 | val _ =
46 | let
47 | val x = 10
48 | in
49 | foo
50 | end
51 |
52 | (* CC *)
53 | val 1 = 1
54 |
--------------------------------------------------------------------------------
/lib/Fixities.sml:
--------------------------------------------------------------------------------
1 | structure Fixities : FIXITIES = struct
2 | val basis =
3 | let
4 | val fixities =
5 | [ ("*", 7, false)
6 | , ("/", 7, false)
7 | , ("div", 7, false)
8 | , ("mod", 7, false)
9 | , ("+", 6, false)
10 | , ("-", 6, false)
11 | , ("^", 6, false)
12 | , ("::", 5, true)
13 | , ("@", 5, true)
14 | , ("=", 4, false)
15 | , ("<>", 4, false)
16 | , (">", 4, false)
17 | , (">=", 4, false)
18 | , ("<", 4, false)
19 | , ("<=", 4, false)
20 | , (":=", 3, false)
21 | , ("o", 3, false)
22 | , ("before", 0, false) ]
23 | in
24 | List.foldl
25 | (fn ((sym, fixity, isInfixR), fixityMap) =>
26 | StringMap.insert
27 | (fixityMap
28 | , sym
29 | , if isInfixR then Fixity.infixright fixity else Fixity.infixleft fixity))
30 | StringMap.empty
31 | fixities
32 | end
33 | end
34 |
--------------------------------------------------------------------------------
/main/SmlFormat.sml:
--------------------------------------------------------------------------------
1 | structure SmlFormat : SML_FORMAT = struct
2 | fun formatted filename =
3 | let
4 | val source =
5 | let
6 | val stream = TextIO.openIn filename
7 | val interactive = false
8 | val consumer = ErrorMsg.defaultConsumer ()
9 | in
10 | Source.newSource (filename, stream, interactive, consumer)
11 | end
12 |
13 | val ast = SmlFile.parse source
14 |
15 | val comments =
16 | IntMap.foldli
17 | (fn (line, comment, acc) => (line, List.map (fn (x, _) => x) comment) :: acc)
18 | []
19 | (CommentParser.parse filename)
20 |
21 | val elabAst =
22 | Elab.elaborate
23 | { comments = ref comments
24 | , sourceMap = (#sourceMap source)
25 | , fixity = ref Fixities.basis }
26 | ast
27 | in
28 | Format.formatDec { indent = 0 } elabAst
29 | end
30 |
31 | fun formatToFile infile outfile =
32 | let
33 | val out = TextIO.openOut outfile
34 | in
35 | (TextIO.output (out, formatted infile); TextIO.closeOut out)
36 | end
37 |
38 | fun format filename = TextIO.output (TextIO.stdOut, formatted filename)
39 | end
40 |
--------------------------------------------------------------------------------
/smlformat:
--------------------------------------------------------------------------------
1 | #!/bin/bash
2 | BASE_DIR=$(dirname "$0")
3 |
4 | while getopts 'i:o:h' flag
5 | do
6 | case "$flag" in
7 | i) INFILE="$OPTARG"
8 | ;;
9 | o) OUTFILE="$OPTARG"
10 | ;;
11 | h) echo "Usage: smlformat [-i inputfile] [-o outputfile]"
12 | echo " -i infile read code from file instead of stdin"
13 | echo " -o outfile write formatted code to file instead of stdout"
14 | echo " -h print this help message"
15 | exit 0
16 | ;;
17 | ?) echo "Usage: smlformat [-i inputfile] [-o outputfile]"
18 | ;;
19 | esac
20 | done
21 |
22 | INPUT=$(mktemp /tmp/smlformat.XXXXXX)
23 | OUTPUT=$(mktemp /tmp/smlformat.XXXXXX)
24 | trap 'rm -f -- "$INPUT"' INT TERM HUP EXIT
25 | trap 'rm -f -- "$OUTPUT"' INT TERM HUP EXIT
26 |
27 | if [ "$INFILE" ]
28 | then
29 | cat $INFILE > $INPUT
30 | else
31 | cat <&0 > $INPUT
32 | fi
33 |
34 | echo "SmlFormat.formatToFile \"$INPUT\" \"$OUTPUT\";" | sml -m "$BASE_DIR/sources.cm" > /dev/null
35 |
36 | if [ ! -s $OUTPUT ]
37 | then
38 | cat $INPUT > $OUTPUT
39 | fi
40 |
41 | if [ "$OUTFILE" ]
42 | then
43 | cat $OUTPUT > $OUTFILE
44 | else
45 | cat $OUTPUT
46 | fi
47 |
48 | rm "$INPUT"
49 | rm "$OUTPUT"
50 |
--------------------------------------------------------------------------------
/tests/fixity.sml:
--------------------------------------------------------------------------------
1 | fun f x y = f x y ^ f x y + 2
2 | infix 9 in_
3 | infix 1 to
4 | infix 5 it
5 |
6 | fun f x y =
7 | when in_ the course of_ human
8 | o events it becomes necessary for + one people
9 | to dissolve the poltical bands * which have connected them
10 | to another and_ to_
11 | ^ assume among the powers of_ the earth the separate and_ equal
12 | before station to / which the laws of_ nature
13 |
14 | infix 9 in_
15 | infix 8 to
16 | infix 5 it
17 |
18 | fun f x y =
19 | when in_ the course of_ human
20 | o events
21 | it becomes necessary for
22 | + one people to dissolve the poltical bands
23 | * which have connected them to another and_ to_
24 | ^ assume among the powers of_ the earth the separate and_ equal
25 | before station to / which the laws of_ nature
26 |
27 | infix 9 in_
28 | infix 8 to
29 | infix 5 it
30 | nonfix + * ^
31 |
32 | fun f x y =
33 | when in_ the course of_ human
34 | o events
35 | it becomes necessary for + one people
36 | to dissolve the poltical bands * which have connected them
37 | to another
38 | and_
39 | to_
40 | ^
41 | assume
42 | among
43 | the
44 | powers
45 | of_
46 | the
47 | earth
48 | the
49 | separate
50 | and_
51 | equal
52 | before station to / which the laws of_ nature
53 |
54 | local
55 | infix i
56 | in
57 | fun x i y = x + y
58 | val _ = 10 i 11
59 | val _ = i 10 11
60 | end
61 |
62 | val _ = i 10 11
63 |
--------------------------------------------------------------------------------
/parser/FixityParser.sml:
--------------------------------------------------------------------------------
1 | structure FixityParser : FIXITY_PARSER = struct
2 | open Ast
3 |
4 | datatype 'a fixexp =
5 | InfixApp of 'a fixexp * 'a * 'a fixexp
6 | | FlatApp of 'a list
7 |
8 | fun map f (InfixApp (l, x, r)) = InfixApp (map f l, f x, map f r)
9 | | map f (FlatApp exps) = FlatApp (List.map f exps)
10 |
11 | fun isFixity fixDecs fixity sym =
12 | case (StringMap.find (fixDecs, sym), fixity) of
13 | (SOME (Fixity.INfix (n1, m1)), Fixity.INfix (n2, m2)) =>
14 | n1 = n2 andalso m1 = m2
15 | | (SOME Fixity.NONfix, Fixity.NONfix) => true
16 | | _ => false
17 |
18 | fun isInfixR fixDecs n { fixity, item, region } =
19 | case fixity of
20 | NONE => false
21 | | SOME sym => isFixity fixDecs (Fixity.infixright n) (Symbol.name sym)
22 |
23 | fun isInfix fixDecs n { fixity, item, region } =
24 | case fixity of
25 | NONE => false
26 | | SOME sym => isFixity fixDecs (Fixity.infixleft n) (Symbol.name sym)
27 |
28 | fun parseFixityR f [] = FlatApp []
29 | | parseFixityR f (exp :: exps) =
30 | if f exp
31 | then InfixApp (FlatApp [], exp, parseFixityR f exps)
32 | else
33 | (case parseFixityR f exps of
34 | FlatApp exps => FlatApp (exp :: exps)
35 | | InfixApp (FlatApp es, e, eR) => InfixApp (FlatApp (exp :: es), e, eR)
36 | | InfixApp (InfixApp _, _, _) =>
37 | raise Fail "BUG: infix app to left in rfixity parsing")
38 |
39 | fun reverse (FlatApp exps) = FlatApp (List.rev exps)
40 | | reverse (InfixApp (eL, e, eR)) = InfixApp (reverse eR, e, reverse eL)
41 |
42 | fun parseFixExp (fixity, infixR, fixDecs) (InfixApp (eL, exp, eR)) =
43 | if fixity > 9
44 | then InfixApp (eL, exp, eR)
45 | else
46 | InfixApp
47 | (parseFixExp (fixity, infixR, fixDecs) eL
48 | , exp
49 | , parseFixExp (fixity, infixR, fixDecs) eR)
50 | | parseFixExp (fixity, infixR, fixDecs) (FlatApp exps) =
51 | if fixity > 9
52 | then FlatApp exps
53 | else
54 | if infixR
55 | then
56 | parseFixExp
57 | (fixity + 1, false, fixDecs)
58 | (parseFixityR (isInfixR fixDecs fixity) exps)
59 | else
60 | parseFixExp
61 | (fixity, true, fixDecs)
62 | (reverse (parseFixityR (isInfix fixDecs fixity) (List.rev exps)))
63 |
64 | fun parse fixDecs exps = parseFixExp (0, false, fixDecs) (FlatApp exps)
65 | end
66 |
--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
1 | # SMLFormat
2 |
3 | SMLFormat is an autoformatter for the Standard ML programing language. It indents, keeps lines under 80 characters, and applies a set of heuristics to prettify code.
4 |
5 | The source code of SMLFormat is formatted with SMLFormat.
6 |
7 |
8 | ## Installation
9 |
10 | 1. Install the [SML/NJ compiler](https://www.smlnj.org).
11 | 2. Clone this git repo: `git clone https://github.com/jluningp/smlformat.git SMLFORMAT_DIR`.
12 | 3. Add SMLFormat to your path (replacing SMLFORMAT_DIR with your SMLFormat directory):
13 | ```
14 | $ echo "PATH=\"\$PATH:SMLFORMAT_DIR\"; export PATH" >> ~/.bashrc
15 | $ source ~/.bashrc
16 | ```
17 | 4. Follow the instructions below for editor installation.
18 |
19 | ## Usage
20 |
21 | SMLFormat can read from stdin and write to stdout, or it can take files as arguments.
22 |
23 | ```
24 | Usage: smlformat [-i inputfile] [-o outputfile]
25 | -i infile read code from file instead of stdin
26 | -o outfile write formatted code to file instead of stdout
27 | -h print this help message
28 | ```
29 |
30 | ### Examples
31 |
32 | Read from file:
33 | ```
34 | $ echo "fun foo x = 10" > test.sml
35 | $ smlformat -i test.sml
36 | fun foo x = 10
37 | ```
38 |
39 | Write to file:
40 | ```
41 | $ echo "fun foo x = 10" | smlformat -o test_output.sml
42 | $ cat test_output.sml
43 | fun foo x = 10
44 | ```
45 |
46 | Read and write files:
47 | ```
48 | $ echo "fun foo x = 10" > test.sml
49 | $ smlformat -i test.sml -o test_output.sml
50 | $ cat test_output.sml
51 | fun foo x = 10
52 | ```
53 |
54 | Read from stdin and write to stdout:
55 | ```
56 | $ echo "fun foo x = 10" | smlformat
57 | fun foo x = 10
58 | ```
59 |
60 | Format a file "in-place":
61 | ```
62 | $ echo "fun foo x = 10" > test.sml
63 | $ smlformat -i test.sml -o test.sml
64 | $ cat test.sml
65 | fun foo x = 10
66 | ```
67 |
68 | If an input fails to parse, SMLFormat cannot format it and will return the original input.
69 | ```
70 | $ echo "val x" | smlformat
71 | val x
72 | ```
73 |
74 | You can also manually run SMLFormat in the SML/NJ REPL by running
75 | ```
76 | sml -m SMLFORMAT_DIR/sources.cm
77 | - SmlFormat.format "input.sml";
78 | val () = ()
79 | -
80 | ```
81 |
82 | ## Editors
83 | ### Emacs
84 | #### Setup
85 | 1. If you want to format on save, uncomment the bottom line of `editors/emacs/smlformat.el`.
86 | 3. Add the following line to your `.emacs`, with `SMLFORMAT_DIR` replaced by your SMLFormat directory:
87 | ```
88 | (load "SMLFORMAT_DIR/editors/emacs/smlformat.el")
89 | ```
90 | 4. Reopen emacs
91 |
92 | #### Usage
93 | 1. Save the file you're working on
94 | 2. `M-x smlformat`
95 | 3. If your file doesn't parse when you run SMLFormat, it will not be formatted.
96 |
97 | ### Vim
98 | #### Setup
99 | 1. Install the [Neoformat](https://github.com/sbdchd/neoformat) vim plugin
100 | 2. Copy the files in `editors/vim` into Neoformat's formatters directory1.
101 | ```
102 | cp editors/vim/* ~/.vim/plugged/neoformat/autoload/neoformat/formatters/
103 | ```
104 | 3. To enable formatting on save, add the following to your .vimrc:
105 | ```
106 | autocmd BufWritePre *.sml,*.sig Neoformat
107 | ```
108 | 1 Why is there `sml.vim` and `lprolog.vim`? Vim thinks `.sig` files have filetype `lprolog`
109 |
110 | #### Usage
111 | 1. `: Neoformat`
112 | 2. If your file doesn't parse when you run SMLFormat, it will not be formatted.
113 |
114 | ## Known Issues
115 | 1. Types have too many parentheses around them
116 | 2. Functor signatures get deleted
117 | 3. Indentation with constructors + newlines is weird (maybe an extra indent?)
118 |
--------------------------------------------------------------------------------
/editors/emacs/smlformat.el:
--------------------------------------------------------------------------------
1 | (defcustom smlformat-command "smlformat"
2 | "smlformat command"
3 | :type 'string
4 | :group 'smlformat)
5 |
6 | ;; Most of the functions below are taken from OCamlFormat's emacs setup
7 | ;; https://github.com/ocaml-ppx/ocamlformat
8 | (defun smlformat--goto-line (line)
9 | (goto-char (point-min))
10 | (forward-line (1- line)))
11 |
12 | (defun smlformat--delete-whole-line (&optional arg)
13 | "Delete the current line without putting it in the `kill-ring'.
14 | Derived from function `kill-whole-line'. ARG is defined as for that
15 | function."
16 | (setq arg (or arg 1))
17 | (if (and (> arg 0)
18 | (eobp)
19 | (save-excursion (forward-visible-line 0) (eobp)))
20 | (signal 'end-of-buffer nil))
21 | (if (and (< arg 0)
22 | (bobp)
23 | (save-excursion (end-of-visible-line) (bobp)))
24 | (signal 'beginning-of-buffer nil))
25 | (cond ((zerop arg)
26 | (delete-region (progn (forward-visible-line 0) (point))
27 | (progn (end-of-visible-line) (point))))
28 | ((< arg 0)
29 | (delete-region (progn (end-of-visible-line) (point))
30 | (progn (forward-visible-line (1+ arg))
31 | (unless (bobp)
32 | (backward-char))
33 | (point))))
34 | (t
35 | (delete-region (progn (forward-visible-line 0) (point))
36 | (progn (forward-visible-line arg) (point))))))
37 |
38 | (defun smlformat--apply-rcs-patch (patch-buffer)
39 | "Apply an RCS-formatted diff from PATCH-BUFFER to the current buffer."
40 | (let ((target-buffer (current-buffer))
41 | ;; Relative offset between buffer line numbers and line numbers
42 | ;; in patch.
43 | ;;
44 | ;; Line numbers in the patch are based on the source file, so
45 | ;; we have to keep an offset when making changes to the
46 | ;; buffer.
47 | ;;
48 | ;; Appending lines decrements the offset (possibly making it
49 | ;; negative), deleting lines increments it. This order
50 | ;; simplifies the forward-line invocations.
51 | (line-offset 0))
52 | (save-excursion
53 | (with-current-buffer patch-buffer
54 | (goto-char (point-min))
55 | (while (not (eobp))
56 | (unless (looking-at "^\\([ad]\\)\\([0-9]+\\) \\([0-9]+\\)")
57 | (error "invalid rcs patch or internal error in smlformat--apply-rcs-patch"))
58 | (forward-line)
59 | (let ((action (match-string 1))
60 | (from (string-to-number (match-string 2)))
61 | (len (string-to-number (match-string 3))))
62 | (cond
63 | ((equal action "a")
64 | (let ((start (point)))
65 | (forward-line len)
66 | (let ((text (buffer-substring start (point))))
67 | (with-current-buffer target-buffer
68 | (setq line-offset (- line-offset len))
69 | (goto-char (point-min))
70 | (forward-line (- from len line-offset))
71 | (insert text)))))
72 | ((equal action "d")
73 | (with-current-buffer target-buffer
74 | (smlformat--goto-line (- from line-offset))
75 | (setq line-offset (+ line-offset len))
76 | (smlformat--delete-whole-line len)))
77 | (t
78 | (error "invalid rcs patch or internal error in smlformat--apply-rcs-patch")))))))))
79 |
80 | (defun smlformat--patch-buffer (outputfile)
81 | (let ((patchbuf (get-buffer-create "*SMLFormat patch*")))
82 | (with-current-buffer patchbuf (erase-buffer))
83 | (call-process-region
84 | (point-min) (point-max) "diff" nil patchbuf nil "-n" "-" outputfile)
85 | (smlformat--apply-rcs-patch patchbuf)
86 | (kill-buffer patchbuf)))
87 |
88 | (defun smlformat ()
89 | "smlformat"
90 | (interactive)
91 | (let*
92 | ((ext (file-name-extension buffer-file-name t))
93 | (outputfile (make-temp-file "smlformat" nil ext)))
94 | (call-process smlformat-command nil nil nil "-i" buffer-file-name "-o" outputfile)
95 | (smlformat--patch-buffer outputfile)
96 | (delete-file outputfile)
97 | ))
98 |
99 | (defun smlformat-on-save ()
100 | (when (eq major-mode 'sml-mode)
101 | (let ((b (current-buffer)))
102 | (with-temp-buffer
103 | ;; If we don't temporarily remove the smlformat-on-save hook, we'll get stuck
104 | ;; in an endless loop, since this function saves
105 | (let ((after-save-hook (remove 'smlformat-on-save after-save-hook)))
106 | (with-current-buffer b
107 | (let ((after-save-hook (remove 'smlformat-on-save after-save-hook)))
108 | (smlformat)
109 | (save-buffer))))))))
110 |
111 | ;; Uncomment this to enable smlformat on save in sml-mode
112 | (add-hook 'after-save-hook #'smlformat-on-save)
113 |
--------------------------------------------------------------------------------
/elab/ElabAst.sig:
--------------------------------------------------------------------------------
1 | signature ELAB_AST = sig
2 | type fixity = Ast.fixity
3 | type symbol = Ast.symbol
4 | type literal = IntInf.int
5 | type srcpos = int
6 | type comment = string list
7 | type region = Ast.srcpos * Ast.srcpos
8 | type path = Symbol.symbol list
9 |
10 | type 'a fixitem =
11 | { fixity : Symbol.symbol option, item : 'a, region : Ast.region }
12 |
13 | datatype 'a sigConst =
14 | NoSig
15 | | Opaque of 'a
16 | | Transparent of 'a
17 |
18 | datatype exp =
19 | AndalsoExp of exp * exp
20 | | AppExp of { argument : exp, function : exp }
21 | | CaseExp of { expr : exp, rules : rule list }
22 | | CharExp of string
23 | | ConstraintExp of { constraint : ty, expr : exp }
24 | | FixAppExp of exp FixityParser.fixexp
25 | | FnExp of rule list
26 | | HandleExp of { expr : exp, rules : rule list }
27 | | IfExp of { elseCase : exp, test : exp, thenCase : exp }
28 | | IntExp of literal
29 | | LetExp of { dec : dec, expr : exp }
30 | | ListExp of exp list
31 | | MarkExp of exp * region
32 | | OrelseExp of exp * exp
33 | | RaiseExp of exp
34 | | RealExp of string
35 | | RecordExp of (symbol * exp) list
36 | | SelectorExp of symbol
37 | | SeqExp of exp list
38 | | StringExp of string
39 | | TupleExp of exp list
40 | | VarExp of path
41 | | VectorExp of exp list
42 | | WhileExp of { expr : exp, test : exp }
43 | | WordExp of literal
44 | | CommentExp of comment * exp
45 | and rule = Rule of { exp : exp, pat : pat }
46 | and pat =
47 | AppPat of { argument : pat, constr : pat }
48 | | CharPat of string
49 | | ConstraintPat of { constraint : ty, pattern : pat }
50 | | FlatAppPat of pat fixitem list
51 | | IntPat of literal
52 | | LayeredPat of { expPat : pat, varPat : pat }
53 | | ListPat of pat list
54 | | MarkPat of pat * region
55 | | OrPat of pat list
56 | | RecordPat of { def : (symbol * pat) list, flexibility : bool }
57 | | StringPat of string
58 | | TuplePat of pat list
59 | | VarPat of path
60 | | VectorPat of pat list
61 | | WildPat
62 | | WordPat of literal
63 | | CommentPat of comment * pat
64 | and strexp =
65 | AppStr of path * (strexp * bool) list
66 | | AppStrI of path * (strexp * bool) list
67 | | BaseStr of dec
68 | | ConstrainedStr of strexp * sigexp sigConst
69 | | LetStr of dec * strexp
70 | | MarkStr of strexp * region
71 | | VarStr of path
72 | | CommentStr of comment * strexp
73 | and fctexp =
74 | AppFct of path * (strexp * bool) list * fsigexp sigConst
75 | | BaseFct of { body : strexp
76 | , constraint : sigexp sigConst
77 | , params : (symbol option * sigexp) list }
78 | | LetFct of dec * fctexp
79 | | MarkFct of fctexp * region
80 | | VarFct of path * fsigexp sigConst
81 | | CommentFct of comment * fctexp
82 | and wherespec =
83 | WhStruct of symbol list * symbol list
84 | | WhType of symbol list * tyvar list * ty
85 | and sigexp =
86 | AugSig of sigexp * wherespec list
87 | | BaseSig of spec list
88 | | MarkSig of sigexp * region
89 | | VarSig of symbol
90 | | CommentSig of comment * sigexp
91 | and fsigexp =
92 | BaseFsig of { param : (symbol option * sigexp) list, result : sigexp }
93 | | MarkFsig of fsigexp * region
94 | | VarFsig of symbol
95 | | CommentFsig of comment * fsigexp
96 | and spec =
97 | DataReplSpec of symbol * path
98 | | DataSpec of { datatycs : db list, withtycs : tb list }
99 | | ExceSpec of (symbol * ty option) list
100 | | FctSpec of (symbol * fsigexp) list
101 | | IncludeSpec of sigexp
102 | | MarkSpec of spec * region
103 | | ShareStrSpec of path list
104 | | ShareTycSpec of path list
105 | | StrSpec of (symbol * sigexp * path option) list
106 | | TycSpec of (symbol * tyvar list * ty option) list * bool
107 | | ValSpec of (symbol * ty) list
108 | | CommentSpec of comment * spec
109 | and dec =
110 | AbsDec of strb list
111 | | AbstypeDec of { abstycs : db list, body : dec, withtycs : tb list }
112 | | DataReplDec of symbol * path
113 | | DatatypeDec of { datatycs : db list, withtycs : tb list }
114 | | DoDec of exp
115 | | ExceptionDec of eb list
116 | | FctDec of fctb list
117 | | FixDec of { fixity : fixity, ops : symbol list }
118 | | FsigDec of fsigb list
119 | | FunDec of fb list * tyvar list
120 | | LocalDec of dec * dec
121 | | MarkDec of dec * region
122 | | OpenDec of path list
123 | | OvldDec of symbol * ty * exp list
124 | | SeqDec of dec list
125 | | SigDec of sigb list
126 | | StrDec of strb list
127 | | TypeDec of tb list
128 | | ValDec of vb list * tyvar list
129 | | ValrecDec of rvb list * tyvar list
130 | | CommentDec of comment * dec
131 | and vb =
132 | MarkVb of vb * region
133 | | Vb of { exp : exp, lazyp : bool, pat : pat }
134 | | CommentVb of comment * vb
135 | and rvb =
136 | MarkRvb of rvb * region
137 | | Rvb of { exp : exp
138 | , fixity : (symbol * region) option
139 | , lazyp : bool
140 | , resultty : ty option
141 | , var : symbol }
142 | | CommentRvb of comment * rvb
143 | and fb =
144 | Fb of clause list * bool
145 | | MarkFb of fb * region
146 | | CommentFb of comment * fb
147 | and clause = Clause of { exp : exp, pats : pat fixitem list, resultty : ty option }
148 | and tb =
149 | MarkTb of tb * region
150 | | Tb of { def : ty, tyc : symbol, tyvars : tyvar list }
151 | | CommentTb of comment * tb
152 | and db =
153 | Db of { lazyp : bool, rhs : (symbol * ty option) list, tyc : symbol, tyvars : tyvar list }
154 | | MarkDb of db * region
155 | | CommentDb of comment * db
156 | and eb =
157 | EbDef of { edef : path, exn : symbol }
158 | | EbGen of { etype : ty option, exn : symbol }
159 | | MarkEb of eb * region
160 | | CommentEb of comment * eb
161 | and strb =
162 | MarkStrb of strb * region
163 | | Strb of { constraint : sigexp sigConst, def : strexp, name : symbol }
164 | | CommentStrb of comment * strb
165 | and fctb =
166 | Fctb of { def : fctexp, name : symbol }
167 | | MarkFctb of fctb * region
168 | | CommentFctb of comment * fctb
169 | and sigb =
170 | MarkSigb of sigb * region
171 | | Sigb of { def : sigexp, name : symbol }
172 | | CommentSigb of comment * sigb
173 | and fsigb =
174 | Fsigb of { def : fsigexp, name : symbol }
175 | | MarkFsigb of fsigb * region
176 | | CommentFsigb of comment * fsigb
177 | and tyvar =
178 | MarkTyv of tyvar * region
179 | | Tyv of symbol
180 | | CommentTyv of comment * tyvar
181 | and ty =
182 | ConTy of symbol list * ty list
183 | | MarkTy of ty * region
184 | | RecordTy of (symbol * ty) list
185 | | TupleTy of ty list
186 | | VarTy of tyvar
187 | | CommentTy of comment * ty
188 | end
189 |
--------------------------------------------------------------------------------
/elab/ElabAst.sml:
--------------------------------------------------------------------------------
1 | structure ElabAst : ELAB_AST = struct
2 | type fixity = Ast.fixity
3 | type symbol = Ast.symbol
4 | type literal = IntInf.int
5 | type srcpos = int
6 | type comment = string list
7 | type region = Ast.srcpos * Ast.srcpos
8 | type path = Symbol.symbol list
9 |
10 | type 'a fixitem =
11 | { fixity : Symbol.symbol option, item : 'a, region : Ast.region }
12 |
13 | datatype 'a sigConst =
14 | NoSig
15 | | Opaque of 'a
16 | | Transparent of 'a
17 |
18 | datatype exp =
19 | AndalsoExp of exp * exp
20 | | AppExp of { argument : exp, function : exp }
21 | | CaseExp of { expr : exp, rules : rule list }
22 | | CharExp of string
23 | | ConstraintExp of { constraint : ty, expr : exp }
24 | | FixAppExp of exp FixityParser.fixexp
25 | | FnExp of rule list
26 | | HandleExp of { expr : exp, rules : rule list }
27 | | IfExp of { elseCase : exp, test : exp, thenCase : exp }
28 | | IntExp of literal
29 | | LetExp of { dec : dec, expr : exp }
30 | | ListExp of exp list
31 | | MarkExp of exp * region
32 | | OrelseExp of exp * exp
33 | | RaiseExp of exp
34 | | RealExp of string
35 | | RecordExp of (symbol * exp) list
36 | | SelectorExp of symbol
37 | | SeqExp of exp list
38 | | StringExp of string
39 | | TupleExp of exp list
40 | | VarExp of path
41 | | VectorExp of exp list
42 | | WhileExp of { expr : exp, test : exp }
43 | | WordExp of literal
44 | | CommentExp of comment * exp
45 | and rule = Rule of { exp : exp, pat : pat }
46 | and pat =
47 | AppPat of { argument : pat, constr : pat }
48 | | CharPat of string
49 | | ConstraintPat of { constraint : ty, pattern : pat }
50 | | FlatAppPat of pat fixitem list
51 | | IntPat of literal
52 | | LayeredPat of { expPat : pat, varPat : pat }
53 | | ListPat of pat list
54 | | MarkPat of pat * region
55 | | OrPat of pat list
56 | | RecordPat of { def : (symbol * pat) list, flexibility : bool }
57 | | StringPat of string
58 | | TuplePat of pat list
59 | | VarPat of path
60 | | VectorPat of pat list
61 | | WildPat
62 | | WordPat of literal
63 | | CommentPat of comment * pat
64 | and strexp =
65 | AppStr of path * (strexp * bool) list
66 | | AppStrI of path * (strexp * bool) list
67 | | BaseStr of dec
68 | | ConstrainedStr of strexp * sigexp sigConst
69 | | LetStr of dec * strexp
70 | | MarkStr of strexp * region
71 | | VarStr of path
72 | | CommentStr of comment * strexp
73 | and fctexp =
74 | AppFct of path * (strexp * bool) list * fsigexp sigConst
75 | | BaseFct of { body : strexp
76 | , constraint : sigexp sigConst
77 | , params : (symbol option * sigexp) list }
78 | | LetFct of dec * fctexp
79 | | MarkFct of fctexp * region
80 | | VarFct of path * fsigexp sigConst
81 | | CommentFct of comment * fctexp
82 | and wherespec =
83 | WhStruct of symbol list * symbol list
84 | | WhType of symbol list * tyvar list * ty
85 | and sigexp =
86 | AugSig of sigexp * wherespec list
87 | | BaseSig of spec list
88 | | MarkSig of sigexp * region
89 | | VarSig of symbol
90 | | CommentSig of comment * sigexp
91 | and fsigexp =
92 | BaseFsig of { param : (symbol option * sigexp) list, result : sigexp }
93 | | MarkFsig of fsigexp * region
94 | | VarFsig of symbol
95 | | CommentFsig of comment * fsigexp
96 | and spec =
97 | DataReplSpec of symbol * path
98 | | DataSpec of { datatycs : db list, withtycs : tb list }
99 | | ExceSpec of (symbol * ty option) list
100 | | FctSpec of (symbol * fsigexp) list
101 | | IncludeSpec of sigexp
102 | | MarkSpec of spec * region
103 | | ShareStrSpec of path list
104 | | ShareTycSpec of path list
105 | | StrSpec of (symbol * sigexp * path option) list
106 | | TycSpec of (symbol * tyvar list * ty option) list * bool
107 | | ValSpec of (symbol * ty) list
108 | | CommentSpec of comment * spec
109 | and dec =
110 | AbsDec of strb list
111 | | AbstypeDec of { abstycs : db list, body : dec, withtycs : tb list }
112 | | DataReplDec of symbol * path
113 | | DatatypeDec of { datatycs : db list, withtycs : tb list }
114 | | DoDec of exp
115 | | ExceptionDec of eb list
116 | | FctDec of fctb list
117 | | FixDec of { fixity : fixity, ops : symbol list }
118 | | FsigDec of fsigb list
119 | | FunDec of fb list * tyvar list
120 | | LocalDec of dec * dec
121 | | MarkDec of dec * region
122 | | OpenDec of path list
123 | | OvldDec of symbol * ty * exp list
124 | | SeqDec of dec list
125 | | SigDec of sigb list
126 | | StrDec of strb list
127 | | TypeDec of tb list
128 | | ValDec of vb list * tyvar list
129 | | ValrecDec of rvb list * tyvar list
130 | | CommentDec of comment * dec
131 | and vb =
132 | MarkVb of vb * region
133 | | Vb of { exp : exp, lazyp : bool, pat : pat }
134 | | CommentVb of comment * vb
135 | and rvb =
136 | MarkRvb of rvb * region
137 | | Rvb of { exp : exp
138 | , fixity : (symbol * region) option
139 | , lazyp : bool
140 | , resultty : ty option
141 | , var : symbol }
142 | | CommentRvb of comment * rvb
143 | and fb =
144 | Fb of clause list * bool
145 | | MarkFb of fb * region
146 | | CommentFb of comment * fb
147 | and clause = Clause of { exp : exp, pats : pat fixitem list, resultty : ty option }
148 | and tb =
149 | MarkTb of tb * region
150 | | Tb of { def : ty, tyc : symbol, tyvars : tyvar list }
151 | | CommentTb of comment * tb
152 | and db =
153 | Db of { lazyp : bool, rhs : (symbol * ty option) list, tyc : symbol, tyvars : tyvar list }
154 | | MarkDb of db * region
155 | | CommentDb of comment * db
156 | and eb =
157 | EbDef of { edef : path, exn : symbol }
158 | | EbGen of { etype : ty option, exn : symbol }
159 | | MarkEb of eb * region
160 | | CommentEb of comment * eb
161 | and strb =
162 | MarkStrb of strb * region
163 | | Strb of { constraint : sigexp sigConst, def : strexp, name : symbol }
164 | | CommentStrb of comment * strb
165 | and fctb =
166 | Fctb of { def : fctexp, name : symbol }
167 | | MarkFctb of fctb * region
168 | | CommentFctb of comment * fctb
169 | and sigb =
170 | MarkSigb of sigb * region
171 | | Sigb of { def : sigexp, name : symbol }
172 | | CommentSigb of comment * sigb
173 | and fsigb =
174 | Fsigb of { def : fsigexp, name : symbol }
175 | | MarkFsigb of fsigb * region
176 | | CommentFsigb of comment * fsigb
177 | and tyvar =
178 | MarkTyv of tyvar * region
179 | | Tyv of symbol
180 | | CommentTyv of comment * tyvar
181 | and ty =
182 | ConTy of symbol list * ty list
183 | | MarkTy of ty * region
184 | | RecordTy of (symbol * ty) list
185 | | TupleTy of ty list
186 | | VarTy of tyvar
187 | | CommentTy of comment * ty
188 | end
189 |
--------------------------------------------------------------------------------
/parser/CommentParser.sml:
--------------------------------------------------------------------------------
1 | structure CommentParser : COMMENT_PARSER = struct
2 | structure ParseInfo = struct
3 | type t =
4 | { previousCharacter : char
5 | , openCommentSymbolCount : int
6 | , inStringLiteral : bool
7 | , currentComment : string
8 | , comments : (string * int) list IntMap.map
9 | , currentLineNumber : int
10 | , currentColumnNumber : int }
11 |
12 | fun flipInStringLiteral
13 | { previousCharacter
14 | , openCommentSymbolCount
15 | , inStringLiteral
16 | , currentComment
17 | , comments
18 | , currentLineNumber
19 | , currentColumnNumber }
20 | =
21 | { previousCharacter = previousCharacter
22 | , openCommentSymbolCount = openCommentSymbolCount
23 | , inStringLiteral = not inStringLiteral
24 | , currentComment = currentComment
25 | , comments = comments
26 | , currentLineNumber = currentLineNumber
27 | , currentColumnNumber = currentColumnNumber }
28 |
29 | fun updatePreviousCharacter
30 | { previousCharacter
31 | , openCommentSymbolCount
32 | , inStringLiteral
33 | , currentComment
34 | , comments
35 | , currentLineNumber
36 | , currentColumnNumber }
37 | char
38 | =
39 | { previousCharacter = char
40 | , openCommentSymbolCount = openCommentSymbolCount
41 | , inStringLiteral = inStringLiteral
42 | , currentComment = currentComment
43 | , comments = comments
44 | , currentLineNumber = currentLineNumber
45 | , currentColumnNumber = currentColumnNumber }
46 |
47 | fun appendToCurrentComment
48 | { previousCharacter
49 | , openCommentSymbolCount
50 | , inStringLiteral
51 | , currentComment
52 | , comments
53 | , currentLineNumber
54 | , currentColumnNumber }
55 | char
56 | =
57 | { previousCharacter = previousCharacter
58 | , openCommentSymbolCount = openCommentSymbolCount
59 | , inStringLiteral = inStringLiteral
60 | , currentComment = currentComment ^ String.str char
61 | , comments = comments
62 | , currentLineNumber = currentLineNumber
63 | , currentColumnNumber = currentColumnNumber }
64 |
65 | fun clearCurrentComment
66 | { previousCharacter
67 | , openCommentSymbolCount
68 | , inStringLiteral
69 | , currentComment
70 | , comments
71 | , currentLineNumber
72 | , currentColumnNumber }
73 | =
74 | { previousCharacter = previousCharacter
75 | , openCommentSymbolCount = openCommentSymbolCount
76 | , inStringLiteral = inStringLiteral
77 | , currentComment = "(*"
78 | , comments = comments
79 | , currentLineNumber = currentLineNumber
80 | , currentColumnNumber = currentColumnNumber }
81 |
82 | fun inStringLiteral (t : t) = #inStringLiteral t
83 | fun openCommentSymbolCount (t : t) = #openCommentSymbolCount t
84 |
85 | fun incOpenCommentSymbolCount
86 | { previousCharacter
87 | , openCommentSymbolCount
88 | , inStringLiteral
89 | , currentComment
90 | , comments
91 | , currentLineNumber
92 | , currentColumnNumber }
93 | =
94 | { previousCharacter = previousCharacter
95 | , openCommentSymbolCount = openCommentSymbolCount + 1
96 | , inStringLiteral = inStringLiteral
97 | , currentComment = currentComment
98 | , comments = comments
99 | , currentLineNumber = currentLineNumber
100 | , currentColumnNumber = currentColumnNumber }
101 |
102 | fun decOpenCommentSymbolCount
103 | { previousCharacter
104 | , openCommentSymbolCount
105 | , inStringLiteral
106 | , currentComment
107 | , comments
108 | , currentLineNumber
109 | , currentColumnNumber }
110 | =
111 | { previousCharacter = previousCharacter
112 | , openCommentSymbolCount = openCommentSymbolCount - 1
113 | , inStringLiteral = inStringLiteral
114 | , currentComment = currentComment
115 | , comments = comments
116 | , currentLineNumber = currentLineNumber
117 | , currentColumnNumber = currentColumnNumber }
118 |
119 | fun insertMultiMap map key data =
120 | case IntMap.find (map, key) of
121 | NONE => IntMap.insert (map, key, [ data ])
122 | | SOME datas => IntMap.insert (map, key, data :: datas)
123 |
124 | fun commentEnded
125 | { previousCharacter
126 | , openCommentSymbolCount
127 | , inStringLiteral
128 | , currentComment
129 | , comments
130 | , currentLineNumber
131 | , currentColumnNumber }
132 | =
133 | { previousCharacter = previousCharacter
134 | , openCommentSymbolCount = openCommentSymbolCount
135 | , inStringLiteral = inStringLiteral
136 | , currentComment = currentComment
137 | , comments = insertMultiMap
138 | comments
139 | currentLineNumber
140 | (currentComment, currentColumnNumber - 1)
141 | , currentLineNumber = currentLineNumber
142 | , currentColumnNumber = currentColumnNumber }
143 |
144 | fun newLine
145 | { previousCharacter
146 | , openCommentSymbolCount
147 | , inStringLiteral
148 | , currentComment
149 | , comments
150 | , currentLineNumber
151 | , currentColumnNumber }
152 | =
153 | { previousCharacter = previousCharacter
154 | , openCommentSymbolCount = openCommentSymbolCount
155 | , inStringLiteral = inStringLiteral
156 | , currentComment = currentComment
157 | , comments = comments
158 | , currentLineNumber = currentLineNumber + 1
159 | , currentColumnNumber = 0 }
160 |
161 | fun incColumn
162 | { previousCharacter
163 | , openCommentSymbolCount
164 | , inStringLiteral
165 | , currentComment
166 | , comments
167 | , currentLineNumber
168 | , currentColumnNumber }
169 | =
170 | { previousCharacter = previousCharacter
171 | , openCommentSymbolCount = openCommentSymbolCount
172 | , inStringLiteral = inStringLiteral
173 | , currentComment = currentComment
174 | , comments = comments
175 | , currentLineNumber = currentLineNumber
176 | , currentColumnNumber = currentColumnNumber + 1 }
177 |
178 | val base =
179 | { previousCharacter = #" "
180 | , openCommentSymbolCount = 0
181 | , inStringLiteral = false
182 | , currentComment = "(*"
183 | , comments = IntMap.empty
184 | , currentLineNumber = 1
185 | , currentColumnNumber = 0 }
186 |
187 | fun toString
188 | { previousCharacter
189 | , openCommentSymbolCount
190 | , inStringLiteral
191 | , currentComment
192 | , comments
193 | , currentLineNumber
194 | , currentColumnNumber }
195 | =
196 | "((previousCharacter " ^ String.toString (String.str previousCharacter)
197 | ^ ") (openCommentSymbolCount "
198 | ^ Int.toString openCommentSymbolCount
199 | ^ ") (inStringLiteral "
200 | ^ Bool.toString inStringLiteral
201 | ^ ") (currentComment "
202 | ^ String.toString currentComment
203 | ^ ") (comments [opaque]) (currentLineNumber "
204 | ^ Int.toString currentLineNumber
205 | ^ ") (currentColumnNumber "
206 | ^ Int.toString currentColumnNumber
207 | ^ "))"
208 | end
209 |
210 | fun fold_stream
211 | (f : 'a * TextIO.elem -> 'a)
212 | (base : 'a)
213 | (instream : TextIO.StreamIO.instream)
214 | : 'a
215 | =
216 | case TextIO.StreamIO.input1 instream of
217 | NONE => base
218 | | SOME (elem, instream) => fold_stream f (f (base, elem)) instream
219 |
220 | fun combine (parseInfo : ParseInfo.t, char) =
221 | let
222 | val openCommentSymbolCount = ParseInfo.openCommentSymbolCount parseInfo
223 |
224 | fun appendChar char' =
225 | let
226 | val info =
227 | if openCommentSymbolCount > 0
228 | then ParseInfo.appendToCurrentComment parseInfo char
229 | else parseInfo
230 | in
231 | if char <> #"\n"
232 | then ParseInfo.incColumn (ParseInfo.updatePreviousCharacter info char')
233 | else ParseInfo.updatePreviousCharacter info char'
234 | end
235 | in
236 | case (#previousCharacter parseInfo, char) of
237 | (#"*", #")") =>
238 | if ParseInfo.inStringLiteral parseInfo
239 | then appendChar char
240 | else
241 | if openCommentSymbolCount > 1
242 | then ParseInfo.decOpenCommentSymbolCount (appendChar char)
243 | else
244 | if openCommentSymbolCount = 1
245 | then
246 | (ParseInfo.clearCurrentComment
247 | (ParseInfo.commentEnded
248 | (ParseInfo.decOpenCommentSymbolCount (appendChar char))))
249 | else raise Fail "Parse error: Invalid comments"
250 | | (#"\\", #"\\") =>
251 | if openCommentSymbolCount > 0 then appendChar char else appendChar (#" ")
252 | | (#"\\", #"\"") => appendChar char
253 | | (_, #"\"") =>
254 | if openCommentSymbolCount > 0
255 | then appendChar char
256 | else ParseInfo.flipInStringLiteral (appendChar char)
257 | | (#"(", #"*") =>
258 | if ParseInfo.inStringLiteral parseInfo
259 | then appendChar char
260 | else (ParseInfo.incOpenCommentSymbolCount (appendChar char))
261 | | (_, #"\n") => ParseInfo.newLine (appendChar char)
262 | | (_, char) => appendChar char
263 | end
264 |
265 | fun parse filename =
266 | let
267 | val stream = TextIO.getInstream (TextIO.openIn filename)
268 | val result = fold_stream combine ParseInfo.base stream
269 | in
270 | #comments result
271 | end
272 | end
273 |
--------------------------------------------------------------------------------
/elab/Elab.sml:
--------------------------------------------------------------------------------
1 | structure Elab : ELAB = struct
2 | open ElabAst
3 |
4 | type conversionInfo =
5 | { sourceMap : SourceMap.sourcemap
6 | , comments : (int * string list) list ref
7 | , fixity : Fixity.fixity StringMap.map ref }
8 |
9 | (* Comments should be sorted in descending order by line *)
10 | fun getLine sourceMap (left, right) =
11 | let
12 | val regions = SourceMap.fileregion sourceMap (left, right)
13 | val lines = List.map (fn (left, _) => #line left) regions
14 | in
15 | List.foldl Int.max 0 lines
16 | end
17 |
18 | fun mapFixitem f { fixity, item, region } =
19 | { fixity = fixity, item = f item, region = region }
20 |
21 | fun mapSigconst f Ast.NoSig = NoSig
22 | | mapSigconst f (Ast.Opaque x) = Opaque (f x)
23 | | mapSigconst f (Ast.Transparent x) = Transparent (f x)
24 |
25 | fun intercalate sep [] = []
26 | | intercalate sep [ x ] = [ x ]
27 | | intercalate sep (x :: xs) = x :: sep :: intercalate sep xs
28 |
29 | fun newFixityScope (conversionInfo : conversionInfo) =
30 | { sourceMap = #sourceMap conversionInfo
31 | , comments = #comments conversionInfo
32 | , fixity = ref (!(#fixity conversionInfo)) }
33 |
34 | fun addComment (conversionInfo : conversionInfo) value convert comment mark region
35 | =
36 | let
37 | val line = getLine (#sourceMap conversionInfo) region
38 | val comments = #comments conversionInfo
39 |
40 | val attachedComments =
41 | List.filter (fn (commentLine, comments) => line >= commentLine) (!comments)
42 |
43 | val remainingComments =
44 | List.filter (fn (commentLine, comments) => line < commentLine) (!comments)
45 |
46 | val () = comments := remainingComments
47 | val converted = convert conversionInfo value
48 | in
49 | case attachedComments of
50 | [] => mark (converted, region)
51 | | comments =>
52 | comment
53 | (List.rev (List.map (fn (_, x) => String.concat x) comments)
54 | , mark (converted, region))
55 | end
56 |
57 | fun convertExp (conversionInfo : conversionInfo) exp =
58 | case exp of
59 | Ast.AndalsoExp (e1, e2) =>
60 | AndalsoExp (convertExp conversionInfo e1, convertExp conversionInfo e2)
61 | | Ast.AppExp { argument : Ast.exp, function : Ast.exp } =>
62 | AppExp
63 | { argument = convertExp conversionInfo argument
64 | , function = convertExp conversionInfo function }
65 | | Ast.CaseExp { expr : Ast.exp, rules : Ast.rule list } =>
66 | CaseExp
67 | { expr = convertExp conversionInfo expr
68 | , rules = List.map (convertRule conversionInfo) rules }
69 | | Ast.CharExp str => CharExp str
70 | | Ast.ConstraintExp { constraint : Ast.ty, expr : Ast.exp } =>
71 | ConstraintExp
72 | { constraint = convertTy conversionInfo constraint
73 | , expr = convertExp conversionInfo expr }
74 | | Ast.FlatAppExp exps =>
75 | FixAppExp
76 | (FixityParser.map
77 | (fn exp => convertExp conversionInfo (#item exp))
78 | (FixityParser.parse (!(#fixity conversionInfo)) exps))
79 | | Ast.FnExp rules => FnExp (List.map (convertRule conversionInfo) rules)
80 | | Ast.HandleExp { expr : Ast.exp, rules : Ast.rule list } =>
81 | HandleExp
82 | { expr = convertExp conversionInfo expr
83 | , rules = List.map (convertRule conversionInfo) rules }
84 | | Ast.IfExp { elseCase : Ast.exp, test : Ast.exp, thenCase : Ast.exp } =>
85 | IfExp
86 | { elseCase = convertExp conversionInfo elseCase
87 | , test = convertExp conversionInfo test
88 | , thenCase = convertExp conversionInfo thenCase }
89 | | Ast.IntExp literal => IntExp (ExtractLiteral.extractLiteral literal)
90 | | Ast.LetExp { dec : Ast.dec, expr : Ast.exp } =>
91 | let
92 | val conversionInfo = newFixityScope conversionInfo
93 | in
94 | LetExp
95 | { dec = convertDec conversionInfo dec, expr = convertExp conversionInfo expr }
96 | end
97 | | Ast.ListExp exps => ListExp (List.map (convertExp conversionInfo) exps)
98 | | Ast.OrelseExp (e1, e2) =>
99 | OrelseExp (convertExp conversionInfo e1, convertExp conversionInfo e2)
100 | | Ast.RaiseExp e => RaiseExp (convertExp conversionInfo e)
101 | | Ast.RealExp s => RealExp (ExtractLiteral.extractRealLiteral s)
102 | | Ast.RecordExp record =>
103 | RecordExp (List.map (fn (s, e) => (s, convertExp conversionInfo e)) record)
104 | | Ast.SelectorExp sym => SelectorExp sym
105 | | Ast.SeqExp exps => SeqExp (List.map (convertExp conversionInfo) exps)
106 | | Ast.StringExp str => StringExp str
107 | | Ast.TupleExp exps => TupleExp (List.map (convertExp conversionInfo) exps)
108 | | Ast.VarExp path => VarExp path
109 | | Ast.VectorExp exps => VectorExp (List.map (convertExp conversionInfo) exps)
110 | | Ast.WhileExp { expr : Ast.exp, test : Ast.exp } =>
111 | WhileExp
112 | { expr = convertExp conversionInfo expr, test = convertExp conversionInfo expr }
113 | | Ast.WordExp literal => WordExp (ExtractLiteral.extractLiteral literal)
114 | | Ast.MarkExp (exp, region) =>
115 | addComment conversionInfo exp convertExp CommentExp MarkExp region
116 |
117 | and convertRule conversionInfo (Ast.Rule { exp : Ast.exp, pat : Ast.pat }) =
118 | Rule
119 | { exp = convertExp conversionInfo exp, pat = convertPat conversionInfo pat }
120 |
121 | and convertPat conversionInfo pat =
122 | case pat of
123 | Ast.AppPat { argument : Ast.pat, constr : Ast.pat } =>
124 | AppPat
125 | { argument = convertPat conversionInfo argument
126 | , constr = convertPat conversionInfo constr }
127 | | Ast.CharPat str => CharPat str
128 | | Ast.ConstraintPat { constraint : Ast.ty, pattern : Ast.pat } =>
129 | ConstraintPat
130 | { constraint = convertTy conversionInfo constraint
131 | , pattern = convertPat conversionInfo pattern }
132 | | Ast.FlatAppPat pats =>
133 | FlatAppPat (List.map (mapFixitem (convertPat conversionInfo)) pats)
134 | | Ast.IntPat l => IntPat (ExtractLiteral.extractLiteral l)
135 | | Ast.LayeredPat { expPat : Ast.pat, varPat : Ast.pat } =>
136 | LayeredPat
137 | { expPat = convertPat conversionInfo expPat
138 | , varPat = convertPat conversionInfo varPat }
139 | | Ast.ListPat pats => ListPat (List.map (convertPat conversionInfo) pats)
140 | | Ast.OrPat pats => OrPat (List.map (convertPat conversionInfo) pats)
141 | | Ast.RecordPat { def : (symbol * Ast.pat) list, flexibility : bool } =>
142 | RecordPat
143 | { def = List.map (fn (sym, pat) => (sym, convertPat conversionInfo pat)) def
144 | , flexibility = flexibility }
145 | | Ast.StringPat str => StringPat str
146 | | Ast.TuplePat pats => TuplePat (List.map (convertPat conversionInfo) pats)
147 | | Ast.VarPat path => VarPat path
148 | | Ast.VectorPat pats => VectorPat (List.map (convertPat conversionInfo) pats)
149 | | Ast.WildPat => WildPat
150 | | Ast.WordPat l => WordPat (ExtractLiteral.extractLiteral l)
151 | | Ast.MarkPat (pat, region) =>
152 | addComment conversionInfo pat convertPat CommentPat MarkPat region
153 |
154 | and convertStrexp conversionInfo strexp =
155 | case strexp of
156 | Ast.AppStr (path, strexps) =>
157 | AppStr
158 | (path
159 | , List.map
160 | (fn (strexp, bool) => (convertStrexp conversionInfo strexp, bool))
161 | strexps)
162 | | Ast.AppStrI (path, strexps) =>
163 | AppStrI
164 | (path
165 | , List.map
166 | (fn (strexp, bool) => (convertStrexp conversionInfo strexp, bool))
167 | strexps)
168 | | Ast.BaseStr dec => BaseStr (convertDec (newFixityScope conversionInfo) dec)
169 | | Ast.ConstrainedStr (strexp, sigConst) =>
170 | ConstrainedStr
171 | (convertStrexp conversionInfo strexp
172 | , mapSigconst (convertSigexp conversionInfo) sigConst)
173 | | Ast.LetStr (dec, strexp) =>
174 | let
175 | val conversionInfo = newFixityScope conversionInfo
176 | in
177 | LetStr (convertDec conversionInfo dec, convertStrexp conversionInfo strexp)
178 | end
179 | | Ast.MarkStr (strexp, region) =>
180 | addComment conversionInfo strexp convertStrexp CommentStr MarkStr region
181 | | Ast.VarStr path => VarStr path
182 |
183 | and convertFctexp conversionInfo fctexp =
184 | case fctexp of
185 | Ast.AppFct (path, strexps, sigConst) =>
186 | AppFct
187 | (path
188 | , List.map
189 | (fn (strexp, bool) => (convertStrexp conversionInfo strexp, bool))
190 | strexps
191 | , mapSigconst (convertFsigexp conversionInfo) sigConst)
192 | | Ast.BaseFct
193 | { body : Ast.strexp
194 | , constraint : Ast.sigexp Ast.sigConst
195 | , params : (symbol option * Ast.sigexp) list } =>
196 | BaseFct
197 | { body = convertStrexp conversionInfo body
198 | , constraint = mapSigconst (convertSigexp conversionInfo) constraint
199 | , params = List.map
200 | (fn (sym, sigexp) => (sym, convertSigexp conversionInfo sigexp))
201 | params }
202 | | Ast.LetFct (dec, fctexp) =>
203 | let
204 | val conversionInfo = newFixityScope conversionInfo
205 | in
206 | LetFct (convertDec conversionInfo dec, convertFctexp conversionInfo fctexp)
207 | end
208 | | Ast.MarkFct (fctexp, region) =>
209 | addComment conversionInfo fctexp convertFctexp CommentFct MarkFct region
210 | | Ast.VarFct (path, sigConst) =>
211 | VarFct (path, mapSigconst (convertFsigexp conversionInfo) sigConst)
212 |
213 | and convertWherespec conversionInfo (Ast.WhStruct x) = WhStruct x
214 | | convertWherespec conversionInfo (Ast.WhType (sym, tyvar, ty)) =
215 | WhType
216 | (sym, List.map (convertTyvar conversionInfo) tyvar, convertTy conversionInfo ty)
217 |
218 | and convertSigexp conversionInfo sigexp =
219 | case sigexp of
220 | Ast.AugSig (sigexp, wherespecs) =>
221 | AugSig
222 | (convertSigexp conversionInfo sigexp
223 | , List.map (convertWherespec conversionInfo) wherespecs)
224 | | Ast.BaseSig specs => BaseSig (List.map (convertSpec conversionInfo) specs)
225 | | Ast.MarkSig (sigexp, region) =>
226 | addComment conversionInfo sigexp convertSigexp CommentSig MarkSig region
227 | | Ast.VarSig sym => VarSig sym
228 |
229 | and convertFsigexp conversionInfo fsigexp =
230 | case fsigexp of
231 | Ast.BaseFsig
232 | { param : (symbol option * Ast.sigexp) list, result : Ast.sigexp } =>
233 | BaseFsig
234 | { param = List.map
235 | (fn (sym, sigexp) => (sym, convertSigexp conversionInfo sigexp))
236 | param
237 | , result = convertSigexp conversionInfo result }
238 | | Ast.MarkFsig (fsigexp, region) =>
239 | addComment
240 | conversionInfo
241 | fsigexp
242 | convertFsigexp
243 | CommentFsig
244 | MarkFsig
245 | region
246 | | Ast.VarFsig sym => VarFsig sym
247 |
248 | and convertSpec conversionInfo spec =
249 | case spec of
250 | Ast.DataReplSpec (symbol, path) => DataReplSpec (symbol, path)
251 | | Ast.DataSpec { datatycs : Ast.db list, withtycs : Ast.tb list } =>
252 | DataSpec
253 | { datatycs = List.map (convertDb conversionInfo) datatycs
254 | , withtycs = List.map (convertTb conversionInfo) withtycs }
255 | | Ast.ExceSpec tys =>
256 | ExceSpec
257 | (List.map
258 | (fn (sym, ty) => (sym, Option.map (convertTy conversionInfo) ty))
259 | tys)
260 | | Ast.FctSpec fsigexps =>
261 | FctSpec
262 | (List.map
263 | (fn (sym, fsigexp) => (sym, convertFsigexp conversionInfo fsigexp))
264 | fsigexps)
265 | | Ast.IncludeSpec sigexp => IncludeSpec (convertSigexp conversionInfo sigexp)
266 | | Ast.MarkSpec (spec, region) =>
267 | addComment conversionInfo spec convertSpec CommentSpec MarkSpec region
268 | | Ast.ShareStrSpec paths => ShareStrSpec paths
269 | | Ast.ShareTycSpec paths => ShareTycSpec paths
270 | | Ast.StrSpec strs =>
271 | StrSpec
272 | (List.map
273 | (fn (sym, sigexp, path) => (sym, convertSigexp conversionInfo sigexp, path))
274 | strs)
275 | | Ast.TycSpec (tys, b) =>
276 | TycSpec
277 | (List.map
278 | (fn (sym, tyvars, ty) =>
279 | (sym
280 | , List.map (convertTyvar conversionInfo) tyvars
281 | , Option.map (convertTy conversionInfo) ty))
282 | tys
283 | , b)
284 | | Ast.ValSpec tys =>
285 | ValSpec (List.map (fn (sym, ty) => (sym, convertTy conversionInfo ty)) tys)
286 |
287 | and convertDec conversionInfo dec =
288 | case dec of
289 | Ast.AbsDec strbs => AbsDec (List.map (convertStrb conversionInfo) strbs)
290 | | Ast.AbstypeDec
291 | { abstycs : Ast.db list, body : Ast.dec, withtycs : Ast.tb list } =>
292 | AbstypeDec
293 | { abstycs = List.map (convertDb conversionInfo) abstycs
294 | , body = convertDec (newFixityScope conversionInfo) dec
295 | , withtycs = List.map (convertTb conversionInfo) withtycs }
296 | | Ast.DataReplDec (sym, path) => DataReplDec (sym, path)
297 | | Ast.DatatypeDec { datatycs : Ast.db list, withtycs : Ast.tb list } =>
298 | DatatypeDec
299 | { datatycs = List.map (convertDb conversionInfo) datatycs
300 | , withtycs = List.map (convertTb conversionInfo) withtycs }
301 | | Ast.DoDec exp => DoDec (convertExp conversionInfo exp)
302 | | Ast.ExceptionDec ebs =>
303 | ExceptionDec (List.map (convertEb conversionInfo) ebs)
304 | | Ast.FctDec fctbs => FctDec (List.map (convertFctb conversionInfo) fctbs)
305 | | Ast.FixDec { fixity : fixity, ops : symbol list } =>
306 | let
307 | val fixitymap = #fixity conversionInfo
308 | in
309 | ((List.app
310 | (fn sym =>
311 | Ref.modify
312 | (fn map => StringMap.insert (map, Symbol.name sym, fixity))
313 | fixitymap)
314 | ops);
315 | FixDec { fixity = fixity, ops = ops })
316 | end
317 | | Ast.FsigDec fsigbs =>
318 | FsigDec (List.map (convertFsigb conversionInfo) fsigbs)
319 | | Ast.FunDec (fbs, tyvars) =>
320 | FunDec
321 | (List.map (convertFb conversionInfo) fbs
322 | , List.map (convertTyvar conversionInfo) tyvars)
323 | | Ast.LocalDec (d1, d2) =>
324 | let
325 | (* Adds d2's infix bindings to outer conversionInfo scope *)
326 | val _ = convertDec conversionInfo d2
327 | val conversionInfo = newFixityScope conversionInfo
328 | in
329 | LocalDec (convertDec conversionInfo d1, convertDec conversionInfo d2)
330 | end
331 | | Ast.OpenDec paths => OpenDec paths
332 | | Ast.OvldDec (symbol, ty, exps) =>
333 | OvldDec
334 | (symbol, convertTy conversionInfo ty, List.map (convertExp conversionInfo) exps)
335 | | Ast.SeqDec decs => SeqDec (List.map (convertDec conversionInfo) decs)
336 | | Ast.SigDec sigbs => SigDec (List.map (convertSigb conversionInfo) sigbs)
337 | | Ast.StrDec strbs => StrDec (List.map (convertStrb conversionInfo) strbs)
338 | | Ast.TypeDec tbs => TypeDec (List.map (convertTb conversionInfo) tbs)
339 | | Ast.ValDec (vbs, tyvars) =>
340 | ValDec
341 | (List.map (convertVb conversionInfo) vbs
342 | , List.map (convertTyvar conversionInfo) tyvars)
343 | | Ast.ValrecDec (rvbs, tyvars) =>
344 | ValrecDec
345 | (List.map (convertRvb conversionInfo) rvbs
346 | , List.map (convertTyvar conversionInfo) tyvars)
347 | | Ast.MarkDec (dec, region) =>
348 | addComment conversionInfo dec convertDec CommentDec MarkDec region
349 |
350 | and convertVb conversionInfo vb =
351 | case vb of
352 | Ast.MarkVb (vb, region) =>
353 | addComment conversionInfo vb convertVb CommentVb MarkVb region
354 | | Ast.Vb { exp : Ast.exp, lazyp : bool, pat : Ast.pat } =>
355 | Vb
356 | { exp = convertExp conversionInfo exp
357 | , lazyp = lazyp
358 | , pat = convertPat conversionInfo pat }
359 |
360 | and convertRvb conversionInfo rvb =
361 | case rvb of
362 | Ast.MarkRvb (rvb, region) =>
363 | addComment conversionInfo rvb convertRvb CommentRvb MarkRvb region
364 | | Ast.Rvb
365 | { exp : Ast.exp
366 | , fixity : (symbol * region) option
367 | , lazyp : bool
368 | , resultty : Ast.ty option
369 | , var : symbol } =>
370 | Rvb
371 | { exp = convertExp conversionInfo exp
372 | , fixity = fixity
373 | , lazyp = lazyp
374 | , resultty = Option.map (convertTy conversionInfo) resultty
375 | , var = var }
376 |
377 | and convertFb conversionInfo (Ast.Fb (clauses, b)) =
378 | Fb (List.map (convertClause conversionInfo) clauses, b)
379 | | convertFb conversionInfo (Ast.MarkFb (fb, region)) =
380 | addComment conversionInfo fb convertFb CommentFb MarkFb region
381 |
382 | and convertClause
383 | conversionInfo
384 | (Ast.Clause
385 | { exp : Ast.exp, pats : Ast.pat Ast.fixitem list, resultty : Ast.ty option })
386 | =
387 | Clause
388 | { exp = convertExp conversionInfo exp
389 | , pats = List.map (mapFixitem (convertPat conversionInfo)) pats
390 | , resultty = Option.map (convertTy conversionInfo) resultty }
391 |
392 | and convertTb conversionInfo (Ast.MarkTb (tb, region)) =
393 | addComment conversionInfo tb convertTb CommentTb MarkTb region
394 | | convertTb
395 | conversionInfo
396 | (Ast.Tb { def : Ast.ty, tyc : symbol, tyvars : Ast.tyvar list })
397 | =
398 | Tb
399 | { def = convertTy conversionInfo def
400 | , tyc = tyc
401 | , tyvars = List.map (convertTyvar conversionInfo) tyvars }
402 |
403 | and convertDb
404 | conversionInfo
405 | (Ast.Db
406 | { lazyp : bool
407 | , rhs : (symbol * Ast.ty option) list
408 | , tyc : symbol
409 | , tyvars : Ast.tyvar list })
410 | =
411 | Db
412 | { lazyp = lazyp
413 | , rhs = List.map
414 | (fn (sym, ty) => (sym, Option.map (convertTy conversionInfo) ty))
415 | rhs
416 | , tyc = tyc
417 | , tyvars = List.map (convertTyvar conversionInfo) tyvars }
418 | | convertDb conversionInfo (Ast.MarkDb (db, region)) =
419 | addComment conversionInfo db convertDb CommentDb MarkDb region
420 |
421 | and convertEb conversionInfo eb =
422 | case eb of
423 | Ast.EbDef { edef : path, exn : symbol } => EbDef { edef = edef, exn = exn }
424 | | Ast.EbGen { etype : Ast.ty option, exn : symbol } =>
425 | EbGen { etype = Option.map (convertTy conversionInfo) etype, exn = exn }
426 | | Ast.MarkEb (eb, region) =>
427 | addComment conversionInfo eb convertEb CommentEb MarkEb region
428 |
429 | and convertStrb conversionInfo (Ast.MarkStrb (strb, region)) =
430 | addComment conversionInfo strb convertStrb CommentStrb MarkStrb region
431 | | convertStrb
432 | conversionInfo
433 | (Ast.Strb
434 | { constraint : Ast.sigexp Ast.sigConst, def : Ast.strexp, name : symbol })
435 | =
436 | Strb
437 | { constraint = mapSigconst (convertSigexp conversionInfo) constraint
438 | , def = convertStrexp conversionInfo def
439 | , name = name }
440 |
441 | and convertFctb conversionInfo (Ast.Fctb { def : Ast.fctexp, name : symbol }) =
442 | Fctb { def = convertFctexp conversionInfo def, name = name }
443 | | convertFctb conversionInfo (Ast.MarkFctb (fctb, region)) =
444 | addComment conversionInfo fctb convertFctb CommentFctb MarkFctb region
445 |
446 | and convertSigb conversionInfo (Ast.MarkSigb (sigb, region)) =
447 | addComment conversionInfo sigb convertSigb CommentSigb MarkSigb region
448 | | convertSigb conversionInfo (Ast.Sigb { def : Ast.sigexp, name : symbol }) =
449 | Sigb { def = convertSigexp conversionInfo def, name = name }
450 |
451 | and convertFsigb conversionInfo (Ast.Fsigb { def : Ast.fsigexp, name : symbol })
452 | =
453 | Fsigb { def = convertFsigexp conversionInfo def, name = name }
454 | | convertFsigb conversionInfo (Ast.MarkFsigb (fsigb, region)) =
455 | addComment conversionInfo fsigb convertFsigb CommentFsigb MarkFsigb region
456 |
457 | and convertTyvar conversionInfo (Ast.MarkTyv (tyvar, region)) =
458 | addComment conversionInfo tyvar convertTyvar CommentTyv MarkTyv region
459 | | convertTyvar conversionInfo (Ast.Tyv sym) = Tyv sym
460 |
461 | and convertTy conversionInfo ty =
462 | case ty of
463 | Ast.ConTy (syms, tys) =>
464 | ConTy (syms, List.map (convertTy conversionInfo) tys)
465 | | Ast.MarkTy (ty, region) =>
466 | addComment conversionInfo ty convertTy CommentTy MarkTy region
467 | | Ast.RecordTy tys =>
468 | RecordTy
469 | (List.map (fn (sym, ty) => (sym, convertTy conversionInfo ty)) tys)
470 | | Ast.TupleTy tys => TupleTy (List.map (convertTy conversionInfo) tys)
471 | | Ast.VarTy tyvar => VarTy (convertTyvar conversionInfo tyvar)
472 |
473 | val elaborate = convertDec
474 | end
475 |
--------------------------------------------------------------------------------
/format/Format.sml:
--------------------------------------------------------------------------------
1 | structure Format : FORMAT = struct
2 | open ElabAst
3 | val indentSize = 2
4 | val characters = 75
5 | type formatInfo = { indent : int }
6 | fun createIndent n = String.concat (List.tabulate (n, fn _ => " "))
7 |
8 | fun intercalate sep [] = []
9 | | intercalate sep [ x ] = [ x ]
10 | | intercalate sep (x :: xs) = x :: sep :: intercalate sep xs
11 |
12 | fun mapFixitem f { fixity, item, region } =
13 | { fixity = fixity, item = f item, region = region }
14 |
15 | fun mapSigconst f NoSig = NoSig
16 | | mapSigconst f (Opaque x) = Opaque (f x)
17 | | mapSigconst f (Transparent x) = Transparent (f x)
18 |
19 | fun shouldNewline formatted =
20 | String.isSubstring "\n" formatted orelse String.size formatted > characters
21 |
22 | fun pathToString path =
23 | String.concat (intercalate "." (List.map Symbol.name path))
24 |
25 | fun formatExp (formatInfo as { indent }) exp =
26 | case exp of
27 | AndalsoExp (e1, e2) =>
28 | let
29 | val e1 = formatExp formatInfo e1
30 | val e2 = formatExp formatInfo e2
31 | val oneLine = e1 ^ " andalso " ^ e2
32 | in
33 | if shouldNewline oneLine
34 | then e1 ^ " andalso\n" ^ (createIndent indent) ^ e2
35 | else oneLine
36 | end
37 | | OrelseExp (e1, e2) =>
38 | let
39 | val e1 = formatExp formatInfo e1
40 | val e2 = formatExp formatInfo e2
41 | val oneLine = e1 ^ " orelse " ^ e2
42 | in
43 | if shouldNewline oneLine
44 | then e1 ^ " orelse\n" ^ (createIndent indent) ^ e2
45 | else oneLine
46 | end
47 | | AppExp { argument : exp, function : exp } =>
48 | formatExp formatInfo function ^ " " ^ formatExp formatInfo argument
49 | | CaseExp { expr : exp, rules : rule list } =>
50 | "case " ^ formatExp formatInfo expr ^ " of\n"
51 | ^ (createIndent (indent + indentSize + 2))
52 | ^ formatRules { indent = indent + indentSize } rules
53 | | CharExp str => "#\"" ^ String.toString str ^ "\""
54 | | ConstraintExp { constraint : ty, expr : exp } =>
55 | formatExp formatInfo expr ^ " : " ^ formatTy formatInfo constraint
56 | | FixAppExp (FixityParser.FlatApp [ exp ]) => formatExp formatInfo exp
57 | | FixAppExp exps =>
58 | let
59 | fun intercalateWithBang sep [] = []
60 | | intercalateWithBang sep [ x ] = [ x ]
61 | | intercalateWithBang sep (x :: xs) =
62 | if x = "!"
63 | then x :: (intercalateWithBang sep xs)
64 | else x :: sep :: (intercalateWithBang sep xs)
65 |
66 | fun format (FixityParser.FlatApp (exp :: exps)) =
67 | let
68 | val func = formatExp formatInfo exp
69 | val args = List.map (formatExp { indent = indent + indentSize }) exps
70 | val argNewline = "\n" ^ (createIndent (indent + indentSize))
71 | val oneLine = String.concat (intercalateWithBang " " (func :: args))
72 | in
73 | if shouldNewline oneLine
74 | then func ^ argNewline ^ String.concat (intercalate argNewline args)
75 | else oneLine
76 | end
77 | | format (FixityParser.FlatApp []) = ""
78 | | format (FixityParser.InfixApp (aL, exp, aR)) =
79 | let
80 | val func = formatExp formatInfo exp
81 | val argsL = format aL
82 | val argsR = format aR
83 | val newline = "\n" ^ (createIndent indent)
84 | val oneLine = argsL ^ " " ^ func ^ " " ^ argsR
85 | in
86 | if shouldNewline oneLine
87 | then argsL ^ newline ^ func ^ " " ^ argsR
88 | else oneLine
89 | end
90 | in
91 | format exps
92 | end
93 | | FnExp rules =>
94 | "fn "
95 | ^ (String.concat
96 | (intercalate
97 | ("\n" ^ (createIndent (indent + 1)) ^ "| ")
98 | (List.map (formatRule { indent = indent + 1 }) rules)))
99 |
100 | | HandleExp { expr : exp, rules : rule list } =>
101 | formatExp formatInfo expr ^ " handle "
102 | ^ formatRules { indent = indent + 7 } rules
103 | | IfExp { elseCase : exp, test : exp, thenCase : exp } =>
104 | let
105 | fun formatPart part partNewlines =
106 | if partNewlines
107 | then "\n" ^ (createIndent (indent + indentSize)) ^ part
108 | else part
109 |
110 | val test = formatExp { indent = indent + indentSize } test
111 | val testNewlines = shouldNewline test
112 | val elseCase = formatExp { indent = indent + indentSize } elseCase
113 | val elseNewlines = shouldNewline elseCase
114 | val thenCase = formatExp { indent = indent + indentSize } thenCase
115 | val thenNewlines = shouldNewline thenCase
116 | val test = formatPart test testNewlines
117 | val elseCase = formatPart elseCase elseNewlines
118 | val thenCase = formatPart thenCase thenNewlines
119 |
120 | val notOneLine =
121 | testNewlines orelse
122 | thenNewlines orelse
123 | elseNewlines orelse
124 | String.size test + String.size thenCase + String.size elseCase + 13
125 | > characters
126 |
127 | val sep = if notOneLine then "\n" ^ (createIndent indent) else " "
128 | in
129 | "if " ^ test ^ sep ^ "then " ^ thenCase ^ sep ^ "else " ^ elseCase
130 | end
131 | | IntExp literal => IntInf.toString literal
132 | | LetExp { dec : dec, expr : exp } =>
133 | let
134 | fun reduceSingletonSeq exp =
135 | case exp of
136 | MarkExp (exp, region) => MarkExp (reduceSingletonSeq exp, region)
137 | | CommentExp (comment, exp) => CommentExp (comment, reduceSingletonSeq exp)
138 | | FixAppExp (FixityParser.FlatApp [ exp ]) =>
139 | FixAppExp (FixityParser.FlatApp [ reduceSingletonSeq exp ])
140 | | SeqExp [ exp ] => reduceSingletonSeq exp
141 | | _ => exp
142 | in
143 | "let" ^ "\n" ^ (createIndent (indent + indentSize))
144 | ^ formatDec { indent = indent + indentSize } dec
145 | ^ "\n"
146 | ^ (createIndent indent)
147 | ^ "in"
148 | ^ "\n"
149 | ^ (createIndent (indent + indentSize))
150 | ^ formatExp { indent = indent + indentSize } (reduceSingletonSeq expr)
151 | ^ "\n"
152 | ^ (createIndent indent)
153 | ^ "end"
154 | end
155 | | ListExp [] => "[]"
156 | | ListExp exps =>
157 | let
158 | val exps = List.map (formatExp formatInfo) exps
159 |
160 | val sep =
161 | if shouldNewline (String.concat exps)
162 | then "\n" ^ (createIndent indent) ^ ", "
163 | else ", "
164 | in
165 | "[ " ^ String.concat (intercalate sep exps) ^ " ]"
166 | end
167 | | MarkExp (exp, region) => formatExp formatInfo exp
168 | | RaiseExp e => "raise " ^ formatExp formatInfo e
169 | | RealExp s => s
170 | | RecordExp [] => "()"
171 | | RecordExp exps =>
172 | let
173 | val fields =
174 | (List.map
175 | (fn (sym, exp) => Symbol.name sym ^ " = " ^ formatExp formatInfo exp)
176 | exps)
177 |
178 | val sep =
179 | if shouldNewline (String.concat fields)
180 | then "\n" ^ (createIndent indent) ^ ", "
181 | else ", "
182 | in
183 | "{ " ^ String.concat (intercalate sep fields) ^ " }"
184 | end
185 | | SelectorExp sym => "#" ^ (Symbol.name sym)
186 | | SeqExp exps =>
187 | let
188 | val exps = List.map (formatExp { indent = indent + 1 }) exps
189 | val oneLine = "(" ^ (String.concat (intercalate "; " exps)) ^ ")"
190 | in
191 | if shouldNewline oneLine
192 | then
193 | "("
194 | ^ (String.concat (intercalate (";\n" ^ (createIndent (indent + 1))) exps))
195 | ^ ")"
196 | else oneLine
197 | end
198 | | StringExp str => "\"" ^ (String.toString str) ^ "\""
199 | | TupleExp exps =>
200 | let
201 | val exps = List.map (formatExp formatInfo) exps
202 |
203 | val sep =
204 | if shouldNewline (String.concat exps)
205 | then "\n" ^ (createIndent indent) ^ ", "
206 | else ", "
207 | in
208 | "(" ^ String.concat (intercalate sep exps) ^ ")"
209 | end
210 | | VarExp path => pathToString path
211 | | VectorExp exps =>
212 | (* TODO: Add newlines to large vectors *)
213 | "#["
214 | ^ String.concat (intercalate ", " (List.map (formatExp formatInfo) exps))
215 | ^ "]"
216 | | WhileExp { expr : exp, test : exp } =>
217 | let
218 | fun formatPart part partNewlines =
219 | if partNewlines
220 | then "\n" ^ (createIndent (indent + indentSize)) ^ part
221 | else part
222 |
223 | val test = formatExp { indent = indent + indentSize } test
224 | val expr = formatExp { indent = indent + indentSize } expr
225 | val testNewlines = shouldNewline test
226 | val exprNewlines = shouldNewline expr
227 |
228 | val notOneLine =
229 | testNewlines orelse
230 | exprNewlines orelse String.size test + String.size expr + 8 > characters
231 |
232 | val sep = if notOneLine then "\n" ^ (createIndent indent) else " "
233 | in
234 | "while " ^ test ^ sep ^ "do " ^ expr
235 | end
236 | | WordExp literal => IntInf.toString literal
237 | | CommentExp (comment, exp) =>
238 | (String.concat (intercalate ("\n" ^ (createIndent indent)) comment)) ^ "\n"
239 | ^ (createIndent indent)
240 | ^ formatExp formatInfo exp
241 |
242 | and formatRules { indent } rules =
243 | String.concat
244 | (intercalate
245 | ("\n" ^ createIndent (Int.max (0, indent + indentSize - 2)) ^ "| ")
246 | (List.map (formatRule { indent = indent + indentSize }) rules))
247 |
248 | and formatRule (formatInfo as { indent }) (Rule { exp : exp, pat : pat }) =
249 | let
250 | val formattedPat = formatPat formatInfo false pat
251 | val formattedExp = formatExp { indent = indent + indentSize } exp
252 |
253 | val sep =
254 | if shouldNewline (formattedPat ^ " => " ^ formattedExp)
255 | then " =>\n" ^ (createIndent (indent + indentSize))
256 | else " => "
257 | in
258 | formattedPat ^ sep ^ formattedExp
259 | end
260 |
261 | and formatPat (formatInfo as { indent }) appNeedsParens pat =
262 | (* TODO: newlines in more patterns *)
263 | case pat of
264 | AppPat { argument : pat, constr : pat } =>
265 | formatPat formatInfo true constr ^ " " ^ formatPat formatInfo true argument
266 | | CharPat str => "#\"" ^ String.toString str ^ "\""
267 | | ConstraintPat { constraint : ty, pattern : pat } =>
268 | let
269 | val app =
270 | formatPat formatInfo appNeedsParens pattern ^ " : "
271 | ^ formatTy formatInfo constraint
272 | in
273 | if appNeedsParens then "(" ^ app ^ ")" else app
274 | end
275 | | FlatAppPat [ pat ] => formatPat formatInfo appNeedsParens (#item pat)
276 | | FlatAppPat pats =>
277 | let
278 | val pats =
279 | List.map
280 | (fn pat => formatPat { indent = indent + indentSize } true (#item pat))
281 | pats
282 |
283 | val oneLine = String.concat (intercalate " " pats)
284 |
285 | val app =
286 | if shouldNewline oneLine
287 | then
288 | String.concat
289 | (intercalate ("\n" ^ (createIndent (indent + indentSize))) pats)
290 | else oneLine
291 | in
292 | if appNeedsParens then "(" ^ app ^ ")" else app
293 | end
294 | | IntPat l => IntInf.toString l
295 | | LayeredPat { expPat : pat, varPat : pat } =>
296 | "(" ^ formatPat formatInfo false varPat ^ " as "
297 | ^ formatPat formatInfo false expPat
298 | ^ ")"
299 | | ListPat [] => "[]"
300 | | ListPat pats =>
301 | let
302 | val pats = List.map (formatPat formatInfo false) pats
303 |
304 | val sep =
305 | if shouldNewline (String.concat pats)
306 | then "\n" ^ (createIndent indent) ^ ", "
307 | else ", "
308 | in
309 | "[ " ^ String.concat (intercalate sep pats) ^ " ]"
310 | end
311 | | MarkPat (pat, region) => formatPat formatInfo appNeedsParens pat
312 | | OrPat pats =>
313 | "("
314 | ^ String.concat
315 | (intercalate " | " (List.map (formatPat formatInfo false) pats))
316 | ^ ")"
317 | | RecordPat { def = [], flexibility } => "()"
318 | | RecordPat { def : (symbol * pat) list, flexibility : bool } =>
319 | let
320 | fun reduceVarPat sym pat =
321 | case pat of
322 | CommentPat (comment, pat) =>
323 | let
324 | val (c0, constraints, isVar) = reduceVarPat sym pat
325 | in
326 | (comment :: c0, constraints, isVar)
327 | end
328 | | MarkPat (pat, region) => reduceVarPat sym pat
329 | | FlatAppPat [ pat ] => reduceVarPat sym (#item pat)
330 | | VarPat path => ([], [], Symbol.name sym = pathToString path)
331 | | ConstraintPat { constraint, pattern } =>
332 | let
333 | val (comments, c0, isVar) = reduceVarPat sym pattern
334 | in
335 | (comments, constraint :: c0, isVar)
336 | end
337 | | _ => ([], [], false)
338 |
339 | fun mkConstraints [] var = var
340 | | mkConstraints (x :: xs) var =
341 | (mkConstraints xs var) ^ " : " ^ (formatTy formatInfo x)
342 |
343 | val fields =
344 | (List.map
345 | (fn (sym, pat) =>
346 | let
347 | val (comments, constraints, isVar) = reduceVarPat sym pat
348 | in
349 | if not isVar
350 | then Symbol.name sym ^ " = " ^ formatPat formatInfo false pat
351 | else
352 | String.concat (List.concat comments)
353 | ^ mkConstraints constraints (Symbol.name sym)
354 | end)
355 | def)
356 |
357 | val sep =
358 | if shouldNewline (String.concat fields)
359 | then "\n" ^ (createIndent indent) ^ ", "
360 | else ", "
361 | in
362 | "{ " ^ String.concat (intercalate sep fields) ^ " }"
363 | end
364 | | StringPat str => "\"" ^ (String.toString str) ^ "\""
365 | | TuplePat pats =>
366 | let
367 | val pats = List.map (formatPat formatInfo false) pats
368 |
369 | val sep =
370 | if shouldNewline (String.concat pats)
371 | then "\n" ^ (createIndent indent) ^ ", "
372 | else ", "
373 | in
374 | "(" ^ String.concat (intercalate sep pats) ^ ")"
375 | end
376 | | VarPat path => pathToString path
377 | | VectorPat pats =>
378 | "#["
379 | ^ String.concat
380 | (intercalate ", " (List.map (formatPat formatInfo false) pats))
381 | ^ "]"
382 | | WildPat => "_"
383 | | WordPat l => IntInf.toString l
384 | | CommentPat (comment, pat) =>
385 | (String.concat (intercalate ("\n" ^ (createIndent indent)) comment)) ^ "\n"
386 | ^ (createIndent indent)
387 | ^ formatPat formatInfo appNeedsParens pat
388 |
389 | and formatStrexp (formatInfo as { indent }) strexp =
390 | case strexp of
391 | AppStr (path, strexps) =>
392 | pathToString path ^ " ("
393 | ^ String.concat
394 | (intercalate " " (List.map (fn (s, _) => formatStrexp formatInfo s) strexps))
395 | ^ ")"
396 | | AppStrI (path, strexps) =>
397 | pathToString path ^ " ("
398 | ^ String.concat
399 | (intercalate " " (List.map (fn (s, _) => formatStrexp formatInfo s) strexps))
400 | ^ ")"
401 | | BaseStr dec =>
402 | let
403 | val dec = formatDec { indent = indent + indentSize } dec
404 | in
405 | if dec = ""
406 | then "struct end"
407 | else
408 | "struct\n" ^ (createIndent (indent + indentSize)) ^ dec ^ "\n"
409 | ^ (createIndent indent)
410 | ^ "end"
411 | end
412 | | ConstrainedStr (strexp, sigConst) =>
413 | formatStrexp formatInfo strexp ^ formatSigconst formatInfo sigConst
414 | | LetStr (dec, strexp) =>
415 | (* TODO: Figure out what a LetStr is. *)
416 | raise Fail "Let structure not supported"
417 | | MarkStr (strexp, region) => formatStrexp formatInfo strexp
418 | | VarStr path => pathToString path
419 | | CommentStr (comment, strexp) =>
420 | (String.concat (intercalate ("\n" ^ (createIndent indent)) comment)) ^ "\n"
421 | ^ (createIndent indent)
422 | ^ formatStrexp formatInfo strexp
423 |
424 | and formatFctexp (formatInfo as { indent }) fctexp =
425 | case fctexp of
426 | AppFct (path, [], sigConst) =>
427 | pathToString path ^ " ()" ^ formatFsigconst formatInfo sigConst
428 | | AppFct (path, [ (strexp, _) ], sigConst) =>
429 | let
430 | val strexp = formatStrexp formatInfo strexp
431 |
432 | val sep =
433 | if shouldNewline strexp
434 | then ("\n" ^ (createIndent (indent + indentSize)))
435 | else " "
436 | in
437 | pathToString path ^ sep ^ "(" ^ strexp ^ ")"
438 | ^ formatFsigconst formatInfo sigConst
439 | end
440 | | AppFct (path, strexps, sigConst) =>
441 | pathToString path ^ "\n" ^ (createIndent (indent + indentSize))
442 | ^ (String.concat
443 | (intercalate
444 | ("\n" ^ (createIndent (indent + indentSize)))
445 | (List.map
446 | (fn (strexp, _) => formatStrexp { indent = indent + indentSize } strexp)
447 | strexps)))
448 |
449 | ^ "\n"
450 | ^ (createIndent (indent + indentSize))
451 | ^ formatFsigconst { indent = indent + indentSize } sigConst
452 | | BaseFct
453 | { body : strexp
454 | , constraint : sigexp sigConst
455 | , params : (symbol option * sigexp) list } =>
456 | String.concat
457 | (intercalate
458 | " "
459 | (List.map
460 | (fn (NONE, sigexp) =>
461 | let
462 | val sigexp = formatSigexp { indent = indent + 1 } true sigexp
463 | in
464 | if shouldNewline sigexp
465 | then "\n" ^ (createIndent (indent + indentSize)) ^ "(" ^ sigexp ^ ")"
466 | else "(" ^ sigexp ^ ")"
467 | end
468 | | (SOME sym, sigexp) =>
469 | "(" ^ Symbol.name sym ^ " : " ^ formatSigexp formatInfo false sigexp ^ ")")
470 | params))
471 | ^ formatSigconst { indent = indent + indentSize } constraint
472 | ^ " = "
473 | ^ formatStrexp formatInfo body
474 | | LetFct (dec, fctexp) =>
475 | (* TODO: Figure out what a LetFct is *)
476 | raise Fail "Let functor not supported"
477 | | MarkFct (fctexp, region) => formatFctexp formatInfo fctexp
478 | | VarFct (path, sigConst) =>
479 | pathToString path ^ formatFsigconst formatInfo sigConst
480 | | CommentFct (comment, fctexp) =>
481 | (String.concat (intercalate ("\n" ^ (createIndent indent)) comment)) ^ "\n"
482 | ^ (createIndent indent)
483 | ^ formatFctexp formatInfo fctexp
484 |
485 | and formatWherespec formatInfo (WhStruct (sym, def)) =
486 | pathToString sym ^ " = " ^ pathToString def
487 | | formatWherespec formatInfo (WhType (path, tyvars, ty)) =
488 | formatTyvars formatInfo tyvars ^ pathToString path ^ " = "
489 | ^ formatTy formatInfo ty
490 |
491 | and formatSigexp (formatInfo as { indent }) isFunctorArg sigexp =
492 | case sigexp of
493 | AugSig (sigexp, wherespecs) =>
494 | formatSigexp formatInfo false sigexp ^ " where type "
495 | ^ (String.concat
496 | (intercalate " and " (List.map (formatWherespec formatInfo) wherespecs)))
497 |
498 | | BaseSig [] => "sig end"
499 | | BaseSig specs =>
500 | let
501 | val body =
502 | let
503 | fun formatSpecs NONE [] = ""
504 | | formatSpecs (SOME prev) [] = prev
505 | | formatSpecs NONE (spec :: specs) =
506 | formatSpecs (SOME (formatSpec { indent = indent + indentSize } spec)) specs
507 | | formatSpecs (SOME prev) (spec :: specs) =
508 | let
509 | val spec = formatSpec { indent = indent + indentSize } spec
510 |
511 | val sep =
512 | if shouldNewline prev orelse shouldNewline spec
513 | then "\n\n" ^ (createIndent (indent + indentSize))
514 | else "\n" ^ (createIndent (indent + indentSize))
515 | in
516 | prev ^ sep ^ formatSpecs (SOME spec) specs
517 | end
518 | in
519 | formatSpecs NONE specs
520 | end
521 | in
522 | if isFunctorArg
523 | then body
524 | else
525 | "sig\n" ^ (createIndent (indent + indentSize)) ^ body ^ "\n"
526 | ^ (createIndent indent)
527 | ^ "end"
528 | end
529 | | MarkSig (sigexp, region) => formatSigexp formatInfo isFunctorArg sigexp
530 | | VarSig sym => Symbol.name sym
531 | | CommentSig (comment, sigexp) =>
532 | (String.concat (intercalate ("\n" ^ (createIndent indent)) comment)) ^ "\n"
533 | ^ (createIndent indent)
534 | ^ formatSigexp formatInfo isFunctorArg sigexp
535 |
536 | and formatSigconst { indent } sigConst =
537 | case sigConst of
538 | NoSig => ""
539 | | Opaque sigexp =>
540 | " :> " ^ formatSigexp { indent = indent + indentSize } false sigexp
541 | | Transparent sigexp =>
542 | " : " ^ formatSigexp { indent = indent + indentSize } false sigexp
543 |
544 | and (* TODO: Support functor signatures *)
545 | formatFsigconst { indent } sigConst =
546 | case sigConst of
547 | NoSig => ""
548 | | Opaque sigexp =>
549 | " :> " ^ formatFsigexp { indent = indent + indentSize } sigexp
550 | | Transparent sigexp =>
551 | " : " ^ formatFsigexp { indent = indent + indentSize } sigexp
552 |
553 | and formatFsigexp formatInfo fsigexp =
554 | case fsigexp of
555 | BaseFsig { param : (symbol option * sigexp) list, result : sigexp } => ""
556 | | MarkFsig (fsigexp, region) => ""
557 | | VarFsig sym => ""
558 | | CommentFsig (comment, sigexp) => ""
559 |
560 | and formatFsigb formatInfo (Fsigb { def : fsigexp, name : symbol }) = ""
561 | | formatFsigb formatInfo (MarkFsigb (fsigb, region)) = ""
562 | | formatFsigb formatInfo (CommentFsigb (comment, fsigb)) = ""
563 |
564 | and formatSpec (formatInfo as { indent }) spec =
565 | case spec of
566 | DataReplSpec (symbol, path) =>
567 | "datatype " ^ Symbol.name symbol ^ " = " ^ pathToString path
568 | | DataSpec { datatycs : db list, withtycs : tb list } =>
569 | let
570 | val withtycs =
571 | case withtycs of
572 | [] => ""
573 | | _ =>
574 | "\n" ^ (createIndent indent) ^ "withtype "
575 | ^ (String.concat
576 | (intercalate
577 | ("\n" ^ (createIndent indent) ^ "and ")
578 | (List.map (formatTb { indent = indent + indentSize }) withtycs)))
579 |
580 | in
581 | "datatype "
582 | ^ (String.concat
583 | (intercalate
584 | ("\n" ^ (createIndent indent) ^ "and ")
585 | (List.map (formatDb { indent = indent + indentSize }) datatycs)))
586 |
587 | ^ withtycs
588 | end
589 | | ExceSpec exns =>
590 | "exception "
591 | ^ String.concat
592 | (intercalate
593 | ("\n" ^ createIndent indent ^ "and ")
594 | (List.map
595 | (fn (sym, ty) =>
596 | Symbol.name sym
597 | ^ (case ty of
598 | NONE => ""
599 | | SOME ty => " of " ^ formatTy { indent = indent + indentSize } ty)
600 | )
601 | exns))
602 | | FctSpec fsigexps =>
603 | (* TODO: Support functor signatures *)
604 | raise Fail "Functor signatures not supported"
605 | | IncludeSpec sigexp => "include " ^ formatSigexp formatInfo false sigexp
606 | | MarkSpec (spec, region) => formatSpec formatInfo spec
607 | | ShareStrSpec paths =>
608 | "sharing "
609 | ^ String.concat (intercalate " = " (List.map pathToString paths))
610 | | ShareTycSpec paths =>
611 | "sharing type "
612 | ^ String.concat (intercalate " = " (List.map pathToString paths))
613 | | StrSpec strs =>
614 | "structure "
615 | ^ String.concat
616 | (intercalate
617 | ("\n" ^ createIndent indent ^ "and ")
618 | (List.map
619 | (fn (sym, sigexp, path) =>
620 | Symbol.name sym ^ " : " ^ formatSigexp formatInfo false sigexp
621 | ^ (case path of
622 | NONE => ""
623 | | SOME str => " = " ^ pathToString str)
624 | )
625 | strs))
626 | | TycSpec (tys, b) =>
627 | "type "
628 | ^ String.concat
629 | (intercalate
630 | ("\n" ^ createIndent indent ^ "and ")
631 | (List.map
632 | (fn (sym, tyvars, ty) =>
633 | (case ty of
634 | NONE => formatTyvars formatInfo tyvars ^ Symbol.name sym ^ ""
635 | | SOME ty =>
636 | formatTb formatInfo (Tb { def = ty, tyc = sym, tyvars = tyvars })))
637 | tys))
638 | | ValSpec syms =>
639 | "val "
640 | ^ String.concat
641 | (intercalate
642 | ("\n" ^ createIndent indent ^ "and ")
643 | (List.map
644 | (fn (sym, ty) =>
645 | Symbol.name sym ^ " : " ^ formatTy { indent = indent + indentSize } ty)
646 | syms))
647 | | CommentSpec (comment, spec) =>
648 | (String.concat (intercalate ("\n" ^ (createIndent indent)) comment)) ^ "\n"
649 | ^ (createIndent indent)
650 | ^ formatSpec formatInfo spec
651 |
652 | and formatDec (formatInfo as { indent }) dec =
653 | case dec of
654 | AbsDec strbs =>
655 | (* TODO: Figure out what an absdec is *)
656 | raise Fail "Absdec not supported"
657 | | AbstypeDec { abstycs : db list, body : dec, withtycs : tb list } =>
658 | let
659 | val withtycs =
660 | case withtycs of
661 | [] => ""
662 | | _ =>
663 | "\n" ^ (createIndent indent) ^ "withtype "
664 | ^ (String.concat
665 | (intercalate
666 | ("\n" ^ (createIndent indent) ^ "and ")
667 | (List.map (formatTb { indent = indent + indentSize }) withtycs)))
668 |
669 | in
670 | "abstype "
671 | ^ String.concat
672 | (intercalate
673 | ("\n" ^ createIndent (indent + indentSize) ^ "and")
674 | (List.map (formatDb { indent = indent + indentSize }) abstycs))
675 | ^ " with\n"
676 | ^ (createIndent (indent + indentSize))
677 | ^ formatDec { indent = indent + indentSize } body
678 | ^ "\n"
679 | ^ (createIndent indent)
680 | ^ "end"
681 | ^ withtycs
682 | end
683 | | DataReplDec (symbol, path) =>
684 | "datatype " ^ Symbol.name symbol ^ " = " ^ pathToString path
685 | | DatatypeDec { datatycs : db list, withtycs : tb list } =>
686 | let
687 | val withtycs =
688 | case withtycs of
689 | [] => ""
690 | | _ =>
691 | "\n" ^ (createIndent indent) ^ "withtype "
692 | ^ (String.concat
693 | (intercalate
694 | ("\n" ^ (createIndent indent) ^ "and ")
695 | (List.map (formatTb { indent = indent + indentSize }) withtycs)))
696 |
697 | in
698 | "datatype "
699 | ^ (String.concat
700 | (intercalate
701 | ("\n" ^ (createIndent indent) ^ "and ")
702 | (List.map (formatDb { indent = indent + indentSize }) datatycs)))
703 |
704 | ^ withtycs
705 | end
706 | | DoDec exp =>
707 | "do " ^ "\n" ^ (createIndent (indent + indentSize))
708 | ^ formatExp { indent = indent + indentSize } exp
709 | | ExceptionDec ebs =>
710 | "exception "
711 | ^ String.concat
712 | (intercalate
713 | ("\n" ^ createIndent indent ^ "and ")
714 | (List.map (formatEb { indent = indent + indentSize }) ebs))
715 | | FctDec fctbs =>
716 | (* TODO: The and should have an indent *)
717 | "functor "
718 | ^ String.concat
719 | (intercalate "\n\nand " (List.map (formatFctb formatInfo) fctbs))
720 | | SigDec sigbs =>
721 | (* TODO: The and should have an indent *)
722 | "signature "
723 | ^ String.concat
724 | (intercalate "\n\nand " (List.map (formatSigb formatInfo) sigbs))
725 | | StrDec strbs =>
726 | (* TODO: The and should have an indent *)
727 | "structure "
728 | ^ String.concat
729 | (intercalate "\n\nand " (List.map (formatStrb formatInfo) strbs))
730 | | FixDec { fixity : fixity, ops : symbol list } =>
731 | Fixity.fixityToString fixity
732 | ^ (String.concat (intercalate " " (List.map Symbol.name ops)))
733 | | FsigDec fsigbs =>
734 | (* TODO: Support functor signatures *)
735 | raise Fail "Functor signatures not supported"
736 | | FunDec (fbs, tyvars) =>
737 | let
738 | val fbs =
739 | case List.rev fbs of
740 | [] => []
741 | | x :: xs =>
742 | List.rev
743 | ((true, formatFb formatInfo x)
744 | :: (List.map (fn x => (false, formatFb formatInfo x)) xs))
745 | in
746 | "fun " ^ formatTyvars formatInfo tyvars
747 | ^ (String.concat
748 | (intercalate
749 | ("\n" ^ (createIndent indent) ^ "and ")
750 | (List.map
751 | (fn (last, fb) => if not last andalso shouldNewline fb then fb ^ "\n" else fb)
752 | fbs)))
753 |
754 | end
755 | | LocalDec (d1, d2) =>
756 | "local " ^ "\n" ^ (createIndent (indent + indentSize))
757 | ^ formatDec { indent = indent + indentSize } d1
758 | ^ "\n"
759 | ^ (createIndent indent)
760 | ^ "in"
761 | ^ "\n"
762 | ^ (createIndent (indent + indentSize))
763 | ^ formatDec { indent = indent + indentSize } d2
764 | ^ "\n"
765 | ^ (createIndent indent)
766 | ^ "end"
767 | | MarkDec (dec, region) => formatDec formatInfo dec
768 | | OpenDec paths =>
769 | "open " ^ (String.concat (intercalate " " (List.map pathToString paths)))
770 | | OvldDec (symbol, ty, exps) =>
771 | (* TODO: Figure out what this dec is *)
772 | raise Fail "OvldDec not supported"
773 | | SeqDec [] => ""
774 | | SeqDec decs =>
775 | let
776 | fun formatDecs NONE [] = ""
777 | | formatDecs (SOME prev) [] = prev
778 | | formatDecs NONE (dec :: decs) =
779 | formatDecs (SOME (formatDec formatInfo dec)) decs
780 | | formatDecs (SOME prev) (dec :: decs) =
781 | let
782 | val d = formatDec formatInfo dec
783 |
784 | val sep =
785 | if shouldNewline prev orelse shouldNewline d
786 | then "\n\n" ^ (createIndent indent)
787 | else "\n" ^ (createIndent indent)
788 | in
789 | prev ^ sep ^ formatDecs (SOME d) decs
790 | end
791 | in
792 | formatDecs NONE decs
793 | end
794 | | TypeDec tbs =>
795 | "type "
796 | ^ String.concat
797 | (intercalate
798 | ("\n" ^ (createIndent indent) ^ "and ")
799 | (List.map (formatTb formatInfo) tbs))
800 | | ValDec (vbs, tyvars) =>
801 | "val "
802 | ^ String.concat
803 | (intercalate
804 | ("\n" ^ (createIndent indent) ^ "and ")
805 | (List.map (formatVb formatInfo) vbs))
806 | | ValrecDec (rvbs, tyvars) =>
807 | "val rec " ^ formatTyvars formatInfo tyvars
808 | ^ String.concat
809 | (intercalate
810 | ("\n\n" ^ (createIndent indent) ^ "and ")
811 | (List.map (formatRvb formatInfo) rvbs))
812 | | CommentDec (comment, dec) =>
813 | (String.concat (intercalate ("\n" ^ (createIndent indent)) comment)) ^ "\n"
814 | ^ (createIndent indent)
815 | ^ formatDec formatInfo dec
816 |
817 | and formatVb (formatInfo as { indent }) vb =
818 | case vb of
819 | MarkVb (vb, region) => formatVb formatInfo vb
820 | | CommentVb (comment, vb) =>
821 | (String.concat (intercalate ("\n" ^ (createIndent indent)) comment)) ^ "\n"
822 | ^ (createIndent indent)
823 | ^ formatVb formatInfo vb
824 | | Vb { exp : exp, lazyp : bool, pat : pat } =>
825 | let
826 | val formattedExp = formatExp { indent = indent + indentSize } exp
827 | val formattedPat = formatPat formatInfo false pat
828 | val oneLine = formattedPat ^ " = " ^ formattedExp
829 | val newline = "\n" ^ createIndent (indent + indentSize)
830 | in
831 | if shouldNewline formattedPat
832 | then newline ^ formattedPat ^ newline ^ "=" ^ newline ^ formattedExp
833 | else
834 | if shouldNewline oneLine
835 | then formattedPat ^ " =\n" ^ (createIndent (indent + indentSize)) ^ formattedExp
836 | else oneLine
837 | end
838 |
839 | and formatRvb (formatInfo as { indent }) rvb =
840 | case rvb of
841 | CommentRvb (comment, rvb) =>
842 | (String.concat (intercalate ("\n" ^ (createIndent indent)) comment)) ^ "\n"
843 | ^ (createIndent indent)
844 | ^ formatRvb formatInfo rvb
845 | | MarkRvb (rvb, region) => formatRvb formatInfo rvb
846 | | Rvb
847 | { exp : exp
848 | , fixity : (symbol * region) option
849 | , lazyp : bool
850 | , resultty : ty option
851 | , var : symbol } =>
852 | let
853 | val ty =
854 | case resultty of
855 | NONE => ""
856 | | SOME ty => " : " ^ formatTy formatInfo ty
857 |
858 | val sym = Symbol.name var
859 | val exp = formatExp { indent = indent + indentSize } exp
860 | val dec = sym ^ ty
861 | val oneLine = dec ^ " = " ^ exp
862 | in
863 | if shouldNewline oneLine
864 | then dec ^ " =\n" ^ (createIndent (indent + indentSize)) ^ exp
865 | else oneLine
866 | end
867 |
868 | and formatFb (formatInfo as { indent }) (Fb (clauses, b)) =
869 | String.concat
870 | (intercalate
871 | ("\n" ^ (createIndent (indent + 2)) ^ "| ")
872 | (List.map (formatClause { indent = indent + indentSize }) clauses))
873 | | formatFb formatInfo (MarkFb (fb, region)) = formatFb formatInfo fb
874 | | formatFb (formatInfo as { indent }) (CommentFb (comment, fb)) =
875 | (String.concat (intercalate ("\n" ^ (createIndent indent)) comment)) ^ "\n"
876 | ^ (createIndent indent)
877 | ^ formatFb formatInfo fb
878 |
879 | and formatClause
880 | (formatInfo as { indent })
881 | (Clause { exp : exp, pats : pat fixitem list, resultty : ty option })
882 | =
883 | let
884 | val formattedExp = formatExp { indent = indent + indentSize } exp
885 |
886 | val formattedPats =
887 | List.map
888 | (fn pat => formatPat { indent = indent + indentSize } true (#item pat))
889 | pats
890 |
891 | val patNewlines = shouldNewline (String.concat formattedPats)
892 | val newline = "\n" ^ createIndent (indent + indentSize)
893 |
894 | val formattedPats =
895 | let
896 | val sep = if patNewlines then newline else " "
897 | in
898 | String.concat (intercalate sep formattedPats)
899 | end
900 |
901 | val resultTy =
902 | case resultty of
903 | NONE => ""
904 | | SOME ty =>
905 | (if patNewlines then newline else " ") ^ ": " ^ formatTy formatInfo ty
906 |
907 | val oneLine = formattedPats ^ resultTy ^ " = " ^ formattedExp
908 | in
909 | if shouldNewline formattedPats
910 | then formattedPats ^ resultTy ^ newline ^ "=" ^ newline ^ formattedExp
911 | else
912 | if shouldNewline oneLine
913 | then
914 | formattedPats ^ resultTy ^ " =\n" ^ createIndent (indent + indentSize)
915 | ^ formattedExp
916 | else oneLine
917 | end
918 |
919 | and formatTyvars formatInfo tyvars =
920 | case tyvars of
921 | [] => ""
922 | | [ tyvar ] => formatTyvar formatInfo tyvar ^ " "
923 | | _ =>
924 | "("
925 | ^ String.concat (intercalate ", " (List.map (formatTyvar formatInfo) tyvars))
926 | ^ ") "
927 |
928 | and formatTb formatInfo (MarkTb (tb, region)) = formatTb formatInfo tb
929 | | formatTb
930 | (formatInfo as { indent })
931 | (Tb { def : ty, tyc : symbol, tyvars : tyvar list })
932 | =
933 | let
934 | val tyvars = formatTyvars formatInfo tyvars
935 | val typat = tyvars ^ Symbol.name tyc
936 | val ty = formatTy { indent = indent + indentSize } def
937 | val oneLine = typat ^ " = " ^ ty
938 | in
939 | if shouldNewline oneLine
940 | then typat ^ " =\n" ^ (createIndent (indent + indentSize)) ^ ty
941 | else oneLine
942 | end
943 | | formatTb (formatInfo as { indent }) (CommentTb (comment, tb)) =
944 | (String.concat (intercalate ("\n" ^ (createIndent indent)) comment)) ^ "\n"
945 | ^ (createIndent indent)
946 | ^ formatTb formatInfo tb
947 |
948 | and formatDb
949 | (formatInfo as { indent })
950 | (Db
951 | { lazyp : bool, rhs : (symbol * ty option) list, tyc : symbol, tyvars : tyvar list })
952 | =
953 | let
954 | fun formatVariant (sym, NONE) = Symbol.name sym
955 | | formatVariant (sym, SOME ty) =
956 | Symbol.name sym ^ " of " ^ formatTy { indent = indent + indentSize } ty
957 | in
958 | formatTyvars formatInfo tyvars ^ Symbol.name tyc ^ " = "
959 | ^ (case rhs of
960 | [ variant ] => formatVariant variant
961 | | _ =>
962 | "\n" ^ createIndent (indent + indentSize + 2)
963 | ^ String.concat
964 | (intercalate
965 | ("\n" ^ createIndent (indent + indentSize) ^ "| ")
966 | (List.map formatVariant rhs)))
967 |
968 | end
969 | | formatDb formatInfo (MarkDb (db, region)) = formatDb formatInfo db
970 | | formatDb (formatInfo as { indent }) (CommentDb (comment, db)) =
971 | (String.concat (intercalate ("\n" ^ (createIndent indent)) comment)) ^ "\n"
972 | ^ (createIndent indent)
973 | ^ formatDb formatInfo db
974 |
975 | and formatEb (formatInfo as { indent }) eb =
976 | case eb of
977 | EbDef { edef : path, exn : symbol } =>
978 | Symbol.name exn ^ " = " ^ pathToString edef
979 | | EbGen { etype : ty option, exn : symbol } =>
980 | Symbol.name exn
981 | ^ (case etype of
982 | NONE => ""
983 | | SOME ty => " of " ^ formatTy { indent = indent + indentSize } ty)
984 |
985 | | MarkEb (eb, region) => formatEb formatInfo eb
986 | | CommentEb (comment, eb) =>
987 | (String.concat (intercalate ("\n" ^ (createIndent indent)) comment)) ^ "\n"
988 | ^ (createIndent indent)
989 | ^ formatEb formatInfo eb
990 |
991 | and formatStrb formatInfo (MarkStrb (strb, region)) =
992 | formatStrb formatInfo strb
993 | | formatStrb
994 | (formatInfo as { indent })
995 | (Strb { constraint : sigexp sigConst, def : strexp, name : symbol })
996 | =
997 | let
998 | val constraint =
999 | case constraint of
1000 | NoSig => ""
1001 | | Opaque sigexp =>
1002 | " :> " ^ formatSigexp { indent = indent + indentSize } false sigexp
1003 | | Transparent sigexp =>
1004 | " : " ^ formatSigexp { indent = indent + indentSize } false sigexp
1005 | in
1006 | Symbol.name name ^ constraint ^ " = " ^ formatStrexp formatInfo def
1007 | end
1008 | | formatStrb (formatInfo as { indent }) (CommentStrb (comment, strb)) =
1009 | (String.concat (intercalate ("\n" ^ (createIndent indent)) comment)) ^ "\n"
1010 | ^ (createIndent indent)
1011 | ^ formatStrb formatInfo strb
1012 |
1013 | and formatFctb formatInfo (Fctb { def : fctexp, name : symbol }) =
1014 | Symbol.name name ^ " " ^ formatFctexp formatInfo def
1015 | | formatFctb formatInfo (MarkFctb (fctb, region)) =
1016 | formatFctb formatInfo fctb
1017 | | formatFctb (formatInfo as { indent }) (CommentFctb (comment, fctb)) =
1018 | (String.concat (intercalate ("\n" ^ (createIndent indent)) comment)) ^ "\n"
1019 | ^ (createIndent indent)
1020 | ^ formatFctb formatInfo fctb
1021 |
1022 | and formatSigb formatInfo (MarkSigb (sigb, region)) =
1023 | formatSigb formatInfo sigb
1024 | | formatSigb formatInfo (Sigb { def : sigexp, name : symbol }) =
1025 | Symbol.name name ^ " = " ^ formatSigexp formatInfo false def
1026 | | formatSigb (formatInfo as { indent }) (CommentSigb (comment, sigb)) =
1027 | (String.concat (intercalate ("\n" ^ (createIndent indent)) comment)) ^ "\n"
1028 | ^ (createIndent indent)
1029 | ^ formatSigb formatInfo sigb
1030 |
1031 | and formatTyvar formatInfo (MarkTyv (tyvar, region)) =
1032 | formatTyvar formatInfo tyvar
1033 | | formatTyvar formatInfo (Tyv sym) = Symbol.name sym
1034 | | formatTyvar (formatInfo as { indent }) (CommentTyv (comment, tyvar)) =
1035 | (String.concat (intercalate ("\n" ^ (createIndent indent)) comment)) ^ "\n"
1036 | ^ (createIndent indent)
1037 | ^ formatTyvar formatInfo tyvar
1038 |
1039 | and formatTy'
1040 | (formatInfo as { indent })
1041 | (parens : { con : bool, tuple : bool, arrow : bool })
1042 | ty
1043 | =
1044 | case ty of
1045 | ConTy (syms, []) => pathToString syms
1046 | | ConTy (syms, [ arg ]) =>
1047 | let
1048 | val conty =
1049 | formatTy' formatInfo { con = false, tuple = true, arrow = true } arg ^ " "
1050 | ^ pathToString syms
1051 | in
1052 | if #con parens then "(" ^ conty ^ ")" else conty
1053 | end
1054 | | ConTy ([ sym ], tys) =>
1055 | let
1056 | fun formatArrowArgs [] = []
1057 | | formatArrowArgs [ ty ] =
1058 | [ formatTy' formatInfo { con = false, tuple = false, arrow = false } ty ]
1059 | | formatArrowArgs (ty :: tys) =
1060 | formatTy' formatInfo { con = false, tuple = false, arrow = true } ty
1061 | :: formatArrowArgs tys
1062 |
1063 | val needsParens = if Symbol.name sym = "->" then #arrow parens else #con parens
1064 |
1065 | val con =
1066 | if Symbol.name sym = "->"
1067 | then String.concat (intercalate " -> " (formatArrowArgs tys))
1068 | else
1069 | "("
1070 | ^ String.concat
1071 | (intercalate
1072 | ", "
1073 | (List.map
1074 | (formatTy' formatInfo { con = false, tuple = false, arrow = false })
1075 | tys))
1076 | ^ ") "
1077 | ^ Symbol.name sym
1078 | in
1079 | if needsParens then "(" ^ con ^ ")" else con
1080 | end
1081 | | ConTy (syms, tys) =>
1082 | let
1083 | val conty =
1084 | "("
1085 | ^ String.concat
1086 | (intercalate
1087 | ", "
1088 | (List.map
1089 | (formatTy' formatInfo { con = false, tuple = false, arrow = false })
1090 | tys))
1091 | ^ ") "
1092 | ^ pathToString syms
1093 | in
1094 | if #con parens then "(" ^ conty ^ ")" else conty
1095 | end
1096 | | MarkTy (ty, region) => formatTy' formatInfo parens ty
1097 | | RecordTy tys =>
1098 | let
1099 | val fields =
1100 | List.map
1101 | (fn (sym, ty) =>
1102 | Symbol.name sym ^ " : "
1103 | ^ formatTy' formatInfo { con = false, tuple = false, arrow = false } ty)
1104 | tys
1105 |
1106 | val sep =
1107 | if shouldNewline (String.concat fields)
1108 | then "\n" ^ (createIndent indent) ^ ", "
1109 | else ", "
1110 | in
1111 | "{ " ^ String.concat (intercalate sep fields) ^ " }"
1112 | end
1113 | | TupleTy tys =>
1114 | let
1115 | val tuplety =
1116 | String.concat
1117 | (intercalate
1118 | " * "
1119 | (List.map
1120 | (formatTy' formatInfo { con = false, tuple = true, arrow = true })
1121 | tys))
1122 | in
1123 | if #tuple parens then "(" ^ tuplety ^ ")" else tuplety
1124 | end
1125 | | VarTy tyvar => formatTyvar formatInfo tyvar
1126 | | CommentTy (comment, ty) =>
1127 | (String.concat (intercalate ("\n" ^ (createIndent indent)) comment)) ^ "\n"
1128 | ^ (createIndent indent)
1129 | ^ formatTy' formatInfo parens ty
1130 |
1131 | and formatTy formatInfo ty =
1132 | formatTy' formatInfo { con = false, tuple = false, arrow = false } ty
1133 | end
1134 |
--------------------------------------------------------------------------------