├── README ├── examples.cm ├── examples.mlb ├── examples └── receipt.sml ├── parcom.cm ├── parcom.mlb ├── parcom.smackspec ├── parcom.smackspec.in ├── src ├── charparse.sig ├── charparse.sml ├── langparse.sml ├── parse.sig ├── parse.sml ├── tokparse.sig ├── tokparse.sml └── util │ ├── either.sig │ └── either.sml └── version.sh /README: -------------------------------------------------------------------------------- 1 | parcom -- a parser combinator library 2 | 3 | This is a simple parser combinator library based on code by Chris 4 | Okasaki, Robert Harper, Frank Pfenning and Tom Murphy VII, with 5 | utility modules inspired by Haskell's parsec library and some error 6 | reporting added. 7 | 8 | Currently it uses their stream and file position implementation: this 9 | should be removed once we get a proper extended standard library. 10 | 11 | This program is free software: you can redistribute it and/or modify 12 | it under the terms of the GNU General Public License as published by 13 | the Free Software Foundation, either version 3 of the License, or 14 | (at your option) any later version. 15 | 16 | This program is distributed in the hope that it will be useful, 17 | but WITHOUT ANY WARRANTY; without even the implied warranty of 18 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19 | GNU General Public License for more details. 20 | 21 | You should have received a copy of the GNU General Public License 22 | along with this program. If not, see http://www.gnu.org/licenses/. 23 | 24 | At this point, the library is supported and developed by Filip 25 | Sieczkowski. -------------------------------------------------------------------------------- /examples.cm: -------------------------------------------------------------------------------- 1 | Group is 2 | 3 | $SMACKAGE/cmlib/v1/cmlib.cm 4 | parcom.cm 5 | 6 | examples/receipt.sml 7 | -------------------------------------------------------------------------------- /examples.mlb: -------------------------------------------------------------------------------- 1 | (* Combinator parsing examples *) 2 | parcom.mlb 3 | 4 | examples/receipt.sml 5 | -------------------------------------------------------------------------------- /examples/receipt.sml: -------------------------------------------------------------------------------- 1 | (* This is a demo example of a simple grammar for receipts. 2 | 3 | Consider the following EBNF: 4 | receipt ::= product* total 5 | product ::= "return" price ";" 6 | | identifier price ";" 7 | total ::= price "total" 8 | price ::= digit+ "." digit digit 9 | 10 | *) 11 | 12 | structure SimpleReceipt = 13 | (* Simple implementation, w/o a proper lexer *) 14 | struct 15 | 16 | open ParserCombinators 17 | open CharParser 18 | 19 | infixr 4 << >> 20 | infixr 3 && 21 | infix 2 -- ## 22 | infix 2 wth suchthat return guard when 23 | infixr 1 || <|> ?? 24 | 25 | val price : int charParser = 26 | repeat1 digit && (char #"." >> digit && digit << spaces) when 27 | (fn (xs, (y, z)) => Int.fromString (String.implode (xs@[y,z]))) 28 | 29 | val total = price << string "total" << spaces 30 | val product = 31 | (string "return" >> spaces >> price << char #";" << spaces wth op~) 32 | <|> (repeat1 letter >> spaces >> price << char #";" << spaces) 33 | 34 | val receipt : bool charParser = 35 | spaces >> repeat product && total << eos wth 36 | (fn (ps, tot) => List.foldl op+ 0 ps = tot) 37 | 38 | end 39 | 40 | structure LexReceipt = 41 | (* An implementation that uses token parser. *) 42 | struct 43 | 44 | open ParserCombinators 45 | open CharParser 46 | 47 | infixr 4 << >> 48 | infixr 3 && 49 | infix 2 -- ## 50 | infix 2 wth suchthat return guard when 51 | infixr 1 || <|> ?? 52 | 53 | structure ReceiptDef :> LANGUAGE_DEF = 54 | (* can also use the SimpleStyle functor from langparse.sml *) 55 | struct 56 | 57 | type scanner = char CharParser.charParser 58 | 59 | val commentStart = NONE 60 | val commentEnd = NONE 61 | val commentLine = NONE 62 | val nestedComments = false 63 | 64 | val identLetter = CharParser.letter 65 | val identStart = identLetter 66 | val opStart = fail "Operators not supported" : scanner 67 | val opLetter = opStart 68 | val reservedNames = ["return", "total"] 69 | val reservedOpNames= [] 70 | val caseSensitive = true 71 | 72 | end 73 | 74 | structure RTP = TokenParser (ReceiptDef) 75 | open RTP 76 | 77 | val price = 78 | (lexeme (repeat1 digit && (char #"." >> digit && digit)) when 79 | (fn (xs, (y, z)) => Int.fromString (String.implode (xs@[y,z])))) 80 | ?? "price expression" 81 | 82 | val total = price << reserved "total" ?? "total" 83 | val product = 84 | (reserved "return" >> price << symbol ";" wth op~) <|> 85 | (identifier >> price << symbol ";") ?? "product" 86 | val receipt = 87 | (repeat product && total << (eos ?? "end of stream") 88 | wth (fn (xs, tot) => List.foldl op+ 0 xs = tot)) 89 | 90 | end 91 | 92 | fun printRes pr = 93 | print (Sum.sumR (fn b => Bool.toString b ^ "\n") pr) 94 | 95 | (* returns: SOME true *) 96 | val example1 = "book 12.00; plant 2.55; 14.55 total" 97 | 98 | (* returns: SOME false *) 99 | val example2 = "book 12.00; plant 2.55; 12.55 total" 100 | 101 | val example3 = "book 12.00;\n 14.55 total; plant 2.55" 102 | 103 | fun doit s = printRes (CharParser.parseString LexReceipt.receipt s) 104 | 105 | val _ = print "Lexer-less implementation:\n Example 1: "; 106 | printRes (CharParser.parseString SimpleReceipt.receipt example1); 107 | print " Example 2: "; 108 | printRes (CharParser.parseString SimpleReceipt.receipt example2); 109 | print " Example 3: "; 110 | printRes (CharParser.parseString SimpleReceipt.receipt example3); 111 | print "\nToken-parser-using implementation:\n Example 1: "; 112 | printRes (CharParser.parseString LexReceipt.receipt example1); 113 | print " Example 2: "; 114 | printRes (CharParser.parseString LexReceipt.receipt example2); 115 | print " Example 3: "; 116 | printRes (CharParser.parseString LexReceipt.receipt example3); 117 | 118 | -------------------------------------------------------------------------------- /parcom.cm: -------------------------------------------------------------------------------- 1 | (* parcom -- combinator parsing *) 2 | library 3 | 4 | signature PARSER_COMBINATORS 5 | signature CHAR_PARSER 6 | signature MINI_LANGUAGE_DEF 7 | signature LANGUAGE_DEF 8 | signature TOKEN_PARSER 9 | 10 | structure ParserCombinators 11 | structure CharParser 12 | 13 | functor TokenParser 14 | functor SimpleStyle 15 | functor JavaStyle 16 | functor MLStyle 17 | 18 | is 19 | 20 | 21 | $SMACKAGE/cmlib/v1/cmlib.cm 22 | 23 | (* parcom proper *) 24 | src/parse.sig 25 | src/parse.sml 26 | 27 | src/charparse.sig 28 | src/charparse.sml 29 | 30 | src/tokparse.sig 31 | src/tokparse.sml 32 | src/langparse.sml 33 | -------------------------------------------------------------------------------- /parcom.mlb: -------------------------------------------------------------------------------- 1 | (* Combinator parsing *) 2 | 3 | $(MLTON_ROOT)/basis/basis.mlb 4 | $(SMACKAGE)/cmlib/v1/cmlib.mlb 5 | 6 | (* Parcom proper *) 7 | local 8 | 9 | src/parse.sig 10 | src/parse.sml 11 | 12 | src/charparse.sig 13 | src/charparse.sml 14 | 15 | src/tokparse.sig 16 | src/tokparse.sml 17 | src/langparse.sml 18 | 19 | in 20 | 21 | signature PARSER_COMBINATORS 22 | signature CHAR_PARSER 23 | signature MINI_LANGUAGE_DEF 24 | signature LANGUAGE_DEF 25 | signature TOKEN_PARSER 26 | 27 | structure ParserCombinators 28 | structure CharParser 29 | 30 | functor TokenParser 31 | functor SimpleStyle 32 | functor JavaStyle 33 | functor MLStyle 34 | 35 | end 36 | -------------------------------------------------------------------------------- /parcom.smackspec: -------------------------------------------------------------------------------- 1 | provides: parcom 1.0.7 2 | requires: cmlib v1.1 3 | remote: git git://github.com/standardml/parcom.git 4 | description: A parser combinator library 5 | keywords: text, parsing 6 | bug-url: https://github.com/standardml/parcom/issues 7 | maintainer: Filip Sieczkowski 8 | license: LGPL3 9 | -------------------------------------------------------------------------------- /parcom.smackspec.in: -------------------------------------------------------------------------------- 1 | provides: parcom ###VERSION### 2 | requires: cmlib v1.1 3 | remote: git git://github.com/standardml/parcom.git 4 | description: A parser combinator library 5 | keywords: text, parsing 6 | bug-url: https://github.com/standardml/parcom/issues 7 | maintainer: Filip Sieczkowski 8 | license: LGPL3 9 | -------------------------------------------------------------------------------- /src/charparse.sig: -------------------------------------------------------------------------------- 1 | (* Signatures for utility combinators for parsing character streams *) 2 | 3 | signature CHAR_PARSER = 4 | sig 5 | 6 | (* type synonym for Parsing.parser working on character streams *) 7 | type 'a charParser = ('a, char) ParserCombinators.parser 8 | type message = char ParserCombinators.message 9 | 10 | (* (oneOf cs) succeeds if the current character is in the supplied list of 11 | characters cs. Returns the parsed character. See also satisfy. 12 | 13 | vowel = oneOf "aeiou" 14 | *) 15 | val oneOf : char list -> char charParser 16 | 17 | (* As the dual of oneOf, (noneOf cs) succeeds if the current character not 18 | in the supplied list of characters cs. Returns the parsed character. 19 | 20 | consonant = noneOf "aeiou" 21 | *) 22 | val noneOf : char list -> char charParser 23 | 24 | (* (char c) parses a single character c. Returns the parsed character 25 | (i.e. c). 26 | 27 | semiColon = char #";" 28 | *) 29 | val char : char -> char charParser 30 | 31 | (* (string s) parses a sequence of characters given by s. Returns the 32 | parsed string (i.e. s). 33 | 34 | divOrMod = string "div" 35 | || string "mod" 36 | *) 37 | val string : string -> string charParser 38 | 39 | (* This parser succeeds for any character. Returns the parsed character. *) 40 | val anyChar : char charParser 41 | 42 | (* Parses an upper case letter (a character between #"A" and #"Z"). Returns 43 | the parsed character. 44 | *) 45 | val upper : char charParser 46 | 47 | (* Parses a lower case character (a character between #"a" and #"z"). 48 | Returns the parsed character. 49 | *) 50 | val lower : char charParser 51 | 52 | (* Parses a letter (an upper case or lower case character). Returns the 53 | parsed character. 54 | *) 55 | val letter : char charParser 56 | 57 | (* Parses a letter or digit. Returns the parsed character. *) 58 | val alphaNum : char charParser 59 | (* Parses a digit (a character between '0' and '9'). Returns the parsed 60 | character. 61 | *) 62 | val digit : char charParser 63 | 64 | (* Parses a hexadecimal digit (a digit or a letter between 'a' and 'f' or 65 | 'A' and 'F'). Returns the parsed character. 66 | *) 67 | val hexDigit : char charParser 68 | 69 | (* Parses an octal digit (a character between '0' and '7'). Returns the 70 | parsed character. 71 | *) 72 | val octDigit : char charParser 73 | 74 | (* Parses a newline character (#"\n"). Returns a newline character. *) 75 | val newLine : char charParser 76 | 77 | (* Parses a tab character (#"\t"). Returns a newline character. *) 78 | val tab : char charParser 79 | 80 | (* Parses a white space character (any character in " \v\f\t\r\n"). Returns 81 | the parsed character. 82 | *) 83 | val space : char charParser 84 | 85 | (* Skips zero or more white space characters. See also repeati 86 | *) 87 | val spaces : unit charParser 88 | 89 | (* The parser (satisfy f) succeeds for any character for which the supplied 90 | function f returns true. Returns the character that is actually parsed. 91 | *) 92 | val satisfy : (char -> bool) -> char charParser 93 | 94 | (* Formatter for messages over char streams *) 95 | val messageToString : message -> string 96 | 97 | (* Parse function that uses the default formatter for char streams *) 98 | val parseChars : 'a charParser -> (char * Coord.t) Stream.stream -> 99 | (string, 'a) Sum.sum 100 | val parseString : 'a charParser -> string -> (string, 'a) Sum.sum 101 | 102 | end 103 | -------------------------------------------------------------------------------- /src/charparse.sml: -------------------------------------------------------------------------------- 1 | (* Character parsers implementation, useful for building lexers *) 2 | 3 | structure CharParser :> CHAR_PARSER = 4 | struct 5 | 6 | open ParserCombinators 7 | infixr 4 << >> 8 | infixr 1 ?? 9 | 10 | type 'a charParser = ('a, char) parser 11 | type message = char message 12 | 13 | fun oneOf xs = try (satisfy (fn x => List.exists (fn y => x = y) xs)) 14 | fun noneOf xs = try (satisfy (fn x => List.all (fn y => x <> y) xs)) 15 | fun char x = try (satisfy (fn y => x = y)) ?? "'" ^ str x ^ "'" 16 | fun string s = 17 | let fun string_aux xs = case xs of 18 | nil => succeed s 19 | | (x :: xs') => char x >> string_aux xs' 20 | in string_aux (String.explode s) end 21 | 22 | val anyChar = any 23 | val upper = try (satisfy Char.isUpper) ?? "upper case letter" 24 | val lower = try (satisfy Char.isLower) ?? "lower case letter" 25 | val letter = try (satisfy Char.isAlpha) ?? "letter" 26 | val alphaNum = try (satisfy Char.isAlphaNum) ?? "alphanumeric character" 27 | val digit = try (satisfy Char.isDigit) ?? "digit" 28 | val hexDigit = try (satisfy Char.isHexDigit) ?? "hexadecimal digit" 29 | val octDigit = try (satisfy (fn x => Char.isDigit x 30 | andalso Char.<= (x, #"7"))) ?? "octal digit" 31 | val newLine = char #"\n" ?? "'\n'" 32 | val tab = char #"\t" ?? "'\t'" 33 | val space = try (satisfy Char.isSpace) 34 | val spaces = repeatSkip space 35 | val satisfy = satisfy 36 | 37 | fun messageToString m = 38 | case m of 39 | Unexpected (SOME t) => "unexpected '" ^ str t ^ "'" 40 | | Unexpected NONE => "unexpected end of stream" 41 | | Expected s => s 42 | | Message m => m 43 | 44 | fun parseChars p = parse messageToString p 45 | fun parseString p s = 46 | let val s = CoordinatedStream.coordinate (fn x => Stream.hd x = #"\n" handle Stream.Empty => false) (Coord.init "-") 47 | (Stream.fromString s) 48 | in parseChars p s 49 | end 50 | 51 | end 52 | -------------------------------------------------------------------------------- /src/langparse.sml: -------------------------------------------------------------------------------- 1 | (* Several functors that facilitate building languages in certain style *) 2 | 3 | functor SimpleStyle (Def : MINI_LANGUAGE_DEF) :> LANGUAGE_DEF = 4 | struct 5 | 6 | open ParserCombinators 7 | open CharParser 8 | infixr 1 <|> 9 | 10 | type scanner = char CharParser.charParser 11 | 12 | val commentStart = NONE 13 | val commentEnd = NONE 14 | val commentLine = NONE 15 | val nestedComments = false 16 | 17 | val identStart = letter <|> char #"_" 18 | val identLetter = alphaNum <|> oneOf (String.explode "_'") 19 | val opLetter = oneOf (String.explode ":!#$%&*+./< =>?@\\^|-~") 20 | val opStart = opLetter 21 | 22 | val reservedNames = Def.reservedNames 23 | val reservedOpNames = Def.reservedOpNames 24 | 25 | val caseSensitive = true 26 | 27 | end 28 | 29 | functor JavaStyle (Def : MINI_LANGUAGE_DEF) :> LANGUAGE_DEF = 30 | struct 31 | 32 | open ParserCombinators 33 | open CharParser 34 | infixr 1 <|> 35 | 36 | type scanner = char CharParser.charParser 37 | 38 | val commentStart = SOME "/*" 39 | val commentEnd = SOME "*/" 40 | val commentLine = SOME "//" 41 | val nestedComments = true 42 | 43 | val identStart = letter 44 | val identLetter = alphaNum <|> oneOf (String.explode "_'") 45 | val opLetter = oneOf (String.explode ":!#$%&*+./< =>?@\\^|-~") 46 | val opStart = opLetter 47 | 48 | val reservedNames = Def.reservedNames 49 | val reservedOpNames = Def.reservedOpNames 50 | 51 | val caseSensitive = false 52 | 53 | end 54 | 55 | functor MLStyle (Def : MINI_LANGUAGE_DEF) :> LANGUAGE_DEF = 56 | struct 57 | 58 | open ParserCombinators 59 | open CharParser 60 | infixr 1 <|> 61 | 62 | type scanner = char CharParser.charParser 63 | 64 | val commentStart = SOME "(*" 65 | val commentEnd = SOME "*)" 66 | val commentLine = NONE 67 | val nestedComments = true 68 | 69 | val identStart = letter 70 | val identLetter = alphaNum <|> oneOf (String.explode "_'") 71 | 72 | (* did I miss anything? add to much? *) 73 | val opLetter = oneOf (String.explode ":!#$%&*+./<=>?@\\^|-~") 74 | val opStart = opLetter 75 | 76 | val reservedNames = Def.reservedNames 77 | val reservedOpNames = Def.reservedOpNames 78 | 79 | val caseSensitive = true 80 | 81 | end 82 | -------------------------------------------------------------------------------- /src/parse.sig: -------------------------------------------------------------------------------- 1 | (* Signatures for standard parsing combinators *) 2 | 3 | signature BASIC_PARSER = 4 | sig 5 | 6 | (* type for error messages *) 7 | datatype 't message = Unexpected of 't option | Expected of string 8 | | Message of string 9 | (* Parser with token type 't, result type 'a *) 10 | type ('a, 't) parser 11 | 12 | (* succeed with given value *) 13 | val succeed : 'a -> ('a, 't) parser 14 | (* fail immediately *) 15 | val fail : string -> ('a, 't) parser 16 | 17 | (* check for end of input *) 18 | val eos : (unit, 't) parser 19 | (* admit anything, provided there's something on the input *) 20 | val any : ('t, 't) parser 21 | 22 | (* sequential successful composition of parsers *) 23 | val -- : ('a, 't) parser * ('a -> ('b, 't) parser) -> ('b, 't) parser 24 | (* sequential failing composition of parsers *) 25 | (* val ## : ('a, 't) parser * (Pos.t -> ('a, 't) parser) -> ('a, 't) parser*) 26 | (* fail-fast composition of parsers *) 27 | val <|> : ('a, 't) parser * ('a, 't) parser -> ('a, 't) parser 28 | (* error reporting combinator *) 29 | val ?? : ('a, 't) parser * string -> ('a, 't) parser 30 | 31 | (* doesn't consume input if fails *) 32 | val try : ('a, 't) parser -> ('a, 't) parser 33 | 34 | (* grab position *) 35 | val !! : ('a, 't) parser -> ('a * Pos.t, 't) parser 36 | 37 | (* get position *) 38 | (*val get : (Pos.t -> ('a, 't) parser) -> ('a, 't) parser*) 39 | 40 | (* to handle mutually-recursive parsers *) 41 | val $ : (unit -> ('a, 't) parser) -> ('a, 't) parser 42 | 43 | (* to construct a recursive parser *) 44 | val fix : (('a, 't) parser -> ('a, 't) parser) -> ('a, 't) parser 45 | 46 | (* re-parse same input, given result of first parse *) 47 | (*val lookahead : ('a, 't) parser -> ('a -> ('b, 't) parser) -> 48 | ('b, 't) parser*) 49 | 50 | (* parse this stream before reading any other input *) 51 | (*val push : ('t * Pos.t) Stream.stream -> 52 | ('a, 't) parser -> ('a, 't) parser *) 53 | 54 | (* parse a stream *) 55 | val runParser : ('a, 't) parser -> ('t * Coord.t) Stream.stream -> 56 | (Pos.t * 't message list, 'a) Sum.sum 57 | val parse : ('t message -> string) -> ('a, 't) parser -> 58 | ('t * Coord.t) Stream.stream -> (string, 'a) Sum.sum 59 | val simpleParse : ('a, 't) parser -> ('t * Coord.t) Stream.stream -> 60 | (string, 'a) Sum.sum 61 | 62 | (* default message printer *) 63 | val messageToString : 't message -> string 64 | 65 | (* transform p s 66 | 67 | parses consecutive maximal prefixes of s with p as many times 68 | as possible, outputting the results as a stream *) 69 | val transform : ('a, 't) parser -> ('t * Coord.t) Stream.stream -> 70 | 'a Stream.stream 71 | 72 | end 73 | 74 | signature PARSER_COMBINATORS = 75 | sig 76 | 77 | include BASIC_PARSER 78 | 79 | (* 80 | infixr 4 << >> 81 | infixr 3 && 82 | infix 2 -- ## 83 | infix 2 wth suchthat return guard when 84 | infixr 1 || 85 | *) 86 | 87 | (* sequential composition *) 88 | val && : ('a, 't) parser * ('b, 't) parser -> ('a * 'b, 't) parser 89 | (* alternation *) 90 | val || : ('a, 't) parser * ('a, 't) parser -> ('a, 't) parser 91 | 92 | (* apply function to success value *) 93 | val wth : ('a, 't) parser * ('a -> 'b) -> ('b, 't) parser 94 | (* succeed only if check on successful is true *) 95 | val suchthat : ('a, 't) parser * ('a -> bool) -> ('a, 't) parser 96 | (* specify success value *) 97 | val return : ('b, 't) parser * 'a -> ('a, 't) parser 98 | 99 | (* end of stream with specific result *) 100 | val done : 'a -> ('a, 't) parser 101 | 102 | (* n-ary sequential composition *) 103 | val seq : ('a, 't) parser list -> ('a list, 't) parser 104 | (* n-ary alternation *) 105 | val alt : ('a, 't) parser list -> ('a, 't) parser 106 | 107 | (* ensure that next token satisfies condition, yielding that token *) 108 | val satisfy : ('t -> bool) -> ('t, 't) parser 109 | 110 | (* succeed only if function returns SOME a *) 111 | val maybe : ('t -> 'a option) -> ('a, 't) parser 112 | 113 | (* succeed with mapped result if SOME, otherwise fail. *) 114 | val when : ('a, 't) parser * ('a -> 'b option) -> ('b, 't) parser 115 | 116 | (* XXX these require equality on tokens; yech! *) 117 | 118 | (* check for a given token *) 119 | val literal : ''t -> (''t, ''t) parser 120 | (* check for a given list of tokens *) 121 | val string : ''t list -> (''t list, ''t) parser 122 | (* check for one of a list of tokens *) 123 | val oneof : ''t list -> (''t, ''t) parser 124 | 125 | (* optional parse, yielding an optional result *) 126 | val opt : ('a, 't) parser -> ('a option, 't) parser 127 | (* optional parse, with given action on success *) 128 | val optional : ('a -> 'b) -> 'b -> ('a, 't) parser -> ('b, 't) parser 129 | 130 | (* zero or more copies *) 131 | val repeat : ('a, 't) parser -> ('a list, 't) parser 132 | (* one or more *) 133 | val repeat1 : ('a, 't) parser -> ('a list, 't) parser 134 | (* exact number *) 135 | val repeatn : int -> ('a, 't) parser -> ('a list, 't) parser 136 | 137 | (* skip zero or more copies *) 138 | val repeatSkip : ('a, 't) parser -> (unit, 't) parser 139 | (* skip one or more copies *) 140 | val repeatSkip1 : ('a, 't) parser -> (unit, 't) parser 141 | 142 | (* parse two things, yielding value of first *) 143 | val first : ('a, 't) parser -> ('b, 't) parser -> ('a, 't) parser 144 | val << : ('a, 't) parser * ('b, 't) parser -> ('a, 't) parser 145 | (* ... second *) 146 | val second : ('a, 't) parser -> ('b, 't) parser -> ('b, 't) parser 147 | val >> : ('a, 't) parser * ('b, 't) parser -> ('b, 't) parser 148 | (* .... middle of three *) 149 | val middle : ('a, 't) parser -> ('b, 't) parser -> ('c, 't) parser 150 | -> ('b, 't) parser 151 | 152 | (* parse one or more, with given separator between items *) 153 | val separate1: ('a, 't) parser -> ('b, 't) parser -> ('a list, 't) parser 154 | (* ... zero or more *) 155 | val separate : ('a, 't) parser -> ('b, 't) parser -> ('a list, 't) parser 156 | (* one or more, obligatory trailing separator *) 157 | val sepEnd1 : ('a, 't) parser -> ('b, 't) parser -> ('a list, 't) parser 158 | (* zero or more, obligatory trailing separator *) 159 | val sepEnd : ('a, 't) parser -> ('b, 't) parser -> ('a list, 't) parser 160 | (* one or more, allowing trailing separator *) 161 | val sepEnd1' : ('a, 't) parser -> ('b, 't) parser -> ('a list, 't) parser 162 | (* zero or more, allowing trailing separator *) 163 | val sepEnd' : ('a, 't) parser -> ('b, 't) parser -> ('a list, 't) parser 164 | 165 | (* parse with the first parser until the other parser succeeds *) 166 | val until : ('a, 't) parser -> ('b, 't) parser -> ('a list, 't) parser 167 | 168 | (* nested parsers *) 169 | val join : (('a, 't) parser, 't) parser -> ('a, 't) parser 170 | 171 | (* chaining of parsers *) 172 | val chainr : ('a, 't) parser -> ('a * 'a -> 'a, 't) parser -> 173 | 'a -> ('a, 't) parser 174 | val chainr1 : ('a, 't) parser -> ('a * 'a -> 'a, 't) parser -> 175 | ('a, 't) parser 176 | val chainl : ('a, 't) parser -> ('a * 'a -> 'a, 't) parser -> 177 | 'a -> ('a, 't) parser 178 | val chainl1 : ('a, 't) parser -> ('a * 'a -> 'a, 't) parser -> 179 | ('a, 't) parser 180 | 181 | (* succeeds without consuming anything if the given parser fails *) 182 | val not : ('a, 't) parser -> (unit, 't) parser 183 | 184 | (***** Pre/In/Post-fix utilities *****) 185 | 186 | datatype associativity = Left | Right | Non 187 | 188 | datatype 'a opr = 189 | Prefix of int * ('a -> 'a) 190 | | Infix of associativity * int * ('a * 'a -> 'a) 191 | | Postfix of int * ('a -> 'a) 192 | 193 | datatype 'a fixityitem = 194 | Atm of 'a 195 | | Opr of 'a opr 196 | 197 | val parsefixity : ('a fixityitem, 't) parser -> ('a, 't) parser 198 | 199 | (* Same, but also look for adjacent tokens, combining them with 200 | the supplied function and associativity. *) 201 | val parsefixityadj : ('a fixityitem, 't) parser -> 202 | associativity -> ('a * 'a -> 'a) -> ('a, 't) parser 203 | 204 | (* Utilities for manipulating intermediate results, 205 | 206 | ie. (IF >> $exp) && (THEN >> $exp) && (ELSE >> $exp) wth If o flat3 207 | *) 208 | 209 | val flat3 : 'a * ('b * 'c) -> 'a * 'b * 'c 210 | val flat4 : 'a * ('b * ('c * 'd)) -> 'a * 'b * 'c * 'd 211 | val flat5 : 'a * ('b * ('c * ('d * 'e))) -> 'a * 'b * 'c * 'd * 'e 212 | 213 | end 214 | -------------------------------------------------------------------------------- /src/parse.sml: -------------------------------------------------------------------------------- 1 | (* Implementation of the parsing combinators *) 2 | 3 | structure BasicParser :> BASIC_PARSER = 4 | (* LL-style parsing combinators. *) 5 | struct 6 | 7 | type pos = Pos.t 8 | type coord = Coord.coord 9 | type 't stream = ('t * coord) Stream.stream 10 | open Sum 11 | 12 | datatype 't message = Unexpected of 't option | Expected of string 13 | | Message of string 14 | type ('a, 't) parser = bool ref -> coord * 't stream -> 15 | (pos * 't message list, 'a * pos * coord * 't stream) sum 16 | 17 | infix 2 -- ## 18 | infixr 1 <|> ?? 19 | 20 | (* Primitive Parsers *) 21 | 22 | fun succeed x _ (c, ts) = INR (x, Pos.pos c c, c, ts) 23 | fun fail s _ (c, ts) = INL (Pos.pos c c, [Message s]) 24 | 25 | fun eos _ (c, ts) = 26 | case Stream.front ts of 27 | Stream.Nil => INR ((), Pos.pos c c, c, ts) 28 | | Stream.Cons ((x, c), _) => INL (Pos.pos c c, [Unexpected (SOME x)]) 29 | 30 | fun any b (c, ts) = 31 | case Stream.front ts of 32 | Stream.Nil => INL (Pos.pos c c, [Unexpected NONE]) 33 | | Stream.Cons ((x, c'), ts) => (b := true; INR (x, Pos.pos c c', c', ts)) 34 | 35 | fun (p -- q) b (c, ts) = 36 | bindR (p b (c, ts)) 37 | (fn (x, posx, c, ts) => 38 | let val nb = ref false 39 | in map (fn (posy, ms) => (b := (!b orelse !nb); ((*Pos.union posx*) posy, ms))) 40 | (fn (y, posy, c, ts) => (y, Pos.union posx posy, c, ts)) 41 | (q x nb (c, ts)) 42 | end) 43 | 44 | fun (p ## q) b (c, ts) = 45 | case p b (c, ts) of 46 | INL (pf, errs) => q pf b (c, ts) 47 | | INR x => INR x 48 | 49 | fun (p <|> q) b (c, ts) = 50 | bindL (p b (c, ts)) (fn e => if !b then INL e else q b (c, ts)) 51 | 52 | fun try p b (c, ts) = 53 | mapL (fn e => (b := false; e)) (p b (c, ts)) 54 | 55 | fun (p ?? s) b (c, ts) = 56 | mapL (fn (pos, errs) => (pos, errs @ [Expected s])) (p b (c, ts)) 57 | 58 | fun lookahead p q b (c, ts) = 59 | bindR (p b (c, ts)) (fn (x, _, _, _) => q x b (c, ts)) 60 | 61 | fun !! p b (c, ts) = 62 | mapR (fn (x, posx, c, ts) => ((x, posx), posx, c, ts)) (p b (c, ts)) 63 | 64 | fun get f b (c, ts) = f (Pos.pos c c) b (c, ts) 65 | 66 | fun $ p b (c, ts) = p () b (c, ts) 67 | 68 | fun fix f b (c, ts) = f (fix f) b (c, ts) 69 | 70 | val initc = Coord.init "-" 71 | 72 | fun runParser (p : ('a, 't) parser) ts = 73 | mapR #1 (p (ref false) (initc, ts)) 74 | fun parsewith s f p = 75 | sum f s o runParser p 76 | 77 | (* fun push ns p (pos, ts) = 78 | p (initpos, Stream.append ns ts)*) 79 | fun messageToString m = 80 | case m of 81 | Unexpected (SOME t) => "unexpected token" 82 | | Unexpected NONE => "unexpected end of stream" 83 | | Expected s => s 84 | | Message m => m 85 | 86 | fun printError fmt (p, msgs) = 87 | let fun unex msgs = 88 | case List.filter (fn Unexpected _ => true | _ => false) msgs of 89 | x :: _ => fmt x ^ ". " 90 | | _ => "" 91 | fun exps xs = case xs of 92 | [] => "" (* impossible case *) 93 | | [x] => " or " ^ fmt x ^ ". " 94 | | x :: xs => ", " ^ fmt x ^ exps xs 95 | fun exp msgs = 96 | case List.filter (fn Expected _ => true | _ => false) msgs of 97 | [] => "" 98 | | [x] => "Expected " ^ fmt x ^ ". " 99 | | x :: xs => "Expected " ^ fmt x ^ exps xs 100 | fun msg msgs = (String.concatWith ". " o List.map (fn Message m => m)) 101 | (List.filter (fn Message _ => true | _ => false) msgs) 102 | in "Parse error at " ^ Pos.toString p ^ ": " ^ 103 | unex msgs ^ exp msgs ^ msg msgs ^ "\n" 104 | end 105 | 106 | fun parse fmt p = mapL (printError fmt) o runParser p 107 | fun simpleParse p = parse messageToString p 108 | 109 | fun transform p ts = 110 | let 111 | fun trans (pos, ts) () = 112 | case p (ref false) (pos, ts) of 113 | INR (x, _, pos', ts') => 114 | Stream.Cons (x, Stream.lazy (trans (pos', ts'))) 115 | | INL _ => Stream.Nil 116 | in 117 | Stream.lazy (trans (initc, ts)) 118 | end 119 | 120 | end 121 | 122 | structure ParserCombinators :> PARSER_COMBINATORS = 123 | struct 124 | 125 | open BasicParser 126 | 127 | fun flat3 (a, (b, c)) = (a, b, c) 128 | fun flat4 (a, (b, (c, d))) = (a, b, c, d) 129 | fun flat5 (a, (b, (c, (d, e)))) = (a, b, c, d, e) 130 | 131 | infixr 4 << >> 132 | infixr 3 && 133 | infix 2 -- ## 134 | infix 2 wth suchthat return guard when 135 | infixr 1 || <|> ?? 136 | 137 | fun p && q = p -- (fn x => q -- (fn y => succeed (x, y))) 138 | fun p || q = try p <|> q 139 | 140 | fun p wth f = p -- succeed o f 141 | fun p suchthat g = 142 | p -- (fn x => if g x then succeed x else fail "") 143 | fun p when f = 144 | p -- (fn x => case f x of SOME r => succeed r | NONE => fail "") 145 | fun p return x = p -- (fn _ => succeed x) 146 | 147 | fun seq ps = foldr (fn (ph, pt) => ph && pt wth op::) (succeed []) ps 148 | fun alt ps = foldr op|| (fail "") ps 149 | 150 | fun satisfy g = any suchthat g 151 | 152 | fun maybe f = any -- (fn x => case f x of SOME r => succeed r | _ => fail "") 153 | 154 | fun literal t = try (satisfy (fn t' => t = t')) 155 | 156 | fun string ts = seq (List.map literal ts) 157 | fun oneof ts = alt (List.map literal ts) 158 | 159 | fun opt p = p wth SOME || succeed NONE 160 | fun optional f x p = p wth f || succeed x 161 | 162 | 163 | fun first p q = p -- (fn x => q return x) 164 | fun second p q = p -- (fn _ => q) 165 | fun middle p q r = p -- (fn _ => q -- (fn x => r return x)) 166 | 167 | fun (p << q) = first p q 168 | fun (p >> q) = second p q 169 | 170 | fun done x = eos >> succeed x 171 | 172 | fun repeat p = fix (fn rep => p && rep wth op:: || succeed []) 173 | 174 | fun repeat1 p = p && repeat p wth op:: 175 | 176 | fun repeatn n p = 177 | let 178 | fun rep 0 () = succeed [] 179 | | rep n () = p && ($(rep (n - 1))) wth op:: 180 | in 181 | $(rep n) 182 | end 183 | 184 | fun repeatSkip p = fix (fn rep => p >> rep || succeed ()) 185 | fun repeatSkip1 p = p >> repeatSkip p 186 | 187 | fun separate1 p q = p && repeat (second q p) wth op:: 188 | fun separate p q = separate1 p q || succeed [] 189 | fun sepEnd' p q = first (separate p q) (opt q) 190 | fun sepEnd1' p q = separate1 p q << opt q 191 | fun sepEnd p q = repeat (p << q) 192 | fun sepEnd1 p q = repeat1 (p << q) 193 | 194 | fun join p = p -- (fn q => q) 195 | 196 | fun until p q = 197 | let fun aux _ = (q return []) <|> p >> $ aux 198 | in $ aux end 199 | 200 | (* chaining of parsers *) 201 | fun chainr1 p opp = 202 | p -- (fn v => (opp && chainr1 p opp wth (fn (f, v') => f (v, v'))) 203 | <|> succeed v) 204 | fun chainr p opp d = chainr1 p opp <|> succeed d 205 | fun chainl1 p opp = 206 | p && (repeat (opp && p)) wth 207 | (fn (v, ts) => List.foldl (fn ((f, vr), vl) => f (vl, vr)) v ts) 208 | fun chainl p opp d = chainl1 p opp <|> succeed d 209 | 210 | fun not p = ((try p) >> fail "unexpected token") <|> succeed () 211 | 212 | (***** pre/in/post-fix parsing *****) 213 | 214 | datatype associativity = Left | Right | Non 215 | 216 | datatype 'a opr = 217 | Prefix of int * ('a -> 'a) 218 | | Infix of associativity * int * ('a * 'a -> 'a) 219 | | Postfix of int * ('a -> 'a) 220 | 221 | datatype 'a fixityitem = 222 | Atm of 'a 223 | | Opr of 'a opr 224 | 225 | fun assoc (Prefix _) = Non 226 | | assoc (Infix(asc, _, _)) = asc 227 | | assoc (Postfix _) = Non 228 | 229 | fun prec (Prefix(n, _)) = n 230 | | prec (Infix(_, n, _)) = n 231 | | prec (Postfix(n, _)) = n 232 | 233 | fun resolvefixity ys = 234 | let fun resolve (xs, c as Atm _, ys) = 235 | next (c::xs, ys) 236 | | resolve (xs, c as Opr(Prefix _), ys) = 237 | next (c::xs, ys) 238 | | resolve (x::[], c as Opr(Infix _), ys) = 239 | next (c::x::[], ys) 240 | | resolve (x::(c' as Opr(f'))::xs, c as Opr(f as Infix _), ys) = 241 | if prec(f) > prec(f') then next (c::x::c'::xs, ys) 242 | else if prec(f') > prec(f) then reduce (x::c'::xs, c::ys) 243 | else (case (assoc(f'), assoc(f)) 244 | of (Left, Left) => reduce (x::c'::xs, c::ys) 245 | | (Right, Right) => next (c::x::c'::xs, ys) 246 | | _ => fail "Operator ambiguous") 247 | | resolve(x::[], c as Opr(Postfix _), ys) = 248 | reduce (c::x::[], ys) 249 | | resolve (x::(c' as Opr(f'))::xs, 250 | c as Opr(f as Postfix _), ys) = 251 | if prec(f) > prec(f') then reduce (c::x::c'::xs, ys) 252 | else if prec(f') > prec(f) then reduce (x::c'::xs, c::ys) 253 | else fail "Operator ambiguous" 254 | | resolve _ = fail "Atom/operator mismatch" 255 | 256 | and reduce (Atm(a)::Opr(Prefix(_, cprefix))::xs, ys) = 257 | next(Atm(cprefix(a))::xs, ys) 258 | | reduce (Atm(a)::Opr(Infix(_, _, cinfix))::Atm(a')::xs, ys) = 259 | next(Atm(cinfix(a', a))::xs, ys) 260 | | reduce (Opr(Postfix(_, cpostfix))::Atm(a)::xs, ys) = 261 | next(Atm(cpostfix(a))::xs, ys) 262 | | reduce _ = fail "Atom/operator mismatch" 263 | 264 | and next (Atm(a)::[], []) = succeed a 265 | | next (xs, []) = reduce (xs, []) 266 | | next (xs, y::ys) = resolve (xs, y, ys) 267 | 268 | in next ([], ys) end 269 | 270 | fun resolvefixityadj cadj cassoc ys = 271 | let fun resolve (Atm(a)::xs, Atm(a'), ys) = 272 | 273 | (* treat adjacent tokens as if they have an infix operator 274 | of high precedence between them -- Tom *) 275 | resolve (Atm(a)::xs, Opr(Infix(cassoc, 999, cadj)), 276 | Atm(a')::ys) 277 | | resolve (xs, Atm(a), ys) = 278 | next (Atm(a)::xs, ys) 279 | | resolve (xs, c as Opr(Prefix _), ys) = 280 | next (c::xs, ys) 281 | | resolve (x::[], c, ys) = 282 | next (c::x::[], ys) 283 | | resolve ((c' as Opr _)::xs, c, ys) = 284 | reduce (c'::xs, c::ys) 285 | | resolve (x::(c' as Opr(f'))::xs, c as Opr(f), ys) = 286 | if prec(f) > prec(f') then next (c::x::c'::xs, ys) 287 | else if prec(f') > prec(f) then reduce (x::c'::xs, c::ys) 288 | else (case (assoc(f'), assoc(f)) 289 | of (Left, Left) => reduce (x::c'::xs, c::ys) 290 | | (Right, Right) => next (c::x::c'::xs, ys) 291 | | _ => fail "Operator ambiguous") 292 | | resolve _ = fail "Operator mismatch" 293 | 294 | and reduce (Atm(a)::Opr(Prefix(_, cprefix))::xs, ys) = 295 | next (Atm(cprefix(a))::xs, ys) 296 | | reduce (Atm(a)::Opr(Infix(_, _, cinfix))::Atm(a')::xs, ys) = 297 | next (Atm(cinfix(a', a))::xs, ys) 298 | | reduce (Opr(Postfix(_, cpostfix))::Atm(a)::xs, ys) = 299 | next (Atm(cpostfix(a))::xs, ys) 300 | | reduce _ = fail "Operator mismatch" 301 | 302 | and next (Atm(a)::[], []) = succeed a 303 | | next (xs, []) = reduce(xs, []) 304 | | next (xs, y::ys) = resolve(xs, y, ys) 305 | 306 | in next ([], ys) end 307 | 308 | fun parsefixity p = 309 | (repeat1 p) -- (fn ys => resolvefixity ys) 310 | 311 | fun parsefixityadj p assoc adj = 312 | (repeat1 p) -- (resolvefixityadj adj assoc) 313 | 314 | end 315 | -------------------------------------------------------------------------------- /src/tokparse.sig: -------------------------------------------------------------------------------- 1 | (* Signatures of language definitions for lexing and lexers 2 | based on those definitions *) 3 | 4 | signature MINI_LANGUAGE_DEF = 5 | sig 6 | 7 | val reservedNames : string list 8 | val reservedOpNames : string list 9 | 10 | end 11 | 12 | signature LANGUAGE_DEF = 13 | sig 14 | 15 | type scanner = char CharParser.charParser 16 | 17 | (* multiline comment start/end sequence *) 18 | val commentStart : string option 19 | val commentEnd : string option 20 | 21 | (* single line comment start *) 22 | val commentLine : string option 23 | 24 | (* do the multiline comments support nesting *) 25 | val nestedComments : bool 26 | 27 | (* parsers for first and subsequent letters of identifiers *) 28 | val identStart : scanner 29 | val identLetter : scanner 30 | 31 | (* parsers for first and subsequent chars of operators *) 32 | val opStart : scanner 33 | val opLetter : scanner 34 | 35 | (* reserved keywords and operators *) 36 | val reservedNames : string list 37 | val reservedOpNames : string list 38 | 39 | (* is the language case sensitive *) 40 | val caseSensitive : bool 41 | 42 | end 43 | 44 | signature TOKEN_PARSER = 45 | sig 46 | 47 | type 'a charParser = 'a CharParser.charParser 48 | 49 | val identifier : string charParser 50 | val reserved : string -> unit charParser 51 | val operator : string charParser 52 | val reservedOp : string -> unit charParser 53 | 54 | val charLiteral : char charParser 55 | val stringLiteral : string charParser 56 | (* val natural : IntInf charParser*) 57 | val integer : int charParser 58 | (* val float : real charParser *) 59 | (* val naturalOrFloat : CharParser st (Either Integer Double)*) 60 | val decimal : int charParser 61 | val hexadecimal : int charParser 62 | val octal : int charParser 63 | 64 | val symbol : string -> string charParser 65 | val lexeme : 'a charParser -> 'a charParser 66 | val whiteSpace : unit charParser 67 | 68 | val parens : 'a charParser -> 'a charParser 69 | val braces : 'a charParser -> 'a charParser 70 | val brackets : 'a charParser -> 'a charParser 71 | val squares : 'a charParser -> 'a charParser 72 | 73 | val semi : string charParser 74 | val comma : string charParser 75 | val colon : string charParser 76 | val dot : string charParser 77 | val semiSep : ('a charParser) -> ('a list) charParser 78 | val semiSep1 : ('a charParser) -> ('a list) charParser 79 | val commaSep : ('a charParser) -> ('a list) charParser 80 | val commaSep1 : ('a charParser) -> ('a list) charParser 81 | 82 | end 83 | -------------------------------------------------------------------------------- /src/tokparse.sml: -------------------------------------------------------------------------------- 1 | (* Token parsers, a simple lexer implementation based on language definitions *) 2 | 3 | functor TokenParser (Lang : LANGUAGE_DEF) :> TOKEN_PARSER = 4 | struct 5 | 6 | fun elem x = List.exists (fn y => x = y) 7 | fun notElem x = List.all (fn y => x <> y) 8 | 9 | open ParserCombinators 10 | open CharParser 11 | infixr 4 << >> 12 | infixr 3 && 13 | infix 2 -- ## 14 | infix 2 wth suchthat return guard when 15 | infixr 1 || <|> ?? 16 | 17 | type 'a charParser = 'a charParser 18 | 19 | val lineComment = 20 | let fun comLine _ = newLine <|> done #"\n" <|> (anyChar >> $ comLine) 21 | in case Lang.commentLine of 22 | SOME s => string s >> $ comLine return () 23 | | NONE => fail "Single-line comments not supported" 24 | end 25 | val mlComment = 26 | case (Lang.commentStart, Lang.commentEnd) of 27 | (SOME st, SOME ed) => 28 | let 29 | fun bcNest _ = try (string st) >> $contNest 30 | and contNest _ = try (string ed return ()) 31 | <|> ($bcNest <|> (anyChar return ())) >> $contNest 32 | val bcU = try (string st) >> repeat (not (string ed) >> anyChar) >> string ed return () 33 | in if Lang.nestedComments then $ bcNest else bcU 34 | end 35 | | _ => fail "Multi-line comments not supported" 36 | val comment = lineComment <|> mlComment 37 | 38 | val whiteSpace = repeatSkip ((space return ()) || comment) 39 | fun lexeme p = p << whiteSpace 40 | fun symbol s = lexeme (string s) 41 | 42 | val name = 43 | Lang.identStart && repeat Lang.identLetter wth implode o op:: 44 | val identifier = 45 | try (lexeme (name suchthat (fn x => notElem x Lang.reservedNames))) 46 | fun reserved kw = 47 | if elem kw Lang.reservedNames then 48 | try (lexeme (name suchthat (fn x => x = kw)) return ()) 49 | else fail "Not a reserved name" 50 | 51 | val opName = 52 | Lang.opStart && repeat Lang.opLetter wth implode o op:: 53 | val operator = 54 | try (lexeme (opName suchthat (fn x => notElem x Lang.reservedOpNames))) 55 | fun reservedOp rop = 56 | if elem rop Lang.reservedOpNames then 57 | try (lexeme (opName suchthat (fn x => x = rop)) return ()) 58 | else fail "Not a reserved operator" 59 | 60 | fun parens p = middle (symbol "(") p (symbol ")") 61 | fun braces p = middle (symbol "{") p (symbol "}") 62 | fun brackets p = middle (symbol "<") p (symbol ">") 63 | fun squares p = middle (symbol "[") p (symbol "]") 64 | 65 | val semi = symbol ";" 66 | val comma = symbol "," 67 | val colon = symbol ":" 68 | val dot = symbol "." 69 | fun semiSep p = separate p semi 70 | fun semiSep1 p = separate1 p semi 71 | fun commaSep p = separate p comma 72 | fun commaSep1 p = separate1 p comma 73 | 74 | val chrEscape = 75 | string "\\" && (anyChar wth Char.toString) wth op^ when Char.fromString 76 | val charLiteral = middle (char #"'") (chrEscape <|> anyChar) (symbol "'") 77 | val stringLiteral = 78 | (middle (char #"\"") 79 | (repeat (chrEscape <|> (anyChar suchthat (fn x => x <> #"\"")))) 80 | (symbol "\"")) wth String.implode 81 | 82 | fun dig d = if Char.isDigit d then Char.ord d - Char.ord #"0" 83 | else Char.ord (Char.toLower d) - Char.ord #"a" + 10 84 | 85 | fun transnum b = List.foldl (fn (s, d) => b*d + s) 0 86 | val decimal = repeat1 digit wth transnum 10 o List.map dig 87 | val hexadecimal = repeat1 hexDigit wth transnum 16 o List.map dig 88 | val octal = repeat1 octDigit wth transnum 8 o List.map dig 89 | val positive = 90 | (char #"0" >> ((char #"x" >> hexadecimal) || octal)) || decimal 91 | val integer = lexeme ((char #"-" >> positive wth op~) || positive) 92 | 93 | end 94 | -------------------------------------------------------------------------------- /src/util/either.sig: -------------------------------------------------------------------------------- 1 | signature EITHER = 2 | sig 3 | 4 | datatype ('a, 'b) either = Left of 'a | Right of 'b 5 | 6 | val either : ('a -> 'c) -> ('b -> 'c) -> ('a, 'b) either -> 'c 7 | val lefts : ('a, 'b) either list -> 'a list 8 | val rights : ('a, 'b) either list -> 'b list 9 | val part : ('a, 'b) either list -> 'a list * 'b list 10 | 11 | end 12 | -------------------------------------------------------------------------------- /src/util/either.sml: -------------------------------------------------------------------------------- 1 | structure Either :> EITHER = 2 | struct 3 | 4 | datatype ('a, 'b) either = Left of 'a | Right of 'b 5 | 6 | fun either lft rgt e = case e of 7 | Left x => lft x 8 | | Right y => rgt y 9 | fun lefts xs = case xs of 10 | [] => [] 11 | | Left x :: xs => x :: lefts xs 12 | | _ :: xs => lefts xs 13 | fun rights xs = case xs of 14 | [] => [] 15 | | Right x :: xs => x :: rights xs 16 | | _ :: xs => rights xs 17 | fun part xs = case xs of 18 | [] => ([], []) 19 | | x :: xs => 20 | let val (ls, rs) = part xs 21 | in (case x of 22 | Left l => (l :: ls, rs) 23 | | Right r => (ls, r :: rs)) 24 | end 25 | 26 | end 27 | -------------------------------------------------------------------------------- /version.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | # version.sh 4 | # 5 | # Generates src/version.sml and parcom.smackspec based on the current version 6 | # Usage: version.sh X.Y.Z 7 | # gdpe, Nov 2 2011 8 | # Updated for parcom from smbt version by fisi, Dec 3 2012 9 | 10 | if [ $# -ne 1 ] 11 | then 12 | echo "Usage: version.sh X.Y.Z" 13 | exit 1 14 | fi 15 | 16 | 17 | cat parcom.smackspec.in | sed "s/###VERSION###/$1/" > parcom.smackspec 18 | echo "(* Generated by version.sh *)\n\ 19 | structure Version = \n\ 20 | struct\n\ 21 | val version = \"$1\"\n\ 22 | end\n" > src/version.sml 23 | 24 | echo "Generated files." 25 | echo "Now run 'git commit -a -m \"bump to v$1\"; git tag v$1'" 26 | 27 | --------------------------------------------------------------------------------