% Pruned SML Compiler %
% this is a SML version of the InitMLState used by bsys.ml %
let InitSMLState(): MLState' =
%AM: I am deeply suspicious but here goes...%
  let  _ = Print.StackCode:=true in
  let NewMLState = EmptyMLState( `Standard ML`, SML )
  enc topenv = TopEnvOfSysState(NewMLState)
  enc  _ = MLHalfStep([EmitRecord(0);EmitReturn(1)],
		      InitLocAllEnv1([]), NewMLState)
  enc protocommand = implode [
       ` datatype bool = false | true `;
       ` datatype 'a list = op :: of ('a * 'a list) | nil `;
       ` datatype '_weak ref = ref of '_weak  `;
%       ` datatype 'l + 'r = inl of 'l | inr of 'r `;%
       ` abstype int = int with val () = () end `;
       ` abstype real = real with val () = () end `;
       ` abstype string = string with val () = () end `;
       ` abstype Dynamic = Dynamic with val () = () end `;
       ` abstype '_weak array = array with val () = () end `;
       ` datatype exn = ... `
       ]
  enc _ = UseString(protocommand, BufStreamOfSysState(NewMLState))
  enc _ = AnalFudgeFns := [ (InitPrintFns.Bool,InitEqFns.Bool);
			    (InitPrintFns.Star,InitEqFns.Star);
			    (InitPrintFns.Ref,InitEqFns.Ref);
%			    (InitPrintFns.Sum,InitEqFns.Sum);%
			    (InitPrintFns.Int,InitEqFns.Int);
			    (InitPrintFns.Real,InitEqFns.Real);
			    (InitPrintFns.String,InitEqFns.String);
			    (InitPrintFns.Dynamic,InitEqFns.Dynamic)]
  enc _ = MLOneStep(NewMLState)
  enc OhDear = \x. failwith `InitMLState`
  enc Bool = fst(RetrieveTypFromTop(AtomBool, topenv.Typ, OhDear))
  enc Int = fst(RetrieveTypFromTop(AtomInt, topenv.Typ, OhDear))
  enc Real = fst(RetrieveTypFromTop(AtomFloat, topenv.Typ, OhDear))
  enc String = fst(RetrieveTypFromTop(AtomString, topenv.Typ, OhDear))
  enc Dynamic = fst(RetrieveTypFromTop(absAtom' `Dynamic`, topenv.Typ, OhDear))
  enc Xn = fst(RetrieveTypFromTop(AtomXn, topenv.Typ, OhDear))
  enc tem1 = fst(RetrieveTypFromTop(AtomList, topenv.Typ, OhDear))
  enc tem2 = (repTypTerm' tem1) as TypAbsOper
  enc List = \arg. ReAllocTypAbsOper(tem2, [arg])
  enc _ = AnalFudgeType := inr(| Bool; Star=List; Int; Real; String; Dynamic; Xn |)
  %AM: here the dubious bit ends...%
  
  enc (| TypVar; EtyTypVar; Unit; Arrow; Cross |) = InitTypConstructors
  enc A = TypVar() enc E = EtyTypVar()
  enc locpairenv = InitLocAllEnv2(
	    append(map (\(x,y,z). (AllocBindPseudo(x,y),z))
		       [(AtomEqual,[|OpEqual|],Arrow(Cross(E,E),Bool));
			(AtomNotEq,[|OpNotEq|],Arrow(Cross(E,E),Bool))
		       ],
		   map (\(x,y). (AllocBindIde(x),y))
			%AM: use an ADT in the next line...%
		       [(absAtom'(`CurrentMLState`),Arrow(Unit,A));
		        (absAtom'(`TheAssembler`),Unit);
%AJGDEL		        (absAtom'(`BCAssembleText`),Unit);%
%AJGDEL		        (absAtom'(`NCAssembleText`),Unit);%
		        (absAtom'(`TextSize`),Unit);
			(absAtom'(`use`),Arrow(List(String),Unit))
		       ]))
%RJGDEL 	    [(AllocBindIde(AtomOldFail), String)])%
  enc (SMCode: SMCode' list) =
%AM: these next three values shouldn't get used! %
    CompBinCombinator(AtomEqual, absSMCode'[|OpEqual=[|Bool|]|],
    CompBinCombinator(AtomNotEq, absSMCode'[|OpEqual=[|Bool|]|],
    CompLiteral([|GlobalObject=mkobj(\().NewMLState)|],
    CompLiteral([|GlobalObject=mkobj(TheAssembler)|],
%AJGDEL    CompLiteral([|GlobalObject=mkobj(BCAssembleText)|],%
%AJGDEL    CompLiteral([|GlobalObject=mkobj(NCAssembleText)|],%
    CompLiteral([|GlobalObject=mkobj(TextSize)|],
    CompLiteral([|GlobalObject=mkobj(NewUse NewMLState)|],
%AM: the next line(s) set up initial exception names%
    CompLiteral([|GlobalObject=mkobj(ref AtomOldFail)|],
    [EmitRecord(7);EmitReturn(1)])))))))
  enc  _ = MLHalfStep(SMCode, locpairenv, NewMLState)
  enc _ = Print.StackCode:=false
%  enc _ = Debug.TypeEnv := true%
  in  NewMLState;
NewExportMLState(InitSMLState())(
    `sml_phase1.exp`,
    `System (SML) with initial environment (AJG's version)`,
    [] );
