CVS: sml-dist/src/compiler/Semant/pickle pickmod-new.sml, 1.27.4.1, 1.27.4.2 unpickmod-new.sml, 1.24.4.1, 1.24.4.2

David MacQueen <[email protected]> Mon, 10 Jul 2006 15:27:15 -0700
Newsgroups gmane.comp.lang.sml.smlnj.commits
Message-ID <[email protected]>
Update of /cvsroot/smlnj/sml-dist/src/compiler/Semant/pickle
In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv7775/src/compiler/Semant/pickle

Modified Files:
      Tag: primop-branch-2
	pickmod-new.sml unpickmod-new.sml 
Log Message:
further changes to primops, starting on translate.sml

Index: pickmod-new.sml
===================================================================
RCS file: /cvsroot/smlnj/sml-dist/src/compiler/Semant/pickle/pickmod-new.sml,v
retrieving revision 1.27.4.1
retrieving revision 1.27.4.2
diff -C2 -d -r1.27.4.1 -r1.27.4.2
*** pickmod-new.sml	7 Jul 2006 21:06:10 -0000	1.27.4.1
--- pickmod-new.sml	10 Jul 2006 22:27:13 -0000	1.27.4.2
***************
*** 138,146 ****
      val (NK, AO, CO, PO, CS, A, CR, LT, TC, TK,
  	 V, C, E, FK, RK, ST, MI, EQP, TYCKIND, DTI,
! 	 DTF, TYCON, T, II, VAR, SD, SG, FSG,  SP, EN,
  	 STR, F, STE, TCE, STRE, FE, EE, ED, EEV, FX,
  	 B, DCON, DICT, FPRIM, FUNDEC, TFUNDEC, DATACON, DTMEM, NRD,
  	 OVERLD, FCTC, SEN, FEN, SPATH, IPATH, STRID, FCTID, CCI, CTYPE,
!          CCALL_TYPE) =
  	(1, 2, 3, 4, 5, 6, 7, 8, 9, 10,
  	 11, 12, 13, 14, 15, 16, 17, 18, 19, 20,
--- 138,146 ----
      val (NK, AO, CO, PO, CS, A, CR, LT, TC, TK,
  	 V, C, E, FK, RK, ST, MI, EQP, TYCKIND, DTI,
! 	 DTF, TYCON, T, PI, VAR, SD, SG, FSG,  SP, EN,
  	 STR, F, STE, TCE, STRE, FE, EE, ED, EEV, FX,
  	 B, DCON, DICT, FPRIM, FUNDEC, TFUNDEC, DATACON, DTMEM, NRD,
  	 OVERLD, FCTC, SEN, FEN, SPATH, IPATH, STRID, FCTID, CCI, CTYPE,
!          CCALL_TYPE, SPE) =
  	(1, 2, 3, 4, 5, 6, 7, 8, 9, 10,
  	 11, 12, 13, 14, 15, 16, 17, 18, 19, 20,
***************
*** 148,152 ****
  	 31, 32, 33, 34, 35, 36, 37, 38, 39, 40,
  	 41, 42, 43, 44, 45, 46, 47, 48, 49,
! 	 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60)
  
      (* this is a bit awful...
--- 148,153 ----
  	 31, 32, 33, 34, 35, 36, 37, 38, 39, 40,
  	 41, 42, 43, 44, 45, 46, 47, 48, 49,
! 	 50, 51, 52, 53, 54, 55, 56, 57, 58, 59,
!          60, 61)
  
      (* this is a bit awful...
***************
*** 948,951 ****
--- 949,954 ----
  	end
  
+ (* replaced by primId and strPrimElem below -- should be removed after
+  * testing. [dbm: 7/10/06]
  	val op $ = PU.$ II
  	fun inl_info i =
***************
*** 953,960 ****
  			 inl_str = fn sl => "B" $ [list inl_info sl],
  			 inl_no = fn () => "C" $ [] }
  
  	val op $ = PU.$ VAR
  	fun var (V.VALvar { access = a, prim, path, typ = ref t }) =
! 	    "1" $ [access a, inl_info prim, spath path, ty t]
  	  | var (V.OVLDvar { name, options = ref p,
  			     scheme = T.TYFUN { arity, body } }) =
--- 956,972 ----
  			 inl_str = fn sl => "B" $ [list inl_info sl],
  			 inl_no = fn () => "C" $ [] }
+ *)
+ 
+         val op $ = PU.$ PI
+         fun primId (POI.Prim s) = "A" $ [string s]
+           | primId (POI.NonPrim) = "B" $ []
+ 
+         val op $ = PU.$ SPE
+         fun strPrimElem(POI.PrimE p) = "a" $ [primId p]
+           | strPrimElem(POI.StrE s) = "b" $ [list strPrimElem s]
  
  	val op $ = PU.$ VAR
  	fun var (V.VALvar { access = a, prim, path, typ = ref t }) =
! 	    "1" $ [access a, primId prim, spath path, ty t]
  	  | var (V.OVLDvar { name, options = ref p,
  			     scheme = T.TYFUN { arity, body } }) =
***************
*** 1063,1067 ****
  		"A" $ [Signature sign, entPath p]
  	      | str M.ERRORstr = "B" $ []
! 	      | str (M.STR (s as { sign, rlzn, access = a, info })) =
  		(case strStub s of
  		     (* stub represents just the strerec suspension! *)
--- 1075,1079 ----
  		"A" $ [Signature sign, entPath p]
  	      | str M.ERRORstr = "B" $ []
! 	      | str (M.STR (s as { sign, rlzn, access = a, prim })) =
  		(case strStub s of
  		     (* stub represents just the strerec suspension! *)
***************
*** 1070,1077 ****
  					   strId i,
  					   access a,
! 					   inl_info info]
  		   | NONE => "D" $ [Signature sign,
  				    shStrEntity (MI.strId s) rlzn,
! 				    access a, inl_info info])
  	in
  	    str arg
--- 1082,1089 ----
  					   strId i,
  					   access a,
! 					   list strPrimElem prim]
  		   | NONE => "D" $ [Signature sign,
  				    shStrEntity (MI.strId s) rlzn,
! 				    access a, list strPrimElem prim])
  	in
  	    str arg
***************
*** 1081,1085 ****
  	    val op $ = PU.$ F
  	    fun fct M.ERRORfct = "E" $ []
! 	      | fct (M.FCT (f as { sign, rlzn, access = a, info })) =
  		(case fctStub f of
  		     SOME (l, i) => "F" $ [fctSig sign,
--- 1093,1097 ----
  	    val op $ = PU.$ F
  	    fun fct M.ERRORfct = "E" $ []
! 	      | fct (M.FCT (f as { sign, rlzn, access = a, prim })) =
  		(case fctStub f of
  		     SOME (l, i) => "F" $ [fctSig sign,
***************
*** 1087,1094 ****
  					   fctId i,
  					   access a,
! 					   inl_info info]
  		   | NONE => "G" $ [fctSig sign,
  				    shFctEntity (MI.fctId f) rlzn,
! 				    access a, inl_info info])
  	in
  	    fct arg
--- 1099,1106 ----
  					   fctId i,
  					   access a,
! 					   list strPrimElem prim]
  		   | NONE => "G" $ [fctSig sign,
  				    shFctEntity (MI.fctId f) rlzn,
! 				    access a, list strPrimElem prim])
  	in
  	    fct arg
***************
*** 1260,1264 ****
  		      k :: lvars)
  		   | _ => bug ("dontPickle 1: " ^ A.prAcc a))
! 	      | B.STRbind (M.STR { sign = s, rlzn = r, access = a, info =z }) =>
  		(case a of
  		     A.LVAR k => 
--- 1272,1276 ----
  		      k :: lvars)
  		   | _ => bug ("dontPickle 1: " ^ A.prAcc a))
! 	      | B.STRbind (M.STR { sign = s, rlzn = r, access = a, prim =z }) =>
  		(case a of
  		     A.LVAR k => 
***************
*** 1268,1276 ****
  						     { access = newAccess i,
  						       sign = s, rlzn = r,
! 						       info = z }),
  				env),
  		      k :: lvars)
  		   | _ => bug ("dontPickle 2" ^ A.prAcc a))
! 	      | B.FCTbind (M.FCT { sign = s, rlzn = r, access = a, info=z }) =>
  		(case a of
  		     A.LVAR k => 
--- 1280,1288 ----
  						     { access = newAccess i,
  						       sign = s, rlzn = r,
! 						       prim = z }),
  				env),
  		      k :: lvars)
  		   | _ => bug ("dontPickle 2" ^ A.prAcc a))
! 	      | B.FCTbind (M.FCT { sign = s, rlzn = r, access = a, prim = z }) =>
  		(case a of
  		     A.LVAR k => 
***************
*** 1280,1284 ****
  						     { access = newAccess i,
  						       sign = s, rlzn = r,
! 						       info = z }),
  				      env),
  		      k :: lvars)
--- 1292,1296 ----
  						     { access = newAccess i,
  						       sign = s, rlzn = r,
! 						       prim = z }),
  				      env),
  		      k :: lvars)

Index: unpickmod-new.sml
===================================================================
RCS file: /cvsroot/smlnj/sml-dist/src/compiler/Semant/pickle/unpickmod-new.sml,v
retrieving revision 1.24.4.1
retrieving revision 1.24.4.2
diff -C2 -d -r1.24.4.1 -r1.24.4.2
*** unpickmod-new.sml	7 Jul 2006 21:06:11 -0000	1.24.4.1
--- unpickmod-new.sml	10 Jul 2006 22:27:13 -0000	1.24.4.2
***************
*** 421,425 ****
  	val tyListM = UU.mkMap ()
  	val iiM = UU.mkMap ()
! 	val vM = UU.mkMap ()
  	val sdM = UU.mkMap ()
  	val sigM = UU.mkMap ()
--- 421,428 ----
  	val tyListM = UU.mkMap ()
  	val iiM = UU.mkMap ()
! 	val primIdM = UU.mkMap ()
!         val strPrimElemM = UU.mkMap ()
! 	val speListM = UU.mkMap()
!         val vM = UU.mkMap ()
  	val sdM = UU.mkMap ()
  	val sigM = UU.mkMap ()
***************
*** 680,684 ****
  	    (l, branch trl)
  	end
! 
  	and inl_info () = let
  	    fun ii #"A" = II.INL_PRIM (primop (), ty ())
--- 683,687 ----
  	    (l, branch trl)
  	end
! (* GK: replaced by primId and strPrimElem
  	and inl_info () = let
  	    fun ii #"A" = II.INL_PRIM (primop (), ty ())
***************
*** 690,694 ****
  	end
  
! 	and iilist () = list iiListM inl_info ()
  
  	and var' () = let
--- 693,715 ----
  	end
  
!         and iilist () = list iiListM inl_info ()
!  *)       
!         and primId () = 
!             let
!                 fun p #"A" = POI.Prim (string ())
!                   | p #"B" = POI.NonPrim ()
!             in 
!                 share primIdM p
!             end
! 
!         and strPrimElem () =
!             let
!                 fun sp #"a" = POI.PrimE (primId ())
!                   | sp #"b" = POI.StrE ( spelist ())
!             in
!                 share strPrimElemM sp
!             end
!         and spelist () = list speListM strPrimElem ()
! 	
  
  	and var' () = let
***************
*** 895,899 ****
  			      rlzn = lookStr (libModSpec (), strId ()),
  			      access = access (),
! 			      info = inl_info () }
  		in
  		    (M.STR r, branch [str, M.STRNODE r])
--- 916,920 ----
  			      rlzn = lookStr (libModSpec (), strId ()),
  			      access = access (),
! 			      prim = spelist () }
  		in
  		    (M.STR r, branch [str, M.STRNODE r])
***************
*** 904,908 ****
  			      rlzn = strEntity (),
  			      access = access (),
! 			      info = inl_info () }
  		in
  		    (M.STR r, branch [str, M.STRNODE r])
--- 925,929 ----
  			      rlzn = strEntity (),
  			      access = access (),
! 			      prim = spelist () }
  		in
  		    (M.STR r, branch [str, M.STRNODE r])
***************
*** 925,929 ****
  			      rlzn = lookFct (libModSpec (), fctId ()),
  			      access = access (),
! 			      info = inl_info () }
  		in
  		    (M.FCT r, branch [str, M.FCTNODE r])
--- 946,950 ----
  			      rlzn = lookFct (libModSpec (), fctId ()),
  			      access = access (),
! 			      prim = spelist () }
  		in
  		    (M.FCT r, branch [str, M.FCTNODE r])
***************
*** 934,938 ****
  			      rlzn = fctEntity (),
  			      access = access (),
! 			      info = inl_info () }
  		in
  		    (M.FCT r, branch [str, M.FCTNODE r])
--- 955,959 ----
  			      rlzn = fctEntity (),
  			      access = access (),
! 			      prim = spelist () }
  		in
  		    (M.FCT r, branch [str, M.FCTNODE r])



-------------------------------------------------------------------------
Using Tomcat but need to do more? Need to support web services, security?
Get stuff done quickly with pre-integrated technology to make your job easier
Download IBM WebSphere Application Server v.1.0.1 based on Apache Geronimo
http://sel.as-us.falkag.net/sel?cmd=lnk&kid=120709&bid=263057&dat=121642