Merge commit '2ac279c2bf6544bb894693ae24444dad393f8022' as 'mllex-polyml'

This commit is contained in:
Achim D. Brucker 2026-03-12 08:31:27 +00:00
commit f2e3d7bbd4
12 changed files with 13985 additions and 0 deletions

10
mllex-polyml/.gitignore vendored Normal file
View File

@ -0,0 +1,10 @@
# binary files
bin/
*.o
# test
ml.lex.sml
# doc
*.aux
*.log
*.pdf
*.toc

60
mllex-polyml/LICENSE Normal file
View File

@ -0,0 +1,60 @@
# MLLex for Poly/ML
MLLex for Poly/ML has been ported from MLton.
And this is released under Apache-2.0 license.
Copyright 2020 Takayuki Goto.
Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at
http://www.apache.org/licenses/LICENSE-2.0
Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.
# MLton
MLton COPYRIGHT NOTICE, LICENSE AND DISCLAIMER.
Copyright (C) 1999-2020 Henry Cejtin, Matthew Fluet, Suresh
Jagannathan, and Stephen Weeks.
Copyright (C) 1997-2000 by the NEC Research Institute
Permission to use, copy, modify, and distribute this software and its
documentation for any purpose and without fee is hereby granted,
provided that the above copyright notice appear in all copies and that
both the copyright notice and this permission notice and warranty
disclaimer appear in supporting documentation, and that the name of
the above copyright holders, or their entities, not be used in
advertising or publicity pertaining to distribution of the software
without specific, written prior permission.
The above copyright holders disclaim all warranties with regard to
this software, including all implied warranties of merchantability and
fitness. In no event shall the above copyright holders be liable for
any special, indirect or consequential damages or any damages
whatsoever resulting from loss of use, data or profits, whether in an
action of contract, negligence or other tortious action, arising out
of or in connection with the use or performance of this software.
# MLLex
Lexical analyzer generator for Standard ML.
Version 1.6, October 1994
Copyright (c) 1989-92 by Andrew W. Appel, James S. Mattson, David R. Tarditi
This software comes with ABSOLUTELY NO WARRANTY.
This software is subject only to the PRINCETON STANDARD ML SOFTWARE LIBRARY
COPYRIGHT NOTICE, LICENSE AND DISCLAIMER, (in the file "COPYRIGHT",
distributed with this software). You may copy and distribute this software;
see the COPYRIGHT NOTICE for details and restrictions.

1447
mllex-polyml/LexGen.sml Normal file

File diff suppressed because it is too large Load Diff

29
mllex-polyml/Main.sml Normal file
View File

@ -0,0 +1,29 @@
(* Copyright (C) 2020 Takayuki Goto.
*
* MLLex-Poly/ML is imported from MLton.
* See the LICENSE file for details.
*)
structure Main =
struct
fun usage s =
raise Fail (concat[s, "\n", "Usage: ", CommandLine.name(), " ", "file.lex ..."])
fun main args =
if null args then
usage "no files"
else
List.app LexGen.lexGen args
val main = fn () => (
main (CommandLine.arguments());
OS.Process.exit OS.Process.success
) handle Fail msg => (
print(concat["Fail: ", msg, "\n"]);
OS.Process.exit OS.Process.failure
) handle exn => (
print(concat[exnMessage exn, "\n"]);
OS.Process.exit OS.Process.failure
)
end

81
mllex-polyml/Makefile Normal file
View File

@ -0,0 +1,81 @@
## Copyright (C) 2020 Takayuki Goto
POLYML := poly
POLYMLC := polyc
POLYMLFLAGS := -q --error-exit
PDFLATEX := pdflatex
DIFF := diff
PREFIX := /usr/local/polyml
BINDIR := bin
DOCDIR := doc/mllex-polyml
MLLEX_POLYML := mllex-polyml
DOCS := mllex-polyml.pdf
SRCS := $(wildcard *.sml)
all: mllex-polyml
.PHONY: mllex-polyml
mllex-polyml: mllex-polyml-nodocs docs
.PHONY: mllex-polyml-nodocs
mllex-polyml-nodocs: $(BINDIR)/$(MLLEX_POLYML)
$(BINDIR)/$(MLLEX_POLYML): $(MLLEX_POLYML).o
@echo " [POLYMLC] $@"
@$(POLYMLC) -o $@ $^
$(MLLEX_POLYML).o: $(SRCS)
@echo " [POLYML] $@"
@echo "" | $(POLYML) $(POLYMLFLAGS) \
--eval 'PolyML.make (OS.FileSys.getDir())' \
--eval 'PolyML.export ("$@", Main.main)'
lexgen.pdf: lexgen.tex
-$(RM) lexgen.aux lexgen.log lexgen.toc lexgen.pdf
$(PDFLATEX) lexgen.tex
$(PDFLATEX) lexgen.tex
$(PDFLATEX) lexgen.tex
$(DOCS): lexgen.pdf
cp lexgen.pdf $(DOCS)
.PHONY: docs
docs: $(DOCS)
.PHONY: test
test: mllex-polyml-nodocs
$(BINDIR)/$(MLLEX_POLYML) ml.lex
$(DIFF) ml.lex.sml ml.lex.sml.exp
$(RM) ml.lex.sml
.PHONY: install-nodocs
install-nodocs: mllex-polyml-nodocs
install -D -m 0755 -t $(PREFIX)/$(BINDIR) $(BINDIR)/$(MLLEX_POLYML)
.PHONY: install
install: install-nodocs docs
install -D -m 0444 -t $(PREFIX)/$(DOCDIR) $(DOCS)
.PHONY: clean
clean:
-$(RM) $(BINDIR)/$(MLLEX_POLYML) $(MLLEX_POLYML).o
-$(RM) $(DOCS)
-$(RM) lexgen.aux lexgen.log lexgen.toc lexgen.pdf

91
mllex-polyml/Readme.md Normal file
View File

@ -0,0 +1,91 @@
# MLLex for Poly/ML
MLLex for Poly/ML is a port of MLLex for Poly/ML.
## Requires
- Poly/ML
- pdflatex (for docs)
## Build
To build `mllex-polyml`, run the default target or `mllex-polyml`.
```sh
$ make
```
Or
```sh
$ make mllex-polyml
```
This command generates `bin/mllex-polyml`.
## Install
To install `mllex-polyml`, run the `install` or `install-nodocs` target.
```sh
$ make install
```
By default, the `install` target installs `mllex-polyml` to `/usr/local/polyml`.
It is possible to overwrite the install directory with `PREFIX` variable.
```sh
$ make install PREFIX=~/.sml/polyml/5.8.1
```
## How to use
`mllex-polyml` take `.lex` files and generates `.lex.sml` files for each input files.
For example, you pass `ml.lex` to this program, `ml.lex.sml` will be generated.
```sh
$ mllex-polyml ml.lex
Number of states = 418
Number of distinct rows = 290
Approx. memory size of trans. table = 593920 bytes
$ file ml.lex.sml
ml.lex.sml: ASCII text
```
See `mllex-polyml.pdf` for details.
## Test
To run the test, run the `test` target.
```sh
mllex-polyml$ make test
bin/mllex-polyml ml.lex
Number of states = 418
Number of distinct rows = 290
Approx. memory size of trans. table = 593920 bytes
diff ml.lex.sml ml.lex.sml.exp
rm -f ml.lex.sml
```
## Document
To generate a document `mllex-polyml.pdf`, run the `docs` target.
```sh
$ make docs
```
## License
see LICENSE file for details.

2
mllex-polyml/bin/.gitignore vendored Normal file
View File

@ -0,0 +1,2 @@
*
!.gitignore

623
mllex-polyml/lexgen.tex Normal file
View File

@ -0,0 +1,623 @@
% Modified by Matthew Fluet on 2007-11-07.
% Add %posint command.
%
% Modified by Matthew Fluet on 2007-10-31.
% Add \r escape sequence (from Florian Weimer).
% Fix TeX formatting bug (from Florian Weimer).
%
\documentstyle{article}
\title{ A lexical analyzer generator for Standard ML.\\
Version 1.6.0, October 1994
}
\author{ Andrew W. Appel$^1$\\
James S. Mattson\\
David R. Tarditi$^2$\\
\\
\small
$^1$Department of Computer Science, Princeton University \\
\small
$^2$School of Computer Science, Carnegie Mellon University
}
\date{}
\begin{document}
\maketitle
\begin{center}
(c) 1989-94 Andrew W. Appel, James S. Mattson, David R. Tarditi
\end{center}
{\bf
This software comes with ABSOLUTELY NO WARRANTY. It is subject only to
the terms of the ML-Yacc NOTICE, LICENSE, and DISCLAIMER (in the
file COPYRIGHT distributed with this software).
}
\vspace{1in}
New in this version:
\begin{itemize}
\item REJECT is much less costly than before.
\item Lexical analyzers with more than 255 states can now compile in your
lifetime.
\end{itemize}
\newpage
\tableofcontents
\newpage
\section{General Description}
Computer programs often need to divide their input into words and
distinguish between different kinds of words. Compilers, for
example, need to distinguish between integers, reserved words, and
identifiers. Applications programs often need to be able to
recognize components of typed commands from users.
The problem of segmenting input into words and recognizing classes of
words is known as lexical analysis. Small cases of this problem,
such as reading text strings separated by spaces, can be solved by
using hand-written programs. Larger cases of this problem, such as
tokenizing an input stream for a compiler, can also be solved using
hand-written programs.
A hand-written program for a large lexical analysis problem, however,
suffers from two major problems. First, the program requires a fair
amount of programmer time to create. Second, the description of
classes of words is not explicit in the program. It must be inferred
from the program code. This makes it difficult to verify if the
program recognizes the correct words for each class. It also makes
future maintenance of the program difficult.
Lex, a programming tool for the Unix system, is a successful solution
to the general problem of lexical analysis. It uses regular
expressions to describe classes of words. A program fragment is
associated with each class of words. This information is given to
Lex as a specification (a Lex program). Lex produces a program for a
function that can be used to perform lexical analysis.
The function operates as follows. It finds the longest word starting
from the current position in the input stream that is in one of the
word classes. It executes the program fragment associated with the
class, and sets the current position in the input stream to be the
character after the word. The program fragment has the actual text
of the word available to it, and may be any piece of code. For many
applications it returns some kind of value.
Lex allows the programmer to make the language description explicit,
and to concentrate on what to do with the recognized words, not how
to recognize the words. It saves programmer time and increases
program maintainability.
Unfortunately, Lex is targeted only C. It also places artificial
limits on the size of strings that can be recognized.
ML-Lex is a variant of Lex for the ML programming language. ML-Lex
has a syntax similar to Lex, and produces an ML program instead of a
C program. ML-Lex produces a program that runs very efficiently.
Typically the program will be as fast or even faster than a
hand-coded lexer implemented in Standard ML.
The program typically uses only a small amount of space.
ML-Lex thus allows ML programmers the same benefits that Lex allows C
programmers. It also does not place artificial limits on the size of
recognized strings.
\section{ML-Lex specifications}
An ML-Lex specification has the general format:
\begin{quote}
{user declarations}
\verb|%%|
{ML-Lex definitions}
\verb|%%|
{rules}
\end{quote}
Each section is separated from the others by a \verb|%%| delimiter.
The rules are used to define the lexical analysis function. Each
rule has two parts---a regular expression and an action. The regular
expression defines the word class that a rule matches. The action is
a program fragment to be executed when a rule matches the input. The
actions are used to compute values, and must all return values of the
same type.
The user can define values available to all rule actions in the user
declarations section. The user must define two values in this
section---a type lexresult and a function eof. Lexresult defines the
type of values returned by the rule actions. The function "eof" is
called by the lexer when the end of the input stream is reached. It
will typically return a value signalling eof or raise an exception.
It is called with the same argument as lex (see \verb|%arg|, below),
and must return a value of type lexresult.
In the definitions section, the user can define named regular
expressions, a set of start states, and specify which of the various
bells and whistles of ML-Lex are desired.
The start states allow the user to control when certain rules are
matched. Rules may be defined to match only when the lexer is in
specific start states. The user may change the lexer's start state
in a rule action. This allows the user to specify special handling
of lexical objects.
This feature is typically used to handle quoted strings with escapes
to denote special characters. The rules to recognize the inside
contents of a string are defined for only one start state. This
start state is entered when the beginning of a string is recognized,
and exited when the end of the string is recognized.
\section{Regular expressions}
Regular expressions are a simple language for denoting classes of
strings. A regular expression is defined inductively over an
alphabet with a set of basic operations. The alphabet for ML-Lex is
the Ascii character set (character codes 0--127; or if
\verb|%full| is used, 0--255).
The syntax and semantics of regular expressions will be described in
order of decreasing precedence (from the most tightly binding operators
to the most weakly binding):
\begin{itemize}
\item An individual character stands for itself, except for the
reserved characters \verb@? * + | ( ) ^ $ / ; . = < > [ { " \@
\item[\\] A backslash followed by one of the reserved characters stands
for that character.
\item A set of characters enclosed in square brackets [ ] stands
for any one of those characters. Inside the brackets, only
the symbols \verb|\ - ^| are reserved. An initial up-arrow
\verb|^| stands
for the complement of the characters listed, e.g. \verb|[^abc]|
stands any character except a, b, or c. The hyphen - denotes
a range of characters, e.g. \verb|[a-z]| stands for any lower-case
alphabetic character, and \verb|[0-9a-fA-F]| stands for any hexadecimal
digit. To include \verb|^| literally in a bracketed set, put it anywhere
but first; to include \verb|-| literally in a set, put it first or last.
\item[\verb|.|] The dot \verb|.| character stands for any character except newline,
i.e. the same as \verb|[^\n]|
\item The following special escape sequences are available, inside
or outside of square-brackets:
\begin{tabular}{ll}
\verb|\b|& backspace\\
\verb|\n|& newline\\
\verb|\r|& carriage return\\
\verb|\t|& tab\\
\verb|\h|& stands for all characters with codes $>127$,\\
&~~~~ when 7-bit characters are used.\\
\verb|\ddd|& where \verb|ddd| is a 3 digit decimal escape.\\
\end{tabular}
\item[\verb|"|] A sequence of characters will stand for itself (reserved
characters will be taken literally) if it is enclosed in
double quotes \verb|" "|.
\item[\{\}] A named regular expression (defined in the ``definitions"
section) may be referred to by enclosing its name in
braces \verb|{ }|.
\item[()] Any regular expression may be enclosed in parentheses \verb|( )|
for syntactic (but, as usual, not semantic) effect.
\item[\verb|*|] The postfix operator \verb|*| stands for Kleene closure:
zero or more repetitions of the preceding expression.
\item[\verb|+|] The postfix operator \verb|+| stands for one or more repetitions
of the preceding expression.
\item[\verb|?|] The postfix operator \verb|?| stands for zero or one occurrence of
the preceding expression.
\item A postfix repetition range $\{n_1,n_2\}$ where $n_1$ and $n_2$ are small
integers stands for any number of repetitions between $n_1$ and $n_2$
of the preceding expression. The notation $\{n_1\}$ stands for
exactly $n_1$ repetitions.
\item Concatenation of expressions denotes concatenation of strings.
The expression $e_1 e_2$ stands for any string that results from
the concatenation of one string that matches $e_1$ with another
string that matches $e_2$.
\item\verb-|- The infix operator \verb-|- stands for alternation. The expression
$e_1$~\verb"|"~$e_2$ stands for anything that either $e_1$ or $e_2$ stands for.
\item[\verb|/|] The infix operator \verb|/| denotes lookahead. Lookahead is not
implemented and cannot be used, because there is a bug
in the algorithm for generating lexers with lookahead. If
it could be used, the expression $e_1 / e_2$ would match any string
that $e_1$ stands for, but only when that string is followed by a
string that matches $e_2$.
\item When the up-arrow \verb|^| occurs at the beginning of an expression,
that expression will only match strings that occur at the
beginning of a line (right after a newline character).
\item[\$] The dollar sign of C Lex \$ is not implemented, since it is an abbreviation
for lookahead involving the newline character (that is, it
is an abbreviation for \verb|/\n|).
\end{itemize}
Here are some examples of regular expressions, and descriptions of the
set of strings they denote:
\begin{tabular}{ll}
\verb~0 | 1 | 2 | 3~& A single digit between 0 and 3\\
\verb|[0123]|& A single digit between 0 and 3\\
\verb|0123|& The string ``0123"\\
\verb|0*|& All strings of 0 or more 0's\\
\verb|00*|& All strings of 1 or more 0's\\
\verb|0+|& All strings of 1 or more 0's\\
\verb|[0-9]{3}|& Any three-digit decimal number.\\
\verb|\\[ntb]|& A newline, tab, or backspace.\\
\verb|(00)*|& Any string with an even number of 0's.
\end{tabular}
\section{ML-Lex syntax summary}
\subsection{User declarations}
Anything up to the first \verb|%%| is in the user declarations section. The
user should note that no symbolic identifier containing
\verb|%%| can be
used in this section.
\subsection{ML-Lex definitions}
Start states can be defined with
\begin{quote}
\verb|%s| {identifier list} \verb|;|
\end{quote}
An identifier list consists of one or more identifiers.
An identifier consists of one or more letters, digits, underscores,
or primes, and must begin with a letter.
Named expressions can be defined with
\begin{quote}
{identifier} = {regular expression} ;
\end{quote}
Regular expressions are defined below.
The following \% commands are also available:
\begin{description}
\item[\tt \%reject] create REJECT() function
\item[\tt \%count] count newlines using yylineno
\item[\tt \%posarg] pass initial-position argument to makeLexer
\item[\tt \%full] create lexer for the full 8-bit character set,
with characters in the range 0--255 permitted
as input.
\item[\tt \%structure \{identifier\}] name the structure in the output program
{identifier} instead of Mlex
\item[\tt \%header] use code following it to create header for lexer
structure
\item[\tt \%arg] extra (curried) formal parameter argument to be
passed to the lex functions, and to be passed
to the eof function in place of ()
\item[\tt \%posint \{identifier\}] use the {\tt INTEGER} structure for the
type of {\tt yypos}; use {\tt Int64} or {\tt Position}
to allow lexing of multi-gigabyte input files
\end{description}
These functions are discussed in section~\ref{avail}.
\subsection{Rules}
Each rule has the format:
\begin{quote}
\verb|<|{\it start state list}\verb|>| {\it regular expression} \verb|=> (| {\it code} \verb|);|
\end{quote}
All parentheses in {\it code} must be balanced, including those
used in strings and comments.
The {\it start state list} is optional. It consists of a list of
identifiers separated by commas, and is delimited by triangle
brackets \verb|< >|. Each identifier must be a start state defined in the
\verb|%s| section above.
The regular expression is only recognized when the lexer is in one of
the start states in the start state list. If no start state list is
given, the expression is recognized in all start states.
The lexer begins in a pre-defined start state called \verb|INITIAL|.
The lexer resolves conflicts among rules by choosing the rule with
the longest match, and in the case two rules match the same string,
choosing the rule listed first in the specification.
The rules should match all possible input. If some input occurs that
does not match any rule, the lexer created by ML-Lex will raise an
exception LexError. Note that this differs from C Lex, which prints
any unmatched input on the standard output.
\section{Values available inside the code associated with a rule.}
\label{avail}
ML-Lex places the value of the string matched by a regular expression
in \verb|yytext|, a string variable.
The user may recursively
call the lexing function with \verb|lex()|. (If \verb|%arg| is used, the
lexing function may be re-invoked with the same argument by using
continue().) This is convenient for ignoring white space or comments silently:
\begin{verbatim}
[\ \t\n]+ => ( lex());
\end{verbatim}
To switch start states, the user may call \verb|YYBEGIN| with the name of a
start state.
The following values will be available only if the corresponding \verb|%|
command is in the ML-Lex definitions sections:
\begin{tabular}{lll}
\\
{\bf Value}&{\bf \% command}&{\bf description}\\
\hline
{\tt REJECT} &{\tt\%reject}&\parbox[t]{2.6in}{{\tt REJECT()} causes the current
rule to be ``rejected.''
The lexer behaves as if the
current rule had not matched;
another rule that matches this
string, or that matches the longest
possible prefix of this string,
is used instead.} \\
{\tt yypos} & & \parbox[t]{2.6in}{The position of the first character
of {\tt yytext}, relative to the beginning of the file.}\\
{\tt yylineno } & {\tt \%count} & Current line number\\
\\
\end{tabular}
These values should be used only if necessary. Adding {\tt REJECT} to a
lexer will slow it down by 20\%; adding {\tt yylineno} will slow it down by
another 20\%, or more. (It is much more efficient to
recognize \verb|\n| and
have an action that increments the line-number variable.) The use of
the lookahead operator {\tt /} will also slow down the entire lexer.
The character-position, {\tt yypos}, is not costly to maintain, however.
\paragraph{Bug.} The position of the first character in the file
is reported as 2 (unless the {\tt \%posarg} feature is used).
To preserve compatibility, this bug has not been fixed.
\section{Running ML-Lex}
From the Unix shell, run {\tt sml-lex~myfile.lex}
The output file will be myfile.lex.sml. The extension {\tt .lex} is not
required but is recommended.
Within an interactive system [not the preferred method]:
Use {\tt lexgen.sml}; this will create a structure LexGen. The function
LexGen.lexGen creates a program for a lexer from an input
specification. It takes a string argument -- the name of the file
containing the input specification. The output file name is
determined by appending ``{\tt .sml}'' to the input file name.
\section{Using the program produced by ML-Lex}
When the output file is loaded, it will create a structure Mlex that
contains the function {\tt makeLexer} which takes a function from
${\it int} \rightarrow {\it string}$ and returns a lexing function:
\begin{verbatim}
val makeLexer : (int->string) -> yyarg -> lexresult
\end{verbatim}
where {\tt yyarg} is the type given in the {\tt \%yyarg} directive,
or {\tt unit} if there is no {\tt \%yyarg} directive.
For example,
\begin{verbatim}
val lexer = Mlex.makeLexer (inputc (open_in "f"))
\end{verbatim}
creates a lexer that operates on the file whose name is f.
When the {\tt \%posarg} directive is used, the type of
{\tt makeLexer} is
\begin{verbatim}
val makeLexer : ((int->string)*int) -> yyarg -> lexresult
\end{verbatim}
where the extra {\tt int} argument is one less than the {\tt yypos}
of the first character in the input. The value $k$ would be used,
for example, when creating
a lexer to start in the middle of a file, when $k$ characters have
already been read. At the beginning of the file, $k=0$ should be used.
The ${\it int} \rightarrow {\it string}$ function
should read a string of characters
from the input stream. It should return a null string to indicate
that the end of the stream has been reached. The integer is the
number of characters that the lexer wishes to read; the function may
return any non-zero number of characters. For example,
\begin{verbatim}
val lexer =
let val input_line = fn f =>
let fun loop result =
let val c = input (f,1)
val result = c :: result
in if String.size c = 0 orelse c = "\n" then
String.implode (rev result)
else loop result
end
in loop nil
end
in Mlex.makeLexer (fn n => input_line std_in)
end
\end{verbatim}
is appropriate for interactive streams where prompting, etc. occurs;
the lexer won't care that \verb|input_line| might return a string of more
than or less than $n$ characters.
The lexer tries to read a large number of characters from the input
function at once, and it is desirable that the input function return
as many as possible. Reading many characters at once makes the lexer
more efficient. Fewer input calls and buffering operations are
needed, and input is more efficient in large block reads. For
interactive streams this is less of a concern, as the limiting factor
is the speed at which the user can type.
To obtain a value, invoke the lexer by passing it a unit:
\begin{verbatim}
val nextToken = lexer()
\end{verbatim}
If one wanted to restart the lexer, one would just discard {\tt lexer}
and create a new lexer on the same stream with another call to
{\tt makeLexer}. This is the best way to discard any characters buffered
internally by the lexer.
All code in the user declarations section is placed inside a
structure UserDeclarations. To access this structure, use the path name
{\tt Mlex.UserDeclarations}.
If any input cannot be matched, the program will raise the exception
{\tt Mlex.LexError}. An internal error (i.e. bug) will cause the
exception {\tt Internal.LexerError} to be raised.
If {\tt \%structure} is used, remember that the structure name will no
longer be Mlex, but the one specified in the command.
\section{Sample}
Here is a sample lexer for a calculator program:
\small
\begin{verbatim}
datatype lexresult= DIV | EOF | EOS | ID of string | LPAREN |
NUM of int | PLUS | PRINT | RPAREN | SUB | TIMES
val linenum = ref 1
val error = fn x => output(std_out,x ^ "\n")
val eof = fn () => EOF
%%
%structure CalcLex
alpha=[A-Za-z];
digit=[0-9];
ws = [\ \t];
%%
\n => (inc linenum; lex());
{ws}+ => (lex());
"/" => (DIV);
";" => (EOS);
"(" => (LPAREN);
{digit}+ => (NUM (revfold (fn(a,r)=>ord(a)-ord("0")+10*r) (explode yytext) 0));
")" => (RPAREN);
"+" => (PLUS);
{alpha}+ => (if yytext="print" then PRINT else ID yytext);
"-" => (SUB);
"*" => (TIMES);
. => (error ("calc: ignoring bad character "^yytext); lex());
\end{verbatim}
Here is the parser for the calculator:
\begin{verbatim}
(* Sample interactive calculator to demonstrate use of lexer
The original grammar was
stmt_list -> stmt_list stmt
stmt -> print exp ; | exp ;
exp -> exp + t | exp - t | t
t -> t * f | t/f | f
f -> (exp) | id | num
The function parse takes a stream and parses it for the calculator
program.
If a syntax error occurs, parse prints an error message and calls
itself on the stream. On this system that has the effect of ignoring
all input to the end of a line.
*)
structure Calc =
struct
open CalcLex
open UserDeclarations
exception Error
fun parse strm =
let
val say = fn s => output(std_out,s)
val input_line = fn f =>
let fun loop result =
let val c = input (f,1)
val result = c :: result
in if String.size c = 0 orelse c = "\n" then
String.implode (rev result)
else loop result
end
in loop nil
end
val lexer = makeLexer (fn n => input_line strm)
val nexttok = ref (lexer())
val advance = fn () => (nexttok := lexer(); !nexttok)
val error = fn () => (say ("calc: syntax error on line" ^
(makestring(!linenum)) ^ "\n"); raise Error)
val lookup = fn i =>
if i = "ONE" then 1
else if i = "TWO" then 2
else (say ("calc: unknown identifier '" ^ i ^ "'\n"); raise Error)
fun STMT_LIST () =
case !nexttok of
EOF => ()
| _ => (STMT(); STMT_LIST())
and STMT() =
(case !nexttok
of EOS => ()
| PRINT => (advance(); say ((makestring (E():int)) ^ "\n"); ())
| _ => (E(); ());
case !nexttok
of EOS => (advance())
| _ => error())
and E () = E' (T())
and E' (i : int ) =
case !nexttok of
PLUS => (advance (); E'(i+T()))
| SUB => (advance (); E'(i-T()))
| RPAREN => i
| EOF => i
| EOS => i
| _ => error()
and T () = T'(F())
and T' i =
case !nexttok of
PLUS => i
| SUB => i
| TIMES => (advance(); T'(i*F()))
| DIV => (advance (); T'(i div F()))
| EOF => i
| EOS => i
| RPAREN => i
| _ => error()
and F () =
case !nexttok of
ID i => (advance(); lookup i)
| LPAREN =>
let val v = (advance(); E())
in if !nexttok = RPAREN then (advance (); v) else error()
end
| NUM i => (advance(); i)
| _ => error()
in STMT_LIST () handle Error => parse strm
end
end
\end{verbatim}
\end{document}

561
mllex-polyml/ml.lex Normal file
View File

@ -0,0 +1,561 @@
(* Heavily modified from SML/NJ sources. *)
(* ml.lex
*
* Copyright 1989 by AT&T Bell Laboratories
*
* SML/NJ is released under a BSD-style license.
* See the file NJ-LICENSE for details.
*)
(* Copyright (C) 2009,2016-2017 Matthew Fluet.
* Copyright (C) 1999-2006 Henry Cejtin, Matthew Fluet, Suresh
* Jagannathan, and Stephen Weeks.
* Copyright (C) 1997-2000 NEC Research Institute.
*
* MLton is released under a BSD-style license.
* See the file MLton-LICENSE for details.
*)
type svalue = Tokens.svalue
type pos = SourcePos.t
type lexresult = (svalue, pos) Tokens.token
type lexarg = {source: Source.t}
type arg = lexarg
type ('a,'b) token = ('a,'b) Tokens.token
local
open Control.Elaborate
in
val allowLineComments = fn () => current allowLineComments
val allowExtendedNumConsts = fn () => current allowExtendedNumConsts
val allowExtendedTextConsts = fn () => current allowExtendedTextConsts
end
fun lastPos (yypos, yytext) = yypos + size yytext - 1
fun tok (t, x, s, l) =
let
val left = Source.getPos (s, l)
val right = Source.getPos (s, lastPos (l, x))
in
t (left, right)
end
fun tok' (t, x, s, l) = tok (fn (l, r) => t (x, l, r), x, s, l)
fun error' (left, right, msg) =
Control.errorStr (Region.make {left = left, right = right}, msg)
fun error (source, left, right, msg) =
error' (Source.getPos (source, left), Source.getPos (source, right), msg)
(* Comments *)
local
val commentErrors: string list ref = ref []
val commentLeft = ref SourcePos.bogus
val commentStack: (int -> unit) list ref = ref []
in
fun addCommentError msg =
List.push (commentErrors, msg)
val inComment = fn () => not (List.isEmpty (!commentStack))
fun startComment (source, yypos, th) =
if inComment ()
then List.push (commentStack, fn _ => th ())
else (commentErrors := []
; commentLeft := Source.getPos (source, yypos)
; List.push (commentStack, fn yypos =>
(List.foreach (!commentErrors, fn msg =>
error' (!commentLeft,
Source.getPos (source, yypos),
msg))
; th ())))
fun finishComment yypos =
(List.pop commentStack) yypos
end
(* Line Directives *)
local
val lineDirCol: int ref = ref ~1
val lineDirFile: File.t option ref = ref NONE
val lineDirLine: int ref = ref ~1
in
fun startLineDir (source, yypos, th) =
let
val _ = lineDirCol := ~1
val _ = lineDirFile := NONE
val _ = lineDirLine := ~1
in
startComment (source, yypos, th)
end
fun addLineDirLineCol (line, col) =
let
val _ = lineDirLine := line
val _ = lineDirCol := col
in
()
end
fun addLineDirFile file =
let
val _ = lineDirFile := SOME file
in
()
end
fun finishLineDir (source, yypos) =
let
val col = !lineDirCol
val file = !lineDirFile
val line = !lineDirLine
val _ = lineDirCol := ~1
val _ = lineDirFile := NONE
val _ = lineDirLine := ~1
in
finishComment yypos
; Source.lineDirective (source, file,
{lineNum = line,
lineStart = yypos + 1 - col})
end
end
(* Numeric Constants *)
local
fun doit (source, yypos, yytext, drop, {extended: string option}, mkTok) =
let
val left = yypos
val right = lastPos (yypos, yytext)
val extended =
if String.contains (yytext, #"_")
then SOME (Option.fold
(extended, "'_' separators", fn (msg1, msg2) =>
msg1 ^ " and " ^ msg2))
else extended
val _ =
case extended of
NONE => ()
| SOME msg =>
if allowExtendedNumConsts ()
then ()
else error (source, left, right,
concat ["Extended numeric constants (using ", msg,
") disallowed, compile with -default-ann 'allowExtendedNumConsts true'"])
in
mkTok (String.keepAll (String.dropPrefix (yytext, drop), fn c => not (c = #"_")),
{extended = Option.isSome extended},
Source.getPos (source, left), Source.getPos (source, right))
end
in
fun real (source, yypos, yytext) =
doit (source, yypos, yytext, 0, {extended = NONE}, fn (digits, {extended: bool}, l, r) =>
Tokens.REAL (digits, l, r))
fun int (source, yypos, yytext, drop, {extended: string option}, {negate: bool}, radix) =
doit (source, yypos, yytext, drop, {extended = extended}, fn (digits, {extended: bool}, l, r) =>
Tokens.INT ({digits = digits,
extended = extended,
negate = negate,
radix = radix},
l, r))
fun word (source, yypos, yytext, drop, {extended: string option}, radix) =
doit (source, yypos, yytext, drop, {extended = extended}, fn (digits, {extended: bool}, l, r) =>
Tokens.WORD ({digits = digits,
radix = radix},
l, r))
end
(* Text Constants *)
local
val chars: IntInf.t list ref = ref []
val inText = ref false
val textLeft = ref SourcePos.bogus
val textFinishFn: (IntInf.t vector * SourcePos.t * SourcePos.t -> lexresult) ref = ref (fn _ => raise Fail "textFinish")
in
fun startText (tl, tf) =
let
val _ = chars := []
val _ = inText := true
val _ = textLeft := tl
val _ = textFinishFn := tf
in
()
end
fun finishText textRight =
let
val cs = Vector.fromListRev (!chars)
val tl = !textLeft
val tr = textRight
val tf = !textFinishFn
val _ = chars := []
val _ = inText := false
val _ = textLeft := SourcePos.bogus
val _ = textFinishFn := (fn _ => raise Fail "textFinish")
in
tf (cs, tl, tr)
end
val inText = fn () => !inText
fun addTextString (s: string) =
chars := String.fold (s, !chars, fn (c, ac) => Int.toIntInf (Char.ord c) :: ac)
fun addTextCharCode (i: IntInf.int) = List.push (chars, i)
end
fun addTextChar (c: char) = addTextString (String.fromChar c)
fun addTextNumEsc (source, yypos, yytext, drop, {extended: string option}, radix): unit =
let
val left = yypos
val right = lastPos (yypos, yytext)
val _ =
case extended of
NONE => ()
| SOME msg =>
if allowExtendedTextConsts ()
then ()
else error (source, left, right,
concat ["Extended text constants (using ", msg,
") disallowed, compile with -default-ann 'allowExtendedTextConsts true'"])
in
case StringCvt.scanString (fn r => IntInf.scan (radix, r)) (String.dropPrefix (yytext, drop)) of
NONE => error (source, left, right, "Illegal numeric escape in text constant")
| SOME i => addTextCharCode i
end
fun addTextUTF8 (source, yypos, yytext): unit =
let
val left = yypos
val right = lastPos (yypos, yytext)
in
if not (allowExtendedTextConsts ())
then error (source, left, right,
"Extended text constants (using UTF-8 byte sequences) disallowed, compile with -default-ann 'allowExtendedTextConsts true'")
else addTextString yytext
end
(* EOF *)
val eof: lexarg -> lexresult =
fn {source, ...} =>
let
val _ = Source.newline (source, ~1)
val pos = Source.getPos (source, ~1)
val _ =
if inComment ()
then error' (pos, SourcePos.bogus, "Unclosed comment at end of file")
else ()
val _ =
if inText ()
then error' (pos, SourcePos.bogus, "Unclosed text constant at end of file")
else ()
in
Tokens.EOF (pos, SourcePos.bogus)
end
%%
%full
%s TEXT TEXT_FMT BLOCK_COMMENT LINE_COMMENT LINE_DIR1 LINE_DIR2 LINE_DIR3 LINE_DIR4;
%header (functor MLLexFun (structure Tokens : ML_TOKENS));
%arg ({source});
ws=\t|"\011"|"\012"|" ";
cr="\013";
nl="\010";
eol=({cr}{nl}|{nl}|{cr});
alphanum=[A-Za-z0-9'_];
alphanumId=[A-Za-z]{alphanum}*;
sym="!"|"%"|"&"|"$"|"#"|"+"|"-"|"/"|":"|"<"|"="|">"|"?"|"@"|"\\"|"~"|"`"|"^"|"|"|"*";
symId={sym}+;
tyvarId="'"{alphanum}*;
longSymId=({alphanumId}".")+{symId};
longAlphanumId=({alphanumId}".")+{alphanumId};
decDigit=[0-9];
decnum={decDigit}("_"*{decDigit})*;
hexDigit=[0-9a-fA-F];
hexnum={hexDigit}("_"*{hexDigit})*;
binDigit=[0-1];
binnum={binDigit}("_"*{binDigit})*;
frac="."{decnum};
exp=[eE](~?){decnum};
real=(~?)(({decnum}{frac}?{exp})|({decnum}{frac}{exp}?));
%%
<INITIAL>{ws}+ => (continue ());
<INITIAL>{eol} => (Source.newline (source, lastPos (yypos, yytext)); continue ());
<INITIAL>"_address" => (tok (Tokens.ADDRESS, yytext, source, yypos));
<INITIAL>"_build_const" => (tok (Tokens.BUILD_CONST, yytext, source, yypos));
<INITIAL>"_command_line_const" => (tok (Tokens.COMMAND_LINE_CONST, yytext, source, yypos));
<INITIAL>"_const" => (tok (Tokens.CONST, yytext, source, yypos));
<INITIAL>"_export" => (tok (Tokens.EXPORT, yytext, source, yypos));
<INITIAL>"_import" => (tok (Tokens.IMPORT, yytext, source, yypos));
<INITIAL>"_overload" => (tok (Tokens.OVERLOAD, yytext, source, yypos));
<INITIAL>"_prim" => (tok (Tokens.PRIM, yytext, source, yypos));
<INITIAL>"_symbol" => (tok (Tokens.SYMBOL, yytext, source, yypos));
<INITIAL>"#" => (tok (Tokens.HASH, yytext, source, yypos));
<INITIAL>"#[" => (tok (Tokens.HASHLBRACKET, yytext, source, yypos));
<INITIAL>"(" => (tok (Tokens.LPAREN, yytext, source, yypos));
<INITIAL>")" => (tok (Tokens.RPAREN, yytext, source, yypos));
<INITIAL>"," => (tok (Tokens.COMMA, yytext, source, yypos));
<INITIAL>"->" => (tok (Tokens.ARROW, yytext, source, yypos));
<INITIAL>"..." => (tok (Tokens.DOTDOTDOT, yytext, source, yypos));
<INITIAL>":" => (tok (Tokens.COLON, yytext, source, yypos));
<INITIAL>":>" => (tok (Tokens.COLONGT, yytext, source, yypos));
<INITIAL>";" => (tok (Tokens.SEMICOLON, yytext, source, yypos));
<INITIAL>"=" => (tok (Tokens.EQUALOP, yytext, source, yypos));
<INITIAL>"=>" => (tok (Tokens.DARROW, yytext, source, yypos));
<INITIAL>"[" => (tok (Tokens.LBRACKET, yytext, source, yypos));
<INITIAL>"]" => (tok (Tokens.RBRACKET, yytext, source, yypos));
<INITIAL>"_" => (tok (Tokens.WILD, yytext, source, yypos));
<INITIAL>"{" => (tok (Tokens.LBRACE, yytext, source, yypos));
<INITIAL>"|" => (tok (Tokens.BAR, yytext, source, yypos));
<INITIAL>"}" => (tok (Tokens.RBRACE, yytext, source, yypos));
<INITIAL>"abstype" => (tok (Tokens.ABSTYPE, yytext, source, yypos));
<INITIAL>"and" => (tok (Tokens.AND, yytext, source, yypos));
<INITIAL>"andalso" => (tok (Tokens.ANDALSO, yytext, source, yypos));
<INITIAL>"as" => (tok (Tokens.AS, yytext, source, yypos));
<INITIAL>"case" => (tok (Tokens.CASE, yytext, source, yypos));
<INITIAL>"datatype" => (tok (Tokens.DATATYPE, yytext, source, yypos));
<INITIAL>"do" => (tok (Tokens.DO, yytext, source, yypos));
<INITIAL>"else" => (tok (Tokens.ELSE, yytext, source, yypos));
<INITIAL>"end" => (tok (Tokens.END, yytext, source, yypos));
<INITIAL>"eqtype" => (tok (Tokens.EQTYPE, yytext, source, yypos));
<INITIAL>"exception" => (tok (Tokens.EXCEPTION, yytext, source, yypos));
<INITIAL>"fn" => (tok (Tokens.FN, yytext, source, yypos));
<INITIAL>"fun" => (tok (Tokens.FUN, yytext, source, yypos));
<INITIAL>"functor" => (tok (Tokens.FUNCTOR, yytext, source, yypos));
<INITIAL>"handle" => (tok (Tokens.HANDLE, yytext, source, yypos));
<INITIAL>"if" => (tok (Tokens.IF, yytext, source, yypos));
<INITIAL>"in" => (tok (Tokens.IN, yytext, source, yypos));
<INITIAL>"include" => (tok (Tokens.INCLUDE, yytext, source, yypos));
<INITIAL>"infix" => (tok (Tokens.INFIX, yytext, source, yypos));
<INITIAL>"infixr" => (tok (Tokens.INFIXR, yytext, source, yypos));
<INITIAL>"let" => (tok (Tokens.LET, yytext, source, yypos));
<INITIAL>"local" => (tok (Tokens.LOCAL, yytext, source, yypos));
<INITIAL>"nonfix" => (tok (Tokens.NONFIX, yytext, source, yypos));
<INITIAL>"of" => (tok (Tokens.OF, yytext, source, yypos));
<INITIAL>"op" => (tok (Tokens.OP, yytext, source, yypos));
<INITIAL>"open" => (tok (Tokens.OPEN, yytext, source, yypos));
<INITIAL>"orelse" => (tok (Tokens.ORELSE, yytext, source, yypos));
<INITIAL>"raise" => (tok (Tokens.RAISE, yytext, source, yypos));
<INITIAL>"rec" => (tok (Tokens.REC, yytext, source, yypos));
<INITIAL>"sharing" => (tok (Tokens.SHARING, yytext, source, yypos));
<INITIAL>"sig" => (tok (Tokens.SIG, yytext, source, yypos));
<INITIAL>"signature" => (tok (Tokens.SIGNATURE, yytext, source, yypos));
<INITIAL>"struct" => (tok (Tokens.STRUCT, yytext, source, yypos));
<INITIAL>"structure" => (tok (Tokens.STRUCTURE, yytext, source, yypos));
<INITIAL>"then" => (tok (Tokens.THEN, yytext, source, yypos));
<INITIAL>"type" => (tok (Tokens.TYPE, yytext, source, yypos));
<INITIAL>"val" => (tok (Tokens.VAL, yytext, source, yypos));
<INITIAL>"where" => (tok (Tokens.WHERE, yytext, source, yypos));
<INITIAL>"while" => (tok (Tokens.WHILE, yytext, source, yypos));
<INITIAL>"with" => (tok (Tokens.WITH, yytext, source, yypos));
<INITIAL>"withtype" => (tok (Tokens.WITHTYPE, yytext, source, yypos));
<INITIAL>{alphanumId} => (tok' (Tokens.SHORTALPHANUMID, yytext, source, yypos));
<INITIAL>{symId} =>
(case yytext of
"*" => tok (Tokens.ASTERISK, yytext, source, yypos)
| _ => tok' (Tokens.SHORTSYMID, yytext, source, yypos));
<INITIAL>{tyvarId} => (tok' (Tokens.TYVAR, yytext, source, yypos));
<INITIAL>{longAlphanumId} => (tok' (Tokens.LONGALPHANUMID, yytext, source, yypos));
<INITIAL>{longSymId} => (tok' (Tokens.LONGSYMID, yytext, source, yypos));
<INITIAL>{real} =>
(real (source, yypos, yytext));
<INITIAL>{decnum} =>
(int (source, yypos, yytext, 0, {extended = NONE}, {negate = false}, StringCvt.DEC));
<INITIAL>"~"{decnum} =>
(int (source, yypos, yytext, 1, {extended = NONE}, {negate = true}, StringCvt.DEC));
<INITIAL>"0x"{hexnum} =>
(int (source, yypos, yytext, 2, {extended = NONE}, {negate = false}, StringCvt.HEX));
<INITIAL>"~0x"{hexnum} =>
(int (source, yypos, yytext, 3, {extended = NONE}, {negate = true}, StringCvt.HEX));
<INITIAL>"0b"{binnum} =>
(int (source, yypos, yytext, 2, {extended = SOME "binary notation"}, {negate = false}, StringCvt.BIN));
<INITIAL>"~0b"{binnum} =>
(int (source, yypos, yytext, 3, {extended = SOME "binary notation"}, {negate = true}, StringCvt.BIN));
<INITIAL>"0w"{decnum} =>
(word (source, yypos, yytext, 2, {extended = NONE}, StringCvt.DEC));
<INITIAL>"0wx"{hexnum} =>
(word (source, yypos, yytext, 3, {extended = NONE}, StringCvt.HEX));
<INITIAL>"0wb"{binnum} =>
(word (source, yypos, yytext, 3, {extended = SOME "binary notation"}, StringCvt.BIN));
<INITIAL>"\"" =>
(startText (Source.getPos (source, yypos), fn (cs, l, r) =>
(YYBEGIN INITIAL;
Tokens.STRING (cs, l, r)))
; YYBEGIN TEXT
; continue ());
<INITIAL>"#\"" =>
(startText (Source.getPos (source, yypos), fn (cs, l, r) =>
let
fun err () =
error' (l, r, "character constant not of size 1")
val c =
case Int.compare (Vector.length cs, 1) of
LESS => (err (); 0)
| EQUAL => Vector.sub (cs, 0)
| GREATER => (err (); Vector.sub (cs, 0))
in
YYBEGIN INITIAL;
Tokens.CHAR (c, l, r)
end)
; YYBEGIN TEXT
; continue ());
<TEXT>"\"" => (finishText (Source.getPos (source, lastPos (yypos, yytext))));
<TEXT>" "|!|[\035-\091]|[\093-\126] =>
(addTextString yytext; continue ());
<TEXT>[\192-\223][\128-\191] =>
(addTextUTF8 (source, yypos, yytext); continue());
<TEXT>[\224-\239][\128-\191][\128-\191] =>
(addTextUTF8 (source, yypos, yytext); continue());
<TEXT>[\240-\247][\128-\191][\128-\191][\128-\191] =>
(addTextUTF8 (source, yypos, yytext); continue());
<TEXT>\\a => (addTextChar #"\a"; continue ());
<TEXT>\\b => (addTextChar #"\b"; continue ());
<TEXT>\\t => (addTextChar #"\t"; continue ());
<TEXT>\\n => (addTextChar #"\n"; continue ());
<TEXT>\\v => (addTextChar #"\v"; continue ());
<TEXT>\\f => (addTextChar #"\f"; continue ());
<TEXT>\\r => (addTextChar #"\r"; continue ());
<TEXT>\\\^[@-_] => (addTextChar (Char.chr(Char.ord(String.sub(yytext, 2)) - Char.ord #"@"));
continue ());
<TEXT>\\\^. => (error (source, yypos, yypos + 2, "Illegal control escape in text constant; must be one of @ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_");
continue ());
<TEXT>\\[0-9]{3} => (addTextNumEsc (source, yypos, yytext, 1,
{extended = NONE}, StringCvt.DEC)
; continue ());
<TEXT>\\u{hexDigit}{4} =>
(addTextNumEsc (source, yypos, yytext, 2,
{extended = NONE}, StringCvt.HEX)
; continue ());
<TEXT>\\U{hexDigit}{8} =>
(addTextNumEsc (source, yypos, yytext, 2,
{extended = SOME "\\Uxxxxxxxx numeric escapes"},
StringCvt.HEX)
; continue ());
<TEXT>"\\\"" => (addTextString "\""; continue ());
<TEXT>\\\\ => (addTextString "\\"; continue ());
<TEXT>\\{ws}+ => (YYBEGIN TEXT_FMT; continue ());
<TEXT>\\{eol} => (Source.newline (source, lastPos (yypos, yytext)); YYBEGIN TEXT_FMT; continue ());
<TEXT>\\ => (error (source, yypos, yypos + 1, "Illegal escape in text constant")
; continue ());
<TEXT>{eol} => (error (source, yypos, lastPos (yypos, yytext), "Unclosed text constant at end of line")
; Source.newline (source, lastPos (yypos, yytext))
; continue ());
<TEXT>. => (error (source, yypos, yypos, "Illegal character in text constant")
; continue ());
<TEXT_FMT>{ws}+ => (continue ());
<TEXT_FMT>{eol} => (Source.newline (source, lastPos (yypos, yytext)); continue ());
<TEXT_FMT>\\ => (YYBEGIN TEXT; continue ());
<TEXT_FMT>. => (error (source, yypos, yypos, "Illegal formatting character in text continuation")
; continue ());
<INITIAL>"(*)" =>
(if allowLineComments ()
then ()
else error (source, yypos, lastPos (yypos, yytext),
"Line comments disallowed, compile with -default-ann 'allowLineComments true'")
; startComment (source, yypos, fn () =>
YYBEGIN INITIAL)
; YYBEGIN LINE_COMMENT
; continue ());
<INITIAL>"(*" =>
(startComment (source, yypos, fn () =>
YYBEGIN INITIAL)
; YYBEGIN BLOCK_COMMENT
; continue ());
<LINE_COMMENT>{eol} =>
(finishComment (lastPos (yypos, yytext))
; Source.newline (source, lastPos (yypos, yytext))
; continue ());
<LINE_COMMENT>. =>
(continue ());
<BLOCK_COMMENT>"(*)" =>
(if allowLineComments ()
then ()
else error (source, yypos, lastPos (yypos, yytext),
"Line comments disallowed, compile with -default-ann 'allowLineComments true'")
; startComment (source, yypos, fn () =>
YYBEGIN BLOCK_COMMENT)
; YYBEGIN LINE_COMMENT
; continue ());
<BLOCK_COMMENT>"(*" =>
(startComment (source, yypos, fn () =>
YYBEGIN BLOCK_COMMENT)
; YYBEGIN BLOCK_COMMENT
; continue ());
<BLOCK_COMMENT>"*)" =>
(finishComment (lastPos (yypos,yytext))
; continue ());
<BLOCK_COMMENT>{eol} =>
(Source.newline (source, lastPos (yypos, yytext))
; continue ());
<BLOCK_COMMENT>. =>
(continue ());
<INITIAL>"(*#line"{ws}+ =>
(startLineDir (source, yypos, fn () =>
YYBEGIN INITIAL)
; YYBEGIN LINE_DIR1
; continue ());
<LINE_DIR1>{decDigit}+"."{decDigit}+ =>
(let
fun err () =
(addCommentError "Illegal line directive"
; YYBEGIN BLOCK_COMMENT)
in
case String.split (yytext, #".") of
[line, col] =>
(YYBEGIN LINE_DIR2
; addLineDirLineCol (valOf (Int.fromString line), valOf (Int.fromString col))
handle Overflow => err () | Option => err ()
; continue ())
| _ => (err (); continue ())
end);
<LINE_DIR2>{ws}+"\"" =>
(YYBEGIN LINE_DIR3
; continue ());
<LINE_DIR3>[^"]*"\"" =>
(addLineDirFile (String.dropLast yytext)
; YYBEGIN LINE_DIR4
; continue ());
<LINE_DIR2,LINE_DIR4>{ws}*"*)" =>
(finishLineDir (source, lastPos (yypos, yytext))
; continue ());
<LINE_DIR1,LINE_DIR2,LINE_DIR3,LINE_DIR4>. =>
(addCommentError "Illegal line directive"
; YYBEGIN BLOCK_COMMENT
; continue ());
<INITIAL>"(*#showBasis"{ws}+"\""[^"]*"\""{ws}*"*)" =>
(let
val file = List.nth (String.split (yytext, #"\""), 1)
val file =
if OS.Path.isAbsolute file
then file
else OS.Path.mkCanonical (OS.Path.concat (OS.Path.dir (Source.name source), file))
in
tok' (fn (_, l, r) => Tokens.SHOW_BASIS (file, l, r), yytext, source, yypos)
end);
<INITIAL>. =>
(error (source, yypos, yypos, "Illegal token")
; continue ());

10996
mllex-polyml/ml.lex.sml.exp Normal file

File diff suppressed because it is too large Load Diff

2
mllex-polyml/ml_bind.sml Normal file
View File

@ -0,0 +1,2 @@
structure Main = Main

83
mllex-polyml/mlex_int.doc Normal file
View File

@ -0,0 +1,83 @@
This is minimal documentation for the lexer driver produced by ml-lex.
Main data structures:
The transition table is stored in tab. Tab is an array of records, indexed
by state number. The first field of the record, fin, is a list of final leaves
assocated with it. The second field of the record, trans, is a transition
table for the state indexed by character number. It gives the next state
for a given input character.
The usual initial start state is state #1. State 0 is a dead state, which
has transitions only to itself.
The field yyfin has type yyfinstate list. yyfinstate consists of the
following three constructors:
* N of int - indicates normal end leaf.
* D of int - dummy end leaf - for indicating when an end state for
a trailing context regular expression has been reached. These are
stored and propagated backwards when action is executed.
* T of int - indicates an actual end leaf for a trailing context reg.
expression, which should be executed only if D i was encountered
after this end leaf while scanning forward. The dummy end leaf is
removed from the backward propagating list after this node is
encountered.
The function scan inside the function lex operates as a transition
function, scanning the input until it is no longer possible to take any
more transitions. It accumulates a list of the accepting leaf list
associated with each accepting state passed through.
Scan operates as follows:
Input: * s - current state
* AcceptingLeaves - list of accepting leave lists. Each state
has a list of accepting leaves associated with it. This list
may be nil if the state is not a final state.
* l - position of the next character in the buffer b to read
* i0 - starting position in the buffer.
Output: If no match is found, it raises the exception LexError.
Otherwise, it returns a value of type lexresult.
It operates as a transtion function:
It (1) adds the list of accepting leaves for the current state to
the list of accepting leave lists
(2) tries to make a transition on the current input character
to the next state. If it can't make a transition, it
executes the action function.
(a) - if it is past the end of the buffer, it
(1) checks if it as at end eof. If it is then:
It checks to see if it has made any
transitions since it was first called -
(l>i0 when this is true.) If it hasn't
this implies that scan was called at
the end of file. It thus executes
eof function declared by the user.
Otherwise it must execute action w/
the current accepting state list.
(2) otherwise it reads a block of up to 1024
characters, and appends this block to the
useful suffix of characters left in the
buffer (those character which have been
scanned in this call to lex()). The buffer
operation should be altered if one intends
to process reg. expressions whose lexemes'
length will be >> 1024. For most normal
applications, the buffer update operation
will be fine.
This buffer update operation requires
O(n^2/1024) char. copies for lexemes > 1024
characters in length, and O(n) char. copies
for lexemes <= 1024 characters in length.
It can be made O(n) using linked list
buffers & a Byte.array of size n (not the
^operator!) for concatenating the buffers
to return a value for yytext when a lexeme
is longer than the typical buffer length.
(3) If the transition is to a dead state (0 is used
for the dead state), action is executed instead.