Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] View of /sml/trunk/benchmarks/programs/logic/get.sml
ViewVC logotype

View of /sml/trunk/benchmarks/programs/logic/get.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 193 - (download) (annotate)
Fri Nov 20 17:43:59 1998 UTC (21 years, 7 months ago) by monnier
File size: 930 byte(s)
Initial revision
(* get.sml *)

structure Get = 
struct
  local
    open Term Trail Unify
  in
	fun get_structure (t, c, n) sc =
	    let
		fun newrefs 0 = nil
		  | newrefs n = REF(ref(NONE))::newrefs(n-1)

		fun gs (REF(r)) =
		    let
			val ts = newrefs n
		    in
			(bind(r, STR(c, ts));
			 sc ts)
		    end
		  | gs (STR(f,args)) =
		    if (c = f)
			then sc (args)
		    else ()
		  | gs _ = raise BadArg "get_structure"
	    in
		gs (deref t)
	    end

	fun get_const (t, c) sc =
	   let
	      fun gs (REF(r)) =
		 (bind(r, CON c);
		  sc ())
		| gs (CON(f)) =
		 if (c = f) then
		    sc ()
		 else ()
		| gs _ = raise BadArg "get_const"
	   in
	      gs (deref t)
	   end

	fun get_integer (t, c) sc =
	   let
	      fun gs (REF(r)) =
		 (bind(r, INT c);
		  sc ())
		| gs (INT(f)) =
		 if (c = f) then
		    sc ()
		 else ()
		| gs _ = raise BadArg "get_integer"
	   in
	      gs (deref t)
	   end
  end (* local *)
end; (* Get *)


root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0