% MLPAR.ML %

% This file contains the main body of code specializing the Generic Parser
  for Hyper-Transfer ML, except for the lexical analyser which is found in
  MLLEX.ML %


let
    MLTypeSycl,
    [
        MLSyclAExp;
        MLSyclExp;
        MLSyclExpList;
        MLSyclPatVar;
        MLSyclAPat;
        MLSyclPatVarForce;
        MLSyclPat;
        MLSyclPatList;
        MLSyclRule;
        MLSyclMatch;
        MLSyclHandlerRule;
        MLSyclHandler;
        MLSyclFunPatOp;
        MLSyclFunPatFree;
        MLSyclFunPat;
        MLSyclValBind;
        MLSyclFunBind;
        MLSyclType;
        MLSyclTypeList;
        MLSyclTypeSeq;
        MLSyclTypePatVar;
        MLSyclTypePatVarSeq;
        MLSyclTypePat;
        MLSyclConstrs;
        MLSyclTypeBind;
        MLSyclDatatypeBind;
        MLSyclExcBind;
        MLSyclNonemptyDec;
        MLSyclDec;
        MLSyclNonemptyTopDec;
        MLSyclTop ]
 = DeclareSycls([
    `AExp`, `Atomic-expression`;
    `Exp`, `Expression`;
    `ExpList`, `Expression-list-or-sequence`;
    `PatVar`, `Pattern-variable`;
    `APat`, `Atomic-pattern`;
    `PatVarForce`, `Constrained-pattern-variable`;
    `Pat`, `Pattern`;
    `PatList`, `Pattern-list`;
    `Rule`, `Rule`;
    `Match`, `Match`;
    `HandlerRule`, `Handler-rule`;
    `Handler`, `Handler`;
    `FunPatOp`, `Operator-function-pattern`;
    `FunPatFree`, `(Unconstrained)-function-pattern`;
    `FunPat`, `(Constrained)-function-pattern`;
    `ValBind`, `Value-binding`;
    `FunBind`, `Function-binding`;
    `Type`, `Type`;
    `TypeList`, `Type-list`;
    `TypeSeq`, `Type-sequence`;
    `TypePatVar`, `Type-pattern-variable`;
    `TypePatVarSeq`, `Type-pattern-variable-sequence`;
    `TypePat`, `Type-pattern`;
    `Constrs`, `Constructor-binding`;
    `TypeBind`, `Type-binding`;
    `DatatypeBind`, `Datatype-binding`;
    `ExcBind`, `Exception-binding`;
    `NonemptyDec`, `Non-empty-declaration`;
    `Dec`, `Declaration`;
    `NonemptyTopDec`, `Non-empty-top-level-declaration`;
    `Top`, `Top-level-declaration-or-expression` ]);


let MLOutLex'(lex') = MLOutLex(LexOfLex'(lex'))
and MLPrLex'(lex') = MLPrLex(LexOfLex'(lex'));

let MLSpOutLex' lex' = ( outtok(` `); MLOutLex'(lex') );

let MLOutPartRevLex'List(n,l) = app MLSpOutLex' (partrev(n,l));


let MLLexHasDictionary(lex: MLLex): bool =
    case repMLLex(lex) of [|
    Ide . true;
    QualIde . false;
    NumLab . false;
    Tyvar . false;
    Nonide . true;
    Int . false;
    Real . false;
    Tok . false;
    TokList . false;
    Unit . false;
    Eof . false |];


let type MLOpStatus = [|
    Nonfix : unit;
    Prefix : int;
    Infix  : int # int;
    Suffix : int |];

let type MLIdeStatus = [|
    Var: unit;
    Konst: unit;
    Constr: unit |];

let type MLInfo <=> [|
    ExpIde : (|
        OpStatus: MLOpStatus ref;
        IdeStatus: MLIdeStatus ref |);
    NonExpIde : unit |];

let rec type MLClz <=> [|
    Exp : SynTerm';
    Pat : SynBind';
    Rule : SynRule';
    Match : SynMatch';
    HandlerRule : SynHandRule';
    Handler : SynHandler';
    FunPat : (|
        patVar: SynBind';
        patListRev: SynBind' list;  % Patterns are held in reverse order %
        typeOpt: SynTypTerm' Opt |);
    Type : SynTypTerm';
    TypeList : SynTypTerm' list;
    TypePatVarList : Atom' list;
    TypePat : (| Bind: Atom'; Params: Atom' list |);
    Constrs : (Atom' # SynTypTerm' # bool) list;
    ExcBind : SynDecl';
    Dec : SynDecl';
    Eof : unit
|];

let type MLLex' = (MLLexMode,MLLex,MLClz,MLInfo)Lex';

let MLDefaultInfo(lex: MLLex): MLInfo =
    absMLInfo(
        if repMLLex(lex) is Ide %Or repMLLex(lex) is QualIde RJG 02-May-89% then
            [| ExpIde = (|
                OpStatus = ref [|Nonfix|];
                IdeStatus = ref [|Var|] |) |]
        else [| NonExpIde |] );

let MLTokOfLex'(lx') = MLTokOfLex(LexOfLex'(lx'));



% Utility functions for Words %

let MLNthWord(phrl,n) = MLTokOfLex'(NthWordLex'(phrl,n));


% Utility functions for Lexical Classes %

let MLNthClassWord(phrl,n) = MLTokOfLex(NthClassLex(phrl,n));
let MLNthClassAtom(phrl,n) = absAtom'(MLTokOfLex(NthClassLex(phrl,n)));
let MLNthClassInt(phrl,n) = repMLLex(NthClassLex(phrl,n)) as Int;
let MLNthClassReal(phrl,n) = repMLLex(NthClassLex(phrl,n)) as Real;
let MLNthClassTok(phrl,n) = repMLLex(NthClassLex(phrl,n)) as Tok;
let MLNthClassTokList(phrl,n) = repMLLex(NthClassLex(phrl,n)) as TokList;


% Utility functions for Clauses %

let MLClzExp(x): MLClz = absMLClz[|Exp=x|];
let MLNthExp(phrl,n) = repMLClz(NthClz(phrl,n)) as Exp;

let MLClzPat(x): MLClz = absMLClz[|Pat=x|];
let MLNthPat(phrl,n) = repMLClz(NthClz(phrl,n)) as Pat;

let MLClzRule(x): MLClz = absMLClz[|Rule=x|];
let MLNthRule(phrl,n) = repMLClz(NthClz(phrl,n)) as Rule;

let MLClzMatch(x): MLClz = absMLClz[|Match=x|];
let MLNthMatch(phrl,n) = repMLClz(NthClz(phrl,n)) as Match;

let MLClzHandlerRule(x): MLClz = absMLClz[|HandlerRule=x|];
let MLNthHandlerRule(phrl,n) = repMLClz(NthClz(phrl,n)) as HandlerRule;

let MLClzHandler(x): MLClz = absMLClz[|Handler=x|];
let MLNthHandler(phrl,n) = repMLClz(NthClz(phrl,n)) as Handler;

let MLClzFunPat(x): MLClz = absMLClz[|FunPat=x|];
let MLNthFunPat(phrl,n) = repMLClz(NthClz(phrl,n)) as FunPat;

let MLClzType(x): MLClz = absMLClz[|Type=x|];
let MLNthType(phrl,n) = repMLClz(NthClz(phrl,n)) as Type;

let MLClzTypeList(x): MLClz = absMLClz[|TypeList=x|];
let MLNthTypeList(phrl,n) = repMLClz(NthClz(phrl,n)) as TypeList;

let MLClzTypePatVarList(x): MLClz = absMLClz[|TypePatVarList=x|];
let MLNthTypePatVarList(phrl,n) = repMLClz(NthClz(phrl,n)) as TypePatVarList;

let MLClzTypePat(x): MLClz = absMLClz[|TypePat=x|];
let MLNthTypePat(phrl,n) = repMLClz(NthClz(phrl,n)) as TypePat;

let MLClzConstrs(x): MLClz = absMLClz[|Constrs=x|];
let MLNthConstrs(phrl,n) = repMLClz(NthClz(phrl,n)) as Constrs;

let MLClzExcBind(x): MLClz = absMLClz[|ExcBind=x|];
let MLNthExcBind(phrl,n) = repMLClz(NthClz(phrl,n)) as ExcBind;

let MLClzDec(x): MLClz = absMLClz[|Dec=x|];
let MLNthDec(phrl,n) = repMLClz(NthClz(phrl,n)) as Dec;

let MLClzEof = absMLClz[|Eof|]: MLClz;




let (
    MLTypeLxcl,
    [   MLLxclReserved;
        MLLxclVarNonfix;
            MLLxclVarPrefix; MLLxclVarInfix; MLLxclVarSuffix;
        MLLxclKonstNonfix;
            MLLxclKonstPrefix; MLLxclKonstInfix; MLLxclKonstSuffix;
        MLLxclConstrNonfix;
            MLLxclConstrPrefix; MLLxclConstrInfix; MLLxclConstrSuffix;
        MLLxclQualIde;
        MLLxclNumLab;
        MLLxclTyvar;
        MLLxclInt;
        MLLxclReal;
        MLLxclTok;
        MLLxclTokList;
        MLLxclUnit;
        MLLxclEof ] )
= DeclareLxcls([
    (`Reserved`, `Reserved-word`);
    (`VarNonfix`, `Nonfix-variable`);
        (`VarPrefix`, `Prefix-variable`);
        (`VarInfix`, `Infix-variable`);
        (`VarSuffix`, `Suffix-variable`);
    (`KonstNonfix`, `Nonfix-constant(-identifier)`);
        (`KonstPrefix`, `Prefix-constant(-identifier)`);
        (`KonstInfix`, `Infix-constant(-identifier)`);
        (`KonstSuffix`, `Suffix-constant(-identifier)`);
    (`ConstrNonfix`, `Nonfix-constructor`);
        (`ConstrPrefix`, `Prefix-constructor`);
        (`ConstrInfix`, `Infix-constructor`);
        (`ConstrSuffix`, `Suffix-constructor`);
    (`QualIde`, `Qualified-name`);
    (`NumLab`, `Numeric-label`);
    (`Tyvar`, `Type-variable`);
    (`Int`, `Integer-constant`);
    (`Real`, `Real-constant`);
    (`Tok`, `Token-constant`);
    (`TokList`, `Token-list-constant`);
    (`Unit`, `Unit-constant`);
    (`Eof`, `End-of-file`) ]);

let (
    MLLxclsetClass,
    [   MLLxclsetReserved;
        MLLxclsetVarNonfix;
            MLLxclsetVarPrefix; MLLxclsetVarInfix; MLLxclsetVarSuffix;
        MLLxclsetKonstNonfix;
            MLLxclsetKonstPrefix; MLLxclsetKonstInfix; MLLxclsetKonstSuffix;
        MLLxclsetConstrNonfix;
            MLLxclsetConstrPrefix; MLLxclsetConstrInfix; MLLxclsetConstrSuffix;
        MLLxclsetQualIde;
        MLLxclsetNumLab;
        MLLxclsetTyvar;
        MLLxclsetInt;
        MLLxclsetReal;
        MLLxclsetTok;
        MLLxclsetTokList;
        MLLxclsetUnit;
        MLLxclsetEof ] )
=
    NewLxclsetClass(MLTypeLxcl);

let [
    MLLxclsetIdeNonfix;
    MLLxclsetIdeNonfixOrQualIde;
    MLLxclsetVarOrKonstInfix;
    MLLxclsetIdeInfix;
    MLLxclsetVarNonPrefix;
    MLLxclsetVarOpfix;
    MLLxclsetVar;
    MLLxclsetKonstNonPrefix;
    MLLxclsetKonstOpfix;
    MLLxclsetKonst;
    MLLxclsetConstrNonPrefix;
    MLLxclsetVarOrKonstOpfix;
    MLLxclsetIdeOpfix;
    MLLxclsetIde;
    MLLxclsetIdeOrQualIde;
    MLLxclsetLab ]
=
    map
        (DeclLxclsetUsingNames MLLxclsetClass)
        [   (   `IdeNonfix`,
                `Nonfix-identifier`,
                " VarNonfix KonstNonfix ConstrNonfix " );
            (   `IdeNonfixOrQualIde`,
                `Nonfix-identifier-or-qualified-name`,
                " VarNonfix KonstNonfix ConstrNonfix QualIde " );
            (   `VarOrKonstInfix`,
                `Infix-variable-or-infix-constant(-identifier)`,
                " VarInfix KonstInfix " );
            (   `IdeInfix`,
                `Infix-identifier`,
                " VarInfix KonstInfix ConstrInfix " );
            (   `VarNonPrefix`,
                `Non-prefix-variable`,
                " VarNonfix VarInfix VarSuffix " );
            (   `VarOpfix`,
                `Prefix//infix//suffix-variable`,
                " VarPrefix VarInfix VarSuffix " );
            (   `Var`,
                `Variable`,
                " VarNonfix VarPrefix VarInfix VarSuffix " );
            (   `KonstNonPrefix`,
                `Non-prefix-constant(-identifier)`,
                " KonstNonfix KonstInfix KonstSuffix " );
            (   `KonstOpfix`,
                `Prefix//infix//suffix-constant(-identifier)`,
                " KonstPrefix KonstInfix KonstSuffix " );
            (   `Konst`,
                `Constant(-identifier)`,
                " KonstNonfix KonstPrefix KonstInfix KonstSuffix " );
            (   `ConstrNonPrefix`,
                `Non-prefix-constructor`,
                " ConstrNonfix ConstrInfix ConstrSuffix " );
            (   `VarOrKonstOpfix`,
                `Prefix//infix//suffix-variable//constant(-identifier)`,
                "   VarPrefix VarInfix VarSuffix
                    KonstPrefix KonstInfix KonstSuffix " );
            (   `IdeOpfix`,
                `Prefix//infix//suffix-identifier`,
                "   VarPrefix VarInfix VarSuffix
                    KonstPrefix KonstInfix KonstSuffix
                    ConstrPrefix ConstrInfix ConstrSuffix " );
            (   `Ide`,
                `Identifier`,
                "   VarNonfix VarPrefix VarInfix VarSuffix
                    KonstNonfix KonstPrefix KonstInfix KonstSuffix
                    ConstrNonfix ConstrPrefix ConstrInfix ConstrSuffix " );
            (   `IdeOrQualIde`,
                `Identifier-or-qualified-name`,
                "   VarNonfix VarPrefix VarInfix VarSuffix
                    KonstNonfix KonstPrefix KonstInfix KonstSuffix
                    ConstrNonfix ConstrPrefix ConstrInfix ConstrSuffix
                    QualIde " );
            (   `Lab`,
                `Lab`,
                "   VarNonfix VarPrefix VarInfix VarSuffix
                    KonstNonfix KonstPrefix KonstInfix KonstSuffix
                    ConstrNonfix ConstrPrefix ConstrInfix ConstrSuffix
                    NumLab " ) ];


let MLLxclOfLex'(lx': MLLex'): Lxcl =
    case repMLLex(LexOfLex'(lx')) of [|
    Ide .
        ( let wi = KnownOfLex'(lx') in
            if !(wi.Reserved) then MLLxclReserved
            else
                let (|OpStatus;IdeStatus|) = repMLInfo(wi.OtherInfo) as ExpIde
                in
                    case !IdeStatus of [|
                    Var . case !OpStatus of [|
                        Nonfix . MLLxclVarNonfix;
                        Prefix . MLLxclVarPrefix;
                        Infix . MLLxclVarInfix;
                        Suffix . MLLxclVarSuffix |];
                    Konst . case !OpStatus of [|
                        Nonfix . MLLxclVarNonfix;
                        Prefix . MLLxclVarPrefix;
                        Infix . MLLxclVarInfix;
                        Suffix . MLLxclVarSuffix |];
                    Constr . case !OpStatus of [|
                        Nonfix . MLLxclVarNonfix;
                        Prefix . MLLxclVarPrefix;
                        Infix . MLLxclVarInfix;
                        Suffix . MLLxclVarSuffix |] |] )
        ?? ExcOpt MLLxclVarNonfix;
    QualIde . MLLxclQualIde;
    NumLab . MLLxclNumLab;
    Tyvar . MLLxclTyvar;
    Nonide . MLLxclReserved;
    Int . MLLxclInt;
    Real . MLLxclReal;
    Tok . MLLxclTok;
    TokList . MLLxclTokList;
    Unit . MLLxclUnit;
    Eof . MLLxclEof |];

%RJG 02-May-89 for sml longid's%
let MLLxclOfLex'SML(lx': MLLex'): Lxcl =
    case repMLLex(LexOfLex'(lx')) of [|
    Ide .
        ( let wi = KnownOfLex'(lx') in
            if !(wi.Reserved) then MLLxclReserved
            else
                let (|OpStatus;IdeStatus|) = repMLInfo(wi.OtherInfo) as ExpIde
                in
                    case !IdeStatus of [|
                    Var . case !OpStatus of [|
                        Nonfix . MLLxclVarNonfix;
                        Prefix . MLLxclVarPrefix;
                        Infix . MLLxclVarInfix;
                        Suffix . MLLxclVarSuffix |];
                    Konst . case !OpStatus of [|
                        Nonfix . MLLxclVarNonfix;
                        Prefix . MLLxclVarPrefix;
                        Infix . MLLxclVarInfix;
                        Suffix . MLLxclVarSuffix |];
                    Constr . case !OpStatus of [|
                        Nonfix . MLLxclVarNonfix;
                        Prefix . MLLxclVarPrefix;
                        Infix . MLLxclVarInfix;
                        Suffix . MLLxclVarSuffix |] |] )
        ?? ExcOpt MLLxclVarNonfix;
    QualIde . ( let wi = KnownOfLex'(lx') in
            if !(wi.Reserved) then MLLxclReserved
            else
                let (|OpStatus;IdeStatus|) = repMLInfo(wi.OtherInfo) as ExpIde
                in
                    case !IdeStatus of [|
                    Var . case !OpStatus of [|
                        Nonfix . MLLxclVarNonfix;
                        Prefix . MLLxclVarPrefix;
                        Infix . MLLxclVarInfix;
                        Suffix . MLLxclVarSuffix |];
                    Konst . case !OpStatus of [|
                        Nonfix . MLLxclVarNonfix;
                        Prefix . MLLxclVarPrefix;
                        Infix . MLLxclVarInfix;
                        Suffix . MLLxclVarSuffix |];
                    Constr . case !OpStatus of [|
                        Nonfix . MLLxclVarNonfix;
                        Prefix . MLLxclVarPrefix;
                        Infix . MLLxclVarInfix;
                        Suffix . MLLxclVarSuffix |] |] )
        ?? ExcOpt MLLxclVarNonfix;
    NumLab . MLLxclNumLab;
    Tyvar . MLLxclTyvar;
    Nonide . MLLxclReserved;
    Int . MLLxclInt;
    Real . MLLxclReal;
    Tok . MLLxclTok;
    TokList . MLLxclTokList;
    Unit . MLLxclUnit;
    Eof . MLLxclEof |];


let MLLexModeOfSycl(tt: Sycl): MLLexMode =
    absMLLexMode([|Expr|]);
%        if EqSycl(tt,MLSyclAExp) then [|Expr|]
        else if EqSycl(tt,MLSyclExp) then [|Expr|]
        else if EqSycl(tt,MLSyclExpList) then [|Expr|]
        else if EqSycl(tt,MLSyclPatVar) then [|Expr|]
        else if EqSycl(tt,MLSyclAPat) then [|Expr|]
        else if EqSycl(tt,MLSyclPatVarForce) then [|Expr|]
        else if EqSycl(tt,MLSyclPat) then [|Expr|]
        else if EqSycl(tt,MLSyclPatList) then [|Expr|]
        else if EqSycl(tt,MLSyclRule) then [|Expr|]
        else if EqSycl(tt,MLSyclMatch) then [|Expr|]
        else if EqSycl(tt,MLSyclHandlerRule) then [|Expr|]
        else if EqSycl(tt,MLSyclHandler) then [|Expr|]
        else if EqSycl(tt,MLSyclFunPatOp) then [|Expr|]
        else if EqSycl(tt,MLSyclFunPatFree) then [|Expr|]
        else if EqSycl(tt,MLSyclFunPat) then [|Expr|]
        else if EqSycl(tt,MLSyclValBind) then [|Expr|]
        else if EqSycl(tt,MLSyclFunBind) then [|Expr|]
        else if EqSycl(tt,MLSyclType) then [|Type|]
        else if EqSycl(tt,MLSyclTypeList) then [|Type|]
        else if EqSycl(tt,MLSyclTypeSeq) then [|Type|]
        else if EqSycl(tt,MLSyclTypePatVar) then [|Type|]
        else if EqSycl(tt,MLSyclTypePatVarSeq) then [|Type|]
        else if EqSycl(tt,MLSyclTypePat) then [|Type|]
        else if EqSycl(tt,MLSyclConstrs) then [|Expr|]
        else if EqSycl(tt,MLSyclTypeBind) then [|Type|]
        else if EqSycl(tt,MLSyclDatatypeBind) then [|Type|]
        else if EqSycl(tt,MLSyclExcBind) then [|Expr|]
        else if EqSycl(tt,MLSyclNonemptyDec) then [|Expr|]
        else if EqSycl(tt,MLSyclDec) then [|Expr|]
        else if EqSycl(tt,MLSyclSig) then [|Expr|] 
        else if EqSycl(tt,MLSyclStr) then [|Expr|] 
        else if EqSycl(tt,MLSyclNonemptyStrDec) then [|Expr|] 
        else if EqSycl(tt,MLSyclStrDec) then [|Expr|] 
        else if EqSycl(tt,MLSyclNonemptyTopDec) then [|Expr|]
        else if EqSycl(tt,MLSyclTop) then [|Expr|]
        else failwith `LexModeOfSycl` ); %


let (|
    syntaxDictionary = SPMLSyntaxDictionary;
    lxclSyntaxTable = SPMLLxclSyntaxTable |)
=
    NewSyntaxTables(| lxclType = MLTypeLxcl; outLex' = MLOutLex' |);

let (|
    syntaxDictionary = HTMLSyntaxDictionary;
    lxclSyntaxTable = HTMLLxclSyntaxTable |)
=
    NewSyntaxTables(| lxclType = MLTypeLxcl; outLex' = MLOutLex' |);

let (|
    syntaxDictionary = SMLSyntaxDictionary;
    lxclSyntaxTable = SMLLxclSyntaxTable |)
=
    NewSyntaxTables(| lxclType = MLTypeLxcl; outLex' = MLOutLex' |);



let MLRaiseType(clt,tt,cl) =
    if EqSycl(clt,tt) then cl
    else if EqSycl(tt,MLSyclExp) then
        if EqSycl(clt,MLSyclAExp) then cl
        else failwith `raiseType`
    else if EqSycl(tt,MLSyclExpList) then
        if EqSycl(clt,MLSyclAExp) then cl
        else if EqSycl(clt,MLSyclExp) then cl
        else failwith `raiseType`
    else if EqSycl(tt,MLSyclAPat) then
        if EqSycl(clt,MLSyclPatVar) then cl
        else failwith `raiseType`
    else if EqSycl(tt,MLSyclPat) then
        if EqSycl(clt,MLSyclPatVar) then cl
        else if EqSycl(clt,MLSyclPatVarForce) then cl
        else if EqSycl(clt,MLSyclAPat) then cl
        else failwith `raiseType`
    else if EqSycl(tt,MLSyclPatList) then
        if EqSycl(clt,MLSyclPatVar) then cl
        else if EqSycl(clt,MLSyclPatVarForce) then cl
        else if EqSycl(clt,MLSyclAPat) then cl
        else if EqSycl(clt,MLSyclPat) then cl
        else failwith `raiseType`
    else if EqSycl(tt,MLSyclFunPat) then
        if EqSycl(clt,MLSyclFunPatOp) then cl
        else if EqSycl(clt,MLSyclFunPatFree) then cl
        else failwith `raiseType`
    else if EqSycl(tt,MLSyclMatch) then
        if EqSycl(clt,MLSyclRule) then
            MLClzMatch(MLSynMatch([repMLClz(cl) as Rule]))
        else failwith `raiseType`
    else if EqSycl(tt,MLSyclHandler) then
        if EqSycl(clt,MLSyclHandlerRule) then
            MLClzHandler(MLSynHandler[repMLClz(cl) as HandlerRule])
        else failwith `raiseType`
    else if EqSycl(tt,MLSyclNonemptyDec) then
        if EqSycl(clt,MLSyclValBind) then cl  % Not applicable in SML %
        else if EqSycl(clt,MLSyclFunBind) then cl  % Not applicable in SML %
        else failwith `raiseType`
    else if EqSycl(tt,MLSyclDec) then
        if EqSycl(clt,MLSyclValBind) then cl  % Not applicable in SML %
        else if EqSycl(clt,MLSyclFunBind) then cl  % Not applicable in SML %
        else if EqSycl(clt,MLSyclNonemptyDec) then cl
        else failwith `raiseType`
    else if EqSycl(tt,MLSyclNonemptyTopDec) then
        if EqSycl(clt,MLSyclNonemptyDec) then cl
        else failwith `raiseType`
    else if EqSycl(tt,MLSyclTop) then
        if EqSycl(clt,MLSyclNonemptyDec) then cl
        else if EqSycl(clt,MLSyclDec) then cl
        % else if EqSycl(clt,MLSyclStrDec) then cl  -  Never generated%
        else if EqSycl(clt,MLSyclNonemptyTopDec) then cl
        else if EqSycl(clt,MLSyclExp) Or EqSycl(clt,MLSyclAExp) then
            MLClzDec(MLSynDecVal(MLSynPatIde(AtomIt),repMLClz(cl) as Exp))
        else failwith `raiseType`
    else failwith `raiseType`;


let type MLSynStream = (MLLexMode,MLLex,MLClz,MLInfo)SynStream;

let type MLBasicLanguageData =
    (MLLexMode,MLLex,MLClz,MLInfo)BasicLanguageData;

let SPML = absBLD(|
    lxclType = MLTypeLxcl;
    lxclsetClass = MLLxclsetClass;
    lexOfValidTok = MLLexOfValidTok[|SPML|];
    tokOfLex = MLTokOfLex;
    lexHasWord = MLLexHasWord;
    lxclOfLex' = MLLxclOfLex';
    lexHasDictionary = MLLexHasDictionary;
    syclType = MLTypeSycl;
    lexModeOfSycl = MLLexModeOfSycl;
    defaultInfo = MLDefaultInfo;
    syntaxDictionary = SPMLSyntaxDictionary;
    lxclSyntaxTable = SPMLLxclSyntaxTable;
    readLexFromBufStream = MLReadLexFromBufStream[|SPML|];
    raiseType = MLRaiseType
|);

let HTML = absBLD(|
    lxclType = MLTypeLxcl;
    lxclsetClass = MLLxclsetClass;
    lexOfValidTok = MLLexOfValidTok[|HTML|];
    tokOfLex = MLTokOfLex;
    lexHasWord = MLLexHasWord;
    lxclOfLex' = MLLxclOfLex';
    lexHasDictionary = MLLexHasDictionary;
    syclType = MLTypeSycl;
    lexModeOfSycl = MLLexModeOfSycl;
    defaultInfo = MLDefaultInfo;
    syntaxDictionary = HTMLSyntaxDictionary;
    lxclSyntaxTable = HTMLLxclSyntaxTable;
    readLexFromBufStream = MLReadLexFromBufStream[|HTML|];
    raiseType = MLRaiseType
|);

let SML = absBLD(|
    lxclType = MLTypeLxcl;
    lxclsetClass = MLLxclsetClass;
    lexOfValidTok = MLLexOfValidTok[|SML|];
    tokOfLex = MLTokOfLex;
    lexHasWord = MLLexHasWord;
    lxclOfLex' = MLLxclOfLex';
    lexHasDictionary = MLLexHasDictionary;
    syclType = MLTypeSycl;
    lexModeOfSycl = MLLexModeOfSycl;
    defaultInfo = MLDefaultInfo;
    syntaxDictionary = SMLSyntaxDictionary;
    lxclSyntaxTable = SMLLxclSyntaxTable;
    readLexFromBufStream = MLReadLexFromBufStream[|SML|];
    raiseType = MLRaiseType
|);


let MLMakeFormSeq( l: string list ) =
    MakeFormSeq( MLLxclsetClass, MLTypeSycl, BuildTokTreeList(l) );


% Must only be applied to non-reserved ExpIde's %
% N.B. Uses "MLBld" %
let MLOpStatusRefOfWord( MLBld: MLBasicLanguageData, wd: Word ): MLOpStatus ref
=
    repMLInfo(KnownOfLex'(EnsureKnownLex'OfValidWord(MLBld,wd)).OtherInfo)
        as ExpIde .OpStatus;

let MLIdeStatusRefOfWord( MLBld: MLBasicLanguageData, wd: Word )
: MLIdeStatus ref
=
    repMLInfo(KnownOfLex'(EnsureKnownLex'OfValidWord(MLBld,wd)).OtherInfo)
        as ExpIde .IdeStatus;

let MLOpStatusValOfWord( MLBld: MLBasicLanguageData, wd: Word ) =
    !(( repMLInfo(KnownOfLex'(Lex'OfValidTok(MLBld,wd)).OtherInfo)
        as ExpIde ).OpStatus)
    ?? ExcOpt [|Nonfix|];

let MLIdeStatusValOfWord( MLBld: MLBasicLanguageData, wd: Word ) =
    !(( repMLInfo(KnownOfLex'(Lex'OfValidTok(MLBld,wd)).OtherInfo)
        as ExpIde ).IdeStatus)
    ?? ExcOpt [|Var|];


% Printing functions only needed for testing - needs enhancement now:-
let { indentStep = 3

enc ft = (|
    bld = MLBld;
    prLxcl = PrLxcl MLTypeLxcl;
    prLex = MLPrLex;
    refPrClz = ref DummyFun;
    indentStep |)

enc MLPrPhrSeq = PrPhrSeqGen ft }

ins { MLPrClz( i: int, s: MLClz ) = (
    space(i);
    case repMLClz s of [|
    clz = (| name = n; phrSeq = phrl |) . (
        outtok(`clause `); printtok(n); newline(1);
        MLPrPhrSeq (i+indentStep) phrl );
    Exp = cl . (
        outtok(`Exp "`); SynTermPrint(cl,MaxInt); outtok`"`; newline(1) );
    Dec = cl . (
        outtok(`Dec "`); SynDeclPrint(cl,MaxInt); outtok`"`; newline(1) );
    Pat = cl . (
        outtok`Pat "`; SynBindPrint(cl,MaxInt); outtok`"`; newline(1) );
    Type = cl . (
        outtok`Type "`; SynTypTermPrint(cl,MaxInt); outtok`"`; newline(1) )
    |] )

enc _ = ft.refPrClz := MLPrClz };
%



let MLSemfnExpIdeInfix phrl =
    MLClzExp(MLSynExpAppl(
        MLSynExpIde(absAtom'(MLNthWord(phrl,2))),
        MLSynExpTuple[ MLNthExp(phrl,1); MLNthExp(phrl,3) ],
        Diadic ));

let MLSemfnExpIdePrefix phrl =
    let si = MLSynExpIde(absAtom'(MLNthWord(phrl,1))) in
        case NthOpt(phrl,2) of [|
        success = phrl1 .
            MLClzExp(MLSynExpAppl( si, MLNthExp(phrl1,1), Monadic ));
        failure .
            MLClzExp(si) |];

let MLSemfnPatConstrInfix phrl =
    MLClzPat(MLSynPatAppl(
        absAtom'(MLNthWord(phrl,2)),
        MLSynPatTuple[ MLNthPat(phrl,1); MLNthPat(phrl,3) ],
        Diadic ));



let MLSubStateSyclsExp = [ MLSyclAExp; MLSyclExp ]
enc MLSubStateSyclsPat =
    [ MLSyclPatVar; MLSyclPatVarForce; MLSyclAPat; MLSyclPat ]
enc MLSubStateSyclsFunPatFree = [ MLSyclFunPatOp; MLSyclFunPatFree ]
enc MLSubTargetSyclsTop = [ MLSyclAExp; MLSyclExp; MLSyclExpList; MLSyclTop ];

let MLInitSyclsValBindOrMatch = [
    MLSyclAPat; MLSyclPat; MLSyclPatList; MLSyclRule; MLSyclMatch;
    MLSyclFunPat; MLSyclValBind; MLSyclFunBind; MLSyclNonemptyDec; MLSyclDec ];


let MLSemfnPatIdePrefix(word,bp) =
    let fml = [ FormWord(word); FormOpt[FormClz(bp,MLSyclPat)] ]
    in
        \ss. let readFormSeq = ReadFormSeqSynStream(ss) in
            \tt.
                let phrl = readFormSeq(fml,tt)
                enc patVar = MLSynPatIde(absAtom'(word))
                in
                    case NthOpt(phrl,2) of [|
                    success = phrl . (
                        MLClzFunPat(|
                            patVar;
                            patListRev = [ MLNthPat(phrl,1) ];
                            typeOpt = None |),
                        MLSyclFunPatOp );
                    failure . ( MLClzPat(patVar), MLSyclPatVar ) |];


let semfn phrl = MLClzExp(MLSynExpIde(absAtom'(MLNthWord(phrl,1))))

ins MLInstallVarNonfixNoredef(MLBld,word) =
    InstallRuleMade MLBld ( "AExp Exp ExpList Top", `AExp`, [FormWord(word)],
        semfn );


% The following would be wrong for SML %
let MLInstallVarPrefix(MLBld,word,bp) = (
    InstallRuleMade MLBld ( "AExp Exp Top", `AExp`,
        [ FormWord(word); FormOpt([ FormClz(bp,MLSyclExp) ]) ],
        MLSemfnExpIdePrefix );
    InstallFunctionalIruleForWord MLBld (
        word,
        "APat Pat PatList Rule Match FunPat ValBind FunBind NonemptyDec Dec",
            % "APat", "NonemptyDec" & "Dec" would be wrong for SML %
        MLSemfnPatIdePrefix(word,bp) ) );


let MLSemfnFunPatInfix phrl = MLClzFunPat(|
    patVar = MLSynPatIde(absAtom'(MLNthWord(phrl,2)));
    patListRev = [ MLSynPatTuple[ MLNthPat(phrl,1); MLNthPat(phrl,3) ] ];
    typeOpt = None |);

let MLErrSemfnVarPatInfix phrl =
    ParseFailFatal[| other = `Invalid occurrence of infix variable` |];

let MLInstallVarInfixQ(MLBld,word,lbp,rbp,redef) = (
    InstallRuleMade MLBld ( "Exp ExpList Top", `Exp`,
        [   FormClzalt(lbp,MLSubStateSyclsExp);
            FormWord(word);
            FormClz(rbp,MLSyclExp) ],
        MLSemfnExpIdeInfix );
    if redef then (
        InstallRuleMade MLBld (
            "Pat FunPat FunBind NonemptyDec Dec",
                % "NonemptyDec Dec" is inapplicable in SML %
            `FunPatOp`,
            [   FormClzalt(lbp,MLSubStateSyclsPat);
                FormWord(word);
                FormClz(rbp,MLSyclPat) ],
            MLSemfnFunPatInfix );
        % The following rule inhibits "val f g i x = ..." where "i" is an infix
          var (and "val x i y j x = ..." where "i" and "j" are infix vars and
          "i" binds tighter than "j") - this is unnecessary in SML where
          "op" is required for such a nonfix use of "i". %
        InstallRuleMade MLBld (
            "FunPat FunBind NonemptyDec Dec",
                % "NonemptyDec Dec" is inapplicable in SML %
            `FunPatOp`,
            [ FormClzalt(lbp,MLSubStateSyclsFunPatFree); FormWord(word) ],
            MLErrSemfnVarPatInfix ) )
    else () );

let MLInstallVarInfix(MLBld,word,lbp,rbp) =
    MLInstallVarInfixQ(MLBld,word,lbp,rbp,true);

let MLInstallVarInfixNoredef MLBld (word,lbp,rbp) =
    MLInstallVarInfixQ(MLBld,word,lbp,rbp,false);

let MLInstallConstrInfix(MLBld,word,lbp,rbp) = (
    InstallRuleMade MLBld ( "Exp ExpList Top", `Exp`,
        [   FormClzalt(lbp,MLSubStateSyclsExp);
            FormWord(word);
            FormClz(rbp,MLSyclExp) ],
        MLSemfnExpIdeInfix );
    InstallRuleMade MLBld (
        "Pat PatList Rule Match FunPat ValBind FunBind NonemptyDec Dec",
            % "NonemptyDec Dec" is inapplicable in SML %
        `Pat`,
        [   FormClzalt(lbp,MLSubStateSyclsPat);
            FormWord(word);
            FormClz(rbp,MLSyclPat) ],
        MLSemfnPatConstrInfix ) );



% Must only be applied to non-reserved ExpIde's %
% Memo:  This function needs more work! %
let MLUndeclareWord( MLBld: MLBasicLanguageData, wd: Word ): unit =
    let lx' = Lex'OfValidTok(MLBld,wd) in
        if IsKnownLex'(lx') then
            let (| IruleTable=irt; MruleTable=mrt; Reserved=r; OtherInfo=oi |)
                = KnownOfLex'(lx')
            enc opStatus = (repMLInfo(oi) as ExpIde).OpStatus
            enc ideStatus = (repMLInfo(oi) as ExpIde).IdeStatus
            in (
                case !opStatus of [|
                    Nonfix . ();
                    Prefix .
                        app
                           (\tty. RemoveFromIruleTable(irt,tty) )
                           ( MLSubTargetSyclsTop @ MLInitSyclsValBindOrMatch );
                    Infix .
                        app
                            (\pty. RemoveFromMruleTable(mrt,pty) )
                            (   MLSubStateSyclsExp
                                @ MLSubStateSyclsPat
                                @ MLSubStateSyclsFunPatFree );
                    Suffix . failwith `Not Implemented` |];
                opStatus := [|Nonfix|];
                ideStatus := [|Var|] )
        else ();


let rec AppListItem (f: 'a -> 'b -> unit) (l: 'a list) (y: 'b): unit =
    if null(l) then ()
    else ( f(hd(l))(y); AppListItem(f)(tl(l))(y) );


let ReserveValidWord MLBld wd = ReserveValidWord(MLBld,wd)
ins MLReserveValidWord = AppListItem ReserveValidWord;

let MLDeclSyn = AppListItem InstallRule;

let MLDeclSynMade = AppListItem InstallRuleMade;

let MLDeclFunctionalInitialSynForWord =
    AppListItem InstallFunctionalIruleForWord;

let MLDeclSynVarInfixNoredef = AppListItem MLInstallVarInfixNoredef;

let MLDeclareWord
    ( MLBld: MLBasicLanguageData )
    ( wd: Word, opStatus: MLOpStatus, ideStatus: MLIdeStatus )
: unit
= (
    MLUndeclareWord(MLBld,wd);
    MLOpStatusRefOfWord(MLBld,wd) := opStatus;
    MLIdeStatusRefOfWord(MLBld,wd) := ideStatus;
    case ideStatus of [|
    Var .
        case opStatus of [|
        Nonfix . ();
        Prefix = bp . MLInstallVarPrefix(MLBld,wd,bp);
        Infix = (lbp,rbp) . MLInstallVarInfix(MLBld,wd,lbp,rbp);
        Suffix = bp . failwith `Not implemented` |];
    Konst .
        case opStatus of [|
        Nonfix . ();
        Prefix = bp . ();
        Infix = (lbp,rbp) . ();
        Suffix = bp . () |];
    Constr .
        case opStatus of [|
        Nonfix . ();
        Prefix = bp . failwith `Not implemented`;
        Infix = (lbp,rbp) . MLInstallConstrInfix(MLBld,wd,lbp,rbp);
        Suffix = bp . failwith `Not implemented` |] |] );

let MLDeclWord = AppListItem MLDeclareWord;


let type MLSynChange = [| OpStatus: MLOpStatus; IdeStatus: MLIdeStatus |];

let type MLLocalSynEnv =
    ( ( Word # MLSynChange ) list ref ) list ref;

let MLLocalSynEnv = (ref [ ref nil ]): MLLocalSynEnv;

let MLRecordOldSyn( wd: Word, synChange: MLSynChange ): unit =
    let rl = hd(!MLLocalSynEnv) in
        rl := (wd,synChange) :: !rl;

let MLEffectNewSyn
    ( MLBld: MLBasicLanguageData )
    ( wd: Word, synChange: MLSynChange )
: unit
=
    case synChange of [|
    OpStatus = newOpStatus .
        let oldOpStatus = MLOpStatusValOfWord(MLBld,wd) in (
            MLRecordOldSyn( wd, [| OpStatus = oldOpStatus |] );
            MLDeclareWord MLBld
                ( wd, newOpStatus, MLIdeStatusValOfWord(MLBld,wd) ) );
    IdeStatus = newIdeStatus .
        let oldIdeStatus = MLIdeStatusValOfWord(MLBld,wd) in (
            MLRecordOldSyn( wd, [| IdeStatus = oldIdeStatus |] );
            MLDeclareWord MLBld
                ( wd, MLOpStatusValOfWord(MLBld,wd), newIdeStatus ) ) |];

let MLRestoreOldSyn
    ( MLBld: MLBasicLanguageData )
    ( wd: Word, synChange: MLSynChange ): unit
=
    let (opStatus,ideStatus) =
        case synChange of [|
        OpStatus = opStatus . ( opStatus, MLIdeStatusValOfWord(MLBld,wd) );
        IdeStatus = ideStatus . ( MLOpStatusValOfWord(MLBld,wd), ideStatus ) |]
    in
        MLDeclareWord MLBld (wd,opStatus,ideStatus);

let MLTempRestoreOldSyn
    ( MLBld: MLBasicLanguageData )
    ( wd: Word, synChange: MLSynChange )
: Word # MLSynChange
=
    let ( opStatus, ideStatus, synChange: MLSynChange ) =
        case synChange of [|
        OpStatus = opStatus . (
            opStatus,
            MLIdeStatusValOfWord(MLBld,wd),
            [| OpStatus = MLOpStatusValOfWord(MLBld,wd) |] );
        IdeStatus = ideStatus . (
            MLOpStatusValOfWord(MLBld,wd),
            ideStatus,
            [| IdeStatus = MLIdeStatusValOfWord(MLBld,wd) |] ) |]
    enc () = MLDeclareWord MLBld (wd,opStatus,ideStatus)
    in (wd,synChange);

let MLPushLocalSynEnv(): unit =
    MLLocalSynEnv := (ref nil) :: !MLLocalSynEnv;

let MLPopLocalSynEnv( MLBld: MLBasicLanguageData ): unit = (
    app (MLRestoreOldSyn MLBld) (!(hd(!MLLocalSynEnv)));
    MLLocalSynEnv := tl(!MLLocalSynEnv) );

let MLJoinLocalSynEnv(): unit =
    let l = !(hd(!MLLocalSynEnv))
    enc () = MLLocalSynEnv := tl(!MLLocalSynEnv)
    enc rl = hd(!MLLocalSynEnv)
    in rl := l @ (!rl);

let MLAdjustLocalSynEnvAfterLocal( MLBld: MLBasicLanguageData ): unit =
    let l = rev( map (MLTempRestoreOldSyn MLBld) (!(hd(!MLLocalSynEnv))) )
    enc () = MLLocalSynEnv := tl(!MLLocalSynEnv)
    enc () = MLPopLocalSynEnv(MLBld)
    in app (MLEffectNewSyn MLBld) l;

let MLUndoLocalSynEnv( MLBld: MLBasicLanguageData ): unit = (
    app (\rl. app (MLRestoreOldSyn MLBld) (!rl) ) (!MLLocalSynEnv);
    MLLocalSynEnv := [ ref[] ] );

let MLClearLocalSynEnv(): unit =
    let n = length(!MLLocalSynEnv) in (
        MLLocalSynEnv := [ ref[] ];
        if n <> 1 then failwith `Local syntax environment logic error`
        else () );



let MLSemfnTypeInfApp phrl =
    MLClzType(MLSynTypeCon(
        absAtom'(MLNthWord(phrl,2)),
        [ MLNthType(phrl,1); MLNthType(phrl,3) ] ));

let MLSemfnTypePatInfApp phrl =
    MLClzTypePat(|
        Bind = absAtom'(MLNthWord(phrl,2));
        Params = MLNthTypePatVarList(phrl,1) @ MLNthTypePatVarList(phrl,3) |);

let MLInstallTypeInfix MLBld (word,lbp,rbp,redef) = (
    InstallRuleMade MLBld ( "Type", `Type`,
        [   FormClz(lbp,MLSyclType);
            FormWord(word);
            FormClz(rbp,MLSyclType) ],
        MLSemfnTypeInfApp );
    if redef then
        InstallRuleMade MLBld ( "TypeBind DatatypeBind", `TypePat`,
            [   FormClz(lbp,MLSyclTypePatVar);
                FormWord(word);
                FormClz(rbp,MLSyclTypePatVar) ],
            MLSemfnTypePatInfApp )
    else () );

let MLDeclTypeInfix = AppListItem MLInstallTypeInfix;

let MLSemfnIllegalTypeCon phrl =
    ParseFail[|other=`Illegal use of special type constructor`|]

ins MLDeclSpecialTypeCon MLBldList (wd,redef) = (
    MLDeclSyn MLBldList ( "Type", `Type`,
        " [ word " @ [wd] @ " ] ",
        MLSemfnIllegalTypeCon );
    MLDeclSyn MLBldList ( "Type", `Type`,
        " [ clause 1000 TypeSeq ]  [ word  " @ [wd] @ " ] ",
        MLSemfnIllegalTypeCon );
    MLDeclSyn MLBldList ( "TypeBind DatatypeBind", `TypePat`,
        " [ word " @ [wd] @ " ] ",
        MLSemfnIllegalTypeCon );
    MLDeclSyn MLBldList ( "TypeBind DatatypeBind", `TypePat`,
        " [ clause 1000 TypePatVarSeq ]  [ word  " @ [wd] @ " ] ",
        MLSemfnIllegalTypeCon );
    if redef then ()
    else
        MLDeclSyn MLBldList ( "TypeBind DatatypeBind", `TypePat`,
            " [ clause 1000 TypePatVar ]  [ word  " @ [wd] @ " ] ",
            MLSemfnIllegalTypeCon ) );



% General function for handling parentheses %
let MLErrSemfnVarPatInfix phrl =
    ParseFailFatal[| other = `Invalid occurrence of infix variable` |];

let fml = [FormWord(`)`)]
ins MLSemfnParen(ss) =
    let readLex' = ReadLex'SynStream(ss)
    enc readFormSeq = ReadFormSeqSynStream(ss)
    enc tryReadClz = TryReadClzSynStream(ss)
    enc semfn tt =
        let tt' = if EqSycl(tt,MLSyclFunBind) Or EqSycl(tt,MLSyclFunPat)
                  then MLSyclPat else tt
        enc _ = readLex'(MLLexModeOfSycl(tt'))
        enc cl, clt = tryReadClz(tt',~120)
        enc _ = readFormSeq(fml,tt') in
        if (EqSycl(tt,MLSyclFunBind) Or EqSycl(tt,MLSyclFunPat))
        And EqSycl(clt,MLSyclFunPatOp)
        then (cl, MLSyclFunPatFree)
        else
          ( cl,
            if EqSycl(clt,MLSyclPatVar) then MLSyclAPat
            else if EqSycl(clt,MLSyclAPat) then MLSyclAPat
            else if EqSycl(clt,MLSyclPatVarForce) then MLSyclAPat
            else if EqSycl(clt,MLSyclPat) then MLSyclAPat
            else if EqSycl(clt,MLSyclPatList) then MLSyclAPat
            else if EqSycl(clt,MLSyclFunPatOp) then MLSyclFunPatFree
            else if EqSycl(clt,MLSyclType) then MLSyclType
            else if EqSycl(clt,MLSyclTypeList) then MLSyclTypeSeq
            else if EqSycl(clt,MLSyclTypePatVar) then MLSyclTypePatVarSeq
            else ParseFailFatal[|other=
                `Cannot parenthesize this syntax class` |] )
    in
        semfn;




%
ClearSyntaxTables();
%



% -------------------------------------------------------------------------- %
%                              Reserved words                                %
% -------------------------------------------------------------------------- %


app
    (\(l,wd). MLReserveValidWord l wd)
    [

        ( [     HTML;SML], `abstype` );
        ( [SPML;HTML;SML], `and` );
        ( [     HTML;SML], `andalso` );
        ( [SPML;HTML;SML], `as` );
        ( [SPML;HTML;SML], `case` );
        ( [SPML;HTML    ], `coerce` );
        ( [     HTML;SML], `datatype` );
        ( [     HTML;SML], `do` );
        ( [SPML;HTML    ], `dynamic` );
        ( [SPML;HTML;SML], `else` );
        ( [SPML;HTML    ], `enc` );
        ( [     HTML;SML], `end` );
        ( [     HTML;SML], `exception` );
        ( [SPML;HTML    ], `fail` );
        ( [SPML;HTML    ], `failwith` );
        ( [          SML], `fn` );  %Should add HTML eventually%
        ( [     HTML;SML], `fun` );

        ( [     HTML;SML], `handle` );
        ( [SPML;HTML;SML], `if` );
        ( [SPML;HTML;SML], `in` );
        ( [SPML;HTML;SML], `infix` );
        ( [     HTML;SML], `infixr` );
%       ( [          SML], `inp` );  RJG for brevity %
        ( [SPML;HTML    ], `ins` );
        ( [SPML;HTML    ], `is` );
        ( [          SML], `jumpcase` );  %RJG%
        ( [SPML;HTML;SML], `let` );
        ( [     HTML;SML], `local` );
        ( [     HTML    ], `newcase` );
        ( [SPML;HTML;SML], `nonfix` );
        ( [     HTML;SML], `of` );
        ( [     HTML;SML], `op` );
        ( [     HTML    ], `open` );
        ( [     HTML;SML], `orelse` );
%       ( [          SML], `out` );  RJG for brevity %
        ( [          SML], `overload` );
        ( [SPML;HTML    ], `prefix` );
        ( [SPML;HTML;SML], `print` );
        ( [     HTML;SML], `raise` );
        ( [SPML;HTML;SML], `rec` );





        ( [SPML;HTML    ], `suffix` );
        ( [SPML;HTML    ], `syntax` );
        ( [SPML;HTML;SML], `then` );
        ( [SPML;HTML;SML], `type` );

        ( [     HTML;SML], `val` );
        ( [     HTML    ], `varcase` );
        ( [SPML;HTML    ], `where` );
        ( [     HTML;SML], `while` );
        ( [SPML;HTML;SML], `with` );
        ( [     HTML;SML], `withtype` );
        ( [SPML;HTML;SML], `:` );
        ( [     HTML;SML], `|` );
%       ( [     HTML;SML], `||` );  RJG old exceptions %
        ( [SPML;HTML;SML], `=` );
        ( [SPML;HTML;SML], `=>` );
        ( [SPML;HTML    ], `<=>` );
        ( [SPML         ], `_` );
        ( [SPML;HTML    ], `?` );  % RJG not SML %
        ( [SPML;HTML    ], `??` );
        ( [SPML;HTML;SML], `?\` );
        ( [SPML;HTML    ], `\` )
    ];
% The following `Nonide`s are also "reserved":
      " { } . , ; ( ) [ ] (| |) [| |] /_ " %



% -------------------------------------------------------------------------- %
%                               Syntax Rules                                 %
% -------------------------------------------------------------------------- %



% Rules for Atomic Expressions %

let semfn phrl = MLClzExp(MLSynExpIde(MLNthClassAtom(phrl,1))) in (
    MLDeclSyn[SPML;HTML]( "AExp Exp Top", `AExp`, " [ class Ide ] ", semfn );
    MLDeclSyn[SML]( "AExp Exp ExpList Top", `AExp`,
        " [ class IdeNonfixOrQualIde ] ",
        semfn ) );

MLDeclSyn[SPML;HTML;SML]( "AExp Exp ExpList Top", `AExp`, " [ class Int ] ",
    \phrl. MLClzExp(MLSynExpInt(MLNthClassInt(phrl,1))) );

MLDeclSyn[SPML;HTML;SML]( "AExp Exp ExpList Top", `AExp`, " [ class Real ] ",
    \phrl. MLClzExp(MLSynExpReal(MLNthClassReal(phrl,1))) );

MLDeclSyn[SPML;HTML;SML]( "AExp Exp ExpList Top", `AExp`, " [ class Tok ] ",
    \phrl. MLClzExp(MLSynExpString(MLNthClassTok(phrl,1))) );

MLDeclSyn[SPML;HTML]( "AExp Exp Top", `AExp`, " [ class TokList ] ",
    \phrl. MLClzExp(MLSynExpList(
        map MLSynExpString (MLNthClassTokList(phrl,1)) )) );

MLDeclSyn[SPML;HTML;SML]( "AExp Exp ExpList Top", `AExp`, " [ class Unit ] ",
    \phrl. MLClzExp(MLSynExpUnit) );

MLDeclSyn[HTML;SML]( "AExp Exp ExpList Top", `AExp`,
    "   [ word op ]
        [ alt
            [ [ class IdeOpfix ] ]
            [ [ word = ] ] ] ",
    \phrl.
        let (| altNum; phrSeq |) = NthAlt(phrl,2) in
            if altNum = 1 then
                MLClzExp(MLSynExpIde(MLNthClassAtom(phrSeq,1)))
            else MLClzExp(MLSynExpIde(absAtom'(`=`))) );

let semfn phrl = MLClzExp(MLSynExpList(
    map (\phrl.MLNthExp(phrl,1)) (NthRptsep(phrl,2)) ))
in (
    MLDeclSynMade[SPML;HTML]( "AExp Exp Top", `AExp`,
        [   FormWord(`[`);
            FormRptsep( 0, FormWord(`;`), [FormClz(~100,MLSyclExp)] );
            FormWord(`]`) ],
        semfn );
    MLDeclSynMade[SML]( "AExp Exp ExpList Top", `AExp`,
        [   FormWord(`[`);
            FormRptsep( 0, FormWord(`,`), [FormClz(~100,MLSyclExp)] );
            FormWord(`]`) ],
        semfn ) );

let MLLtTokFail(t1,t2) =
    if t1=t2 then ParseFailFatal[|other=`Labels not all distinct`|]
    else t1 #< t2;

let MLDeclNumLabelOK a = 
    intToAtom'(a,\x.ParseFailFatal[|other= `Not a numeric-label`|]);

let MLDeclTagOrTuple (sortedtags: 'a list,
		      atomfn: 'a -> Atom',
		      tagfn: 'a list -> 'b,
		      tupfn: 'a list -> 'b,
		      tuple: bool) : 'b =
    let len = length(sortedtags)
    in if len=0 then tupfn sortedtags
       else
        let htag = atomfn(hd(sortedtags))
        enc ttag = atomfn(nth(sortedtags,len))
        in
       if tuple andalso len>1 andalso isNumLabel(htag) andalso isNumLabel(ttag)
         andalso Atom'toInt(htag)=1 andalso Atom'toInt(ttag)=len
         then tupfn sortedtags
         else tagfn sortedtags;

MLDeclSyn[SPML;HTML]( "AExp Exp Top", `AExp`,
    "   [ word (| ]
        [ rptsep 0 [ word ; ]
            [ class Ide ]
            [ opt [ word = ] [ clause ~100 Exp ] ] ]
        [ word |) ] ",
    \phrl. MLClzExp(MLSynExpRecord(
        sort
            ( (\(rk,e).repAtom'(rk)), MLLtTokFail )
            (map
                (\phrl. let rk = MLNthClassAtom(phrl,1) in (
                    rk,
                    case NthOpt(phrl,2) of [|
                    success = phrl . MLNthExp(phrl,2);
                    failure . MLSynExpIde(rk) |] ))
                (NthRptsep(phrl,2)) ) )) );

    


 MLDeclSyn[SML]( "AExp Exp ExpList Top", `AExp`,
    "   [ word { ]
        [ rptsep 0 [ word , ]
        [ alt
              [ [ class Lab ] ]
              [ [ class Int ] ] ]
        [ word = ] [ clause ~100 Exp ] ]
        [ word } ] ",
    \phrl. 
        let sortedtags = sort
            ( (\(rk,e).repAtom'(rk)), MLLtTokFail )
            (map
                (\phrl. 
		   let (| altNum; phrSeq |) = NthAlt(phrl,1) 
                   enc atm = if altNum=1 then MLNthClassAtom(phrSeq,1)
		              else %altNum=2%
		              MLDeclNumLabelOK(MLNthClassInt(phrSeq,1))
                   in (atm, MLNthExp(phrl,3)))
                (NthRptsep(phrl,2)))
        in MLDeclTagOrTuple(sortedtags,
                            (\(atm,_).atm),
	                    (\tagd.MLClzExp(MLSynExpRecord(tagd))),
			    (\tagd.MLClzExp(MLSynExpTuple(
				    map (\(_,tm).tm) tagd))),
                            true ));

MLDeclSyn[SPML;HTML]( "AExp Exp Top", `AExp`,
    "   [ word [| ]
        [ class Ide ]
        [ opt [ word = ] [ clause ~100 Exp ] ]
        [ word |] ] ",
    \phrl. MLClzExp(MLSynExpVariant(
        MLNthClassAtom(phrl,2),
        case NthOpt(phrl,3) of [|
            success = phrl . MLNthExp(phrl,2);
            failure . MLSynExpUnit |] )) );

let MLSemfnVarcase phrl =
    MLClzExp(MLSynExpVarcase(
        MLNthExp(phrl,2),
        sort((\r.repAtom'(r.Tag)),MLLtTokFail) (
            map
                (\phrl. (|
                    Tag = MLNthClassAtom(phrl,1);
                    Bind =
                        case NthOpt(phrl,2) of [|
                        success = phrl . MLNthPat(phrl,2);
                        failure . MLSynPatAny |];
                    Body = MLNthExp(phrl,4) |) )
                (NthRptsep(phrl,5)) ) ))
in (
    MLDeclSyn[HTML]( "AExp Exp Top", `AExp`,
        "   [ word varcase ]
            [ clause ~100 Exp ]
            [ word of ]
            [ word [| ]
            [ rptsep 0 [ word ; ]
                [ class Ide ]
                [ opt [ word = ] [ clause ~100 Pat ] ]
                [ word . ]
                [ clause ~100 Exp ] ]
            [ word |] ] ",
        MLSemfnVarcase );

    MLDeclSyn[SPML;HTML]( "AExp Exp Top", `AExp`,
        "   [ word case ]
            [ clause ~100 Exp ]
            [ word of ]
            [ word [| ]
            [ rptsep 0 [ word ; ]
                [ class Ide ]
                [ opt [ word = ] [ clause ~100 Pat ] ]
                [ word . ]
                [ clause ~100 Exp ] ]
            [ word |] ] ",
        MLSemfnVarcase ) );




MLDeclSyn[SPML;HTML]( "AExp Exp Top", `AExp`,
    " [ word \ ] [ clause ~100 Pat ] [ word . ] [ clause ~100 Exp ] ",
    \phrl. MLClzExp(MLSynExpFun(MLSynMatch[
        MLSynRule( MLNthPat(phrl,2), MLNthExp(phrl,4) ) ])) );

let MLSemfnPar phrl = NthClz(phrl,2);

MLDeclSyn[SPML;HTML]( "AExp Exp Top", `AExp`,
    " [ word ( ] [ clause ~120 Exp ] [ word ) ] ",
    MLSemfnPar );
MLDeclSyn[SML]( "AExp Exp ExpList Top", `AExp`,
    " [ word ( ] [ clause ~120 ExpList ] [ word ) ] ",
    MLSemfnPar );




% Rules for Expressions %

let semfn phrl =
    MLClzExp(MLSynExpAppl( MLNthExp(phrl,1), MLNthExp(phrl,3), Niladic ))
in (
    MLDeclSyn[SPML;HTML]( "Exp Top", `Exp`,
        " [ clause 1499 AExp Exp ] [ word [empty] ] [ clause 1500 AExp ] ",
        semfn );
    MLDeclSyn[SML]( "Exp ExpList Top", `Exp`,
        " [ clause 1000 AExp Exp ] [ word [empty] ] [ clause 1001 AExp ] ",
        semfn ) );

let semfn _ = failwith `Parser error - terminator`
ins MLDeclExpTerm MLBld word =
    InstallRuleMade MLBld ( "AExp Exp ExpList Top", `Exp`,
        [ FormClzalt(~1000,MLSubStateSyclsExp); FormWord(word) ],
        semfn );

app (MLDeclExpTerm SPML) " else enc in ins then } ) ] |) |] ";

%RJG wasapp (MLDeclExpTerm HTML) " do else enc end in ins of then | || } ) ] |) |] ";%
app (MLDeclExpTerm HTML) " do else enc end in ins of then | } ) ] |) |] ";

%RJG 18-Jul was app (MLDeclExpTerm SML) " do else end in of then | || ) ] ";%
app (MLDeclExpTerm SML) " do else end in of then | ) ] ";

let semfn phrl = MLClzExp(MLSynExpDot(
    MLNthExp(phrl,1), MLNthClassAtom(phrl,3) ))
in (
    MLDeclSyn[SPML;HTML]( "Exp Top", `Exp`,
        " [ clause 1299 AExp Exp ] [ word . ] [ class Ide ] ",
        semfn ) % ;  Comment out record field selection op for now... 
    MLDeclSyn[SML]( "Exp ExpList Top", `Exp`,
        " [ clause 900 AExp Exp ] [ word .. ] [ class Lab ] ",
        semfn ) % );  

MLDeclSyn[SML]( "Exp ExpList Top", `Exp`,
        " [ word # ] [ alt [ [ class Lab ] ] [ [ class Int ] ] ]",
        \phrl. 
           let a = let (| altNum; phrSeq |) = NthAlt(phrl,2) in
	           ( if altNum=1 then MLNthClassAtom(phrSeq,1) 
		     else MLDeclNumLabelOK(MLNthClassInt(phrSeq,1)) )
	   enc x = absAtom' `x`
           enc pat = MLSynPatRecord([(a,MLSynPatIde(x))], true)
           enc match = [(pat, MLSynExpIde(x))]
           enc func = MLClzExp(MLSynExpFun(match))
            in func );

MLDeclSyn[SPML;HTML]( "Exp Top", `Exp`,
    " [ clause 1299 AExp Exp ] [ word is ] [ class Ide ] ",
    \phrl. MLClzExp(MLSynExpIs(
        MLNthExp(phrl,1), MLNthClassAtom(phrl,3) )) );

MLDeclSyn[SPML;HTML]( "Exp Top", `Exp`,
    " [ clause 1299 AExp Exp ] [ word as ] [ class Ide ] ",
    \phrl. MLClzExp(MLSynExpAs(
        MLNthExp(phrl,1), MLNthClassAtom(phrl,3) )) );

MLDeclWord[SPML;HTML;SML]( `true`, [|Nonfix|], [|Konst|] );

MLDeclWord[SPML;HTML;SML]( `false`, [|Nonfix|], [|Konst|] );

MLDeclWord[SPML;HTML;SML]( `nil`, [|Nonfix|], [|Konst|] );

MLDeclWord[SPML;HTML;SML]( `ref`, [|Nonfix|], [|Constr|] );

MLDeclWord[SPML;HTML]( `inl`, [|Nonfix|], [|Constr|] );

MLDeclWord[SPML;HTML]( `inr`, [|Nonfix|], [|Constr|] );

MLDeclWord[SPML;HTML]( `::`, [|Infix=(200,200)|], [|Constr|] );
MLDeclWord[SML]( `::`, [|Infix=(50,50)|], [|Constr|] );

MLDeclSynVarInfixNoredef[SPML;HTML](`=`,699,700);
app (\MLBld. MLInstallVarNonfixNoredef(MLBld,`=`)) [SPML;HTML];
MLDeclSynVarInfixNoredef[SML](`=`,40,41);

MLDeclWord[SPML;HTML]( `<>`, [|Infix=(699,700)|], [|Var|] );
MLDeclWord[SML]( `<>`, [|Infix=(40,41)|], [|Var|] );

MLDeclSyn[SPML;HTML]( "Exp Top", `Exp`,
    " [ word print ] [ clause ~100 AExp ] ", % Is this prec correct? %
    \phrl. MLClzExp(MLSynExpTagType( [|Print|], MLNthExp(phrl,2) )) );

MLDeclSyn[SPML;HTML]( "Exp Top", `Exp`,
    " [ word dynamic ] [ clause ~100 AExp ] ", % Is this prec correct? %
    \phrl. MLClzExp(MLSynExpTagType( [|Dynamic|], MLNthExp(phrl,2) )) );

MLDeclSyn[SPML;HTML]( "Exp Top", `Exp`,
    " [ word coerce ] [ clause ~100 AExp ] ", % Is this prec correct? %
    \phrl. MLClzExp(MLSynExpTagType( [|Cast|], MLNthExp(phrl,2) )) );

MLDeclSyn[SML]( "Exp ExpList Top", `Exp`,
    " [ word print ] [ clause ~100 AExp ] ", % Is this prec correct? %
    \phrl. MLClzExp(MLSynExpTagType( [|Print|], MLNthExp(phrl,2) )) );

%MLDeclSyn[SML]( "Exp ExpList Top", `Exp`,%
%    " [ word dynamic ] [ clause ~100 AExp ] ",% % Is this prec correct? %
%    \phrl. MLClzExp(MLSynExpTagType( [|Dynamic|], MLNthExp(phrl,2) )) );%

MLDeclSyn[SML]( "Exp ExpList Top", `Exp`,
    " [ word coerce ] [ clause ~100 AExp ] ", % Is this prec correct? %
    \phrl. MLClzExp(MLSynExpTagType( [|Cast|], MLNthExp(phrl,2) )) );

let semfn phrl = MLClzExp(MLSynExpForce( MLNthExp(phrl,1), MLNthType(phrl,3) ))
in (
    MLDeclSyn[SPML;HTML]( "Exp Top", `Exp`,
        " [ clause 149 AExp Exp ] [ word : ] [ clause ~100 Type ] ",
        semfn );
    MLDeclSyn[SML]( "Exp ExpList Top", `Exp`,
        " [ clause ~10 AExp Exp ] [ word : ] [ clause ~100 Type ] ",
        semfn ) );

MLDeclSyn[HTML;SML]( "Exp ExpList Top", `Exp`,
    " [ clause ~20 AExp Exp ] [ word andalso ] [ clause ~20 Exp ] ",
    \phrl. MLClzExp(MLSynExpCond(
        MLNthExp(phrl,1), MLNthExp(phrl,3), MLSynExpIde(AtomFalse) )) );

MLDeclSyn[HTML;SML]( "Exp ExpList Top", `Exp`,
    " [ clause ~25 AExp Exp ] [ word orelse ] [ clause ~25 Exp ] ",
    \phrl. MLClzExp(MLSynExpCond(
        MLNthExp(phrl,1), MLSynExpIde(AtomTrue), MLNthExp(phrl,3) )) );

%RJG 07-Mar-89%
MLDeclSyn[HTML;SML]( "Exp ExpList Top", `Exp`,
    " [ clause ~30 AExp Exp ] [ word handle ] [ clause ~100 Match ] ",
    \phrl. MLClzExp(MLSynExpHandle(
        MLNthExp(phrl,1), MLNthMatch(phrl,3) )) );

MLDeclSyn[SPML;HTML]( "Exp Top", `Exp`, " [ word fail ] ",
    \phrl. MLClzExp(MLSynExpRaise( AtomOldFail, MLSynExpString(`fail`) )) );

MLDeclSyn[SPML;HTML]( "Exp Top", `Exp`,
    " [ word failwith ] [ clause ~40 Exp ] ", % Is this prec correct? %
    \phrl. MLClzExp(MLSynExpRaise( AtomOldFail, MLNthExp(phrl,2) )) );

%RJG 09-Mar-89%
MLDeclSyn[HTML;SML]( "Exp ExpList Top", `Exp`,
    "   [ word raise ] [ clause ~40 Exp ] ",
    \phrl. MLClzExp(MLSynExpRaise( AtomXn, MLNthExp(phrl,2))));

let semfn phrl = MLClzExp(MLSynExpCond(
    MLNthExp(phrl,2), MLNthExp(phrl,4), MLNthExp(phrl,6) ))
in (
    MLDeclSyn[SPML;HTML]( "Exp Top", `Exp`,
        "   [ word if ] [ clause ~100 Exp ]
            [ word then ] [ clause ~100 Exp ]
            [ word else ] [ clause ~100 Exp ] ",
        semfn );
    MLDeclSyn[SML]( "Exp ExpList Top", `Exp`,
        "   [ word if ] [ clause ~100 Exp ]
            [ word then ] [ clause ~100 Exp ]
            [ word else ] [ clause ~50 Exp ] ",
        semfn ) );

% Are the following precedences correct? %
MLDeclSyn[SPML;HTML]( "Exp Top", `Exp`,
    "   [ clause ~50 AExp Exp ]
        [ word => ] [ clause ~100 Exp ]
        [ word | ] [ clause ~50 Exp ] ",
    \phrl. MLClzExp(MLSynExpCond(
        MLNthExp(phrl,1), MLNthExp(phrl,3), MLNthExp(phrl,5) )) );

MLDeclSyn[HTML;SML]( "Exp ExpList Top", `Exp`,
        " [ word while ] [ clause ~100 Exp ] [ word do ] [ clause ~60 Exp ] ",
        \phrl. MLClzExp(MLSynExpWhile(
           MLNthExp(phrl,2), MLNthExp(phrl,4) )) );

MLDeclSyn[SPML;HTML]( "Exp Top", `Exp`,
    " [ clause ~70 AExp Exp ] [ word ? ] [ clause ~69 Exp ] ",
    \phrl. MLClzExp(MLSynExpTrapAll( MLNthExp(phrl,1), MLNthExp(phrl,3) )) );

MLDeclSyn[SPML;HTML]( "Exp Top", `Exp`,
    "   [ clause ~70 AExp Exp ]
        [ word ?? ] [ clause 1500 AExp ] [ clause ~69 Exp ] ",
    \phrl. MLClzExp(MLSynExpTrapList(
        MLNthExp(phrl,1), MLNthExp(phrl,3), MLNthExp(phrl,4) )) );

MLDeclSyn[SPML;HTML;SML]( "Exp Top", `Exp`,
    " [ clause ~70 AExp Exp ] [ word ?\ ] [ class Ide ] [ clause ~69 Exp ] ",
    \phrl. MLClzExp(MLSynExpTrapLambda(
        MLNthExp(phrl,1),
        MLSynPatIde(MLNthClassAtom(phrl,3)),
        MLNthExp(phrl,4) )) );

let fmlSPML = MLMakeFormSeq(
    "   [ word let ] [ clause ~110 Dec ]
        [ word in ] [ clause ~80 Exp ] " )
and fmlHTML = MLMakeFormSeq(
    "   [ word let ] [ clause ~110 Dec ]
        [ word in ] [ clause ~80 Exp ]
        [ opt [ word end ] ] " )
and fmlSML = MLMakeFormSeq(
    "   [ word let ] [ clause ~110 Dec ]
        [ word in ] [ clause ~110 ExpList ]
        [ word end ] " )
and semfn (fml,sycl) ss =
    let MLBld = BldOfSynStream(ss)
    enc readFormSeq = ReadFormSeqSynStream(ss) in
        \tt.
            let _ = MLPushLocalSynEnv()
            enc phrl = readFormSeq(fml,tt)
            enc _ = MLPopLocalSynEnv(MLBld)
            in (
                MLClzExp(MLSynExpLet( MLNthDec(phrl,2), MLNthExp(phrl,4) )),
                sycl )
in (
    MLDeclFunctionalInitialSynForWord[SPML](
        `let`, "AExp Exp", semfn(fmlSPML,MLSyclAExp) );
    MLDeclFunctionalInitialSynForWord[HTML](
        `let`, "AExp Exp", semfn(fmlHTML,MLSyclAExp) );
    MLDeclFunctionalInitialSynForWord[SML](
        `let`, "Exp ExpList Top", semfn(fmlSML,MLSyclExp) ) );

MLDeclSyn[SPML;HTML]( "Exp Top", `Exp`,
    " [ clause ~80 AExp Exp ] [ word where ] [ clause ~100 Dec ] ",
    \phrl. MLClzExp(MLSynExpLet( MLNthDec(phrl,3), MLNthExp(phrl,1) )) );

let semfn phrl =
    MLClzExp(MLSynExpCase( MLNthExp(phrl,2), MLNthMatch(phrl,4) ))
in (
    MLDeclSyn[HTML]( "Exp Top", `Exp`,
        "   [ word newcase ] [ clause ~100 Exp ]
            [ word of ] [ clause ~100 Match ] ",
        semfn );
    MLDeclSyn[SML]( "Exp ExpList Top", `Exp`,
        "   [ word case ] [ clause ~100 Exp ]
            [ word of ] [ clause ~100 Match ] ",
        semfn ) );


%RJG - 25-June
 SML-ish jump tables for jumpcases - restricted patterns%

let MLSemfnJumpcase phrl =
 MLClzExp(MLSynExpJumpcase(
  MLNthExp(phrl,2), %Exp%
  sort((\r.repAtom'(r.Tag)),MLLtTokFail) (
     map
        (\phrl. (|
             Tag = let (| altNum; phrSeq |) = NthAlt (phrl,1)
                   in MLNthClassAtom(phrSeq,altNum);
             Bind =
               case NthOpt(phrl,2) of [|
                  success = phrl . MLNthPat(phrl,1);
                  failure . MLSynPatAny |];
             Body = MLNthExp(phrl,4) |))
        (NthRptsep(phrl,4))
      )))
in
  MLDeclSyn[SML]( "Exp ExpList Top", `Exp`,
   "  [ word jumpcase ]
      [ clause ~100 Exp ]
      [ word of ]
      [ rptsep 1 [ word | ]
        [ alt 
          [ [ class IdeNonfix ] ]
          [ [ word op ] [ class IdeOpfix ] ]
        ]
        [ opt [ clause ~100 Pat ] ]
        [ word => ]
        [ clause ~100 Exp ] ] ",
   MLSemfnJumpcase );
      

MLDeclSyn[%Memo: should include HTML;%SML]( "Exp ExpList Top", `Exp`,
    " [ word fn ] [ clause ~100 Match ] ",
    \phrl. MLClzExp(MLSynExpFun(MLNthMatch(phrl,2))) );

%RJG not in the core lang. MLDeclSyn[SML]( "Exp ExpList Top", `Exp`,
    "   [ clause 1000 AExp ]
        [ word inp ] [ clause ~100 Pat ]
        [ word => ] [ clause ~100 Exp ] ",
    \phrl. MLClzExp(MLSynExpAppl(
        MLSynExpIde(absAtom'(`pfl_read`)),
        MLSynExpTuple[
            MLNthExp(phrl,1);
            MLSynExpFun(MLSynMatch[
                MLSynRule(MLNthPat(phrl,3),MLNthExp(phrl,5)) ]) ],
        Niladic )) );
%
% RJG not core MLDeclSyn[SML]( "Exp ExpList Top", `Exp`,
    "   [ clause 1000 AExp ]
        [ word out ] [ clause ~100 Exp ]
        [ word => ] [ clause ~100 Exp ] ",
    \phrl. MLClzExp(MLSynExpAppl(
        MLSynExpIde(absAtom'(`pfl_write`)),
        MLSynExpTuple[
            MLNthExp(phrl,1);
            MLNthExp(phrl,3);
            MLSynExpFun(MLSynMatch[
                MLSynRule(MLSynPatUnit,MLNthExp(phrl,5)) ]) ],
        Niladic )) );
%



% Rules for Expression Lists %

MLDeclSyn[SPML;HTML]( "Exp Top", `Exp`,
    " [ clause ~110 AExp Exp ] [ word ; ] [ clause ~100 Exp ] ",
    \phrl. MLClzExp(MLSynExpSeq(MLNthExp(phrl,1),MLNthExp(phrl,3))) );
%RJG fix insufficient repetition%
MLDeclSyn[SML]( "ExpList", `ExpList`,
    "   [ clause ~110 AExp Exp ] [ word ; ]
        [ clause ~100 Exp ]
        [ rpt 0 [ word ; ]
            [ clause ~100 Exp ] ] ",
    \phrl. MLClzExp(
        SpecialReduceList
            MLSynExpSeq
            (   MLNthExp(phrl,1) :: MLNthExp(phrl,3)
                :: map (\phrl.MLNthExp(phrl,2)) (NthRpt(phrl,4)) ) ) );

let semfn phrl = MLClzExp(MLSynExpTuple(
    MLNthExp(phrl,1) :: map (\phrl. MLNthExp(phrl,1)) (NthRptsep(phrl,3)) ))
enc semfnsml phrl = MLClzExp(MLSynExpTuple(
    MLNthExp(phrl,1) :: MLNthExp(phrl,3) ::
    map (\phrl. MLNthExp(phrl,2)) (NthRpt(phrl,4)) ))
in (
    MLDeclSyn[SPML;HTML]( "Exp Top", `Exp`,
        "   [ clause 100 AExp Exp ] [ word , ]
            [ rptsep 1 [ word , ]
                [ clause 101 Exp ] ] ",
        semfn );  %necessary to be i1,i2,.. ij | j>1 ??%
%RJG fix insufficient repetition%
    MLDeclSyn[SML]( "ExpList", `ExpList`,
        "   [ clause ~120 AExp Exp ] [ word , ]
            [ clause ~100 Exp ]
            [ rpt 0 [ word , ]
                [ clause ~100 Exp ] ] ",
        semfnsml ) );




% Rules for Pattern Variables %

let MLSemfnPatIde phrl = MLClzPat(MLSynPatIde(MLNthClassAtom(phrl,1)));

MLDeclSyn[SPML;HTML]( "APat", `PatVar`, " [ class VarNonfix ] ",
    MLSemfnPatIde );
MLDeclSyn[SPML;HTML](
    "Pat PatList Rule Match FunPat ValBind FunBind NonemptyDec Dec",
    `PatVar`,
    " [ class VarNonPrefix ] ",
    MLSemfnPatIde );
MLDeclSyn[SML]( "APat Pat PatList Rule Match FunPat ValBind FunBind", `PatVar`,
    " [ class VarNonfix ] ",
    MLSemfnPatIde );

% See also syntax for "op" under "Rules for Patterns" %




% Rules for Atomic Patterns %

let semfn phrl = MLClzPat(MLSynPatAny) in (
    MLDeclSyn[SPML;HTML](
        "APat Pat PatList Rule Match FunPat ValBind FunBind NonemptyDec Dec",
        `APat`,
        " [ word /_ ] ",
        semfn );
    MLDeclSyn[SML](
        "APat Pat PatList Rule Match FunPat ValBind FunBind",
        `APat`,
        " [ word /_ ] ",
        semfn ) );

MLDeclSyn[SPML;HTML](
    "APat Pat PatList Rule Match FunPat ValBind FunBind NonemptyDec Dec",
    `APat`,
    " [ class Konst ] ",
    MLSemfnPatIde );
MLDeclSyn[SML]( "APat Pat PatList Rule Match FunPat ValBind FunBind", `APat`,
    " [ class KonstNonfix ] ",
    MLSemfnPatIde );

MLDeclSyn[SML]( "APat", `APat`, " [ class QualIde ] ", MLSemfnPatIde );

let semfn phrl = MLClzPat(MLSynPatInt(MLNthClassInt(phrl,1))) in (
    MLDeclSyn[SPML;HTML](
        "APat Pat PatList Rule Match FunPat ValBind FunBind NonemptyDec Dec",
        `APat`,
        " [ class Int ] ",
        semfn );
    MLDeclSyn[SML](
        "APat Pat PatList Rule Match FunPat ValBind FunBind",
        `APat`,
        " [ class Int ] ",
        semfn ) );

let semfn phrl = MLClzPat(MLSynPatReal(MLNthClassReal(phrl,1)))
in (
    MLDeclSyn[SPML;HTML](
        "APat Pat PatList Rule Match FunPat ValBind FunBind NonemptyDec Dec",
        `APat`,
        " [ class Real ] ",
        semfn );
    MLDeclSyn[SML](
        "APat Pat PatList Rule Match FunPat ValBind FunBind",
        `APat`,
        " [ class Real ] ",
        semfn ) );

let semfn phrl = MLClzPat(MLSynPatString(MLNthClassTok(phrl,1)))
in (
    MLDeclSyn[SPML;HTML](
        "APat Pat PatList Rule Match FunPat ValBind FunBind NonemptyDec Dec",
        `APat`,
        " [ class Tok ] ",
        semfn );
    MLDeclSyn[SML](
        "APat Pat PatList Rule Match FunPat ValBind FunBind",
        `APat`,
        " [ class Tok ] ",
        semfn ) );

MLDeclSyn[SPML;HTML](
    "APat Pat PatList Rule Match FunPat ValBind FunBind NonemptyDec Dec",
    `APat`,
    " [ class TokList ] ",
    \phrl. MLClzPat(MLSynPatList(
        map MLSynPatString (MLNthClassTokList(phrl,1)) )) );

let semfn phrl = MLClzPat(MLSynPatUnit) in (
    MLDeclSyn[SPML;HTML](
        "APat Pat PatList Rule Match FunPat ValBind FunBind NonemptyDec Dec",
        `APat`,
        " [ class Unit ] ",
        semfn );
    MLDeclSyn[SML](
        "APat Pat PatList Rule Match FunPat ValBind FunBind",
        `APat`,
        " [ class Unit ] ",
        semfn ) );

let semfn phrl = MLClzPat(MLSynPatList(
    map (\phrl.MLNthPat(phrl,1)) (NthRptsep(phrl,2)) ))
in (
    MLDeclSynMade[SPML;HTML](
        "APat Pat PatList Rule Match FunPat ValBind FunBind NonemptyDec Dec",
        `APat`,
        [   FormWord(`[`);
            FormRptsep(0,FormWord(`;`),[ FormClz(~100,MLSyclPat) ]);
            FormWord(`]`) ],
        semfn );
    MLDeclSynMade[SML](
        "APat Pat PatList Rule Match FunPat ValBind FunBind",
        `APat`,
        [   FormWord(`[`);
            FormRptsep(0,FormWord(`,`),[ FormClz(~100,MLSyclPat) ]);
            FormWord(`]`) ],
        semfn ) );

MLDeclSyn[SPML;HTML](
    "APat Pat PatList Rule Match FunPat ValBind FunBind NonemptyDec Dec",
    `APat`,
    "   [ word (| ]
        [ rptsep 0 [ word ; ]
            [ class Ide ]
            [ opt [ word = ] [ clause ~100 Pat ] ]  ]
        [ word |) ] ",
    \phrl. MLClzPat(MLSynPatRecord(
        sort((\(a,p).repAtom'(a)),MLLtTokFail) (
            map
                (\phrl. let a = MLNthClassAtom(phrl,1) in (
                    a,
                    case NthOpt(phrl,2) of [|
                        success = phrl . MLNthPat(phrl,2);
                        failure . MLSynPatIde(a) |] ) )
                (NthRptsep(phrl,2)) ),
        false )) );

%RJG: 15-Dec-89 convert record patterns to tuples if possible%
let { rec semfn' phrll =
    if null phrll then ([],false,true)
    else
        let phrl :: phrll = phrll
        enc (| altNum; phrSeq |) = NthAlt(phrl,1)
        in
            if altNum = 1 then
                let (l,flex,tuplepat) = semfn'(phrll)
                enc (a,tuplepat) = let (| altNum; phrSeq |) = NthAlt(phrSeq,1)
		        in (if altNum=1 then (MLNthClassAtom(phrSeq,1),false)
			   else (MLDeclNumLabelOK(MLNthClassInt(phrSeq,1)),tuplepat))
                enc p =
                    case NthOpt(phrSeq,2) of [|
                    success = phrl .
                        MLNthPat(phrl,2); %2nd & 3rd opts will fail%
                    failure .
                        let p = MLSynPatIde(a)
                        enc p =
                            case NthOpt(phrSeq,3) of [|
                            success=phrl . MLSynPatForce(p,MLNthType(phrl,2));
                            failure . p |]
                        in
                            case NthOpt(phrSeq,4) of [|
                            success = phrl . MLSynPatBoth(p,MLNthPat(phrl,2));
                            failure . p |] |]
                in
                    ( (a,p)::l, flex, tuplepat )

            else %altNum = 2%
                if null phrll then ([],true,false)
                else ParseFailFatal[| other =
                 `"..." should only appear at the end of a record pattern` |] }
ins semfn phrl =
    let (l,flex,tuplepat) = semfn'(NthRptsep(phrl,2)) 
    enc sortedtags = sort ((\(a,p).repAtom'(a)),MLLtTokFail) (l)
    in MLDeclTagOrTuple(sortedtags,(\(t,_).t),
             (\sortedtags. MLClzPat(MLSynPatRecord(sortedtags, flex ))),
	     (\sortedtags. MLClzPat(MLSynPatTuple(map (\(_,p).p) sortedtags))),
	     tuplepat)

in
    MLDeclSyn[SML](
        "APat Pat PatList Rule Match FunPat ValBind FunBind",
        `APat`,
        "   [ word { ]
            [ rptsep 0 [ word , ]
                [ alt
                    [  [ alt [ [ class Ide ] ] [ [ class Int ] ] ]
                        [ opt [ word = ] [ clause ~100 Pat ] ]
                        [ opt [ word : ] [ clause ~100 Type ] ]
                        [ opt [ word as ] [ clause ~100 Pat ] ] ]
                    [ [ word ... ] ] ] ]
            [ word } ] ",
        %In the above, if the 1st opt succeeds the 2nd and 3rd opts will fail%
        semfn );

MLDeclSyn[SPML;HTML](
    "APat Pat PatList Rule Match FunPat ValBind FunBind NonemptyDec Dec",
    `APat`,
    "   [ word [| ]
        [ class Ide ]
        [ opt [ word = ] [ clause ~100 Pat ] ]
        [ word |] ] ",
    \phrl. MLClzPat(MLSynPatVariant(
        MLNthClassAtom(phrl,2),
        case NthOpt(phrl,3) of [|
            success = phrl . MLNthPat(phrl,2);
            failure . MLSynPatUnit |] )) );

let semfn phrl = NthClz(phrl,2) in (
    MLDeclSyn[SPML;HTML](
        "APat Pat PatList Rule Match ValBind",
        `APat`,
        " [ word ( ] [ clause ~120 Pat ] [ word ) ] ",
        semfn );
    MLDeclSyn[SML]( "APat Pat PatList Rule Match ValBind", `APat`,
        " [ word ( ] [ clause ~120 PatList ] [ word ) ] ",
        semfn ) );

% See also syntax for "op" under "Rules for Patterns" %




% Rules for Constrained Pattern Variables %

let MLSemfnPatForce phrl =
    MLClzPat(MLSynPatForce( MLNthPat(phrl,1), MLNthType(phrl,3) ));

MLDeclSyn[SPML;HTML](
    "Pat PatList Rule Match FunPat ValBind FunBind NonemptyDec Dec",
    `PatVarForce`,
    " [ clause 149 PatVar ] [ word : ] [ clause ~100 Type ] ",
    MLSemfnPatForce );
MLDeclSyn[SML]( "Pat PatList Rule Match FunPat ValBind FunBind", `PatVarForce`,
    " [ clause ~10 PatVar ] [ word : ] [ clause ~100 Type ] ",
    MLSemfnPatForce );




% Rules for Patterns %

let semfn phrl = MLClzPat(MLSynPatAppl(
    MLNthClassAtom(phrl,1), MLNthPat(phrl,2), Niladic ))
in (
    MLDeclSyn[SPML;HTML](
        "Pat PatList Rule Match FunPat ValBind FunBind NonemptyDec Dec",
        `Pat`,
        " [ class ConstrNonPrefix ] [ clause 1500 APat ] ",
        semfn );
    MLDeclSyn[SML]( "Pat PatList Rule Match ValBind", `Pat`,
        " [ clause 1000 PatVar ] [ word [empty] ] [ clause 1001 APat ] ",
        \phrl. 
           MLClzPat( MLSynPatAppl(
                 MLAtomOfPatIde(MLNthPat(phrl,1)), 
                 MLNthPat(phrl,3), Niladic )) ) );



MLDeclSyn[SML]( "Pat PatList Rule Match FunPat ValBind FunBind", `Pat`,
    " [ class QualIde ] [ opt [ clause 1001 APat ] ] ",
    \phrl. MLClzPat(
        let a = MLNthClassAtom(phrl,1) in
            case NthOpt(phrl,2) of [|
            success = phrl . MLSynPatAppl( a, MLNthPat(phrl,1), Niladic );
            failure .  MLSynPatIde(a) |] ) );

% This returns a PatVar, an APat or a Pat depending on what follows %
let semfn bp ss =
    let readLex' = ReadLex'SynStream(ss)
    enc readClz = ReadClzSynStream(ss)
    enc semfn' tt =
        let _ = readLex'(MLLexModeOfSycl(tt))
        enc lx' = readLex'(MLLexModeOfSycl(tt))
        enc lxcl = MLLxclOfLex'(lx')
        in
            if MemberLxclset(lxcl,MLLxclsetIdeOpfix) then
                let wd = MLTokOfLex(LexOfLex'(lx'))
                enc a = absAtom'(wd)
                in
                  ( MLClzPat(MLSynPatIde(a)), MLSyclPatVar )
            % "=" is excluded as a reserved word - it may not be rebound %
            else ParseFail[|class=MLLxclsetIdeOpfix|]
    in
        semfn'
in (
    MLDeclFunctionalInitialSynForWord[HTML]( `op`,
        "APat Pat PatList Rule Match FunPat ValBind FunBind NonemptyDec Dec",
        semfn(1500) );
    MLDeclFunctionalInitialSynForWord[SML]( `op`,
        "APat Pat PatList Rule Match FunPat ValBind FunBind",
        semfn(1001) ) );

MLDeclSyn[SPML;HTML](
    "Pat PatList Rule Match FunPat ValBind FunBind NonemptyDec Dec",
    `Pat`,
    "   [ clause 149 APat PatVarForce Pat ]
        [ word : ] [ clause ~100 Type ] ",
    MLSemfnPatForce );
MLDeclSyn[SML]( "Pat PatList Rule Match FunPat ValBind FunBind", `Pat`,
    "   [ clause ~10 APat PatVarForce Pat ]
        [ word : ] [ clause ~100 Type ] ",
    MLSemfnPatForce );

% See also syntax for "," under "Rules for Pattern Lists" %

MLDeclSyn[HTML;SML](
    "Pat PatList Rule Match FunPat ValBind FunBind NonemptyDec Dec",
        % "NonemptyDec Dec" inapplicable in SML %
    `Pat`,
    " [ clause ~20 PatVar PatVarForce ] [ word as ] [ clause ~20 Pat ] ",
    \phrl. MLClzPat(MLSynPatBoth( MLNthPat(phrl,1), MLNthPat(phrl,3) )) );




% Rules for Pattern Lists %

let semfn phrl = MLClzPat(MLSynPatTuple(
    MLNthPat(phrl,1) :: map (\phrl. MLNthPat(phrl,1)) (NthRptsep(phrl,3)) ))
%RJG fix insufficient repetition%
enc semfnsml phrl = MLClzPat(MLSynPatTuple(
    MLNthPat(phrl,1) :: MLNthPat(phrl,3) :: 
    map (\phrl. MLNthPat(phrl,2)) (NthRpt(phrl,4)) ))

in (
    MLDeclSyn[SPML;HTML](
        "Pat PatList Rule Match FunPat ValBind FunBind NonemptyDec Dec",
        `Pat`,
        "   [ clause 100 PatVar APat PatVarForce Pat ]
            [ word , ]
            [ rptsep 1 [ word , ]
                [ clause 101 Pat ] ] ",
        semfn );
    MLDeclSyn[SML]( "PatList Rule Match FunPat ValBind FunBind", `PatList`,
        "   [ clause ~120 PatVar APat PatVarForce Pat ]
            [ word , ] [ clause ~100 Pat ]
            [ rpt 0 [ word , ]
                [ clause ~100 Pat ] ] ",
        semfnsml ) );




% Rules for Rules %

MLDeclSyn[HTML;SML]( "Rule Match", `Rule`,
    "   [ clause ~50 PatVar APat PatVarForce Pat ]
        [ word => ]
        [ clause ~100 Exp ] ",
    \phrl. MLClzRule(MLSynRule( MLNthPat(phrl,1), MLNthExp(phrl,3) )) );




% Rules for Matches %
%RJG fix insufficient repetition%

MLDeclSyn[HTML;SML]( "Match", `Match`,
    "   [ clause ~50 Rule ]
        [ word | ] [ clause ~100 Rule ]
        [ rpt 0 [ word | ]
            [ clause ~100 Rule ] ] ",
    \phrl. MLClzMatch(MLSynMatch(
        MLNthRule(phrl,1) :: MLNthRule(phrl,3)
        :: map (\phrl.MLNthRule(phrl,2)) (NthRpt(phrl,4)) )) );




% Rules for Handler Rules %

MLDeclSyn[HTML]( "HandlerRule Handler", `HandlerRule`,
    "   [ class Ide ]
        [ alt
            [ [ word with ] [ clause ~100 Match ] ]
            [ [ word => ] [ clause ~100 Exp ] ] ] ",
    \phrl. MLClzHandlerRule(MLSynHandlerRuleSpecific(
        MLNthClassAtom(phrl,1),
        let phrl = NthAlt(phrl,2).phrSeq in
            if MLNthWord(phrl,1) = `with` then MLNthMatch(phrl,2)
            else MLSynMatch[ MLSynRule( MLSynPatAny, MLNthExp(phrl,2) ) ] )) );

MLDeclSyn[HTML]( "HandlerRule Handler", `HandlerRule`,
    " [ word ? ] [ word => ] [ clause ~100 Exp ] ",
    \phrl. MLClzHandlerRule(MLSynHandlerRuleGeneral(MLNthExp(phrl,3))) );

%MLDeclSyn[SML]( "Exp ExpList Top", `Exp`,
    " [ word ?\ ] [ class Ide ] [ word => ] [ clause ~100 Exp ] ",
    \phrl. MLClzExp(
                 MLSynHandlerRuleTrapLamb(MLSynPatIde(MLNthClassAtom(phrl,2)),
                                          MLNthExp(phrl,4))) );
%



% Rules for Handlers %

% RJG old MLDeclSyn[HTML;SML]( "Handler", `Handler`,
    "   [ clause ~50 HandlerRule ]
        [ word || ]
        [ rptsep 1 [ word || ]
            [ clause ~100 HandlerRule ] ] ",
    \phrl. MLClzHandler(MLSynHandler(
        MLNthHandlerRule(phrl,1)
        :: map (\phrl.MLNthHandlerRule(phrl,1)) (NthRptsep(phrl,3)) )) );
%



% Rules for (Unconstrained) Function Patterns %

let semfn phrl = MLClzFunPat(|
    patVar = MLNthPat(phrl,1);
    patListRev = [ MLNthPat(phrl,3) ];
    typeOpt = None |)
in (
    MLDeclSyn[SPML;HTML]( "FunPat FunBind NonemptyDec Dec", `FunPatFree`,
        " [ clause 1499 PatVar ]  [ word [empty] ]  [ clause 1500 APat ] ",
        semfn );
    MLDeclSyn[SML]( "FunPat FunBind", `FunPatFree`,
        " [ clause 1000 PatVar ]  [ word [empty] ]  [ clause 1001 APat ] ",
        semfn ) );

let semfn phrl = let (|patVar;patListRev;typeOpt|) = MLNthFunPat(phrl,1) in
    MLClzFunPat(|
        patVar;
        patListRev = MLNthPat(phrl,3) :: patListRev;
        typeOpt |)
in (
    MLDeclSyn[SPML;HTML]( "FunPat FunBind NonemptyDec Dec", `FunPatFree`,
        "[ clause 1499 FunPatFree ] [ word [empty] ] [ clause 1500 APat ]",
        semfn );
    MLDeclSyn[SML]( "FunPat FunBind", `FunPatFree`,
        "[ clause 1000 FunPatFree ] [ word [empty] ] [ clause 1001 APat ]",
        semfn ) );




% Rules for (Constrained) Function Patterns %

let semfn phrl = let (|patVar;patListRev;typeOpt|) = MLNthFunPat(phrl,1) in
    MLClzFunPat(|
        patVar;
        patListRev;
        typeOpt = A(MLNthType(phrl,3)) |)
in (
    MLDeclSyn[SPML;HTML]( "FunPat FunBind NonemptyDec Dec", `FunPat`,
        " [ clause 149 FunPatOp FunPatFree ] [ word : ] [ clause ~100 Type ] ",
        semfn );
    MLDeclSyn[SML]( "FunPat FunBind", `FunPat`,
        " [ clause ~10 FunPatOp FunPatFree ] [ word : ] [ clause ~100 Type ] ",
        semfn ) );

MLDeclFunctionalInitialSynForWord[SPML;HTML;SML](
    `(`, "FunPat", MLSemfnParen );




% Rules for Value Bindings %

MLDeclSyn[SPML;HTML;SML](
    "ValBind NonemptyDec Dec",  % "NonemptyDec Dec" inapplicable in SML %
    `ValBind`,
    "   [ clause ~60 PatVar APat PatVarForce Pat ]
        [ word = ]
        [ clause ~100 Exp ] ",
    \phrl. MLClzDec(MLSynDecVal(MLNthPat(phrl,1),MLNthExp(phrl,3))) );

MLDeclSyn[HTML;SML]( "ValBind", `ValBind`,
    " [ clause ~70 ValBind ] [ word and ] [ clause ~70 ValBind ] ",
    \phrl. MLClzDec(MLSynDecAnd( MLNthDec(phrl,1), MLNthDec(phrl,3) )) );

MLDeclSyn[HTML;SML]( "ValBind", `ValBind`,
    " [ word rec ] [ clause ~70 ValBind ] ",
    \phrl. MLClzDec(MLSynDecRec( MLNthDec(phrl,2) )) );




% Rules for Function Bindings %

let { n = ref 0
ins genInt(): int = ( n := !n + 1; !n ) }

enc { rec genIdeList'(p,i,n) =
    if i>n then [] else absAtom'(p #@ tokofint(i)) :: genIdeList'(p,i+1,n) }

enc genIdeList(p,n) = genIdeList'( p #@ tokofint(genInt()) #@ `:`, 1, n )

enc mkExp(exp,typeOpt) = MLSynExpForce(exp,The(typeOpt)) ?? ExcOpt exp

enc { rec mkFun'(localListRev,exp) =
    if null(localListRev) then exp
    else
        mkFun'(
            tl(localListRev),
            MLSynExpFun[( MLSynPatIde(hd(localListRev)), exp )] ) }

enc mkFun(n,match) =
    if n=1 then MLSynExpFun(match)
    else
        let localList = genIdeList(`x:`,n) in
            mkFun'(
                rev(localList),
                MLSynExpCase(
                    MLSynExpTuple(map MLSynExpIde localList),
                    match ) )

enc { rec MLSemfnClFunDecl(patVar1,n,phrll,matchRev) =
    if null(phrll) then
        MLClzDec(MLSynDecVal( patVar1, mkFun(n,rev(matchRev)) ))
    else
        let phrl :: phrll = phrll
        enc (|patVar;patListRev;typeOpt|) = MLNthFunPat(phrl,2)
        enc exp = mkExp( MLNthExp(phrl,4), typeOpt )
        in
            if Not(EqAtom(MLAtomOfPatIde(patVar),MLAtomOfPatIde(patVar1))) then
                ParseFailFatal[| other =
                  `Different function names in clausal function declaration` |]
            else if length(patListRev) <> n then ParseFailFatal[| other =
                `Unbalanced clausal function declaration` |]
            else MLSemfnClFunDecl(
                patVar1,
                n,
                phrll,
                ( MLSynPatTupleOrSingle(rev(patListRev)), exp ) :: matchRev ) }

in
    MLDeclSyn[SPML;HTML;SML](
        "FunBind NonemptyDec Dec",  % "NonemptyDec Dec" inapplicable in SML %
        `FunBind`,
        "   [ clause ~60 FunPatOp FunPatFree FunPat ]
            [ word = ] [ clause ~100 Exp ]
            [ rpt 0
                [ word | ] [ clause ~100 FunPat ]
                [ word = ] [ clause ~100 Exp ] ] ",
        \phrl.
            let (|patVar;patListRev;typeOpt|) = MLNthFunPat(phrl,1)
            enc exp = mkExp( MLNthExp(phrl,3), typeOpt )
            enc phrll = NthRpt(phrl,4)
            enc n = length(patListRev)
            enc matchRev = [( MLSynPatTupleOrSingle(rev(patListRev)), exp )]
            in MLSemfnClFunDecl(patVar,n,phrll,matchRev) );

MLDeclSyn[HTML;SML]( "FunBind", `FunBind`,
    " [ clause ~70 FunBind ] [ word and ] [ clause ~70 FunBind ] ",
    \phrl. MLClzDec(MLSynDecAnd( MLNthDec(phrl,1), MLNthDec(phrl,3) )) );

MLDeclFunctionalInitialSynForWord[HTML;SML](
    `(`, "FunBind", MLSemfnParen );




% Rules for Types %

MLDeclSyn[SPML;HTML;SML]( "Type", `Type`, " [ class Tyvar ] ",
    \phrl. MLClzType(MLSynTypeVar(MLNthClassAtom(phrl,1))) );

MLDeclSyn[SPML;HTML;SML]( "Type", `Type`, " [ class Ide ] ",
    \phrl.MLClzType(MLSynTypeConNullary(MLNthClassAtom(phrl,1))) );

MLDeclSyn[SPML;HTML]( "Type", `Type`, " [ word . ] ",
    \phrl. MLClzType(MLSynTypeUnit) );

MLDeclSyn[SPML;HTML;SML]( "Type", `Type`,
    " [ clause 1000 Type ] [ word [empty] ] [ class Ide ] ",
    \phrl. MLClzType(MLSynTypeCon(
        MLNthClassAtom(phrl,3), [MLNthType(phrl,1)] )) );

MLDeclSyn[SPML;HTML;SML]( "Type", `Type`,
    " [ clause 1000 TypeSeq ] [ word [empty] ] [ class Ide ] ",
    \phrl. MLClzType(MLSynTypeCon(
        MLNthClassAtom(phrl,3), MLNthTypeList(phrl,1) )) );

let semfn phrl = MLClzType(MLSynTypeCon(
    AtomCross,
    MLNthType(phrl,1) :: map (\phrl. MLNthType(phrl,1)) (NthRptsep(phrl,3)) ))
%RJG fix insufficient repetition%
enc semfnsml phrl = MLClzType(MLSynTypeCon(
    AtomCross,
    MLNthType(phrl,1) :: MLNthType(phrl,3) ::
    map (\phrl. MLNthType(phrl,2)) (NthRpt(phrl,4)) ))
in (
    MLDeclSpecialTypeCon[SPML;HTML](`#`,false);
    MLDeclSyn[SPML;HTML]( "Type", `Type`,
        "   [ clause 50 Type ] [ word # ]
            [ rptsep 1 [ word # ]
                [ clause 51 Type ] ] ",
        semfn );
    MLDeclSpecialTypeCon[SML](`*`,false);
    MLDeclSyn[SML]( "Type", `Type`,
        "   [ clause 50 Type ] [ word * ] [ clause 51 Type ]
            [ rpt 0 [ word * ]
                [ clause 51 Type ] ] ",
        semfnsml ) );

MLDeclSpecialTypeCon[SPML;HTML](`+`,true);
MLDeclTypeInfix[SPML;HTML](`+`,45,45,true);

MLDeclSpecialTypeCon[SPML;HTML](`->`,true);
MLDeclTypeInfix[SPML;HTML](`->`,40,40,true);
MLDeclSpecialTypeCon[SML](`->`,false);
MLDeclTypeInfix[SML](`->`,40,40,false);

let MLSemfnTypeRecVar (tagSort,defaultArgForTag) phrl =
    MLClzType(MLSynTypeTagCon(
        tagSort,
        sort((\r.repAtom'(r.Tag)),MLLtTokFail) (
            map
                (\phrl. let a = MLNthClassAtom(phrl,1) in (|
                    Tag = a;
                    Arg =
                        case NthOpt(phrl,2) of [|
                        success = phrl . MLNthType(phrl,2);
                        failure . defaultArgForTag(a) |] |) )
                (NthRptsep(phrl,2)) ) ));

MLDeclSyn[SPML;HTML]( "Type", `Type`,
    "   [ word (| ]
        [ rptsep 0 [ word ; ]
            [ class Ide ]
            [ opt [ word : ] [ clause ~100 Type ] ] ]
        [ word |) ] ",
    MLSemfnTypeRecVar([|Record|],MLSynTypeConNullary) );

%RJG: 15-Dec-89 convert record types to tuples if possible%
let semfn phrl =
   let sortedtags =
        sort((\r.repAtom'(r.Tag)),MLLtTokFail) (
            map
                (\phrl.let atm = 
                   let (| altNum; phrSeq |) = NthAlt(phrl,1) 
                   in (if altNum=1 then MLNthClassAtom(phrSeq,1)
                       else MLDeclNumLabelOK(MLNthClassInt(phrSeq,1)))
                  in (| Tag=atm; Arg=MLNthType(phrl,3) |))
                (NthRptsep(phrl,2)) )
   in
     MLDeclTagOrTuple(sortedtags,(\(|Tag=x;Arg|).x),
        (\sortedtags. MLClzType(MLSynTypeTagCon([|Record|], sortedtags))),
        (\sortedtags. 
         MLClzType(MLSynTypeCon(AtomCross,map (\(|Tag;Arg=x|).x) sortedtags))),
        true)

in
MLDeclSyn[SML]( "Type", `Type`,
    "   [ word { ]
        [ rptsep 0 [ word , ]
            [ alt [ [ class Lab ] ] [ [ class Int ] ] ]
            [ word : ] [ clause ~100 Type ] ]
        [ word } ] ",semfn );

MLDeclSyn[SPML;HTML]( "Type", `Type`,
    "   [ word [| ]
        [ rptsep 0 [ word ; ]
            [ class Ide ]
            [ opt [ word : ] [ clause ~100 Type ] ] ]
        [ word |] ] ",
    MLSemfnTypeRecVar( [|Variant|], \a.MLSynTypeUnit ) );

MLDeclFunctionalInitialSynForWord[SPML;HTML;SML]( `(`, "Type", MLSemfnParen );




% Rules for Type Lists %

MLDeclSyn[SPML;HTML]( "Type", `TypeList`,
    "   [ clause ~120 Type ] [ word , ]
        [ rptsep 1 [ word , ]
            [ clause ~100 Type ] ] ",
    \phrl. MLClzTypeList(
        MLNthType(phrl,1)
        :: map (\phrl.MLNthType(phrl,1)) (NthRptsep(phrl,3)) ) );

MLDeclSyn[SML]( "Type", `TypeList`,
    "   [ clause ~120 Type ] [ word , ] [ clause ~100 Type ]
        [ rpt 0 [ word , ]
            [ clause ~100 Type ] ] ",
    \phrl. MLClzTypeList(
        MLNthType(phrl,1) :: MLNthType(phrl,3)
        :: map (\phrl.MLNthType(phrl,2)) (NthRpt(phrl,4)) ) );




% Rules for Type Pattern Variables %

MLDeclSyn[SPML;HTML;SML](
    "TypePatVar TypePat TypeBind DatatypeBind",
    `TypePatVar`,
    " [ class Tyvar ] ",
    \phrl. MLClzTypePatVarList[ MLNthClassAtom(phrl,1) ] );




% Rules for Type Pattern Variable Sequences %

MLDeclSyn[SPML;HTML]( "TypePat TypeBind DatatypeBind", `TypePatVarSeq`,
    "   [ word ( ]
        [ rptsep 1 [ word , ]
            [ class Tyvar ] ]
        [ word ) ] ",
    \phrl. MLClzTypePatVarList(
        map (\phrl.MLNthClassAtom(phrl,1)) (NthRptsep(phrl,2)) ) );

%RJG fix insufficient repetition%
MLDeclSyn[SML]( "TypePat TypeBind DatatypeBind", `TypePatVarSeq`,
    "   [ word ( ]
        [ class Tyvar ] 
        [ rpt 0 [ word , ]
            [ class Tyvar ] ]
        [ word ) ] ",
    \phrl. MLClzTypePatVarList( MLNthClassAtom(phrl,2) ::
        map (\phrl.MLNthClassAtom(phrl,2)) (NthRpt(phrl,3)) ) );




% Rules for Type Patterns %

MLDeclSyn[SPML;HTML;SML]( "TypePat TypeBind DatatypeBind", `TypePat`,
    " [ class Ide ] ",
    \phrl. MLClzTypePat(| Bind=MLNthClassAtom(phrl,1); Params=[] |) );

MLDeclSyn[SPML;HTML;SML]( "TypePat TypeBind DatatypeBind", `TypePat`,
    "   [ clause 1000 TypePatVar TypePatVarSeq ]
        [ word [empty] ]
        [ class Ide ] ",
    \phrl. MLClzTypePat(|
        Bind = MLNthClassAtom(phrl,3);
        Params = MLNthTypePatVarList(phrl,1) |) );




% Rules for Constructor Bindings %
%				 		  %
% Changed by RJG 10-Jan-89 : extensible datatypes %
% Extensible datatypes are defined using the ... constructor %
% These are represented as nullary constructors with	     %
% the dummyAtom as identifier				     %

let semfn (ddd,f) phrl = (
    let phrl = f(phrl) in
        MLClzConstrs(
            map
                (\(dotdotdot,phrl).
		   if dotdotdot then
		          ( dummyAtom, MLSynTypeUnit, true )
	           else
		   let constr = MLNthClassAtom(phrl,1)
		   in
		       case NthOpt(phrl,2) of [|
                        success = phrl . ( constr, MLNthType(phrl,2), false );
                        failure . ( constr, MLSynTypeUnit, true ) |] )
                ((ddd, [hd(phrl);hd(tl(phrl))]) ::
		  map (\phrl.
		      let (| altNum; phrSeq |) = NthAlt (phrl,2) in
		       (if altNum = 1 then (true,[])
		        else (if altNum = 2 then (false,phrSeq)
 		          else   (false,hd(tl(phrSeq)) :: tl(tl(phrSeq))))))
		   (NthRpt(phrl,3)))) ) ? absMLClz [|Eof|]
in (
    MLDeclSyn[HTML;SML]( "Constrs", `Constrs`,
        "   [ class IdeNonfix ]
	    [ opt [ word of ] [ clause ~100 Type ] ]
            [ rpt 0
                [ word | ]
		[ alt 
  	            [ [ word ... ] ]
		    [ [ class IdeNonfix ]
		      [ opt [ word of ] [ clause ~100 Type ] ] ]
                    [ [ word op ] [ class IdeOpfix ] 
		      [ opt [ word of ] [ clause ~100 Type ] ] ] ] ]  ",
        semfn(false,I) );
    MLDeclSyn[HTML;SML]( "Constrs", `Constrs`,
        "   [ word op ]
	    [ class IdeOpfix ] 
	    [ opt [ word of ] [ clause ~100 Type ] ]
            [ rpt 0
                [ word | ]
		[ alt 
  	            [ [ word ... ] ]
		    [ [ class IdeNonfix ]
		      [ opt [ word of ] [ clause ~100 Type ] ] ]
                    [ [ word op ] [ class IdeOpfix ] 
		      [ opt [ word of ] [ clause ~100 Type ] ] ] ] ]  ",
        semfn(false,tl) ); 
    MLDeclSyn[HTML;SML]( "Constrs", `Constrs`,
        "   [ word ... ]
            [ rpt 0
                [ word | ]
		[ alt 
  	            [ [ word ... ] ]
		    [ [ class IdeNonfix ]
		      [ opt [ word of ] [ clause ~100 Type ] ] ]
                    [ [ word op ] [ class IdeOpfix ] 
		      [ opt [ word of ] [ clause ~100 Type ] ] ] ] ]  ",
        semfn(true,\x. hd(x) :: x) ) );
		       % to get around list requirements in semfn %



% Rules for Type Bindings %

MLDeclSyn[SPML;HTML;SML]( "TypeBind", `TypeBind`,
    " [ clause ~60 TypePat ] [ word = ] [ clause ~100 Type ] ",
    \phrl. let (| Bind=b; Params=p |) = MLNthTypePat(phrl,1) in
        MLClzDec(MLSynTypeBindAbbrev( b, p, MLNthType(phrl,3) )) );

MLDeclSyn[SPML;HTML]( "TypeBind", `TypeBind`,
    " [ clause ~60 TypePat ] [ word <=> ] [ clause ~59 Type ] ",
    \phrl.
        let (| Bind=b; Params=p |) = MLNthTypePat(phrl,1)
        enc { atomAbs = absAtom'(`abs`#@repAtom'(b))
        and atomRep = absAtom'(`rep`#@repAtom'(b)) }
        in
            MLClzDec(MLSynDecEnc(
                MLSynTypeBindData( b, p, [(atomAbs,MLNthType(phrl,3),false)], MLLtTokFail ),
                MLSynDecVal(
                    MLSynPatIde(atomRep),
                    MLSynExpFun(MLSynMatch[MLSynRule(
                        MLSynPatAppl(
                            atomAbs, MLSynPatIde(absAtom'(`x`)), Niladic ),
                        MLSynExpIde(absAtom'(`x`)) )]) ) )) );

MLDeclSyn[SPML;HTML;SML]( "TypeBind", `TypeBind`,
    " [ clause ~70 TypeBind ] [ word and ] [ clause ~70 TypeBind ] ",
    \phrl. MLClzDec(MLSynDecAnd( MLNthDec(phrl,1), MLNthDec(phrl,3) )) );

MLDeclSyn[SPML;HTML]( "TypeBind", `TypeBind`,
    " [ word rec ] [ clause ~70 TypeBind ] ",
    \phrl. MLClzDec(MLSynDecRec( MLNthDec(phrl,2) )) );

MLDeclSyn[SPML;HTML]( "TypeBind", `TypeBind`,
    " [ clause ~80 TypeBind ] [ word enc ] [ clause ~80 TypeBind ] ",
    \phrl. MLClzDec(MLSynDecEnc( MLNthDec(phrl,1), MLNthDec(phrl,3) )) );

MLDeclSyn[SPML;HTML]( "TypeBind", `TypeBind`,
    " [ clause ~80 TypeBind ] [ word ins ] [ clause ~80 TypeBind ] ",
    \phrl. MLClzDec(MLSynDecIns( MLNthDec(phrl,1), MLNthDec(phrl,3) )) );

MLDeclSyn[SPML;HTML]( "TypeBind", `TypeBind`,
    "  [ word { ] [ clause ~100 TypeBind ] [ word } ] ",
    \phrl. NthClz(phrl,2) );




% Rules for Datatype Bindings %

app
    (\MLBld. MLDeclSyn[MLBld]( "DatatypeBind", `DatatypeBind`,
        " [ clause ~60 TypePat ] [ word = ] [ clause ~100 Constrs ] ",
        \phrl.
            let (| Bind=b; Params=p |) = MLNthTypePat(phrl,1)
            enc constrs = MLNthConstrs(phrl,3)
            enc _ =
                app
                    (\(constr,ty,implicit).
                        MLEffectNewSyn MLBld (
                            repAtom'(constr),
                            [| IdeStatus =
                                if implicit then [|Konst|] else [|Constr|]
                            |] ) )
                    constrs
            in 
                MLClzDec(MLSynTypeBindData(b,p,constrs,MLLtTokFail)) ))
    [HTML;SML];

MLDeclSyn[HTML;SML]( "DatatypeBind", `DatatypeBind`,
    " [ clause ~70 DatatypeBind ] [ word and ] [ clause ~70 DatatypeBind ] ",
    \phrl. MLClzDec(MLSynDecAnd( MLNthDec(phrl,1), MLNthDec(phrl,3) )) );




% Rules for Exception Bindings %
%RJG 06-Mar-89%
MLDeclSyn[HTML;SML]( "ExcBind", `ExcBind`,
    "   [ class Ide ]
        [ opt
	    [ alt [ [ word of ] [ clause ~100 Type ] ]     
                  [ [ word =  ] [ class Ide ] ]
            ]
        ] ",
    \phrl.
    let excon = MLNthClassAtom(phrl,1)
    enc ddd = (dummyAtom, MLSynTypeUnit, true)
    in
	case NthOpt(phrl,2) of [|
	  failure . MLClzDec(MLSynTypeBindData(
                    AtomXn,[], [ddd; (excon, MLSynTypeUnit, true)],
					       MLLtTokFail));
	  success = phrl .
	     let (| altNum; phrSeq |) = NthAlt (phrl,1)
	     in if altNum = 1
	     then MLClzDec(MLSynTypeBindData(
		    AtomXn,[],
                    [ddd; (excon, MLNthType(phrSeq,2), false)],
                    MLLtTokFail))
	     else MLClzDec(MLSynDecConBind(excon,
                                           MLNthClassAtom(phrSeq,2)))
        |]);


MLDeclSyn[HTML;SML]( "ExcBind", `ExcBind`,
    " [ clause ~70 ExcBind ] [ word and ] [ clause ~70 ExcBind ] ",
    \phrl. MLClzDec(MLSynDecAnd(
        MLNthDec(phrl,1), MLNthDec(phrl,3) )) );




% Rules for (Possibly Empty) Declarations %

MLDeclSyn[HTML;SML]( "Dec Top", `Dec`, " [ word [empty] ] ",
    \phrl. MLClzDec(MLSynDecEmpty()) );

MLDeclFunctionalInitialSynForWord[SPML;HTML]( `(`, "Dec", MLSemfnParen );




% Rules for Non-empty Declarations %

MLDeclSyn[SPML;HTML]( "NonemptyDec Dec", `NonemptyDec`,
    "   [ clause ~70 ValBind FunBind NonemptyDec Dec ]
        [ word and ]
        [ clause ~70 Dec ] ",
    \phrl. MLClzDec(MLSynDecAnd( MLNthDec(phrl,1), MLNthDec(phrl,3) )) );

MLDeclSyn[SPML;HTML]( "NonemptyDec Dec", `NonemptyDec`,
    " [ word rec ] [ clause ~70 Dec ] ",
    \phrl. MLClzDec(MLSynDecRec( MLNthDec(phrl,2) )) );

MLDeclSyn[HTML;SML](
    "NonemptyDec Dec NonemptyTopDec Top",
    `NonemptyDec`,
    " [ word val ] [ clause ~100 ValBind ] ",
    \phrl. NthClz(phrl,2) );

MLDeclSyn[HTML;SML](
    "NonemptyDec Dec  NonemptyTopDec Top",
    `NonemptyDec`,
    " [ word fun ] [ clause ~100 FunBind ] ",
    \phrl. MLClzDec(MLSynDecRec( MLNthDec(phrl,2) )) );

let semfn phrl = NthClz(phrl,2) in (
    MLDeclSyn[SPML;HTML]( "NonemptyDec Dec NonemptyTopDec Top", `NonemptyDec`,
        " [ word type ] [ clause ~70 TypeBind ] ",
        semfn );
    MLDeclSyn[SML](
        "NonemptyDec Dec  NonemptyTopDec Top",
        `NonemptyDec`,
        " [ word type ] [ clause ~100 TypeBind ] ",
        semfn ) );

MLDeclSyn[HTML;SML](
    "NonemptyDec Dec  NonemptyTopDec Top",
    `NonemptyDec`,
    " [ word datatype ] [ clause ~100 DatatypeBind ] 
      [ opt [ word withtype ] [ clause ~100 TypeBind ] ] ",
    \phrl. let dec = MLSynDecRec( MLNthDec(phrl,2) ) in
       case NthOpt(phrl, 3) of [|
       success=phrl.
          MLClzDec(MLSynDecRec(MLSynDecAnd( dec, MLNthDec(phrl, 2) )));
       failure. MLClzDec(dec) |] );

let fml1 = MLMakeFormSeq(" [ word abstype ] [ clause ~100 DatatypeBind ] ")
and fml2 = MLMakeFormSeq(" [ word with ] [ clause ~110 Dec ] [ word end ] ")
in
    MLDeclFunctionalInitialSynForWord[HTML;SML]( `abstype`,
        "NonemptyDec Dec  NonemptyTopDec Top",
        \ss.
            let MLBld = BldOfSynStream(ss)
            enc readFormSeq = ReadFormSeqSynStream(ss) in
                \tt.
                    let () = MLPushLocalSynEnv()
                    enc phrl1 = readFormSeq(fml1,tt)
                    enc () = MLPushLocalSynEnv()
                    enc phrl2 = readFormSeq(fml2,tt)
                    enc () = MLAdjustLocalSynEnvAfterLocal(MLBld)
                    in
                        (   MLClzDec(MLSynDecWith(
                                MLSynDecRec(MLNthDec(phrl1,2)),
                                MLNthDec(phrl2,2) )),
                            MLSyclNonemptyDec ) );

%RJG 06-Mar-89 new exceptions (less the shorthand declaration form)%
MLDeclSyn[HTML;SML](
    "NonemptyDec Dec  NonemptyTopDec Top",
    `NonemptyDec`,
    " [ word exception ] [ clause ~100 ExcBind ] ",
    \phrl. MLClzDec(MLSynDecRec(MLNthDec(phrl,2))));


let fml1 = MLMakeFormSeq(" [ word local ] [ clause ~110 Dec ] ")
and fml2 = MLMakeFormSeq(" [ word in ] [ clause ~110 Dec ] [ word end ] ")
in
    MLDeclFunctionalInitialSynForWord[HTML;SML]( `local`,
        "NonemptyDec Dec  NonemptyTopDec Top",
        \ss.
            let MLBld = BldOfSynStream(ss)
            enc readFormSeq = ReadFormSeqSynStream(ss) in
            \tt.
                let () = MLPushLocalSynEnv()
                enc phrl1 = readFormSeq(fml1,tt)
                enc () = MLPushLocalSynEnv()
                enc phrl2 = readFormSeq(fml2,tt)
                enc () = MLAdjustLocalSynEnvAfterLocal(MLBld)
                in
                    (   MLClzDec(MLSynDecIns(
                            MLNthDec(phrl1,2), MLNthDec(phrl2,2) )),
                        MLSyclNonemptyDec ) );

let MLDefaultBp = 0;

let MLNthBp(phrl,n) =
    case NthOpt(phrl,n) of [|
    success = phrl . MLNthClassInt(phrl,1);
    failure . MLDefaultBp |];

let MLProcessSyntaxExtra(t,o) =
    case o of [|
    success = phrl .
        AddToDictionary(
            MLExtraSyntaxDict,
            t,
            (| opcode=MLNthClassInt(phrl,1); arity=MLNthClassInt(phrl,2) |) );
    failure . () |];

let MLSemfnAnyfix (MLBld,f,n) phrl =
    let opStatus = f(phrl)
    and opt = NthOpt(phrl,n+1)
    in
        MLClzDec(MLSynDecDir(
            app
                (\phrl. let wd = MLNthClassWord(phrl,1) in (
                    MLProcessSyntaxExtra(wd,opt);
                    MLEffectNewSyn MLBld (wd,[|OpStatus=opStatus|]) ) )
                (NthRpt(phrl,n)) ));

%RJG fix insufficient repetition - use of rpt 0 instead of rpt 1 in 
 infix/nonfix declarations - SML only initially%
let MLSemfnAnyfixsml (MLBld,f,n) phrl =  %n is position of single ide%
    let opStatus = f(phrl)
    and opt = NthOpt(phrl,n+2)
    and wds = MLNthClassWord(phrl,n) :: 
              map (\phrl.MLNthClassWord(phrl,1)) (NthRpt(phrl,n+1))
    in
        MLClzDec(MLSynDecDir(
            app
                (\wd. (
                    MLProcessSyntaxExtra(wd,opt);
                    MLEffectNewSyn MLBld (wd,[|OpStatus=opStatus|]) ) )
                wds ));

let MLNthSMLPrec(phrl,n) =
    let p = MLNthBp(phrl,n) in
        if (p>=0) And (p<=9) then 10 * p
        else ParseFailFatal[| other = `Precedence out of range 0..9` |];

app
    (\MLBld. (
        MLDeclSyn[MLBld](
            "NonemptyDec Dec  NonemptyTopDec Top",
            `NonemptyDec`,
            "   [ word nonfix ]
                [ class Ide ]
                [ rpt 0 [ class Ide ] ]
                [ opt [ class Int ] [ class Int ] ] ",
            MLSemfnAnyfixsml( MLBld, (\phrl.[|Nonfix|]), 2 ) );
        MLDeclSyn[MLBld](
            "NonemptyDec Dec  NonemptyTopDec Top",
            `NonemptyDec`,
            "   [ word infix ]
                [ opt [ class Int ] ]
                [ class Ide ]
                [ rpt 0 [ class Ide ] ]
                [ opt [ class Int ] [ class Int ] ] ",
            MLSemfnAnyfixsml(
                MLBld,
                (\phrl. let n = MLNthSMLPrec(phrl,2) in [|Infix=(n,n+1)|]),
                3 ) );
        MLDeclSyn[MLBld](
            "NonemptyDec Dec  NonemptyTopDec Top",
            `NonemptyDec`,
            "   [ word infixr ]
                [ opt [ class Int ] ]
                [ class Ide ]
                [ rpt 0 [ class Ide ] ]
                [ opt [ class Int ] [ class Int ] ] ",
            MLSemfnAnyfixsml(
                MLBld,
                (\phrl. let n = MLNthSMLPrec(phrl,2) in [|Infix=(n,n)|]),
                3 ) ) ) )
    [SML];
app
    (\MLBld. (
        MLDeclSyn[MLBld](
            "NonemptyDec Dec  NonemptyTopDec Top",
            `NonemptyDec`,
            "   [ word nonfix ]
                [ rpt 1 [ class Ide ] ]
                [ opt [ class Int ] [ class Int ] ] ",
            MLSemfnAnyfix( MLBld, (\phrl.[|Nonfix|]), 2 ) );
        MLDeclSyn[MLBld](
            "NonemptyDec Dec  NonemptyTopDec Top",
            `NonemptyDec`,
            "   [ word infix ]
                [ opt [ class Int ] ]
                [ rpt 1 [ class Ide ] ]
                [ opt [ class Int ] [ class Int ] ] ",
            MLSemfnAnyfix(
                MLBld,
                (\phrl. let n = MLNthSMLPrec(phrl,2) in [|Infix=(n,n+1)|]),
                3 ) );
        MLDeclSyn[MLBld](
            "NonemptyDec Dec  NonemptyTopDec Top",
            `NonemptyDec`,
            "   [ word infixr ]
                [ opt [ class Int ] ]
                [ rpt 1 [ class Ide ] ]
                [ opt [ class Int ] [ class Int ] ] ",
            MLSemfnAnyfix(
                MLBld,
                (\phrl. let n = MLNthSMLPrec(phrl,2) in [|Infix=(n,n)|]),
                3 ) ) ) )
    [HTML];
app
    (\MLBld. (
        MLDeclSyn[MLBld]( "NonemptyDec Dec NonemptyTopDec Top", `NonemptyDec`,
            "   [ word prefix ]
                [ opt [ class Int ] ]
                [ rpt 1 [ class Ide ] ]
                [ opt [ class Int ] [ class Int ] ] ",
            MLSemfnAnyfix(
                MLBld,
                (\phrl. [| Prefix = MLNthSMLPrec(phrl,2) |]),
                3 ) );
        MLDeclSyn[MLBld]( "NonemptyDec Dec NonemptyTopDec Top", `NonemptyDec`,
            "   [ word suffix ]
                [ opt [ class Int ] ]
                [ rpt 1 [ class Ide ] ]
                [ opt [ class Int ] [ class Int ] ] ",
            MLSemfnAnyfix(
                MLBld,
                (\phrl. [| Suffix = MLNthSMLPrec(phrl,2) |]),
                3 ) ) ) )
    [HTML];

let MLSemfnDecEnc phrl =
    MLClzDec(MLSynDecEnc( MLNthDec(phrl,1), MLNthDec(phrl,3) ));

MLDeclSyn[SPML;HTML]( "NonemptyDec Dec", `NonemptyDec`,
    "   [ clause ~80 ValBind FunBind NonemptyDec Dec ]
        [ word enc ]
        [ clause ~80 Dec ] ",
    MLSemfnDecEnc );

MLDeclSyn[SPML;HTML]( "NonemptyDec Dec", `NonemptyDec`,
    "   [ clause ~80 ValBind FunBind NonemptyDec Dec ]
        [ word ins ]
        [ clause ~80 Dec ] ",
    \phrl. MLClzDec(MLSynDecIns( MLNthDec(phrl,1), MLNthDec(phrl,3) )) );

MLDeclSyn[SPML;HTML]( "NonemptyDec Dec", `NonemptyDec`,
    "   [ clause ~80 ValBind FunBind NonemptyDec Dec ]
        [ word with ]
        [ clause ~80 Dec ] ",
    \phrl. MLClzDec(MLSynDecWith( MLNthDec(phrl,1), MLNthDec(phrl,3) )) );

MLDeclSyn[HTML;SML]( "NonemptyDec Dec", `NonemptyDec`,
    "[ clause ~100 NonemptyDec ] [ word [empty] ] [ clause ~100 NonemptyDec ]",
    MLSemfnDecEnc );

MLDeclSyn[HTML;SML]( "NonemptyDec Dec", `NonemptyDec`,
    " [ clause ~110 NonemptyDec Dec ] [ word ; ] [ clause ~110 Dec ] ",
    MLSemfnDecEnc );

MLDeclSyn[SPML;HTML]( "NonemptyDec Dec", `NonemptyDec`,
    " [ word { ] [ clause ~120 Dec ] [ word } ] ",
    \phrl. NthClz(phrl,2) );

MLDeclFunctionalInitialSynForWord[SPML;HTML](`(`,"NonemptyDec",MLSemfnParen);


MLDeclSyn[SML]( "NonemptyTopDec Top", `NonemptyTopDec`,
    "   [ word overload ] [ class Ide ] [ word : ] [ clause ~100 Type ] ",
    \phrl. 
        let idname = MLNthClassAtom(phrl,2)
        and overtype = MLNthType(phrl,4)
        in MLClzDec(MLSynDecDir(Do(MLOverload(idname,overtype)))) );



% Rules for Signatures %

% Rules for Structures %

% Rules for Non-empty Structure (and Abstraction) Level Declarations %

% Rules for Non-empty Top Level Declarations %


MLDeclSyn[HTML;SML]( "NonemptyTopDec Top", `NonemptyTopDec`,
    "   [ clause ~100 NonemptyDec  NonemptyTopDec ]
        [ word [empty] ]
        [ clause ~100 NonemptyTopDec ] ",
    % "ValBind & FunBind" inapplicable in SML %
    MLSemfnDecEnc );




% Rules for Top Level Declarations and Expressions %

let fmlSPML = MLMakeFormSeq(
    "   [ word let ] [ clause ~100 Dec ]
        [ opt [ word in ] [ clause ~80 Exp ] ] " )
and fmlHTML = MLMakeFormSeq(
    "   [ word let ] [ clause ~100 Dec ]
        [ opt
            [ word in ] [ clause ~80 Exp ]
            [ opt [ word end ] ] ] " )
and semfn fml ss =
    let MLBld = BldOfSynStream(ss)
    and readFormSeq = ReadFormSeqSynStream(ss)
    in
        \tt.
            let () = MLPushLocalSynEnv()
            enc phrl = readFormSeq(fml,tt)
            enc d = MLNthDec(phrl,2)
            in
                case NthOpt(phrl,3) of [|
                success = phrl .
                    let () = MLPopLocalSynEnv(MLBld) in (
                        MLClzExp(MLSynExpLet( d, MLNthExp(phrl,2) )),
                        MLSyclAExp );
                failure .
                    let () = MLJoinLocalSynEnv() in
                        ( MLClzDec(d), MLSyclTop ) |]
in (
    MLDeclFunctionalInitialSynForWord[SPML]( `let`, "Top", semfn(fmlSPML) );
    MLDeclFunctionalInitialSynForWord[HTML]( `let`, "Top", semfn(fmlHTML) ) );


let MLProcessSyntax MLBld phrl = MLClzDec(MLSynDecDir(
    app
        (\phrl.
            let phrl = NthAlt(phrl,1).phrSeq
            enc k = MLNthWord(phrl,1)
            enc (wd,opStatus) = (
                if k=`nonfix` then
                    let wd = MLNthClassWord(phrl,2) in (
                        MLProcessSyntaxExtra(wd,NthOpt(phrl,3));
                        ( wd, [|Nonfix|] ) )
                else if k=`prefix` then
                    let wd = MLNthClassWord(phrl,2) in (
                        MLProcessSyntaxExtra(wd,NthOpt(phrl,4));
                        ( wd, [|Prefix=MLNthBp(phrl,3)|] ) )
                else if k=`infix` then
                    let wd = MLNthClassWord(phrl,3) in (
                        MLProcessSyntaxExtra(wd,NthOpt(phrl,5));
                        % N.B. the translation of precedence on the next line %
                        (   wd,
                            [| Infix =
                                ( MLNthBp(phrl,2)-1, MLNthBp(phrl,4) ) |] ) )
                else failwith `impossible!` ): Word # MLOpStatus
            in
                MLEffectNewSyn MLBld ( wd, [| OpStatus = opStatus |] ) )
        (NthRpt(phrl,2)) ));

app
    (\MLBld.
        MLDeclSyn[MLBld]( "Top", `Top`,
            "   [ word syntax ]
                [ rpt 0
                    [ alt
                        [   [ word nonfix ]
                            [ class Ide ]
                            [ opt [ class Int ] [ class Int ] ] ]
                        [   [ word prefix ]
                            [ class Ide ]
                            [ opt [ class Int ] ]
                            [ opt [ class Int ] [ class Int ] ] ]
                        [   [ word infix ]
                            [ opt [ class Int ] ]
                            [ class Ide ]
                            [ opt [ class Int ] ]
                            [ opt [ class Int ] [ class Int ] ] ] ] ] ",
            MLProcessSyntax MLBld ) )
    [SPML;HTML];

MLDeclSyn[SPML;HTML;SML]( "Top", `Top`, " [ class Eof ] ", \phrl. MLClzEof );




% -------------------------------------------------------------------------- %
%                           End of Syntax Rules                              %
% -------------------------------------------------------------------------- %





% ML Abstract Syntax Stream package %

let type MLLex'Memstr = (MLLexMode,MLLex')Memstr;

let lex'Err = Lex'OfValidTok(SML,`<?>`)

ins MLReadClzTop(synStream: MLSynStream): MLClz =
    let MLBld = BldOfSynStream(synStream)
    and readClz = ReadClzSynStream(synStream)
    and readLex' = ReadLex'SynStream(synStream)
    in (
        BreakSynStream(synStream);
        ParseFailRef := [|none|];
            %Should this be in the structure of some stream?%
        ( let cl = readClz(MLSyclTop,~100) in (
            if repMLClz(cl) is Eof then (
                Do(readLex'(absMLLexMode[|Expr|])); %Throw away extra eof%
                failwith `eof` )
            else ();
            let lx = LexOfLex'(readLex'(absMLLexMode[|Expr|])) in
                if MLLexHasWord(lx,`;`) Or (repMLLex(lx) is Eof) then cl
                else ParseFailFatal[|word=`;`|] ) )
        ?? "Scan" (newline(2);
            outtok(`Lexical analysis error:`); newline(1);
            outtok(`    Invalid or unexpected character,`);
            outtok(` or number out of range`); 
            newline(2);
            ReEnter() )
        ?? "Parse FatalParse" (
            newline(2);
            outtok(`Parse error:`); newline(1);
            space(4); OutParseFail(MLBld,!ParseFailRef); newline(2);
            outtok(`In:  ...`);
            let l = Lex'MemstrListSynStream(synStream) in
                MLOutPartRevLex'List( 16, hd(l)::lex'Err::tl(l) );
            newline(2);
            failwith `FatalParse` ) );

let rec MLReadSynDecl(sysState) =
    let synStream = SynStreamOfSysState(sysState)
    enc MLBld = BldOfSynStream(synStream)
    in
        case
            ( [| success = MLReadClzTop(synStream) |]
            ?? "FatalParse" [| failure |]
            ?? "eof" [| eof |]
            ?? "EndOfInput" failwith `CtrlZ` ):
                [| success: 'a; failure: 'b; eof: 'c |]
        of [|
        success = cl . repMLClz(cl) as Dec;
        eof . MLReadSynDecl(sysState);
        failure . ( %skip'past([|Nonide=`;`|]);% failwith `Reenter` ) |];
