------------------------------------------------------------------------------- |-- Module : Data.SBV.Compilers.C-- Copyright : (c) Levent Erkok-- License : BSD3-- Maintainer : erkokl@gmail.com-- Stability : experimental-- Portability : portable---- Compilation of symbolic programs to C-----------------------------------------------------------------------------{-# LANGUAGE PatternGuards #-}moduleData.SBV.Compilers.C(compileToC,compileToC')whereimportData.Char(isSpace)importData.Maybe(isJust)importqualifiedData.FoldableasF(toList)importText.PrettyPrint.HughesPJimportSystem.RandomimportData.SBV.BitVectors.DataimportData.SBV.BitVectors.PrettyNum(shex)importData.SBV.Compilers.CodeGen-- token for the target languagedataSBVToC=SBVToCinstanceSBVTargetSBVToCwheretargetName_="C"translate_=cgen-- Unexpected input, or things we will probably never supportdie::String->adiemsg=error$"SBV->C: Unexpected: "++msg-- Unsupported features, or features TBDtbd::String->atbdmsg=error$"SBV->C: Not yet supported: "++msg-- | Given a symbolic computation, render it as an equivalent C program.---- * First argument: States whether run-time-checks should be inserted for index-out-of-bounds or shifting-by-large values etc.-- If `False`, such checks are ignored, gaining efficiency, at the cost of potential undefined behavior.---- * Second argument is an optional directory name under which the files will be saved. If `Nothing`, the result-- will be written to stdout. Use @`Just` \".\"@ for creating files in the current directory.---- * The third argument is name of the function, which also forms the names of the C and header files.---- * The fourth argument are the names of the arguments to be used and the names of the outputs, if any.-- Provide as many arguments as you like, SBV will make up ones if you don't pass enough.---- * The fifth and the final argument is the computation to be compiled.---- Compilation will also generate a @Makefile@ and a sample driver program, which executes the program over random-- input values.compileToC::SymExecutablef=>Bool->MaybeFilePath->String->[String]->f->IO()compileToCrtcmbDirfnextraNamesf=dorands<-newStdGen>>=return.randomscodeGenSBVToCrandsrtcmbDirfnextraNamesf-- | Alternative interface for generating C. The output driver program uses the specified values (first argument) instead of random values.-- Also this version returns the generated files for further manipulation. (Useful mainly for generating regression tests.)compileToC'::SymExecutablef=>[Integer]->Bool->String->[String]->f->IOCgPgmBundlecompileToC'dvals=codeGen'SBVToC(dvals++repeat0)cgen::[Integer]->Bool->String->[String]->Result->CgPgmBundlecgenrandValsrtcnmextraNamessbvProg@(Resultins______outs)=CgPgmBundle[("Makefile",genMakenmnmd),(nm++".h",genHeadernmsig),(nmd++".c",genDriverrandValsnmtyp),(nm++".c",genCProgrtcnmsigsbvProg(mapfstoutputVars))]wherenmd=nm++"_driver"typ@(CType(_,outputVars))=mkCTypeextraNamesinsoutssig=pprCFunHeadernmtyp-- | A simple representation of C types for functions-- sufficient enough to represent SBV generated functionsnewtypeCType=CType([(String,(Bool,Int))],[(String,(Bool,Int))])mkCType::[String]->[NamedSymVar]->[SW]->CTypemkCTypeextraNamesinsouts=CType(mapmkVarins,mapmkVar(zipoutsoutNames))whereoutNames=extraNames++["out"++showi|i<-[lengthextraNames..]]mkVar(sw,n)=(n,(hasSignsw,sizeOfsw))-- | Pretty print a functions type. If there is only one output, we compile it-- as a function that returns that value. Otherwise, we compile it as a void function-- that takes return values as pointers to be updated.pprCFunHeader::String->CType->DocpprCFunHeaderfn(CType(ins,outs))=retType<+>textfn<>parens(fsep(punctuatecomma(mapmkParamins++os)))where(retType,os)=caseoutsof[(_,bs)]->(pprCWordFalsebs,[])_->(text"void",mapmkPParamouts)mkParam,mkPParam::(String,(Bool,Int))->DocmkParam(n,bs)=pprCWordTruebs<+>textnmkPParam(n,bs)=pprCWordFalsebs<+>text"*"<>textn-- | Renders as "const SWord8 s0", etc. the first parameter is the width of the typefielddeclSW::Int->SW->DocdeclSWwsw@(SWsgsz_)=text"const"<+>pad(showCTypesgsz)<+>text(showsw)wherepads=text$s++take(w-lengths)(repeat' ')-- | Renders as "s0", etc, or the corresponding constantshowSW::[(SW,CW)]->SW->DocshowSWconstssw|sw==falseSW=text"0"|sw==trueSW=text"1"|Justcw<-sw`lookup`consts=showConstcw|True=text$showsw-- | Words as it would be defined in the standard header stdint.hpprCWord::Bool->(Bool,Int)->DocpprCWordcnstsgsz=(ifcnstthentext"const"elseempty)<+>text(showCTypesgsz)showCType::(Bool,Int)->StringshowCType(False,1)="SBool"showCType(s,sz)|sz`elem`[8,16,32,64]=t|True=die$"Non-regular bitvector type: "++twheret=(ifsthen"SInt"else"SWord")++showsz-- | The printf specifier for the typespecifier::(Bool,Int)->Docspecifier(False,1)=text"%d"specifier(False,8)=text"%\"PRIu8\""specifier(True,8)=text"%\"PRId8\""specifier(False,16)=text"0x%04\"PRIx16\"U"specifier(True,16)=text"%\"PRId16\""specifier(False,32)=text"0x%08\"PRIx32\"UL"specifier(True,32)=text"%\"PRId32\"L"specifier(False,64)=text"0x%016\"PRIx64\"ULL"specifier(True,64)=text"%\"PRId64\"LL"specifier(s,sz)=die$"Format specifier at type "++(ifsthen"SInt"else"SWord")++showsz-- | Make a constant value of the given type. We don't check for out of bounds here, as it should not be needed.-- There are many options here, using binary, decimal, etc. We simply-- 8-bit or less constants using decimal; otherwise we use hex.-- Note that this automatically takes care of the boolean (1-bit) value problem, since it-- shows the result as an integer, which is OK as far as C is concerned.mkConst::Integer->(Bool,Int)->DocmkConsti(False,1)=integerimkConstit@(False,8)=text(shexFalseTrueti)mkConstit@(True,8)=text(shexFalseTrueti)mkConstit@(False,16)=text(shexFalseTrueti)<>text"U"mkConstit@(True,16)=text(shexFalseTrueti)mkConstit@(False,32)=text(shexFalseTrueti)<>text"UL"mkConstit@(True,32)=text(shexFalseTrueti)<>text"L"mkConstit@(False,64)=text(shexFalseTrueti)<>text"ULL"mkConstit@(True,64)=text(shexFalseTrueti)<>text"LL"mkConsti(True,1)=die$"Signed 1-bit value "++showimkConsti(s,sz)=die$"Constant "++showi++" at type "++(ifsthen"SInt"else"SWord")++showsz-- | Show a constantshowConst::CW->DocshowConstcw=mkConst(cwValcw)(hasSigncw,sizeOfcw)-- | Generate a makefile for ease of experimentation..genMake::String->String->DocgenMakefndn=text"# Makefile for"<+>nm<>text". Automatically generated by SBV. Do not edit!"$$text""$$text"CC=gcc"$$text"CCFLAGS=-Wall -O3 -DNDEBUG -fomit-frame-pointer"$$text""$$text"all:"<+>nmd$$text""$$nmo<>text":"<+>hsep[nmc,nmh]$$text"\t${CC} ${CCFLAGS}"<+>text"-c"<+>nmc<+>text"-o"<+>nmo$$text""$$nmdo<>text":"<+>nmdc$$text"\t${CC} ${CCFLAGS}"<+>text"-c"<+>nmdc<+>text"-o"<+>nmdo$$text""$$nmd<>text":"<+>hsep[nmo,nmdo]$$text"\t${CC} ${CCFLAGS}"<+>nmo<+>nmdo<+>text"-o"<+>nmd$$text""$$text"clean:"$$text"\trm -f"<+>nmdo<+>nmo$$text""$$text"veryclean: clean"$$text"\trm -f"<+>nmd$$text""wherenm=textfnnmd=textdnnmh=nm<>text".h"nmc=nm<>text".c"nmo=nm<>text".o"nmdc=nmd<>text".c"nmdo=nmd<>text".o"-- | Generate the headergenHeader::String->Doc->DocgenHeaderfnsignature=text"/* Header file for"<+>nm<>text". Automatically generated by SBV. Do not edit! */"$$text""$$text"#ifndef"<+>tag$$text"#define"<+>tag$$text""$$text"#include <inttypes.h>"$$text"#include <stdint.h>"$$text""$$text"/* Unsigned bit-vectors */"$$text"typedef uint8_t SBool ;"$$text"typedef uint8_t SWord8 ;"$$text"typedef uint16_t SWord16;"$$text"typedef uint32_t SWord32;"$$text"typedef uint64_t SWord64;"$$text""$$text"/* Signed bit-vectors */"$$text"typedef int8_t SInt8 ;"$$text"typedef int16_t SInt16;"$$text"typedef int32_t SInt32;"$$text"typedef int64_t SInt64;"$$text""$$text"/* Entry point prototype: */"$$signature<>semi$$text""$$text"#endif /*"<+>tag<+>text"*/"$$text""wherenm=textfntag=text"__"<>nm<>text"__HEADER_INCLUDED__"sepIf::Bool->DocsepIfb=ifbthentext""elseempty-- | Generate an example driver programgenDriver::[Integer]->String->CType->DocgenDriverrandValsfn(CType(inps,outs))=text"/* Example driver program for"<+>nm<>text". */"$$text"/* Automatically generated by SBV. Edit as you see fit! */"$$text""$$text"#include <inttypes.h>"$$text"#include <stdint.h>"$$text"#include <stdio.h>"$$text"#include"<+>doubleQuotes(nm<>text".h")$$text""$$text"int main(void)"$$text"{"$$text""$$nest2(vcat(map(\(n,bs)->pprCWordFalsebs<+>textn<>semi)(ifsingleOutthen[]elseouts))$$sepIf(notsingleOut)$$call$$text""$$(caseoutsof[(n,bsz)]->text"printf"<>parens(printQuotes(fcall<+>text"="<+>specifierbsz<>text"\\n")<>comma<+>textn)<>semi_->text"printf"<>parens(printQuotes(fcall<+>text"->\\n"))<>semi$$vcat(mapdisplayouts))$$text""$$text"return 0"<>semi)$$text"}"$$text""wherenm=textfnsingleOut=caseoutsof[_]->True_->Falsecall=caseoutsof[(n,bs)]->pprCWordTruebs<+>textn<+>text"="<+>fcall<>semi_->fcall<>semimkCVal(_,bsz@(b,sz))r|notb=mkConst(absr`mod`(2^sz))bsz|True=mkConst((absr`mod`(2^sz))-(2^(sz-1)))bszfcall=caseoutsof[_]->nm<>parens(fsep(punctuatecomma(zipWithmkCValinpsrandVals)))_->nm<>parens(fsep(punctuatecomma(zipWithmkCValinpsrandVals++map(\(n,_)->text"&"<>textn)outs)))display(s,bsz)=text"printf"<>parens(printQuotes(text" "<+>texts<+>text"="<+>specifierbsz<>text"\\n")<>comma<+>texts)<>semi-- | Generate the C programgenCProg::Bool->String->Doc->Result->[String]->DocgenCProgrtcfnproto(ResultinpspreConststblsarrsuintsaxmsasgnsouts)outputVars|not(nullarrs)=tbd"User specified arrays"|not(nulluints)=tbd"Uninterpreted constants"|not(nullaxms)=tbd"User given axioms"|True=text"/* File:"<+>doubleQuotes(nm<>text".c")<>text". Automatically generated by SBV. Do not edit! */"$$text""$$text"#include <inttypes.h>"$$text"#include <stdint.h>"$$text"#include"<+>doubleQuotes(nm<>text".h")$$text""$$proto$$text"{"$$text""$$nest2(vcat(mapgenInpinps)$$vcat(merge(mapgenTbltbls)(mapgenAsgnassignments))$$sepIf(not(nullassignments)||not(nulltbls))$$genOutsouts)$$text"}"$$text""wherenm=textfnassignments=F.toListasgnstypeWidth=getMax0[len(hasSigns,sizeOfs)|(s,_)<-assignments]wherelen(False,1)=5-- SBoollen(False,n)=5+length(shown)-- SWordNlen(True,n)=4+length(shown)-- SIntNgetMax7_=7-- 7 is the max we can get with SWord64, so don't bother looking any furthergetMaxm[]=mgetMaxm(x:xs)=getMax(m`max`x)xsconsts=(falseSW,falseCW):(trueSW,trueCW):preConstsisConsts=isJust(lookupsconsts)genInp::NamedSymVar->DocgenInp(sw,n)|showsw==n=empty-- no aliasing, so no need to assign|True=declSWtypeWidthsw<+>text"="<+>textn<>semigenTbl::((Int,(Bool,Int),(Bool,Int)),[SW])->(Int,Doc)genTbl((i,_,(sg,sz)),elts)=(location,static<+>mkParam("table"++showi,(sg,sz))<>text"[] = {"$$nest4(fsep(punctuatecomma(align(map(showSWconsts)elts))))$$text"};")wherestatic=iflocation==-1thentext"static"elseemptylocation=maximum(-1:mapgetNodeIdelts)getNodeIds@(SW_(NodeIdn))|isConsts=-1|True=ngenAsgn::(SW,SBVExpr)->(Int,Doc)genAsgn(sw,n)=(getNodeIdsw,declSWtypeWidthsw<+>text"="<+>ppExprrtcconstsn<>semi)genOuts::[SW]->DocgenOuts[sw]=text"return"<+>showSWconstssw<>semigenOutsos|lengthos/=lengthoutputVars=die$"Mismatched outputs: "++show(os,outputVars)|True=vcat(zipWithassignOutoutputVarsos)whereassignOutvsw=text"*"<>textv<+>text"="<+>showSWconstssw<>semi-- merge tables intermixed with assignments, paying attention to putting tables as-- early as possible.. Note that the assignment list (second argument) is sorted on its ordermerge::[(Int,Doc)]->[(Int,Doc)]->[Doc]merge[]as=mapsndasmergets[]=mapsndtsmergets@((i,t):trest)as@((i',a):arest)|i<i'=t:mergetrestas|True=a:mergetsarest-- Align a bunch of docs to occupy the exact same length by padding in the left by space-- this is ugly and inefficient, but easy to code..align::[Doc]->[Doc]alignds=map(text.pad)sswheress=maprenderdsl=maximum(0:maplengthss)pads=take(l-lengths)(repeat' ')++sppExpr::Bool->[(SW,CW)]->SBVExpr->DocppExprrtcconsts(SBVAppopopArgs)=pop(map(showSWconsts)opArgs)wherecBinOps=[(Plus,"+"),(Times,"*"),(Minus,"-"),(Quot,"/"),(Rem,"%"),(Equal,"=="),(NotEqual,"!="),(LessThan,"<"),(GreaterThan,">"),(LessEq,"<="),(GreaterEq,">="),(And,"&"),(Or,"|"),(XOr,"^")]p(ArrRead_)_=tbd$"User specified arrays (ArrRead)"p(ArrEq__)_=tbd$"User specified arrays (ArrEq)"p(Uninterpreteds)_=tbd$"Uninterpreted constants ("++shows++")"p(Extractij)[a]=extractij(lets=headopArgsin(hasSigns,sizeOfs))apJoin[a,b]=join(let(s1:s2:_)=opArgsin((hasSigns1,sizeOfs1),(hasSigns2,sizeOfs2),a,b))p(Roli)[a]=rotateTrueia(lets=headopArgsin(hasSigns,sizeOfs))p(Rori)[a]=rotateFalseia(lets=headopArgsin(hasSigns,sizeOfs))p(Shli)[a]=shiftTrueia(lets=headopArgsin(hasSigns,sizeOfs))p(Shri)[a]=shiftFalseia(lets=headopArgsin(hasSigns,sizeOfs))pNot[a]=text"~"<>apIte[a,b,c]=a<+>text"?"<+>b<+>text":"<+>cp(LkUp(t,(as,at),_,len)inddef)[]|notrtc=lkUp-- ignore run-time-checks per user request|needsCheckL&&needsCheckR=cndLkUpcheckBoth|needsCheckL=cndLkUpcheckLeft|needsCheckR=cndLkUpcheckRight|True=lkUpwhere[index,defVal]=map(showSWconsts)[ind,def]lkUp=text"table"<>intt<>brackets(showSWconstsind)cndLkUpcnd=cnd<+>text"?"<+>defVal<+>text":"<+>lkUpcheckLeft=index<+>text"< 0"checkRight=index<+>text">="<+>intlencheckBoth=parens(checkLeft<+>text"||"<+>checkRight)(needsCheckL,needsCheckR)|as=(True,(2::Integer)^(at-1)-1>=(fromIntegrallen))|True=(False,(2::Integer)^(at)-1>=(fromIntegrallen))po[a,b]|Justco<-lookupocBinOps=a<+>textco<+>bpoargs=die$"Received operator "++showo++" applied to "++showargsshifttoLeftia(sg,sz)|i<0=shift(nottoLeft)(-i)a(sg,sz)|i==0=a|i>=sz=mkConst0(sg,sz)|True=a<+>textcop<+>intiwherecop|toLeft="<<"|True=">>"rotatetoLeftia(True,sz)=tbd$"Rotation of signed words at size "++show(toLeft,i,a,sz)rotatetoLeftia(False,sz)|i<0=rotate(nottoLeft)(-i)a(False,sz)|i==0=a|i>=sz=rotatetoLeft(i`mod`sz)a(False,sz)|True=parens(a<+>textcop<+>inti)<+>text"|"<+>parens(a<+>textcop'<+>int(sz-i))where(cop,cop')|toLeft=("<<",">>")|True=(">>","<<")-- TBD: below we only support the values that SBV actually currently generates.-- we would need to add new ones if we generate others. (Check instances in Data/SBV/BitVectors/Splittable.hs).extract6332(False,64)a=text"(SWord32)"<+>(parens(a<+>text">> 32"))extract310(False,64)a=text"(SWord32)"<+>aextract3116(False,32)a=text"(SWord16)"<+>(parens(a<+>text">> 16"))extract150(False,32)a=text"(SWord16)"<+>aextract158(False,16)a=text"(SWord8)"<+>(parens(a<+>text">> 8"))extract70(False,16)a=text"(SWord8)"<+>aextractij(sg,sz)_=tbd$"extract with "++show(i,j,(sg,sz))-- TBD: ditto here for join, just like extract abovejoin((False,8),(False,8),a,b)=parens((parens(text"(SWord16)"<+>a))<+>text"<< 8")<+>text"|"<+>parens(text"(SWord16)"<+>b)join((False,16),(False,16),a,b)=parens((parens(text"(SWord32)"<+>a))<+>text"<< 16")<+>text"|"<+>parens(text"(SWord32)"<+>b)join((False,32),(False,32),a,b)=parens((parens(text"(SWord64)"<+>a))<+>text"<< 32")<+>text"|"<+>parens(text"(SWord64)"<+>b)join(sgsz1,sgsz2,_,_)=tbd$"join with "++show(sgsz1,sgsz2)-- same as doubleQuotes, except we have to make sure there are no line breaks..-- Otherwise breaks the generated code.. sighprintQuotes::Doc->DocprintQuotesd=text$'"':ppSameLined++"\""-- Remove newlines.. Useful when generating Makefile and suchppSameLine::Doc->StringppSameLine=trim.renderwheretrim""=""trim('\n':cs)=' ':trim(dropWhileisSpacecs)trim(c:cs)=c:trimcs