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/branches/arith64/compiler/Elaborator/basics/conrep.sml
ViewVC logotype

View of /sml/branches/arith64/compiler/Elaborator/basics/conrep.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 4874 - (download) (annotate)
Fri Oct 5 14:33:11 2018 UTC (10 months, 2 weeks ago) by jhr
File size: 1472 byte(s)
  merge in edits from trunk
(* conrep.sml
 *
 * COPYRIGHT (c) 2018 The Fellowship of SML/NJ (http://www.smlnj.org)
 * All rights reserved.
 *)

signature CONREP =
  sig

    val infer : bool -> (Symbol.symbol * bool * Types.ty) list
                     -> (Access.conrep list * Access.consig)

  end (* signature CONREP *)


structure ConRep : CONREP =
  struct

    open Access Types

    fun notconst(_,b,_) = not b

    fun count l = foldl (fn (c,acc) => if notconst c then acc+1 else acc) 0 l

    (* the first argument indicates whether this is a recursive datatype *)
    fun infer false ([(_, false, CONty(_,[_,_]))]) =
	([UNTAGGED], CSIG(1,0)) (* [TRANSPARENT] *)
	  (* The TRANSPARENT conrep is temporarily turned off;
	     it should be working very soon. Ask zsh. *)

      | infer _ cons =
	  let val multiple = (count cons) > 1

	      fun decide (ctag,vtag, (_,true,_)::rest, reps) =
		    if multiple andalso !ElabControl.boxedconstconreps
		    then decide(ctag, vtag+1, rest, (TAGGED vtag) :: reps)
		    else decide(ctag+1, vtag, rest, (CONSTANT ctag) :: reps)
		| decide (ctag,vtag, (_,false,CONty(_,[_,_]))::rest, reps) =
		    if multiple
		    then decide(ctag, vtag+1, rest, (TAGGED vtag) :: reps)
		    else decide(ctag, vtag+1, rest, (UNTAGGED :: reps))
		| decide (_, _, _::_, _) =
		    ErrorMsg.impossible "Conrep: unexpected conrep-decide"
		| decide (ctag, vtag, [], reps) = (rev reps, CSIG(vtag,ctag))

	   in decide(0, 0, cons, [])
	  end

end (* structure ConRep *)

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