1 files changed, 114 insertions, 0 deletions
diff --git a/ipl/packs/skeem/skfun.icn b/ipl/packs/skeem/skfun.icn
new file mode 100644
index 0000000..f5bec79
--- /dev/null
+++ b/ipl/packs/skeem/skfun.icn
@@ -0,0 +1,114 @@
+############################################################################
+#
+#	Name:	skfun.icn
+#
+#	Title:	Scheme in Icon
+#
+#	Author: Bob Alexander
+#
+#	Date:	March 23, 1995
+#
+#	Description: see skeem.icn
+#
+############################################################################
+
+#
+# skeem -- Scheme in Icon
+#
+
+#
+# Function/syntax list format
+#
+# Each function and syntax defined appears in a definition list which is
+# processed at skeem-initialization time.  The following are the rules
+# for function/syntax list entries:
+#
+#  -  Each entry begins with a procedure name and ends just preceding
+#     the next procedure name or the end of the list.
+#     - Rules regarding number of arguments:
+#	 -  If an entry contains the object "oneOrMore", then it requires
+#	    at least one argument.
+#	 -  If an entry contains the object "twoOrMore", then it requires
+#	    at least two arguments.
+#	 -  If an entry contains one number N, it requires exactly N
+#	    arguements.
+#	 -  If an entry contains a number N followed by &null, the function
+#	    requires at least N arguments.
+#	 -  If an entry contains a number N followed by a number M, the
+#	    function requires at least N arguments but can take no more than
+#	    M arguments.
+#	 -  If an entry contains no numbers but contains &null, the function
+#	    can take any number of arguments.
+#	 -  If an entry contains no numbers and no &null, the procedure
+#	    requires exactly one argument.
+#     -  If an entry contains a string, then that string is used as the
+#	 function's skeem-name rather that the name calculated from its
+#	 Icon procedure name.
+#
+
+procedure InitFunctions()
+   every (
+	 InitBasic |	      # basic syntaxes		    skbasic.icn
+	 InitControl |	      # control functions	    skcontrl.icn
+	 InitIO |	      # I/O functions		    skio.icn
+	 InitList |	      # list & vector functions     sklist.icn
+	 InitMisc |	      # misc functions		    skmisc.icn
+	 InitNumber |	      # number functions	    sknumber.icn
+	 InitString |	      # string and char functions   skstring.icn
+	 \!InitUser())()      # user-defined functions	    skuser.icn
+end
+
+procedure DefFunction(prcList,funType)
+   local item,funName,prc,minArgs,maxArgs,gotNull,special
+   /funType := Function
+   prc := get(prcList)
+   while \prc do {
+      funName := minArgs := maxArgs := gotNull := special := &null
+      repeat {
+	 (item := get(prcList)) | {
+	    item := &null
+	    break
+	    }
+	 if type(item) == "procedure" then break
+	 if type(item) == "integer" then /minArgs | maxArgs := item
+	 else if /item then gotNull := "true"
+	 else if type(item) == "string" then
+	    (if item == ("oneOrMore" | "twoOrMore") then special
+		  else funName) := item
+	 }
+      if special === "oneOrMore" then minArgs := 1
+      else if special === "twoOrMore" then  minArgs := 2
+      else if /minArgs then
+	 if \gotNull then minArgs := 0
+	 else minArgs := maxArgs := 1
+      else if /gotNull then
+	 /maxArgs := minArgs
+      /funName := ProcName(prc)
+      #write("+++ ",funName,": ",image(prc),", ",image(minArgs),", ",
+      #     image(maxArgs))
+      DefVar(funName,funType(prc,funName,minArgs,maxArgs))
+      prc := item
+      }
+   return
+end
+
+procedure DefSyntax(prc)
+   return DefFunction(prc,Syntax)
+end
+
+procedure ProcName(prc)
+   local nm
+   image(prc) ? {
+      tab(find(" ") + 1)
+      nm := ""
+      while nm ||:= tab(find("_")) do {
+	 move(1)
+	 nm ||:= if ="BANG" & pos(0) then "!"
+	    else if ="2_" then "->"
+	    else if ="P" & pos(0) then "?"
+	    else "-"
+	 }
+      nm ||:= tab(0)
+      }
+   return nm
+end