Command defined. It does nothing yet.

4 files changed, 120 insertions, 1 deletions

diff --git a/doc/const.n b/doc/const.n
new file mode 100644
index 0000000..e388a4d
--- /dev/null
+++ b/doc/const.n
@@ -0,0 +1,83 @@
+'\"
+'\" Copyright (c) 2023 Donal K. Fellows
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+.TH const n 9.0 Tcl "Tcl Built-In Commands"
+.so man.macros
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+const \- create and initialize a constant
+.SH SYNOPSIS
+\fBconst \fIvarName value\fR
+.BE
+.SH DESCRIPTION
+.PP
+This command is normally used within a procedure body (or method body, 
+or lambda term) to create a constant within that procedure, or within a 
+\fBnamespace eval\fR body to create a constant within that namespace. 
+The constant is an unmodifiable variable, called \fIvarName\fR, that is 
+initialized with \fIvalue\fR.
+.PP
+If a variable \fIvarName\fR does not exist, it is created.
+If the variable already exists, it is set to \fIvalue\fR.
+The variable is marked as a constant; this means that no other command
+(e.g., \fBset\fR, \fBappend\fR, \fBincr\fR, \fBunset\fR)
+may modify or remove the variable; variables are checked for whether they 
+are constants before any traces are called.
+.PP
+The \fIvarName\fR may not be a qualified name or reference an element of an 
+array by any means. If the variable exists and is an array, that is an error.
+.PP
+Constants are normally only removed by their containing procedure exiting or 
+their namespace being deleted.
+.SH EXAMPLES
+.PP
+Create a constant in a procedure:
+.PP
+.CS
+proc foo {a b} {
+    \fBconst\fR BAR 12345
+    return [expr {$a + $b + $BAR}]
+}
+.CE
+.PP
+Create a constant in a namespace to factor out a regular expression:
+.PP
+.CS
+namespace eval someNS {
+    \fBconst\fR FOO_MATCHER {(?i)}\emfoo\eM}
+
+    proc findFoos str {
+        variable FOO_MATCHER
+        regexp -all $FOO_MATCHER $str
+    }
+
+    proc findFooIndices str {
+        variable FOO_MATCHER
+        regexp -all -indices $FOO_MATCHER $str
+    }
+}
+.CE
+.PP
+Making a constant in a loop doesn't error:
+.PP
+.CS
+proc foo {n} {
+    set result {}
+    for {set i 0} {$i < $n} {incr i} {
+        \fBconst\fR X 123
+	lappend result [expr {$X + $i**2}]
+    }
+}
+.CE
+.SH "SEE ALSO"
+proc(n), namespace(n), set(n), unset(n)
+.SH KEYWORDS
+namespace, procedure, variable, constant
+.\" Local variables:
+.\" mode: nroff
+.\" fill-column: 78
+.\" End:
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index b6cbd89..eab810d 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -316,6 +316,7 @@ static const CmdInfo builtInCmds[] = {
     {"break",		Tcl_BreakObjCmd,	TclCompileBreakCmd,	NULL,	CMD_IS_SAFE},
     {"catch",		Tcl_CatchObjCmd,	TclCompileCatchCmd,	TclNRCatchObjCmd,	CMD_IS_SAFE},
     {"concat",		Tcl_ConcatObjCmd,	TclCompileConcatCmd,	NULL,	CMD_IS_SAFE},
+    {"const", 		Tcl_ConstObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
     {"continue",	Tcl_ContinueObjCmd,	TclCompileContinueCmd,	NULL,	CMD_IS_SAFE},
     {"coroinject",	NULL,			NULL,                   TclNRCoroInjectObjCmd,	CMD_IS_SAFE},
     {"coroprobe",	NULL,			NULL,                   TclNRCoroProbeObjCmd,	CMD_IS_SAFE},
@@ -333,7 +334,7 @@ static const CmdInfo builtInCmds[] = {
     {"join",		Tcl_JoinObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
     {"lappend",		Tcl_LappendObjCmd,	TclCompileLappendCmd,	NULL,	CMD_IS_SAFE},
     {"lassign",		Tcl_LassignObjCmd,	TclCompileLassignCmd,	NULL,	CMD_IS_SAFE},
-    {"ledit",		Tcl_LeditObjCmd,	NULL,	NULL,	CMD_IS_SAFE},
+    {"ledit",		Tcl_LeditObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
     {"lindex",		Tcl_LindexObjCmd,	TclCompileLindexCmd,	NULL,	CMD_IS_SAFE},
     {"linsert",		Tcl_LinsertObjCmd,	TclCompileLinsertCmd,	NULL,	CMD_IS_SAFE},
     {"list",		Tcl_ListObjCmd,		TclCompileListCmd,	NULL,	CMD_IS_SAFE|CMD_COMPILES_EXPANDED},
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 8835060..cee419a 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -3658,6 +3658,7 @@ MODULE_SCOPE void	TclClockInit(Tcl_Interp *interp);
 MODULE_SCOPE Tcl_ObjCmdProc TclClockOldscanObjCmd;
 MODULE_SCOPE Tcl_ObjCmdProc Tcl_CloseObjCmd;
 MODULE_SCOPE Tcl_ObjCmdProc Tcl_ConcatObjCmd;
+MODULE_SCOPE Tcl_ObjCmdProc Tcl_ConstObjCmd;
 MODULE_SCOPE Tcl_ObjCmdProc Tcl_ContinueObjCmd;
 MODULE_SCOPE Tcl_TimerToken TclCreateAbsoluteTimerHandler(
 			    Tcl_Time *timePtr, Tcl_TimerProc *proc,
diff --git a/generic/tclVar.c b/generic/tclVar.c
index e952614..7922a69 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.c
@@ -4842,6 +4842,40 @@ Tcl_GetVariableFullName(
 /*
  *----------------------------------------------------------------------
  *
+ * Tcl_ConstObjCmd --
+ * 
+ *	This function is invoked to process the "const" Tcl command.
+ *	See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl object result value.
+ *
+ * Side effects:
+ *	See the user documentation.
+ * 
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_ConstObjCmd(
+    TCL_UNUSED(void *),
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
+{
+    if (objc != 3) {
+	Tcl_WrongNumArgs(interp, 1, objv, "varName value");
+	return TCL_ERROR;
+    }
+
+    /* FIXME: implement this! */
+    Tcl_SetObjResult(interp, Tcl_ObjPrintf("not yet implemented"));
+    return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * Tcl_GlobalObjCmd --
  *
  *	This object-based function is invoked to process the "global" Tcl