implementation module saplinterface

import StdEnv, CoclSystemDependent, syntax, partition, gensapl

// Generation of Sapl definition from Clean definitions
// JMJ: May 2007 

gensaplfiles :: !Files {#DclModule} {#{#CheckedTypeDef}} !*{!Component} !*{# FunDef} CommonDefs {#CommonDefs} Ident  [IndexRange] !String
                -> (!Files,!*{!Component}, !*{# FunDef})
gensaplfiles files dcl_mods types components fun_defs icl_common common_defs icl_name icl_function_indices csf_path
	# (ok, files)
		= ensureCleanSystemFilesExists csf_path files
	| not ok
		= abort ("can't create folder \"" +++ csf_path +++"\"\n")
	
	# gfp_path = csf_path +++ {DirectorySeparator} +++ toString icl_name +++ ".gfp"	  
	# (ok,f,files) = fopen gfp_path FWriteText files 
	| not ok
		= abort ("can't create file \"" +++ gfp_path +++"\"\n")	
	
	# deps_path = csf_path +++ {DirectorySeparator} +++ toString icl_name +++ ".deps"
	# (ok,fdeps,files) = fopen deps_path FWriteText files 
	| not ok
		= abort ("can't create file \"" +++ deps_path +++"\"\n")
	
	# modnames = getModNames dcl_mods // modules used by this Clean module
 	# (components,fun_defs,f,fdeps) = convert2sapl components fun_defs icl_common common_defs icl_name f fdeps modnames (toString icl_name) dcl_mods icl_function_indices
	  (ok,files) = fclose f files
	| ok<>ok 		= abort "";
	# (ok,files) = fclose fdeps files 
	| ok<>ok 		= abort "";
	= (files,components,fun_defs) 

convert2sapl :: !*{!Component} !*{# FunDef} CommonDefs {#CommonDefs} Ident !*File !*File [String] String {#DclModule} [IndexRange] -> (!*{!Component}, !*{# FunDef},!*File,!*File)
convert2sapl comps fun_defs icl_common comdefs icl_name file fdeps modnames mymod dcl_mods icl_function_indices 
  # saplcons  = getSaplConstructors mymod icl_common        // only this module
  # extcons  = getExternalConstructors modnames comdefs     // all including this module!
  # saplrecs  = getSaplRecords  icl_common mymod
  # saplcons = remRecs saplcons saplrecs
  # (comps,fun_defs,saplfuncs) = getSaplFunDefs comps 0 fun_defs modnames mymod dcl_mods icl_function_indices
  # saplfuncs = convertSelects saplfuncs extcons           // convert clean like select to Sapl select
  # saplfuncs = map renameVars saplfuncs                   // give vars a unique name
  # saplfuncs = flatten (map checkIfSelect saplfuncs)      // extract non toplevel if/select
  # fundeps   = genFunDepends saplfuncs saplcons saplrecs  // for linking
  # file = file <<< "|| Generated Sapl file for " <<< icl_name <<< ".icl\n"
  # file = file <<< "\n\n"
  # file = writedef2file saplfuncs file
  # file =  writedef2file (consgroups saplcons) (file <<< "\n")
  # file = writerecs2file saplrecs (file <<< "\n|| Converted Records\n")
  # fdeps = writedeps2file fundeps (fdeps <<< "|| Function dependencies\n")
  = (comps,fun_defs,file,fdeps)
where
  consgroups conss = [":: " +++ (\ (SaplConsDef mod t _ _ _ _) = mod +++ "_" +++ t) (hd a) +++ " = " +++ makeConsGroup a \\ a <- group eqcg conss] 
  eqcg (SaplConsDef a1 a2 _ _ _ _) (SaplConsDef b1 b2 _ _ _ _) = a1 == b1 && a2 == b2
  group f [] = []
  group f [x:xs] = let (as,bs) = span (f x) xs in [[x:as] : group f bs]  
  writedef2file [] file = file
  writedef2file [f:fs] file = writedef2file fs (file <<< toString f <<< "\n")
  writerecs2file [] file = file
  writerecs2file [f:fs] file = writerecs2file fs (file <<< toString f <<< "\n")
  makeString [] = ""
  makeString [f:fs] = f +++ " " +++ makeString fs
  writedeps2file [] file = file
  writedeps2file [(name,names):deps] file = writedeps2file deps (file <<< name <<< "\t\t" <<< mkString names <<< "\n") 
  mkString [] = ""
  mkString [a:as] = " " +++ a +++ mkString as
  remRecs cs recs = [SaplConsDef mod t name alt nrargs nralt \\ SaplConsDef mod t name alt nrargs nralt <- cs| not (isMember name recnames)]
  where recnames = [recname\\ SaplRecordDef mod recname fields <- recs]
  
makeConsGroup :: [SaplConsDef] -> String
makeConsGroup [     ]    = ""
makeConsGroup [arg]      = toString arg
makeConsGroup [arg:args] = toString arg +++ " | " +++ makeConsGroup args   

getSaplFunDefs :: !*{!Component} !Int  !*{# FunDef} [String] String {#DclModule} [IndexRange] -> (!*{!Component}, !*{# FunDef},[SaplFuncDef])
getSaplFunDefs comps comp_index fun_defs  mod_names mymod dcl_mods icl_function_indices
	| comp_index >= size comps
		= (comps,fun_defs,[])
		# (comp, comps) = comps![comp_index]
		# (fun_defs,saplfuncs) = show_component comp.component_members fun_defs []
		# (comps,fun_defs,sfuncs) = getSaplFunDefs comps (inc comp_index) fun_defs mod_names mymod dcl_mods icl_function_indices
		= (comps,fun_defs,saplfuncs ++ sfuncs)
where
	show_component NoComponentMembers fun_defs sapdefs
		= (fun_defs, sapdefs)
	show_component (ComponentMember fun funs) fun_defs sapdefs 
		# (fun_def, fun_defs) = fun_defs![fun]
		# saplfunc = CleanFunctoSaplFunc comp_index fun fun_def mod_names mymod dcl_mods icl_function_indices
		= show_component funs fun_defs [saplfunc:sapdefs]
	show_component (GeneratedComponentMember fun _ funs) fun_defs sapdefs 
		# (fun_def, fun_defs) = fun_defs![fun]
		# saplfunc = CleanFunctoSaplFunc comp_index fun fun_def mod_names mymod dcl_mods icl_function_indices
		= show_component funs fun_defs [saplfunc:sapdefs]

getExternalConstructors :: [String] {#CommonDefs} -> [SaplConsDef]			
getExternalConstructors mods comdefs = flatten [getSaplConstructors mod comdef\\(comdef,mod) <-  zip (lcomdefs,mods)]
where lcomdefs = [comdef\\ comdef <-: comdefs] 

getSaplConstructors :: String CommonDefs -> [SaplConsDef]			
getSaplConstructors mod icl_common = collectTypes [consdef\\ consdef <-: icl_common.com_cons_defs] 
where collectTypes conses = makeSaplCons  (group eqc (tosapl conses))
      tosapl conses = [(getConsType cons,getName cons,getNrArgs cons)\\ cons <- conses]
      makeSaplCons conses = [SaplConsDef mod type name alt nrarg (length css)\\ css <- conses, (alt,(type,name,nrarg)) <- zip ([1..],css)]
      group f [] = []
      group f [x:xs] = let (as,bs) = span (f x) xs in [[x:as] : group f bs]
      eqc (a,_,_) (b,_,_) = a == b
      getName cons = toString cons.cons_ident
      getNrArgs cons = length cons.cons_type.st_args //length cons.cons_exi_vars
      getConsType cons = (icl_common.com_type_defs).[cons.cons_type_index].td_ident.id_name 
      //getType cons = makeType cons (toString cons.cons_type.st_result.at_attribute)//a.td_ident
      //makeType cons "*" = (getConsType cons) // getName cons //mod +++ "*"   // **** for Record use the consname!!!
      //makeType cons x   = x
      
getSaplRecords :: CommonDefs String -> [SaplRecordDef]
getSaplRecords icl_common mymod = map makeRec [rectype\\ type <-: icl_common.com_type_defs, RecordType rectype <-  [type.td_rhs]]
where makeRec rectype = SaplRecordDef mymod (toString rectype.rt_constructor.ds_ident) [toString field.fs_ident\\ field <-: rectype.rt_fields]

getModNames :: {#DclModule} -> [String]
getModNames dcl_mods = [dcl_mod.dcl_name.id_name\\ dcl_mod <-: dcl_mods]

showConstructors :: *File CommonDefs -> *File
showConstructors file icl_common = file <<< [type.rt_constructor.ds_ident\\ consdef <-: icl_common.com_type_defs, RecordType type <-  [consdef.td_rhs]]