never executed always true always false
1 -- GENERATED by C->Haskell Compiler, version 0.28.8 Switcheroo, 25 November 2017 (Haskell)
2 -- Edit the ORIGNAL .chs file instead!
3
4
5 {-# LANGUAGE TemplateHaskell, StandaloneDeriving, EmptyDataDecls #-}
6 -- internal utilities to convert special enums: either complex ones or represented as QuantLib objects that I didn't want to expose so I represented them as ADTs
7 {-# OPTIONS_GHC -Wno-unused-top-binds #-}
8 module QuantLib.Internal.Common
9 (
10 qlInterpolation
11 , qlInterpolation'
12 , Approximation(..)
13 , Interpolation(..)
14 , Interpolation2D(..)
15
16 , ExerciseType(..)
17 , Exercise(..)
18 , QlExercise
19 , EuropeanExercise(..)
20 , BermudanExercise(..)
21 , QlEuropeanExercise
22 , QlBermudanExercise
23 , SwingExercise(..)
24 , QlSwingExercise
25
26 , OptionType(..)
27 , PositionType(..)
28 , BondPriceType(..)
29
30 , StrikedPayoff(..)
31 , PlainVanillaPayoff(..)
32 , PercentageStrikePayoff(..)
33 , QlPlainVanillaPayoff
34 , QlPercentageStrikePayoff
35 , QlStrikedTypePayoff
36 , Payoff(..)
37 , QlPayoff
38 , BasketPayoff(..)
39 , QlBasketPayoff
40 , TypePayoff(..)
41 , QlTypePayoff
42
43 , CallabilityType(..)
44 , Callability(..)
45 , QlCallability
46
47 , Claim(..)
48 , QlClaim
49 , withClaim
50
51 , FittingMethod(..)
52 , QlFittedBondDiscountCurveFittingMethod
53 , withFittedBondDiscountCurveFittingMethod
54
55 , FdmSchemeType(..)
56 , FdmScheme(..)
57 , QlFdmSchemeDesc
58 , withFdmSchemeDesc
59
60 , CPIInterpolationType(..)
61
62 , Constraint(..)
63 , QlConstraint
64 , withConstraint
65 , withMaybeConstraint
66 , OptimizationMethod(..)
67 , QlOptimizationMethod
68 , withOptimizationMethod
69 , withMaybeOptimizationMethod
70 , EndCriteria(..)
71 , QlEndCriteria
72 , withEndCriteria
73 , withMaybeEndCriteria
74
75 , QlRounding
76 , RoundingType(..)
77 , Rounding(..)
78 , withRounding
79 , withMaybeRounding
80
81 , withCallability
82 , withCallabilityArray
83
84 , QlLmVolatilityModel
85 , LmVolatilityModel(..)
86 , QlLmCorrelationModel
87 , LmCorrelationModel(..)
88 , withLmCorrelationModel
89 , withLmVolatilityModel
90
91 , TimeUnit(..)
92 , BusinessDayConvention(..)
93
94 , withEuropeanExercise
95 , withSwingExercise
96 , withBermudanExercise
97 , withExercise
98 , withPercentageStrikePayoff
99 , withPlainVanillaPayoff
100 , withStrikedPayoff
101 , withTypePayoff
102 , withBasketPayoff
103 , withPayoff
104 , withCustomPayoff
105 , withCustomStrikedPayoff
106 , withCustomBasketPayoff
107
108 , strikedPayoff
109 , percentageStrikePayoff
110 , plainVanillaPayoff
111 , swingExercise
112
113 , CalibrationBasketType(..)
114
115 , UnitOfMeasureType(..)
116 , PaymentTermEventType(..)
117 , PricingErrorLevel(..)
118 , peekPricingErrorLevelArray
119 , DeliverySchedule(..)
120 , QuantityPeriodicity(..)
121
122 , AdditionalResultType(..)
123 , AdditionalResultVal(..)
124 , RawResultPtr
125 , RawResult(..)
126 , convertResult
127 , peekAdditionalResults
128 ) where
129 import qualified Foreign.C.String as C2HSImp
130 import qualified Foreign.C.Types as C2HSImp
131 import qualified Foreign.ForeignPtr as C2HSImp
132 import qualified Foreign.Marshal.Utils as C2HSImp
133 import qualified Foreign.Ptr as C2HSImp
134 import qualified Foreign.Storable as C2HSImp
135
136
137 import Foreign.Ptr(Ptr, FunPtr, nullPtr, castPtr)
138 import Foreign.C.Types(CUInt, CInt, CDouble)
139 import Foreign.C.String(CString, peekCString)
140 import Foreign.Storable(Storable(..))
141 import Foreign.Marshal.Utils(withMany)
142 import Foreign.Marshal.Array(withArray, peekArray)
143 import Control.Exception(finally)
144
145 import QuantLib.Internal
146 import QuantLib.Internal.Type hiding(ptr)
147 import QuantLib.Internal.Syntax
148
149
150
151
152
153
154
155 -- this enum is not special, just used in many places and was put here to avoid cyclic dependencies
156 data TimeUnit = Days
157 | Weeks
158 | Months
159 | Years
160 | Hours
161 | Minutes
162 | Seconds
163 | Milliseconds
164 | Microseconds
165 deriving (Enum,Show,Eq,Read,Bounded)
166
167
168 -- moved from QuantLib.Time.Calendar, its "natural" home, for the same reason as TimeUnit above --
169 -- needed directly here for RebatedExercise's rebatePaymentConvention param. Like TimeUnit, every
170 -- cross-module use marshals through a manual fromEnumC/toEnumC/fromMaybeEnum function rather than
171 -- a bare c2hs backtick spec: a bare `` `BusinessDayConvention' `` needs the type's own module's
172 -- .chi already built, which this other-modules-listed module isn't guaranteed to have by the time
173 -- an early exposed-modules file (e.g. QuantLib.Time.Calendar itself) is processed.
174 data BusinessDayConvention = Following
175 | ModifiedFollowing
176 | Preceding
177 | ModifiedPreceding
178 | Unadjusted
179 | HalfMonthModifiedFollowing
180 | Nearest
181 deriving (Enum,Show,Eq,Read)
182
183
184 data ApproximationType = Approximation__NaturalSpline
185 | Approximation__Parabolic
186 | Approximation__Kruger
187 | Approximation__FritschButland
188 deriving (Enum,Show,Eq,Read)
189
190
191 data InterpolationType = InterpolationBackwardFlat
192 | InterpolationForwardFlat
193 | InterpolationLinear
194 | InterpolationLogLinear
195 | InterpolationCubic
196 | InterpolationLogCubic
197 | InterpolationAbcd
198 deriving (Enum,Show,Eq,Read)
199
200
201 -- 2-D interpolators for a BlackVarianceSurface. Unlike InterpolationType/ApproximationType
202 -- above (merged into the public Interpolation ADT by deriveCrossEnum), this enum is itself the
203 -- public type: setInterpolation on a surface is a member template over a default-constructed
204 -- interpolator, so there is no approximator to pair it with. Declared here rather than in
205 -- QuantLib.TermStructure.Volatility for the usual cross-module {#import#} ordering reason.
206 data Interpolation2D = Bilinear
207 | Bicubic
208 deriving (Enum,Show,Eq,Read,Bounded)
209
210
211 data ExerciseType = ExerciseTypeAmerican
212 | ExerciseTypeBermudan
213 | ExerciseTypeEuropean
214 deriving (Enum,Show,Eq,Read)
215
216
217 data OptionType = Put
218 | Call
219 deriving (Show,Eq,Read)
220 instance Enum OptionType where
221 succ Put = Call
222 succ Call = error "OptionType.succ: Call has no successor"
223
224 pred Call = Put
225 pred Put = error "OptionType.pred: Put has no predecessor"
226
227 enumFromTo from to = go from
228 where
229 end = fromEnum to
230 go v = case compare (fromEnum v) end of
231 LT -> v : go (succ v)
232 EQ -> [v]
233 GT -> []
234
235 enumFrom from = enumFromTo from Call
236
237 fromEnum Put = (-1)
238 fromEnum Call = 1
239
240 toEnum (-1) = Put
241 toEnum 1 = Call
242 toEnum unmatched = error ("OptionType.toEnum: Cannot match " ++ show unmatched)
243
244
245 data PositionType = Long
246 | Short
247 deriving (Enum,Show,Eq,Read)
248
249
250 data BondPriceType = Dirty
251 | Clean
252 deriving (Enum,Show,Eq,Read)
253
254
255 data CallabilityType = CallabilityCall
256 | CallabilityPut
257 deriving (Enum,Show,Eq,Read)
258
259
260 data FdmSchemeType = HundsdorferType
261 | DouglasType
262 | CraigSneydType
263 | ModifiedCraigSneydType
264 | ImplicitEulerType
265 | ExplicitEulerType
266 | MethodOfLinesType
267 | TrBDF2Type
268 | CrankNicolsonType
269 deriving (Enum,Show,Eq,Read)
270
271
272 data RoundingType = None
273 | Up
274 | Down
275 | Closest
276 | Floor
277 | Ceiling
278 deriving (Enum,Show,Eq,Read)
279
280
281 -- experimental/commodities: cross-cutting the same way TimeUnit is (UnitOfMeasureType is used by
282 -- both UnitOfMeasure itself and, in a later stage, CommodityPricingHelper/EnergyCommodity).
283 -- Quantity's C tag is renamed QuantityUnit in cbits/qlEnumC2HS.h to avoid colliding with the
284 -- Quantity class bound in QuantLib.Commodity.
285 data UnitOfMeasureType = Mass
286 | Volume
287 | Energy
288 | QuantityUnit
289 deriving (Enum,Show,Eq,Read,Bounded)
290
291
292 data PaymentTermEventType = TradeDate
293 | PricingDate
294 deriving (Enum,Show,Eq,Read,Bounded)
295
296
297 -- experimental/commodities/commodity.hpp (PricingError::Level) and
298 -- experimental/commodities/energycommodity.hpp (EnergyCommodity::DeliverySchedule,
299 -- EnergyCommodity::QuantityPeriodicity), homed here for the same cross-cutting reason as
300 -- UnitOfMeasureType above (used by both EnergyCommodity's leaf constructors and
301 -- CommodityPricingHelper::createPricingPeriods, both in QuantLib.Instrument.Energy -- a later
302 -- stage than this module).
303 data PricingErrorLevel = Info
304 | Warning
305 | Error
306 | Fatal
307 deriving (Enum,Show,Eq,Read,Bounded)
308
309
310 peekPricingErrorLevelArray :: Ptr CUInt -> Ptr (Ptr CInt) -> IO [PricingErrorLevel]
311 peekPricingErrorLevelArray = peekIntArray' toEnumC
312 -- Confirmed clash (a real one, caught by the build, not assumed): 4 of DeliverySchedule's 8 tags
313 -- (Daily/Weekly/Monthly/Quarterly) collide with QuantLib.Time.Schedule's own Frequency enum, whose
314 -- module this file is imported into unqualified. Prefixed Haskell-side only (c2hs's own "add
315 -- prefix", not a cbits/qlEnumC2HS.h rename) -- same targeted-rename convention as
316 -- UnitOfMeasureType's Quantity->QuantityUnit above, not a blanket defensive prefix.
317 data DeliverySchedule = DeliveryConstant
318 | DeliveryWindow
319 | DeliveryHourly
320 | DeliveryDaily
321 | DeliveryWeekly
322 | DeliveryMonthly
323 | DeliveryQuarterly
324 | DeliveryYearly
325 deriving (Enum,Show,Eq,Read,Bounded)
326
327
328 data QuantityPeriodicity = Absolute
329 | PerHour
330 | PerDay
331 | PerWeek
332 | PerMonth
333 | PerQuarter
334 | PerYear
335 deriving (Enum,Show,Eq,Read,Bounded)
336
337
338 -- flat/linear interpolation of a CPI index between its publication dates -- skips the
339 -- deprecated AsIndex upstream case, so cbits/qlEnumObjects.h's values (and thus this
340 -- c2hs-derived enum's fromEnum) start at 1, not 0; see that header's comment for why a
341 -- renumbered-from-0 enum here would silently alias to the wrong upstream case. Declared here
342 -- (not in QuantLib.TermStructure.Inflation, its "natural" home) for the same reason as
343 -- TimeUnit above: needed by several modules whose build order can't all safely {#import#} that
344 -- module (built before it, or -- for QuantLib.TermStructure.Yield -- mutually dependent with
345 -- it already).
346 data CPIInterpolationType = CPIFlat
347 | CPILinear
348 deriving (Show,Eq,Read,Bounded)
349 instance Enum CPIInterpolationType where
350 succ CPIFlat = CPILinear
351 succ CPILinear = error "CPIInterpolationType.succ: CPILinear has no successor"
352
353 pred CPILinear = CPIFlat
354 pred CPIFlat = error "CPIInterpolationType.pred: CPIFlat has no predecessor"
355
356 enumFromTo from to = go from
357 where
358 end = fromEnum to
359 go v = case compare (fromEnum v) end of
360 LT -> v : go (succ v)
361 EQ -> [v]
362 GT -> []
363
364 enumFrom from = enumFromTo from CPILinear
365
366 fromEnum CPIFlat = 1
367 fromEnum CPILinear = 2
368
369 toEnum 1 = CPIFlat
370 toEnum 2 = CPILinear
371 toEnum unmatched = error ("CPIInterpolationType.toEnum: Cannot match " ++ show unmatched)
372
373
374 data CalibrationBasketType = CalibrationBasketNaive
375 | MaturityStrikeByDeltaGamma
376 deriving (Enum,Show,Eq,Read,Bounded)
377
378
379
380 -- Payoff/Exercise pointer hierarchy: the Finalizable/Upcastable instances and raw phantom
381 -- tags (CPayoff' etc.) live in QuantLib.Internal.Type alongside every other class hierarchy;
382 -- these are just c2hs-local aliases so {#fun#} specs below can keep writing the bare `QlX'
383 -- names, resolving to a raw, unwrapped Ptr (no auto-generated foreign-pointer code) since
384 -- construction/upcasting is handled by hand in the with* functions further down.
385 type QlPayoff = Ptr CPayoff'
386 type QlBasketPayoff = Ptr CBasketPayoff'
387 type QlTypePayoff = Ptr CTypePayoff'
388 type QlStrikedTypePayoff = Ptr CStrikedTypePayoff'
389 type QlPercentageStrikePayoff = Ptr CPercentageStrikePayoff'
390 type QlPlainVanillaPayoff = Ptr CPlainVanillaPayoff'
391 type QlExercise = Ptr CExercise'
392 type QlEuropeanExercise = Ptr CEuropeanExercise'
393 type QlAmericanExercise = Ptr CAmericanExercise'
394 type QlSwingExercise = Ptr CSwingExercise'
395 type QlBermudanExercise = Ptr CBermudanExercise'
396 type QlRebatedExercise = Ptr CRebatedExercise'
397 -- identity peek function: c2hs {#fun#} return specs always need a named out-marshaller,
398 -- even when (as here) construction should just hand back the raw, un-wrapped pointer.
399 peekPtr :: Ptr a -> IO (Ptr a)
400 peekPtr = pure
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450 -- monotonic flag for CubicInterpolation::Spline/::Parabolic -- tells deriveCrossEnum to give
451 -- these two values a runtime Bool field instead of cross-producting named sub-values (same
452 -- pattern as Actual360Convention etc. in CalendarEnum.chs). Order matters here in a way it
453 -- doesn't for the ApproximationType enum itself: these two type synonyms (and ApproximationExtra
454 -- below) must be declared textually *above* the deriveCrossEnum splice, since a TH splice can
455 -- only see top-level declarations that already exist earlier in the same module -- classifySub's
456 -- lookupTypeName would silently miss them (falling back to NoSub, dropping the Bool field) if
457 -- they were moved below the splice.
458 type NaturalSplineMonotonic = Bool
459 type ParabolicMonotonic = Bool
460
461 -- every Approximation case is driven by ApproximationType itself, so unlike
462 -- CalendarExtra/DayCounterExtra/IborExtra there are no non-enum-driven cases to add here
463 data ApproximationExtra
464
465 $(deriveCrossEnum CrossEnumSpec
466 { crossTypeName = "Approximation"
467 , crossMapperFn = "qlApproximation"
468 , crossMainEnum = ''ApproximationType
469 , crossSubSuffix = "Monotonic"
470 , crossExtraType = ''ApproximationExtra
471 })
472
473 deriving instance Show Approximation
474 deriving instance Eq Approximation
475 deriving instance Read Approximation
476
477 -- Remaining cpp<->hs lockstep, unlike CalendarConstructor/DayCounterConstructor/IborConstructor:
478 -- those own a full C-side array/table, so *every* lockstep edit needed for a new value stays
479 -- inside cbits/. Approximation/Interpolation instead get dispatched via symbolic switch-case on
480 -- the shared enum -- now in exactly one place, cbits/qlTermStructureAux.cpp's
481 -- `dispatchInterpolation`, which every interpolator-parametrized curve/surface entry point in
482 -- cbits/ routes through (it used to be ~18 hand-duplicated
483 -- switch(interpolator){switch(approximator){...}} sites, one per curve template). Adding a new
484 -- ApproximationType/InterpolationType value to cbits/qlEnumObjects.h is zero-touch here on the
485 -- Haskell side (deriveCrossEnum picks it up automatically, defaulting to a nullary constructor
486 -- unless a <Value>Monotonic marker is added above), but dispatchInterpolation (and makeCubic,
487 -- for a new approximation) still needs a matching `case hasquant::NewValue:` by hand -- a missed
488 -- one isn't a compile error, just a runtime QL_FAIL("Unsupported ..."), exactly the pre-existing
489 -- gap Abcd fell into (see the comment on dispatchInterpolation's Cubic/LogCubic arms).
490
491 qlInterpolation :: Interpolation -> (Int, (Int, Int))
492 qlInterpolation BackwardFlat = (fromEnum InterpolationBackwardFlat, (0, 0))
493 qlInterpolation ForwardFlat = (fromEnum InterpolationForwardFlat, (0, 0))
494 qlInterpolation Linear = (fromEnum InterpolationLinear, (0, 0))
495 qlInterpolation LogLinear = (fromEnum InterpolationLogLinear, (0, 0))
496 qlInterpolation (Cubic x) = (fromEnum InterpolationCubic, qlApproximation x)
497 qlInterpolation (LogCubic x) = (fromEnum InterpolationLogCubic, qlApproximation x)
498 qlInterpolation Abcd = (fromEnum InterpolationAbcd, (0, 0))
499
500 qlInterpolation' :: Maybe Interpolation -> (Int, (Int, Int))
501 qlInterpolation' Nothing = (fromIntegral qlNullInteger, (0, 0))
502 qlInterpolation' (Just i) = qlInterpolation i
503
504 data Interpolation =
505 BackwardFlat
506 | ForwardFlat
507 | Linear
508 | LogLinear
509 | Cubic !Approximation
510 | LogCubic !Approximation
511 | Abcd
512 deriving (Show, Eq)
513
514 data EuropeanExercise = EuropeanExercise Day
515 -- | Use 'swingExerice' to construct 'Exercise'
516 data SwingExercise =
517 SwingListExercise ![(Day, Word)] -- ^(dates, seconds)
518 | SwingIntervalExercise !Day !Day !Word -- ^stepSizeSecs
519 data BermudanExercise =
520 BermudanExercise ![Day] !Bool
521 | Swing SwingExercise
522
523 -- | > Exercise
524 -- > American
525 -- > Early
526 -- > Vanilla
527 -- > EuropeanExercise
528 -- > BermudanExercise
529 -- > SwingExercise
530 -- > Rebated (wraps another Exercise)
531 data Exercise =
532 American
533 !(Maybe Day) -- ^earliestDate
534 !Day -- ^latestDate
535 !Bool -- ^paoffAtExpiry
536 | Early !ExerciseType !Bool
537 | Vanilla !ExerciseType
538 | European !EuropeanExercise
539 | Bermudan !BermudanExercise
540 | Rebated
541 !Exercise -- ^wrapped exercise
542 !Double -- ^rebate
543 !Word -- ^rebateSettlementDays
544 !Calendar -- ^rebatePaymentCalendar
545 !BusinessDayConvention -- ^rebatePaymentConvention
546
547 qlExercise :: (ExerciseType) -> IO ((QlExercise))
548 qlExercise a1 =
549 let {a1' = (fromIntegral . fromEnum) a1} in
550 preErrorCheck $ \a2' ->
551 qlExercise'_ a1' a2' >>= \res ->
552 peekPtr res >>= \res' ->
553 errorCheck a2'>>
554 return (res')
555
556
557 qlAmericanExercise :: (Day) -> (Day) -> (Bool) -> IO ((QlAmericanExercise))
558 qlAmericanExercise a1 a2 a3 =
559 withDay a1 $ \a1' ->
560 withDay a2 $ \a2' ->
561 let {a3' = C2HSImp.fromBool a3} in
562 preErrorCheck $ \a4' ->
563 qlAmericanExercise'_ a1' a2' a3' a4' >>= \res ->
564 peekPtr res >>= \res' ->
565 errorCheck a4'>>
566 return (res')
567
568
569 qlAmericanExercise1 :: (Day) -> (Bool) -> IO ((QlAmericanExercise))
570 qlAmericanExercise1 a1 a2 =
571 withDay a1 $ \a1' ->
572 let {a2' = C2HSImp.fromBool a2} in
573 preErrorCheck $ \a3' ->
574 qlAmericanExercise1'_ a1' a2' a3' >>= \res ->
575 peekPtr res >>= \res' ->
576 errorCheck a3'>>
577 return (res')
578
579
580 qlBermudanExercise :: ([Day]) -> (Bool) -> IO ((QlBermudanExercise))
581 qlBermudanExercise a1 a2 =
582 withDayArray a1 $ \(a1'1, a1'2) ->
583 let {a2' = C2HSImp.fromBool a2} in
584 preErrorCheck $ \a3' ->
585 qlBermudanExercise'_ a1'1 a1'2 a2' a3' >>= \res ->
586 peekPtr res >>= \res' ->
587 errorCheck a3'>>
588 return (res')
589
590
591 qlEarlyExercise :: (ExerciseType) -> (Bool) -> IO ((QlExercise))
592 qlEarlyExercise a1 a2 =
593 let {a1' = (fromIntegral . fromEnum) a1} in
594 let {a2' = C2HSImp.fromBool a2} in
595 preErrorCheck $ \a3' ->
596 qlEarlyExercise'_ a1' a2' a3' >>= \res ->
597 peekPtr res >>= \res' ->
598 errorCheck a3'>>
599 return (res')
600
601
602 qlEuropeanExercise :: (Day) -> IO ((QlEuropeanExercise))
603 qlEuropeanExercise a1 =
604 withDay a1 $ \a1' ->
605 preErrorCheck $ \a2' ->
606 qlEuropeanExercise'_ a1' a2' >>= \res ->
607 peekPtr res >>= \res' ->
608 errorCheck a2'>>
609 return (res')
610
611
612 qlSwingExercise :: ([Day]) -> ([Word]) -> IO ((QlSwingExercise))
613 qlSwingExercise a1 a2 =
614 withDayArray a1 $ \(a1'1, a1'2) ->
615 withIntArray a2 $ \(a2'1, a2'2) ->
616 preErrorCheck $ \a3' ->
617 qlSwingExercise'_ a1'1 a1'2 a2'1 a2'2 a3' >>= \res ->
618 peekPtr res >>= \res' ->
619 errorCheck a3'>>
620 return (res')
621
622
623 qlSwingExercise1 :: (Day) -> (Day) -> (Word) -> IO ((QlSwingExercise))
624 qlSwingExercise1 a1 a2 a3 =
625 withDay a1 $ \a1' ->
626 withDay a2 $ \a2' ->
627 let {a3' = fromIntegral a3} in
628 preErrorCheck $ \a4' ->
629 qlSwingExercise1'_ a1' a2' a3' a4' >>= \res ->
630 peekPtr res >>= \res' ->
631 errorCheck a4'>>
632 return (res')
633
634
635 qlRebatedExercise :: (QlExercise) -> (Double) -> (Word) -> (Calendar) -> (BusinessDayConvention) -> IO ((QlRebatedExercise))
636 qlRebatedExercise a1 a2 a3 a4 a5 =
637 let {a1' = id a1} in
638 let {a2' = realToFrac a2} in
639 let {a3' = fromIntegral a3} in
640 withCalendar a4 $ \a4' ->
641 let {a5' = fromEnumC a5} in
642 preErrorCheck $ \a6' ->
643 qlRebatedExercise'_ a1' a2' a3' a4' a5' a6' >>= \res ->
644 peekPtr res >>= \res' ->
645 errorCheck a6'>>
646 return (res')
647
648
649
650 withEuropeanExercise :: EuropeanExercise -> (QlEuropeanExercise -> IO a) -> IO a
651 withEuropeanExercise (EuropeanExercise d) f = qlEuropeanExercise d >>= newCastForeignPtr >>= flip withGenForeignPtr f
652
653 withSwingExercise :: SwingExercise -> (QlSwingExercise -> IO a) -> IO a
654 withSwingExercise (SwingListExercise ds) f = uncurry qlSwingExercise (unzip ds) >>= newCastForeignPtr >>= flip withGenForeignPtr f
655 withSwingExercise (SwingIntervalExercise d1 d2 s) f = qlSwingExercise1 d1 d2 s >>= newCastForeignPtr >>= flip withGenForeignPtr f
656
657 withBermudanExercise :: BermudanExercise -> (QlBermudanExercise -> IO a) -> IO a
658 withBermudanExercise (BermudanExercise d p) f = qlBermudanExercise d p >>= newCastForeignPtr >>= flip withGenForeignPtr f
659 withBermudanExercise (Swing e) f = withSwingExercise e (\sp -> upcast sp >>= \bp -> f bp `finally` freeUpcast bp)
660
661 withExercise :: Exercise -> (QlExercise -> IO a) -> IO a
662 withExercise (American Nothing d p) f = qlAmericanExercise1 d p >>= newGenForeignPtr >>= flip withGenForeignPtr f
663 withExercise (American (Just d0) d p) f = qlAmericanExercise d0 d p >>= newGenForeignPtr >>= flip withGenForeignPtr f
664 withExercise (Early t p) f = qlEarlyExercise t p >>= newCastForeignPtr >>= flip withGenForeignPtr f
665 withExercise (Vanilla t) f = qlExercise t >>= newCastForeignPtr >>= flip withGenForeignPtr f
666 withExercise (European e) f = withEuropeanExercise e (\ep -> upcast ep >>= \xp -> f xp `finally` freeUpcast xp)
667 withExercise (Bermudan e) f = withBermudanExercise e (\bp -> upcast bp >>= \xp -> f xp `finally` freeUpcast xp)
668 withExercise (Rebated e rebate days cal bdc) f = withExercise e (\ep -> qlRebatedExercise ep rebate days cal bdc >>= newGenForeignPtr >>= flip withGenForeignPtr f)
669
670 -- | use 'percentageStrikePayoff' to construct 'Payoff'
671 data PercentageStrikePayoff = PercentageStrikePayoff
672 !OptionType -- ^type
673 !Double -- ^moneyness
674
675 -- | use 'plainVanillaPayoff' to construct 'Payoff'
676 data PlainVanillaPayoff = PlainVanillaPayoff
677 !OptionType -- ^type
678 !Double -- ^strike
679
680 -- | use 'strikedPayoff' to construct 'Payoff'
681 data StrikedPayoff =
682 AssetOrNothing
683 !OptionType -- ^type
684 !Double -- ^strike
685 | CashOrNothing
686 !OptionType -- ^type
687 !Double -- ^strike
688 !Double -- ^cashPayoff
689 | Gap
690 !OptionType -- ^type
691 !Double -- ^strike
692 !Double -- ^secondStrike
693 | PercentageStrike !PercentageStrikePayoff
694 | PlainVanilla !PlainVanillaPayoff
695 | SuperFund
696 !Double -- ^strike
697 !Double -- ^secondStrike
698 | SuperSharePayoff
699 !Double -- ^strike
700 !Double -- ^secondStrike
701 !Double -- ^cashPayoff
702 -- |A Haskell-defined payoff carrying an advisory @(type, strike)@ pair. Build it with
703 -- 'withCustomStrikedPayoff'.
704 | CustomStriked
705 !OptionType -- ^type
706 !Double -- ^strike
707 !String -- ^name
708 !(FunPtr PayoffFun)
709
710 withPercentageStrikePayoff :: PercentageStrikePayoff -> (QlPercentageStrikePayoff -> IO a) -> IO a
711 withPercentageStrikePayoff (PercentageStrikePayoff t m) f = qlPercentageStrikePayoff t m >>= newCastForeignPtr >>= flip withGenForeignPtr f
712
713 withPlainVanillaPayoff :: PlainVanillaPayoff -> (QlPlainVanillaPayoff -> IO a) -> IO a
714 withPlainVanillaPayoff (PlainVanillaPayoff t s) f = qlPlainVanillaPayoff t s >>= newCastForeignPtr >>= flip withGenForeignPtr f
715
716 withStrikedPayoff :: StrikedPayoff -> (QlStrikedTypePayoff -> IO a) -> IO a
717 withStrikedPayoff (AssetOrNothing t s) f = qlAssetOrNothingPayoff t s >>= newCastForeignPtr >>= flip withGenForeignPtr f
718 withStrikedPayoff (CashOrNothing t s c) f = qlCashOrNothingPayoff t s c >>= newCastForeignPtr >>= flip withGenForeignPtr f
719 withStrikedPayoff (Gap t s ss) f = qlGapPayoff t s ss >>= newCastForeignPtr >>= flip withGenForeignPtr f
720 withStrikedPayoff (PercentageStrike p) f = withPercentageStrikePayoff p (\pp -> upcast pp >>= \sp -> f sp `finally` freeUpcast sp)
721 withStrikedPayoff (PlainVanilla p) f = withPlainVanillaPayoff p (\pp -> upcast pp >>= \sp -> f sp `finally` freeUpcast sp)
722 withStrikedPayoff (SuperFund s ss) f = qlSuperFundPayoff s ss >>= newCastForeignPtr >>= flip withGenForeignPtr f
723 withStrikedPayoff (SuperSharePayoff s ss c) f = qlSuperSharePayoff s ss c >>= newCastForeignPtr >>= flip withGenForeignPtr f
724 withStrikedPayoff (CustomStriked t k n fp) f = qlStrikedPayoffFromFunction t k n fp >>= newCastForeignPtr >>= flip withGenForeignPtr f
725
726 data TypePayoff = Striked !StrikedPayoff
727 | Floating !OptionType -- ^type
728 data BasketPayoff =
729 Average
730 !Payoff -- ^p
731 !Word -- ^n
732 | AverageMultiple
733 !Payoff -- ^p
734 ![Double] -- ^a
735 | Max
736 !Payoff -- ^p
737 | Min
738 !Payoff -- ^p
739 | Spread
740 !Payoff -- ^p
741 -- |A Haskell-defined @accumulate@ over the underlying-state vector, wrapped around a base
742 -- 'Payoff' exactly as 'Max'\/'Min'\/'Spread' are. Build it with 'withCustomBasketPayoff'.
743 | CustomAccumulate
744 !Payoff -- ^base payoff, applied to the accumulated value
745 !(FunPtr BasketAccumulateFun)
746
747 withTypePayoff :: TypePayoff -> (QlTypePayoff -> IO a) -> IO a
748 withTypePayoff (Floating t) f = qlFloatingTypePayoff t >>= newCastForeignPtr >>= flip withGenForeignPtr f
749 withTypePayoff (Striked s) f = withStrikedPayoff s (\sp -> upcast sp >>= \tp -> f tp `finally` freeUpcast tp)
750
751 withBasketPayoff :: BasketPayoff -> (QlBasketPayoff -> IO a) -> IO a
752 withBasketPayoff (Average p n) f = withPayoff p (\pp -> qlAverageBasketPayoff pp n >>= newCastForeignPtr >>= flip withGenForeignPtr f)
753 withBasketPayoff (AverageMultiple p a) f = withPayoff p (\pp -> qlAverageBasketPayoff1 pp a >>= newCastForeignPtr >>= flip withGenForeignPtr f)
754 withBasketPayoff (Max p) f = withPayoff p (\pp -> qlMaxBasketPayoff pp >>= newCastForeignPtr >>= flip withGenForeignPtr f)
755 withBasketPayoff (Min p) f = withPayoff p (\pp -> qlMinBasketPayoff pp >>= newCastForeignPtr >>= flip withGenForeignPtr f)
756 withBasketPayoff (Spread p) f = withPayoff p (\pp -> qlSpreadBasketPayoff pp >>= newCastForeignPtr >>= flip withGenForeignPtr f)
757 withBasketPayoff (CustomAccumulate p fp) f = withPayoff p (\pp -> qlBasketPayoffFromFunction pp fp >>= newCastForeignPtr >>= flip withGenForeignPtr f)
758
759 -- | > Payoff
760 -- > DoubleStickyRatchet
761 -- > ForwardType
762 -- > RatchettMax
763 -- > RatchetMin
764 -- > StickyMax
765 -- > StickyMin
766 -- > Sticky
767 -- > Custom
768 -- > TypePayoff
769 -- > Floating
770 -- > Striked
771 -- > AssetOrNothing
772 -- > CashOrNothing
773 -- > Gap
774 -- > PercentageStrike
775 -- > PlainVanilla
776 -- > SuperFund
777 -- > SuperSharePayoff
778 -- > CustomStriked
779 -- > BasketPayoff
780 -- > Average
781 -- > AverageMultiple
782 -- > Max
783 -- > Min
784 -- > Spread
785 -- > CustomAccumulate
786 data Payoff =
787 DoubleStickyRatchet
788 !Double -- ^type1
789 !Double -- ^type2
790 !Double -- ^gearing1
791 !Double -- ^gearing2
792 !Double -- ^gearing3
793 !Double -- ^spread1
794 !Double -- ^spread2
795 !Double -- ^spread3
796 !Double -- ^initialValue1
797 !Double -- ^initialValue2
798 !Double -- ^accrualFactor
799 | ForwardType
800 !PositionType -- ^type
801 !Double -- ^strike
802 | RatchetMax
803 !Double -- ^gearing1
804 !Double -- ^gearing2
805 !Double -- ^gearing3
806 !Double -- ^spread1
807 !Double -- ^spread2
808 !Double -- ^spread3
809 !Double -- ^initialValue1
810 !Double -- ^initialValue2
811 !Double -- ^accrualFactor
812 | RatchetMin
813 !Double -- ^gearing1
814 !Double -- ^gearing2
815 !Double -- ^gearing3
816 !Double -- ^spread1
817 !Double -- ^spread2
818 !Double -- ^spread3
819 !Double -- ^initialValue1
820 !Double -- ^initialValue2
821 !Double -- ^accrualFactor
822 | Ratchet
823 !Double -- ^gearing1
824 !Double -- ^gearing2
825 !Double -- ^spread1
826 !Double -- ^spread2
827 !Double -- ^initialValue
828 !Double -- ^accrualFactor
829 | StickyMax
830 !Double -- ^gearing1
831 !Double -- ^gearing2
832 !Double -- ^gearing3
833 !Double -- ^spread1
834 !Double -- ^spread2
835 !Double -- ^spread3
836 !Double -- ^initialValue1
837 !Double -- ^initialValue2
838 !Double -- ^accrualFactor
839 | StickyMin
840 !Double -- ^gearing1
841 !Double -- ^gearing2
842 !Double -- ^gearing3
843 !Double -- ^spread1
844 !Double -- ^spread2
845 !Double -- ^spread3
846 !Double -- ^initialValue1
847 !Double -- ^initialValue2
848 !Double -- ^accrualFactor
849 | Sticky
850 !Double -- ^gearing1
851 !Double -- ^gearing2
852 !Double -- ^spread1
853 !Double -- ^spread2
854 !Double -- ^initialValue
855 !Double -- ^accrualFactor
856 | Type !TypePayoff
857 | Basket !BasketPayoff
858 -- |A Haskell-defined payoff. Build it with 'withCustomPayoff' rather than by hand: the
859 -- 'FunPtr' must stay alive for as long as anything can still call the payoff, which
860 -- 'withCustomPayoff' arranges and a hand-built value does not.
861 | Custom
862 !String -- ^name
863 !String -- ^description
864 !(FunPtr PayoffFun)
865
866
867 qlAssetOrNothingPayoff :: (OptionType) -> (Double) -> IO ((QlStrikedTypePayoff))
868 qlAssetOrNothingPayoff a1 a2 =
869 let {a1' = (fromIntegral . fromEnum) a1} in
870 let {a2' = realToFrac a2} in
871 preErrorCheck $ \a3' ->
872 qlAssetOrNothingPayoff'_ a1' a2' a3' >>= \res ->
873 peekPtr res >>= \res' ->
874 errorCheck a3'>>
875 return (res')
876
877
878 qlAverageBasketPayoff :: (QlPayoff) -> (Word) -> IO ((QlBasketPayoff))
879 qlAverageBasketPayoff a1 a2 =
880 let {a1' = id a1} in
881 let {a2' = fromIntegral a2} in
882 preErrorCheck $ \a3' ->
883 qlAverageBasketPayoff'_ a1' a2' a3' >>= \res ->
884 peekPtr res >>= \res' ->
885 errorCheck a3'>>
886 return (res')
887
888
889 qlCashOrNothingPayoff :: (OptionType) -> (Double) -> (Double) -> IO ((QlStrikedTypePayoff))
890 qlCashOrNothingPayoff a1 a2 a3 =
891 let {a1' = (fromIntegral . fromEnum) a1} in
892 let {a2' = realToFrac a2} in
893 let {a3' = realToFrac a3} in
894 preErrorCheck $ \a4' ->
895 qlCashOrNothingPayoff'_ a1' a2' a3' a4' >>= \res ->
896 peekPtr res >>= \res' ->
897 errorCheck a4'>>
898 return (res')
899
900
901 qlDoubleStickyRatchetPayoff :: (Double) -> (Double) -> (Double) -> (Double) -> (Double) -> (Double) -> (Double) -> (Double) -> (Double) -> (Double) -> (Double) -> IO ((QlPayoff))
902 qlDoubleStickyRatchetPayoff a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 =
903 let {a1' = realToFrac a1} in
904 let {a2' = realToFrac a2} in
905 let {a3' = realToFrac a3} in
906 let {a4' = realToFrac a4} in
907 let {a5' = realToFrac a5} in
908 let {a6' = realToFrac a6} in
909 let {a7' = realToFrac a7} in
910 let {a8' = realToFrac a8} in
911 let {a9' = realToFrac a9} in
912 let {a10' = realToFrac a10} in
913 let {a11' = realToFrac a11} in
914 preErrorCheck $ \a12' ->
915 qlDoubleStickyRatchetPayoff'_ a1' a2' a3' a4' a5' a6' a7' a8' a9' a10' a11' a12' >>= \res ->
916 peekPtr res >>= \res' ->
917 errorCheck a12'>>
918 return (res')
919
920
921 qlFloatingTypePayoff :: (OptionType) -> IO ((QlTypePayoff))
922 qlFloatingTypePayoff a1 =
923 let {a1' = (fromIntegral . fromEnum) a1} in
924 preErrorCheck $ \a2' ->
925 qlFloatingTypePayoff'_ a1' a2' >>= \res ->
926 peekPtr res >>= \res' ->
927 errorCheck a2'>>
928 return (res')
929
930
931 qlForwardTypePayoff :: (PositionType) -> (Double) -> IO ((QlPayoff))
932 qlForwardTypePayoff a1 a2 =
933 let {a1' = (fromIntegral . fromEnum) a1} in
934 let {a2' = realToFrac a2} in
935 preErrorCheck $ \a3' ->
936 qlForwardTypePayoff'_ a1' a2' a3' >>= \res ->
937 peekPtr res >>= \res' ->
938 errorCheck a3'>>
939 return (res')
940
941
942 qlGapPayoff :: (OptionType) -> (Double) -> (Double) -> IO ((QlStrikedTypePayoff))
943 qlGapPayoff a1 a2 a3 =
944 let {a1' = (fromIntegral . fromEnum) a1} in
945 let {a2' = realToFrac a2} in
946 let {a3' = realToFrac a3} in
947 preErrorCheck $ \a4' ->
948 qlGapPayoff'_ a1' a2' a3' a4' >>= \res ->
949 peekPtr res >>= \res' ->
950 errorCheck a4'>>
951 return (res')
952
953
954 qlMaxBasketPayoff :: (QlPayoff) -> IO ((QlBasketPayoff))
955 qlMaxBasketPayoff a1 =
956 let {a1' = id a1} in
957 preErrorCheck $ \a2' ->
958 qlMaxBasketPayoff'_ a1' a2' >>= \res ->
959 peekPtr res >>= \res' ->
960 errorCheck a2'>>
961 return (res')
962
963
964 qlMinBasketPayoff :: (QlPayoff) -> IO ((QlBasketPayoff))
965 qlMinBasketPayoff a1 =
966 let {a1' = id a1} in
967 preErrorCheck $ \a2' ->
968 qlMinBasketPayoff'_ a1' a2' >>= \res ->
969 peekPtr res >>= \res' ->
970 errorCheck a2'>>
971 return (res')
972
973
974 qlPercentageStrikePayoff :: (OptionType) -> (Double) -> IO ((QlPercentageStrikePayoff))
975 qlPercentageStrikePayoff a1 a2 =
976 let {a1' = (fromIntegral . fromEnum) a1} in
977 let {a2' = realToFrac a2} in
978 preErrorCheck $ \a3' ->
979 qlPercentageStrikePayoff'_ a1' a2' a3' >>= \res ->
980 peekPtr res >>= \res' ->
981 errorCheck a3'>>
982 return (res')
983
984
985 qlPlainVanillaPayoff :: (OptionType) -> (Double) -> IO ((QlPlainVanillaPayoff))
986 qlPlainVanillaPayoff a1 a2 =
987 let {a1' = (fromIntegral . fromEnum) a1} in
988 let {a2' = realToFrac a2} in
989 preErrorCheck $ \a3' ->
990 qlPlainVanillaPayoff'_ a1' a2' a3' >>= \res ->
991 peekPtr res >>= \res' ->
992 errorCheck a3'>>
993 return (res')
994
995
996 qlRatchetMaxPayoff :: (Double) -> (Double) -> (Double) -> (Double) -> (Double) -> (Double) -> (Double) -> (Double) -> (Double) -> IO ((QlPayoff))
997 qlRatchetMaxPayoff a1 a2 a3 a4 a5 a6 a7 a8 a9 =
998 let {a1' = realToFrac a1} in
999 let {a2' = realToFrac a2} in
1000 let {a3' = realToFrac a3} in
1001 let {a4' = realToFrac a4} in
1002 let {a5' = realToFrac a5} in
1003 let {a6' = realToFrac a6} in
1004 let {a7' = realToFrac a7} in
1005 let {a8' = realToFrac a8} in
1006 let {a9' = realToFrac a9} in
1007 preErrorCheck $ \a10' ->
1008 qlRatchetMaxPayoff'_ a1' a2' a3' a4' a5' a6' a7' a8' a9' a10' >>= \res ->
1009 peekPtr res >>= \res' ->
1010 errorCheck a10'>>
1011 return (res')
1012
1013
1014 qlRatchetMinPayoff :: (Double) -> (Double) -> (Double) -> (Double) -> (Double) -> (Double) -> (Double) -> (Double) -> (Double) -> IO ((QlPayoff))
1015 qlRatchetMinPayoff a1 a2 a3 a4 a5 a6 a7 a8 a9 =
1016 let {a1' = realToFrac a1} in
1017 let {a2' = realToFrac a2} in
1018 let {a3' = realToFrac a3} in
1019 let {a4' = realToFrac a4} in
1020 let {a5' = realToFrac a5} in
1021 let {a6' = realToFrac a6} in
1022 let {a7' = realToFrac a7} in
1023 let {a8' = realToFrac a8} in
1024 let {a9' = realToFrac a9} in
1025 preErrorCheck $ \a10' ->
1026 qlRatchetMinPayoff'_ a1' a2' a3' a4' a5' a6' a7' a8' a9' a10' >>= \res ->
1027 peekPtr res >>= \res' ->
1028 errorCheck a10'>>
1029 return (res')
1030
1031
1032 qlRatchetPayoff :: (Double) -> (Double) -> (Double) -> (Double) -> (Double) -> (Double) -> IO ((QlPayoff))
1033 qlRatchetPayoff a1 a2 a3 a4 a5 a6 =
1034 let {a1' = realToFrac a1} in
1035 let {a2' = realToFrac a2} in
1036 let {a3' = realToFrac a3} in
1037 let {a4' = realToFrac a4} in
1038 let {a5' = realToFrac a5} in
1039 let {a6' = realToFrac a6} in
1040 preErrorCheck $ \a7' ->
1041 qlRatchetPayoff'_ a1' a2' a3' a4' a5' a6' a7' >>= \res ->
1042 peekPtr res >>= \res' ->
1043 errorCheck a7'>>
1044 return (res')
1045
1046
1047 qlSpreadBasketPayoff :: (QlPayoff) -> IO ((QlBasketPayoff))
1048 qlSpreadBasketPayoff a1 =
1049 let {a1' = id a1} in
1050 preErrorCheck $ \a2' ->
1051 qlSpreadBasketPayoff'_ a1' a2' >>= \res ->
1052 peekPtr res >>= \res' ->
1053 errorCheck a2'>>
1054 return (res')
1055
1056
1057 qlStickyMaxPayoff :: (Double) -> (Double) -> (Double) -> (Double) -> (Double) -> (Double) -> (Double) -> (Double) -> (Double) -> IO ((QlPayoff))
1058 qlStickyMaxPayoff a1 a2 a3 a4 a5 a6 a7 a8 a9 =
1059 let {a1' = realToFrac a1} in
1060 let {a2' = realToFrac a2} in
1061 let {a3' = realToFrac a3} in
1062 let {a4' = realToFrac a4} in
1063 let {a5' = realToFrac a5} in
1064 let {a6' = realToFrac a6} in
1065 let {a7' = realToFrac a7} in
1066 let {a8' = realToFrac a8} in
1067 let {a9' = realToFrac a9} in
1068 preErrorCheck $ \a10' ->
1069 qlStickyMaxPayoff'_ a1' a2' a3' a4' a5' a6' a7' a8' a9' a10' >>= \res ->
1070 peekPtr res >>= \res' ->
1071 errorCheck a10'>>
1072 return (res')
1073
1074
1075 qlStickyMinPayoff :: (Double) -> (Double) -> (Double) -> (Double) -> (Double) -> (Double) -> (Double) -> (Double) -> (Double) -> IO ((QlPayoff))
1076 qlStickyMinPayoff a1 a2 a3 a4 a5 a6 a7 a8 a9 =
1077 let {a1' = realToFrac a1} in
1078 let {a2' = realToFrac a2} in
1079 let {a3' = realToFrac a3} in
1080 let {a4' = realToFrac a4} in
1081 let {a5' = realToFrac a5} in
1082 let {a6' = realToFrac a6} in
1083 let {a7' = realToFrac a7} in
1084 let {a8' = realToFrac a8} in
1085 let {a9' = realToFrac a9} in
1086 preErrorCheck $ \a10' ->
1087 qlStickyMinPayoff'_ a1' a2' a3' a4' a5' a6' a7' a8' a9' a10' >>= \res ->
1088 peekPtr res >>= \res' ->
1089 errorCheck a10'>>
1090 return (res')
1091
1092
1093 qlStickyPayoff :: (Double) -> (Double) -> (Double) -> (Double) -> (Double) -> (Double) -> IO ((QlPayoff))
1094 qlStickyPayoff a1 a2 a3 a4 a5 a6 =
1095 let {a1' = realToFrac a1} in
1096 let {a2' = realToFrac a2} in
1097 let {a3' = realToFrac a3} in
1098 let {a4' = realToFrac a4} in
1099 let {a5' = realToFrac a5} in
1100 let {a6' = realToFrac a6} in
1101 preErrorCheck $ \a7' ->
1102 qlStickyPayoff'_ a1' a2' a3' a4' a5' a6' a7' >>= \res ->
1103 peekPtr res >>= \res' ->
1104 errorCheck a7'>>
1105 return (res')
1106
1107
1108 qlSuperFundPayoff :: (Double) -> (Double) -> IO ((QlStrikedTypePayoff))
1109 qlSuperFundPayoff a1 a2 =
1110 let {a1' = realToFrac a1} in
1111 let {a2' = realToFrac a2} in
1112 preErrorCheck $ \a3' ->
1113 qlSuperFundPayoff'_ a1' a2' a3' >>= \res ->
1114 peekPtr res >>= \res' ->
1115 errorCheck a3'>>
1116 return (res')
1117
1118
1119 qlSuperSharePayoff :: (Double) -> (Double) -> (Double) -> IO ((QlStrikedTypePayoff))
1120 qlSuperSharePayoff a1 a2 a3 =
1121 let {a1' = realToFrac a1} in
1122 let {a2' = realToFrac a2} in
1123 let {a3' = realToFrac a3} in
1124 preErrorCheck $ \a4' ->
1125 qlSuperSharePayoff'_ a1' a2' a3' a4' >>= \res ->
1126 peekPtr res >>= \res' ->
1127 errorCheck a4'>>
1128 return (res')
1129
1130
1131 qlAverageBasketPayoff1 :: (QlPayoff) -> ([Double]) -> IO ((QlBasketPayoff))
1132 qlAverageBasketPayoff1 a1 a2 =
1133 let {a1' = id a1} in
1134 withDoubleArray a2 $ \(a2'1, a2'2) ->
1135 preErrorCheck $ \a3' ->
1136 qlAverageBasketPayoff1'_ a1' a2'1 a2'2 a3' >>= \res ->
1137 peekPtr res >>= \res' ->
1138 errorCheck a3'>>
1139 return (res')
1140
1141
1142 qlPayoffFromFunction :: (String) -> (String) -> (FunPtr PayoffFun) -> IO ((QlPayoff))
1143 qlPayoffFromFunction a1 a2 a3 =
1144 C2HSImp.withCString a1 $ \a1' ->
1145 C2HSImp.withCString a2 $ \a2' ->
1146 let {a3' = id a3} in
1147 preErrorCheck $ \a4' ->
1148 qlPayoffFromFunction'_ a1' a2' a3' a4' >>= \res ->
1149 peekPtr res >>= \res' ->
1150 errorCheck a4'>>
1151 return (res')
1152
1153
1154 qlBasketPayoffFromFunction :: (QlPayoff) -> (FunPtr BasketAccumulateFun) -> IO ((QlBasketPayoff))
1155 qlBasketPayoffFromFunction a1 a2 =
1156 let {a1' = id a1} in
1157 let {a2' = id a2} in
1158 preErrorCheck $ \a3' ->
1159 qlBasketPayoffFromFunction'_ a1' a2' a3' >>= \res ->
1160 peekPtr res >>= \res' ->
1161 errorCheck a3'>>
1162 return (res')
1163
1164
1165 qlStrikedPayoffFromFunction :: (OptionType) -> (Double) -> (String) -> (FunPtr PayoffFun) -> IO ((QlStrikedTypePayoff))
1166 qlStrikedPayoffFromFunction a1 a2 a3 a4 =
1167 let {a1' = (fromIntegral . fromEnum) a1} in
1168 let {a2' = realToFrac a2} in
1169 C2HSImp.withCString a3 $ \a3' ->
1170 let {a4' = id a4} in
1171 preErrorCheck $ \a5' ->
1172 qlStrikedPayoffFromFunction'_ a1' a2' a3' a4' a5' >>= \res ->
1173 peekPtr res >>= \res' ->
1174 errorCheck a5'>>
1175 return (res')
1176
1177
1178
1179 withPayoff :: Payoff -> (QlPayoff -> IO a) -> IO a
1180 withPayoff (DoubleStickyRatchet t1 t2 g1 g2 g3 s1 s2 s3 i1 i2 a) f = qlDoubleStickyRatchetPayoff t1 t2 g1 g2 g3 s1 s2 s3 i1 i2 a >>= newCastForeignPtr >>= flip withGenForeignPtr f
1181 withPayoff (ForwardType t s) f = qlForwardTypePayoff t s >>= newCastForeignPtr >>= flip withGenForeignPtr f
1182 withPayoff (RatchetMax g1 g2 g3 s1 s2 s3 i1 i2 a) f = qlRatchetMaxPayoff g1 g2 g3 s1 s2 s3 i1 i2 a >>= newCastForeignPtr >>= flip withGenForeignPtr f
1183 withPayoff (RatchetMin g1 g2 g3 s1 s2 s3 i1 i2 a) f = qlRatchetMinPayoff g1 g2 g3 s1 s2 s3 i1 i2 a >>= newCastForeignPtr >>= flip withGenForeignPtr f
1184 withPayoff (Ratchet g1 g2 s1 s2 i a) f = qlRatchetPayoff g1 g2 s1 s2 i a >>= newCastForeignPtr >>= flip withGenForeignPtr f
1185 withPayoff (StickyMax g1 g2 g3 s1 s2 s3 i1 i2 a) f = qlStickyMaxPayoff g1 g2 g3 s1 s2 s3 i1 i2 a >>= newCastForeignPtr >>= flip withGenForeignPtr f
1186 withPayoff (StickyMin g1 g2 g3 s1 s2 s3 i1 i2 a) f = qlStickyMinPayoff g1 g2 g3 s1 s2 s3 i1 i2 a >>= newCastForeignPtr >>= flip withGenForeignPtr f
1187 withPayoff (Sticky g1 g2 s1 s2 i a) f = qlStickyPayoff g1 g2 s1 s2 i a >>= newCastForeignPtr >>= flip withGenForeignPtr f
1188 withPayoff (Type t) f = withTypePayoff t (\tp -> upcast tp >>= \pp -> f pp `finally` freeUpcast pp)
1189 withPayoff (Basket b) f = withBasketPayoff b (\bp -> upcast bp >>= \pp -> f pp `finally` freeUpcast pp)
1190 withPayoff (Custom n d fp) f = qlPayoffFromFunction n d fp >>= newCastForeignPtr >>= flip withGenForeignPtr f
1191
1192 -- |Wrap a Haskell @price -> value@ function as a real QuantLib @Payoff@, usable anywhere a
1193 -- 'Payoff' is (@QuantLib.Instrument.Option.oneAssetOption@, @multiAssetOption@,
1194 -- @QuantLib.Instrument.Swap.varianceOption@, @QuantLib.Method.fdmLogInnerValue@,
1195 -- @fdmCellAveragingInnerValue@, ...) -- the fully custom counterpart to the concrete
1196 -- pre-implemented payoffs listed by the 'Payoff' constructors above.
1197 --
1198 -- The payoff is valid only inside the continuation, and the continuation must span the whole
1199 -- /use/, not just the construction: every consumer stores the payoff and calls back into it
1200 -- later (an @Instrument@ at @NPV@ time, an @FdmInnerValueCalculator@ at @fdmSolve@ time), so
1201 -- pricing must happen before this function returns. Same lifetime rule, and the same reason, as
1202 -- @QuantLib.Method.withCustomFdmInnerValueCalculator@.
1203 --
1204 -- @name@ and @description@ are what QuantLib's own error messages and @Payoff::name@ report; they
1205 -- are not interpreted.
1206 --
1207 -- __Not every engine accepts a non-standard payoff.__ QuantLib's analytic, binomial, finite-
1208 -- difference and @MCEuropeanEngine@ families all recover the strike by downcasting to
1209 -- @StrikedTypePayoff@\/@PlainVanillaPayoff@ first, and a further ~30 engines route through
1210 -- @BlackCalculator@, whose @AcyclicVisitor@ knows only the four built-in striked payoffs. Most of
1211 -- these fail with a clean QuantLib exception, but
1212 -- @QuantLib.PricingEngine.fdBlackScholesVanillaEngine@ and
1213 -- @QuantLib.PricingEngine.fdHestonVanillaEngine@ perform that downcast /unchecked/ upstream and
1214 -- will __crash the process__, not throw, on a custom payoff. Confirmed-generic consumers:
1215 -- @QuantLib.Method.fdmLogInnerValue@\/@fdmCellAveragingInnerValue@ (and hence @fdmSolve@), and
1216 -- @QuantLib.PricingEngine.mcAmericanEngine@ with @controlVariate = False@.
1217 withCustomPayoff :: String -- ^name
1218 -> String -- ^description
1219 -> (Double -> Double) -- ^payoff(price)
1220 -> (Payoff -> IO b) -> IO b
1221 withCustomPayoff n d f k = withPayoffFun f (k . Custom n d)
1222
1223 -- |As 'withCustomPayoff', but produces a real QuantLib @StrikedTypePayoff@ carrying an
1224 -- @(optionType, strike)@ pair alongside the Haskell function.
1225 --
1226 -- __The pair is advisory: it does not define the payoff__ -- @payoff(price)@ alone does, exactly
1227 -- as for 'withCustomPayoff'. It exists because QuantLib's finite-difference vanilla engines reach
1228 -- past the @Payoff@ interface for a strike when sizing their grid:
1229 -- @FdBlackScholesVanillaEngine@ @dynamic_pointer_cast@s to @StrikedTypePayoff@ /without/ a check
1230 -- and calls @strike()@ twice -- once for the mesher's extent, once for its node-concentration
1231 -- point -- then hands the payoff itself to @FdmLogInnerValue@, which takes a plain @Payoff@. So a
1232 -- payoff built here prices correctly through
1233 -- 'QuantLib.PricingEngine.fdBlackScholesVanillaEngine' and
1234 -- 'QuantLib.PricingEngine.fdHestonVanillaEngine', where one built by 'withCustomPayoff' would
1235 -- crash the process on that unchecked cast. Pass the strike you want the grid centred on.
1236 --
1237 -- Everything else matches 'withCustomPayoff', including the continuation-lifetime rule: the
1238 -- payoff is valid only inside the continuation, which must span the whole use (pricing included),
1239 -- not just construction. @description@ is not a parameter here -- @StrikedTypePayoff@ derives it
1240 -- from the type and strike itself.
1241 --
1242 -- Engines routing through @BlackCalculator@ (the @analytic*@ family) still reject this, as they
1243 -- must: its @AcyclicVisitor@ knows only the four built-in striked payoffs, and there is no
1244 -- closed-form price for an arbitrary function. That rejection is a clean QuantLib exception.
1245 withCustomStrikedPayoff :: OptionType -- ^advisory option type
1246 -> Double -- ^advisory strike (grid centring only)
1247 -> String -- ^name
1248 -> (Double -> Double) -- ^payoff(price)
1249 -> (StrikedPayoff -> IO b) -> IO b
1250 withCustomStrikedPayoff t k n f g = withPayoffFun f (g . CustomStriked t k n)
1251
1252 -- |Wrap a Haskell @underlyings -> accumulated@ function as a real QuantLib @BasketPayoff@ around
1253 -- @base@ (which is applied to the accumulated value, exactly as for 'Max'\/'Min'\/'Spread') --
1254 -- usable with @QuantLib.Instrument.Option.basketOption@ and
1255 -- @QuantLib.Method.fdmLogBasketInnerValue@. Same continuation-lifetime rule as 'withCustomPayoff';
1256 -- unlike it, this callback crosses once per evaluation with the whole underlying-state vector,
1257 -- because that is the shape @BasketPayoff::accumulate@ already has upstream.
1258 withCustomBasketPayoff :: Payoff -- ^base payoff
1259 -> ([Double] -> Double) -- ^accumulate(underlyings)
1260 -> (BasketPayoff -> IO b) -> IO b
1261 withCustomBasketPayoff base f k = withBasketAccumulateFun f (k . CustomAccumulate base)
1262
1263 data Callability =
1264 Soft
1265 !(Double, BondPriceType)
1266 !Day
1267 !Double -- ^trigger
1268 | Callability
1269 !(Double, BondPriceType)
1270 !CallabilityType
1271 !Day
1272
1273 callability :: Callability -> IO (Standalone CQlCallability)
1274 callability (Soft (p, t) d tg) = qlSoftCallability p t d tg
1275 callability (Callability (p, t) ct d) = qlCallability p t ct d
1276
1277 newtype EnumMeta a b = EnumMeta (a -> IO (Standalone b))
1278
1279 withEnumType :: EnumMeta a b -> a -> (Ptr b -> IO c) -> IO c
1280 withEnumType (EnumMeta t) x f = t x >>= (`withStandalone` f)
1281
1282 withMaybeEnumType :: EnumMeta a b -> Maybe a -> (Ptr b -> IO c) -> IO c
1283 withMaybeEnumType (EnumMeta t) x f = maybe (f nullPtr) (\xx -> t xx >>= (`withStandalone` f)) x
1284
1285 withEnumTypeArray :: EnumMeta a b -> [a] -> ((CUInt, Ptr (Ptr b)) -> IO c) -> IO c
1286 withEnumTypeArray m x f = withMany (withEnumType m) x (`withArray` (\px -> f (fromIntegral $ length x, px)))
1287
1288 callabilityMeta :: EnumMeta Callability CQlCallability
1289 callabilityMeta = EnumMeta callability
1290
1291 withCallability :: Callability -> (Ptr CQlCallability -> IO a) -> IO a
1292 withCallability = withEnumType callabilityMeta
1293
1294 withCallabilityArray :: [Callability] -> ((CUInt, Ptr (Ptr CQlCallability)) -> IO c) -> IO c
1295 withCallabilityArray = withEnumTypeArray callabilityMeta
1296
1297 constraintMeta :: EnumMeta Constraint CConstraint
1298 constraintMeta = EnumMeta constraint
1299
1300 roundingMeta :: EnumMeta Rounding CRounding
1301 roundingMeta = EnumMeta rounding
1302
1303 withMaybeConstraint :: Maybe Constraint -> (Ptr CConstraint -> IO a) -> IO a
1304 withMaybeConstraint = withMaybeEnumType constraintMeta
1305
1306 withMaybeRounding :: Maybe Rounding -> (Ptr CRounding -> IO a) -> IO a
1307 withMaybeRounding = withMaybeEnumType roundingMeta
1308
1309 withConstraint :: Constraint -> (Ptr CConstraint -> IO a) -> IO a
1310 withConstraint = withEnumType constraintMeta
1311
1312 withRounding :: Rounding -> (Ptr CRounding -> IO a) -> IO a
1313 withRounding = withEnumType roundingMeta
1314
1315 fittedBondDiscountFittingMethodMeta :: EnumMeta FittingMethod CFittedBondDiscountCurveFittingMethod
1316 fittedBondDiscountFittingMethodMeta = EnumMeta fittingMethod
1317
1318 withFittedBondDiscountCurveFittingMethod :: FittingMethod -> (Ptr CFittedBondDiscountCurveFittingMethod -> IO a) -> IO a
1319 withFittedBondDiscountCurveFittingMethod = withEnumType fittedBondDiscountFittingMethodMeta
1320
1321 endCriteriaMeta :: EnumMeta EndCriteria CEndCriteria
1322 endCriteriaMeta = EnumMeta endCriteria
1323
1324 withEndCriteria :: EndCriteria -> (Ptr CEndCriteria -> IO a) -> IO a
1325 withEndCriteria = withEnumType endCriteriaMeta
1326
1327 withMaybeEndCriteria :: Maybe EndCriteria -> (Ptr CEndCriteria -> IO a) -> IO a
1328 withMaybeEndCriteria = withMaybeEnumType endCriteriaMeta
1329
1330 fdmSchemeDescMeta :: EnumMeta FdmScheme CFdmSchemeDesc
1331 fdmSchemeDescMeta = EnumMeta fdmScheme
1332
1333 withFdmSchemeDesc :: FdmScheme -> (Ptr CFdmSchemeDesc -> IO a) -> IO a
1334 withFdmSchemeDesc = withEnumType fdmSchemeDescMeta
1335
1336 optimizationMethodMeta :: EnumMeta OptimizationMethod COptimizationMethod
1337 optimizationMethodMeta = EnumMeta optimizationMethod
1338
1339 withOptimizationMethod :: OptimizationMethod -> (Ptr COptimizationMethod -> IO a) -> IO a
1340 withOptimizationMethod = withEnumType optimizationMethodMeta
1341
1342 withMaybeOptimizationMethod :: Maybe OptimizationMethod -> (Ptr COptimizationMethod -> IO a) -> IO a
1343 withMaybeOptimizationMethod = withMaybeEnumType optimizationMethodMeta
1344
1345 -- Payoff/Exercise with* functions are now defined directly, near their ADTs, using
1346 -- Upcastable/GenForeignPtr (see QuantLib.Internal.Type) instead of EnumMeta'/IsQlPayoff/IsQlExercise.
1347
1348 -- |callability leaving to the holder the possibility to convert
1349 qlSoftCallability :: (Double) -> (BondPriceType) -> (Day) -> (Double) -> IO ((QlCallability))
1350 qlSoftCallability a1 a2 a3 a4 =
1351 let {a1' = realToFrac a1} in
1352 let {a2' = (fromIntegral . fromEnum) a2} in
1353 withDay a3 $ \a3' ->
1354 let {a4' = realToFrac a4} in
1355 preErrorCheck $ \a5' ->
1356 qlSoftCallability'_ a1' a2' a3' a4' a5' >>= \res ->
1357 peekCallability res >>= \res' ->
1358 errorCheck a5'>>
1359 return (res')
1360
1361
1362 qlCallability :: (Double) -> (BondPriceType) -> (CallabilityType) -> (Day) -> IO ((QlCallability))
1363 qlCallability a1 a2 a3 a4 =
1364 let {a1' = realToFrac a1} in
1365 let {a2' = (fromIntegral . fromEnum) a2} in
1366 let {a3' = (fromIntegral . fromEnum) a3} in
1367 withDay a4 $ \a4' ->
1368 preErrorCheck $ \a5' ->
1369 qlCallability'_ a1' a2' a3' a4' a5' >>= \res ->
1370 peekCallability res >>= \res' ->
1371 errorCheck a5'>>
1372 return (res')
1373
1374
1375
1376 -- Every constructor below binds the QuantLib overload's leading optimizationMethod param via a
1377 -- trailing Maybe OptimizationMethod field (Nothing -> upstream's own empty-shared_ptr default,
1378 -- letting the fit fall back to LevenbergMarquardt). OptimizationMethod's hasquant-side handle
1379 -- (QlOptimizationMethod) is a shared_ptr box, not a raw Haskell-finalized pointer -- see the
1380 -- qlaux.h comment above the QlEndCriteria/QlOptimizationMethod typedefs -- so a caller-supplied
1381 -- one can safely be copied into FittingMethod's own shared_ptr member (and survive
1382 -- FittedBondDiscountCurve cloning the fitting method) regardless of when Haskell's own box is
1383 -- collected.
1384 data FittingMethod =
1385 CubicBSplines
1386 ![Double] -- ^knotVector (year fraction)
1387 !Bool -- ^constrainAtZero
1388 ![Double] -- ^weights
1389 ![Double] -- ^l2
1390 !Double -- ^minCutoffTime
1391 !Double -- ^maxCutoffTime
1392 !(Maybe Constraint)
1393 !(Maybe OptimizationMethod)
1394 | ExponentialSplines
1395 !Bool -- ^constrainAtZero
1396 ![Double] -- ^weights
1397 ![Double] -- ^l2
1398 !Double -- ^minCutoffTime
1399 !Double -- ^maxCutoffTime
1400 !Word -- ^numCoeffs
1401 !(Maybe Double) -- ^fixedKappa
1402 !(Maybe Constraint)
1403 !(Maybe OptimizationMethod)
1404 | NelsonSiegel
1405 ![Double] -- ^weights
1406 ![Double] -- ^l2
1407 !Double -- ^minCutoffTime
1408 !Double -- ^maxCutoffTime
1409 !(Maybe Constraint)
1410 !(Maybe OptimizationMethod)
1411 | SimplePolynomial
1412 !Word -- ^degree
1413 !Bool -- ^constrainAtZero
1414 ![Double] -- ^weights
1415 ![Double] -- ^l2
1416 !Double -- ^minCutoffTime
1417 !Double -- ^maxCutoffTime
1418 !(Maybe Constraint)
1419 !(Maybe OptimizationMethod)
1420 | Svensson
1421 ![Double] -- ^weights
1422 ![Double] -- ^l2
1423 !Double -- ^minCutoffTime
1424 !Double -- ^maxCutoffTime
1425 !(Maybe Constraint)
1426 !(Maybe OptimizationMethod)
1427
1428 fittingMethod :: FittingMethod -> IO QlFittedBondDiscountCurveFittingMethod
1429 fittingMethod (CubicBSplines k c w l2 mn mx cn om) = qlCubicBSplinesFitting k c w l2 mn mx om cn
1430 fittingMethod (ExponentialSplines c w l2 mn mx n fk cn om) = qlExponentialSplinesFitting c w l2 mn mx n fk om cn
1431 fittingMethod (NelsonSiegel w l2 mn mx cn om) = qlNelsonSiegelFitting w l2 mn mx om cn
1432 fittingMethod (SimplePolynomial d c w l2 mn mx cn om) = qlSimplePolynomialFitting d c w l2 mn mx om cn
1433 fittingMethod (Svensson w l2 mn mx cn om) = qlSvenssonFitting w l2 mn mx om cn
1434
1435 qlCubicBSplinesFitting :: ([Double]) -> (Bool) -> ([Double]) -- ^weights
1436 -> ([Double]) -- ^l2
1437 -> (Double) -- ^minCutoffTime
1438 -> (Double) -- ^maxCutoffTime
1439 -> (Maybe OptimizationMethod) -> (Maybe Constraint) -> IO ((QlFittedBondDiscountCurveFittingMethod))
1440 qlCubicBSplinesFitting a1 a2 a3 a4 a5 a6 a7 a8 =
1441 withDoubleArray a1 $ \(a1'1, a1'2) ->
1442 let {a2' = C2HSImp.fromBool a2} in
1443 withDoubleArray a3 $ \(a3'1, a3'2) ->
1444 withDoubleArray a4 $ \(a4'1, a4'2) ->
1445 let {a5' = realToFrac a5} in
1446 let {a6' = realToFrac a6} in
1447 withMaybeOptimizationMethod a7 $ \a7' ->
1448 withMaybeConstraint a8 $ \a8' ->
1449 preErrorCheck $ \a9' ->
1450 qlCubicBSplinesFitting'_ a1'1 a1'2 a2' a3'1 a3'2 a4'1 a4'2 a5' a6' a7' a8' a9' >>= \res ->
1451 peekFittedBondDiscountCurveFittingMethod res >>= \res' ->
1452 errorCheck a9'>>
1453 return (res')
1454
1455
1456 qlExponentialSplinesFitting :: (Bool) -> ([Double]) -- ^weights
1457 -> ([Double]) -- ^l2
1458 -> (Double) -- ^minCutoffTime
1459 -> (Double) -- ^maxCutoffTime
1460 -> (Word) -- ^numCoeffs
1461 -> (Maybe Double) -- ^fixedKappa
1462 -> (Maybe OptimizationMethod) -> (Maybe Constraint) -> IO ((QlFittedBondDiscountCurveFittingMethod))
1463 qlExponentialSplinesFitting a1 a2 a3 a4 a5 a6 a7 a8 a9 =
1464 let {a1' = C2HSImp.fromBool a1} in
1465 withDoubleArray a2 $ \(a2'1, a2'2) ->
1466 withDoubleArray a3 $ \(a3'1, a3'2) ->
1467 let {a4' = realToFrac a4} in
1468 let {a5' = realToFrac a5} in
1469 let {a6' = fromIntegral a6} in
1470 let {a7' = fromMaybeDouble a7} in
1471 withMaybeOptimizationMethod a8 $ \a8' ->
1472 withMaybeConstraint a9 $ \a9' ->
1473 preErrorCheck $ \a10' ->
1474 qlExponentialSplinesFitting'_ a1' a2'1 a2'2 a3'1 a3'2 a4' a5' a6' a7' a8' a9' a10' >>= \res ->
1475 peekFittedBondDiscountCurveFittingMethod res >>= \res' ->
1476 errorCheck a10'>>
1477 return (res')
1478
1479
1480 qlNelsonSiegelFitting :: ([Double]) -- ^weights
1481 -> ([Double]) -- ^l2
1482 -> (Double) -- ^minCutoffTime
1483 -> (Double) -- ^maxCutoffTime
1484 -> (Maybe OptimizationMethod) -> (Maybe Constraint) -> IO ((QlFittedBondDiscountCurveFittingMethod))
1485 qlNelsonSiegelFitting a1 a2 a3 a4 a5 a6 =
1486 withDoubleArray a1 $ \(a1'1, a1'2) ->
1487 withDoubleArray a2 $ \(a2'1, a2'2) ->
1488 let {a3' = realToFrac a3} in
1489 let {a4' = realToFrac a4} in
1490 withMaybeOptimizationMethod a5 $ \a5' ->
1491 withMaybeConstraint a6 $ \a6' ->
1492 preErrorCheck $ \a7' ->
1493 qlNelsonSiegelFitting'_ a1'1 a1'2 a2'1 a2'2 a3' a4' a5' a6' a7' >>= \res ->
1494 peekFittedBondDiscountCurveFittingMethod res >>= \res' ->
1495 errorCheck a7'>>
1496 return (res')
1497
1498
1499 qlSimplePolynomialFitting :: (Word) -> (Bool) -> ([Double]) -- ^weights
1500 -> ([Double]) -- ^l2
1501 -> (Double) -- ^minCutoffTime
1502 -> (Double) -- ^maxCutoffTime
1503 -> (Maybe OptimizationMethod) -> (Maybe Constraint) -> IO ((QlFittedBondDiscountCurveFittingMethod))
1504 qlSimplePolynomialFitting a1 a2 a3 a4 a5 a6 a7 a8 =
1505 let {a1' = fromIntegral a1} in
1506 let {a2' = C2HSImp.fromBool a2} in
1507 withDoubleArray a3 $ \(a3'1, a3'2) ->
1508 withDoubleArray a4 $ \(a4'1, a4'2) ->
1509 let {a5' = realToFrac a5} in
1510 let {a6' = realToFrac a6} in
1511 withMaybeOptimizationMethod a7 $ \a7' ->
1512 withMaybeConstraint a8 $ \a8' ->
1513 preErrorCheck $ \a9' ->
1514 qlSimplePolynomialFitting'_ a1' a2' a3'1 a3'2 a4'1 a4'2 a5' a6' a7' a8' a9' >>= \res ->
1515 peekFittedBondDiscountCurveFittingMethod res >>= \res' ->
1516 errorCheck a9'>>
1517 return (res')
1518
1519
1520 qlSvenssonFitting :: ([Double]) -- ^weights
1521 -> ([Double]) -- ^l2
1522 -> (Double) -- ^minCutoffTime
1523 -> (Double) -- ^maxCutoffTime
1524 -> (Maybe OptimizationMethod) -> (Maybe Constraint) -> IO ((QlFittedBondDiscountCurveFittingMethod))
1525 qlSvenssonFitting a1 a2 a3 a4 a5 a6 =
1526 withDoubleArray a1 $ \(a1'1, a1'2) ->
1527 withDoubleArray a2 $ \(a2'1, a2'2) ->
1528 let {a3' = realToFrac a3} in
1529 let {a4' = realToFrac a4} in
1530 withMaybeOptimizationMethod a5 $ \a5' ->
1531 withMaybeConstraint a6 $ \a6' ->
1532 preErrorCheck $ \a7' ->
1533 qlSvenssonFitting'_ a1'1 a1'2 a2'1 a2'2 a3' a4' a5' a6' a7' >>= \res ->
1534 peekFittedBondDiscountCurveFittingMethod res >>= \res' ->
1535 errorCheck a7'>>
1536 return (res')
1537
1538
1539
1540 data FdmScheme =
1541 FdmScheme
1542 !FdmSchemeType -- ^type
1543 !Double -- ^theta
1544 !Double -- ^mu
1545 | CraigSneyd
1546 | Douglas
1547 | ExplicitEuler
1548 | Hundsdorfer
1549 | ImplicitEuler
1550 | ModifiedCraigSneyd
1551 | ModifiedHundsdorfer
1552
1553 qlFdmSchemeDesc :: (FdmSchemeType) -> (Double) -> (Double) -> IO ((QlFdmSchemeDesc))
1554 qlFdmSchemeDesc a1 a2 a3 =
1555 let {a1' = (fromIntegral . fromEnum) a1} in
1556 let {a2' = realToFrac a2} in
1557 let {a3' = realToFrac a3} in
1558 preErrorCheck $ \a4' ->
1559 qlFdmSchemeDesc'_ a1' a2' a3' a4' >>= \res ->
1560 peekFdmSchemeDesc res >>= \res' ->
1561 errorCheck a4'>>
1562 return (res')
1563
1564
1565 qlFdmSchemeDescCraigSneyd :: IO ((QlFdmSchemeDesc))
1566 qlFdmSchemeDescCraigSneyd =
1567 preErrorCheck $ \a1' ->
1568 qlFdmSchemeDescCraigSneyd'_ a1' >>= \res ->
1569 peekFdmSchemeDesc res >>= \res' ->
1570 errorCheck a1'>>
1571 return (res')
1572
1573
1574 qlFdmSchemeDescDouglas :: IO ((QlFdmSchemeDesc))
1575 qlFdmSchemeDescDouglas =
1576 preErrorCheck $ \a1' ->
1577 qlFdmSchemeDescDouglas'_ a1' >>= \res ->
1578 peekFdmSchemeDesc res >>= \res' ->
1579 errorCheck a1'>>
1580 return (res')
1581
1582
1583 qlFdmSchemeDescExplicitEuler :: IO ((QlFdmSchemeDesc))
1584 qlFdmSchemeDescExplicitEuler =
1585 preErrorCheck $ \a1' ->
1586 qlFdmSchemeDescExplicitEuler'_ a1' >>= \res ->
1587 peekFdmSchemeDesc res >>= \res' ->
1588 errorCheck a1'>>
1589 return (res')
1590
1591
1592 qlFdmSchemeDescHundsdorfer :: IO ((QlFdmSchemeDesc))
1593 qlFdmSchemeDescHundsdorfer =
1594 preErrorCheck $ \a1' ->
1595 qlFdmSchemeDescHundsdorfer'_ a1' >>= \res ->
1596 peekFdmSchemeDesc res >>= \res' ->
1597 errorCheck a1'>>
1598 return (res')
1599
1600
1601 qlFdmSchemeDescImplicitEuler :: IO ((QlFdmSchemeDesc))
1602 qlFdmSchemeDescImplicitEuler =
1603 preErrorCheck $ \a1' ->
1604 qlFdmSchemeDescImplicitEuler'_ a1' >>= \res ->
1605 peekFdmSchemeDesc res >>= \res' ->
1606 errorCheck a1'>>
1607 return (res')
1608
1609
1610 qlFdmSchemeDescModifiedCraigSneyd :: IO ((QlFdmSchemeDesc))
1611 qlFdmSchemeDescModifiedCraigSneyd =
1612 preErrorCheck $ \a1' ->
1613 qlFdmSchemeDescModifiedCraigSneyd'_ a1' >>= \res ->
1614 peekFdmSchemeDesc res >>= \res' ->
1615 errorCheck a1'>>
1616 return (res')
1617
1618
1619 qlFdmSchemeDescModifiedHundsdorfer :: IO ((QlFdmSchemeDesc))
1620 qlFdmSchemeDescModifiedHundsdorfer =
1621 preErrorCheck $ \a1' ->
1622 qlFdmSchemeDescModifiedHundsdorfer'_ a1' >>= \res ->
1623 peekFdmSchemeDesc res >>= \res' ->
1624 errorCheck a1'>>
1625 return (res')
1626
1627
1628
1629 fdmScheme :: FdmScheme -> IO QlFdmSchemeDesc
1630 fdmScheme (FdmScheme t th mu) = qlFdmSchemeDesc t th mu
1631 fdmScheme CraigSneyd = qlFdmSchemeDescCraigSneyd
1632 fdmScheme Douglas = qlFdmSchemeDescDouglas
1633 fdmScheme ExplicitEuler = qlFdmSchemeDescExplicitEuler
1634 fdmScheme Hundsdorfer = qlFdmSchemeDescHundsdorfer
1635 fdmScheme ImplicitEuler = qlFdmSchemeDescImplicitEuler
1636 fdmScheme ModifiedCraigSneyd = qlFdmSchemeDescModifiedCraigSneyd
1637 fdmScheme ModifiedHundsdorfer = qlFdmSchemeDescModifiedHundsdorfer
1638
1639 data Constraint =
1640 Boundary
1641 !Double -- ^low
1642 !Double -- ^high
1643 | Composite
1644 !Constraint -- ^c1
1645 !Constraint -- ^c2
1646 | NoConstraint
1647 | PositiveConstraint
1648
1649 constraint :: Constraint -> IO QlConstraint
1650 constraint (Boundary l h) = qlBoundaryConstraint l h
1651 constraint (Composite c1 c2) = qlCompositeConstraint c1 c2
1652 constraint NoConstraint = qlNoConstraint
1653 constraint PositiveConstraint = qlPositiveConstraint
1654
1655 qlBoundaryConstraint :: (Double) -> (Double) -> IO ((QlConstraint))
1656 qlBoundaryConstraint a1 a2 =
1657 let {a1' = realToFrac a1} in
1658 let {a2' = realToFrac a2} in
1659 preErrorCheck $ \a3' ->
1660 qlBoundaryConstraint'_ a1' a2' a3' >>= \res ->
1661 peekConstraint res >>= \res' ->
1662 errorCheck a3'>>
1663 return (res')
1664
1665
1666 qlCompositeConstraint :: (Constraint) -> (Constraint) -> IO ((QlConstraint))
1667 qlCompositeConstraint a1 a2 =
1668 withConstraint a1 $ \a1' ->
1669 withConstraint a2 $ \a2' ->
1670 preErrorCheck $ \a3' ->
1671 qlCompositeConstraint'_ a1' a2' a3' >>= \res ->
1672 peekConstraint res >>= \res' ->
1673 errorCheck a3'>>
1674 return (res')
1675
1676
1677 qlNoConstraint :: IO ((QlConstraint))
1678 qlNoConstraint =
1679 preErrorCheck $ \a1' ->
1680 qlNoConstraint'_ a1' >>= \res ->
1681 peekConstraint res >>= \res' ->
1682 errorCheck a1'>>
1683 return (res')
1684
1685
1686 qlPositiveConstraint :: IO ((QlConstraint))
1687 qlPositiveConstraint =
1688 preErrorCheck $ \a1' ->
1689 qlPositiveConstraint'_ a1' >>= \res ->
1690 peekConstraint res >>= \res' ->
1691 errorCheck a1'>>
1692 return (res')
1693
1694
1695
1696 data OptimizationMethod =
1697 LevenbergMarquardt
1698 !Double -- ^epsfcn
1699 !Double -- ^xtol
1700 !Double -- ^gtol
1701 !Bool -- ^useCostFunctionsJacobian
1702 | Simplex !Double -- ^lambda, characteristic length
1703
1704 optimizationMethod :: OptimizationMethod -> IO QlOptimizationMethod
1705 optimizationMethod (LevenbergMarquardt e x g j) = qlLevenbergMarquardt e x g j
1706 optimizationMethod (Simplex l) = qlSimplex l
1707 qlLevenbergMarquardt :: (Double) -> (Double) -> (Double) -> (Bool) -> IO ((QlOptimizationMethod))
1708 qlLevenbergMarquardt a1 a2 a3 a4 =
1709 let {a1' = realToFrac a1} in
1710 let {a2' = realToFrac a2} in
1711 let {a3' = realToFrac a3} in
1712 let {a4' = C2HSImp.fromBool a4} in
1713 preErrorCheck $ \a5' ->
1714 qlLevenbergMarquardt'_ a1' a2' a3' a4' a5' >>= \res ->
1715 peekOptimizationMethod res >>= \res' ->
1716 errorCheck a5'>>
1717 return (res')
1718
1719
1720 qlSimplex :: (Double) -> IO ((QlOptimizationMethod))
1721 qlSimplex a1 =
1722 let {a1' = realToFrac a1} in
1723 preErrorCheck $ \a2' ->
1724 qlSimplex'_ a1' a2' >>= \res ->
1725 peekOptimizationMethod res >>= \res' ->
1726 errorCheck a2'>>
1727 return (res')
1728
1729
1730
1731 data EndCriteria =
1732 EndCriteria
1733 !Word -- ^maxIterations
1734 !Word -- ^maxStationaryStateIterations
1735 !Double -- ^rootEpsilon
1736 !Double -- ^functionEpsilon
1737 !Double -- ^gradientNormEpsilon
1738
1739 endCriteria :: EndCriteria -> IO QlEndCriteria
1740 endCriteria (EndCriteria m1 m2 e f g) = qlEndCriteria m1 m2 e f g
1741 qlEndCriteria :: (Word) -> (Word) -> (Double) -> (Double) -> (Double) -> IO ((QlEndCriteria))
1742 qlEndCriteria a1 a2 a3 a4 a5 =
1743 let {a1' = fromIntegral a1} in
1744 let {a2' = fromIntegral a2} in
1745 let {a3' = realToFrac a3} in
1746 let {a4' = realToFrac a4} in
1747 let {a5' = realToFrac a5} in
1748 preErrorCheck $ \a6' ->
1749 qlEndCriteria'_ a1' a2' a3' a4' a5' a6' >>= \res ->
1750 peekEndCriteria res >>= \res' ->
1751 errorCheck a6'>>
1752 return (res')
1753
1754
1755
1756 data Rounding = NoRounding
1757 | Rounding
1758 !Int -- ^precision
1759 !RoundingType
1760 !Int -- ^digit
1761 deriving (Show, Eq)
1762
1763 rounding :: Rounding -> IO QlRounding
1764 rounding NoRounding = qlRounding
1765 rounding (Rounding p t d) = qlRounding1 p t d
1766
1767 qlRounding :: IO ((QlRounding))
1768 qlRounding =
1769 preErrorCheck $ \a1' ->
1770 qlRounding'_ a1' >>= \res ->
1771 peekRounding res >>= \res' ->
1772 errorCheck a1'>>
1773 return (res')
1774
1775
1776 qlRounding1 :: (Int) -> (RoundingType) -> (Int) -> IO ((QlRounding))
1777 qlRounding1 a1 a2 a3 =
1778 let {a1' = fromIntegral a1} in
1779 let {a2' = (fromIntegral . fromEnum) a2} in
1780 let {a3' = fromIntegral a3} in
1781 preErrorCheck $ \a4' ->
1782 qlRounding1'_ a1' a2' a3' a4' >>= \res ->
1783 peekRounding res >>= \res' ->
1784 errorCheck a4'>>
1785 return (res')
1786
1787
1788
1789 data LmCorrelationModel = ConstWrapperCorrelation LmCorrelationModel
1790 | ExponentialCorrelation Word -- ^size
1791 !Double -- ^rho
1792 | LinearExponentialCorrelation Word -- ^size
1793 !Double -- ^rho
1794 !Double -- ^beta
1795 !Word -- ^factors
1796 deriving (Show, Eq)
1797
1798 qlLmConstWrapperCorrelationModel :: (QlLmCorrelationModel) -> IO ((QlLmCorrelationModel))
1799 qlLmConstWrapperCorrelationModel a1 =
1800 withStandalone a1 $ \a1' ->
1801 preErrorCheck $ \a2' ->
1802 qlLmConstWrapperCorrelationModel'_ a1' a2' >>= \res ->
1803 peekLmCorrelationModel res >>= \res' ->
1804 errorCheck a2'>>
1805 return (res')
1806
1807
1808 qlLmExponentialCorrelationModel :: (Word) -> (Double) -> IO ((QlLmCorrelationModel))
1809 qlLmExponentialCorrelationModel a1 a2 =
1810 let {a1' = fromIntegral a1} in
1811 let {a2' = realToFrac a2} in
1812 preErrorCheck $ \a3' ->
1813 qlLmExponentialCorrelationModel'_ a1' a2' a3' >>= \res ->
1814 peekLmCorrelationModel res >>= \res' ->
1815 errorCheck a3'>>
1816 return (res')
1817
1818
1819 qlLmLinearExponentialCorrelationModel :: (Word) -> (Double) -> (Double) -> (Word) -> IO ((QlLmCorrelationModel))
1820 qlLmLinearExponentialCorrelationModel a1 a2 a3 a4 =
1821 let {a1' = fromIntegral a1} in
1822 let {a2' = realToFrac a2} in
1823 let {a3' = realToFrac a3} in
1824 let {a4' = fromIntegral a4} in
1825 preErrorCheck $ \a5' ->
1826 qlLmLinearExponentialCorrelationModel'_ a1' a2' a3' a4' a5' >>= \res ->
1827 peekLmCorrelationModel res >>= \res' ->
1828 errorCheck a5'>>
1829 return (res')
1830
1831
1832
1833 correlationModel :: LmCorrelationModel -> IO QlLmCorrelationModel
1834 correlationModel (ConstWrapperCorrelation m) = correlationModel m >>= qlLmConstWrapperCorrelationModel
1835 correlationModel (ExponentialCorrelation s r) = qlLmExponentialCorrelationModel s r
1836 correlationModel (LinearExponentialCorrelation s r b f) = qlLmLinearExponentialCorrelationModel s r b f
1837
1838 correlationModelMeta :: EnumMeta LmCorrelationModel CLmCorrelationModel
1839 correlationModelMeta = EnumMeta correlationModel
1840
1841 withLmCorrelationModel :: LmCorrelationModel -> (Ptr CLmCorrelationModel -> IO a) -> IO a
1842 withLmCorrelationModel = withEnumType correlationModelMeta
1843
1844 data LmVolatilityModel = ConstWrapperVolatility LmVolatilityModel
1845 | FixedVolatility ![Double] ![Double]
1846 | LinearExponentialVolatility ![Double] -- ^fixing times
1847 !Double -- ^a
1848 !Double -- ^b
1849 !Double -- ^c
1850 !Double -- ^d
1851 deriving (Show, Eq)
1852
1853 qlLmConstWrapperVolatilityModel :: (QlLmVolatilityModel) -> IO ((QlLmVolatilityModel))
1854 qlLmConstWrapperVolatilityModel a1 =
1855 withStandalone a1 $ \a1' ->
1856 preErrorCheck $ \a2' ->
1857 qlLmConstWrapperVolatilityModel'_ a1' a2' >>= \res ->
1858 peekLmVolatilityModel res >>= \res' ->
1859 errorCheck a2'>>
1860 return (res')
1861
1862
1863 qlLmFixedVolatilityModel :: ([Double]) -> ([Double]) -> IO ((QlLmVolatilityModel))
1864 qlLmFixedVolatilityModel a1 a2 =
1865 withDoubleArray a1 $ \(a1'1, a1'2) ->
1866 withDoubleArray a2 $ \(a2'1, a2'2) ->
1867 preErrorCheck $ \a3' ->
1868 qlLmFixedVolatilityModel'_ a1'1 a1'2 a2'1 a2'2 a3' >>= \res ->
1869 peekLmVolatilityModel res >>= \res' ->
1870 errorCheck a3'>>
1871 return (res')
1872
1873
1874 qlLmLinearExponentialVolatilityModel :: ([Double]) -> (Double) -> (Double) -> (Double) -> (Double) -> IO ((QlLmVolatilityModel))
1875 qlLmLinearExponentialVolatilityModel a1 a2 a3 a4 a5 =
1876 withDoubleArray a1 $ \(a1'1, a1'2) ->
1877 let {a2' = realToFrac a2} in
1878 let {a3' = realToFrac a3} in
1879 let {a4' = realToFrac a4} in
1880 let {a5' = realToFrac a5} in
1881 preErrorCheck $ \a6' ->
1882 qlLmLinearExponentialVolatilityModel'_ a1'1 a1'2 a2' a3' a4' a5' a6' >>= \res ->
1883 peekLmVolatilityModel res >>= \res' ->
1884 errorCheck a6'>>
1885 return (res')
1886
1887
1888
1889 volatilityModel :: LmVolatilityModel -> IO QlLmVolatilityModel
1890 volatilityModel (ConstWrapperVolatility m) = volatilityModel m >>= qlLmConstWrapperVolatilityModel
1891 volatilityModel (FixedVolatility d1 d2) = qlLmFixedVolatilityModel d1 d2
1892 volatilityModel (LinearExponentialVolatility s a b c d) = qlLmLinearExponentialVolatilityModel s a b c d
1893
1894 volatilityModelMeta :: EnumMeta LmVolatilityModel CLmVolatilityModel
1895 volatilityModelMeta = EnumMeta volatilityModel
1896
1897 withLmVolatilityModel :: LmVolatilityModel -> (Ptr CLmVolatilityModel -> IO a) -> IO a
1898 withLmVolatilityModel = withEnumType volatilityModelMeta
1899
1900 data Claim = FaceValue | FaceValueAccrual Bond
1901 claimMeta :: EnumMeta Claim CQlClaim
1902 claimMeta = EnumMeta claim
1903
1904 withClaim :: Claim -> (Ptr CQlClaim -> IO a) -> IO a
1905 withClaim = withEnumType claimMeta
1906
1907 claim :: Claim -> IO QlClaim
1908 claim FaceValue = qlFaceValueClaim
1909 claim (FaceValueAccrual b) = qlFaceValueAccrualClaim b
1910
1911 -- |Claim on a notional
1912 qlFaceValueClaim :: IO ((QlClaim))
1913 qlFaceValueClaim =
1914 preErrorCheck $ \a1' ->
1915 qlFaceValueClaim'_ a1' >>= \res ->
1916 peekClaim res >>= \res' ->
1917 errorCheck a1'>>
1918 return (res')
1919
1920
1921
1922 -- |Claim on the notional of a reference security, including accrual
1923 qlFaceValueAccrualClaim :: (Bond) -> IO ((QlClaim))
1924 qlFaceValueAccrualClaim a1 =
1925 withBond a1 $ \a1' ->
1926 preErrorCheck $ \a2' ->
1927 qlFaceValueAccrualClaim'_ a1' a2' >>= \res ->
1928 peekClaim res >>= \res' ->
1929 errorCheck a2'>>
1930 return (res')
1931
1932
1933
1934 strikedPayoff :: StrikedPayoff -> Payoff
1935 strikedPayoff = Type . Striked
1936
1937 percentageStrikePayoff :: PercentageStrikePayoff -> Payoff
1938 percentageStrikePayoff = Type . Striked . PercentageStrike
1939
1940 plainVanillaPayoff :: PlainVanillaPayoff -> Payoff
1941 plainVanillaPayoff = Type . Striked . PlainVanilla
1942
1943 swingExercise :: SwingExercise -> Exercise
1944 swingExercise = Bermudan . Swing
1945
1946 -- |One value from QuantLib's `Instrument::additionalResults()` map. QuantLib stores the map as
1947 -- `ext::any`, so this Haskell view picks three concrete shapes -- `Real` (`Double`), `std::string`
1948 -- (`String`), `std::vector<Real>` (`[Double]`) -- plus an `UnsupportedVal` fallback recording the
1949 -- value's C++ RTTI type name, so no key is ever silently dropped or mislabelled.
1950 data AdditionalResultVal = RealVal Double | StringVal String | RealVectorVal [Double] | UnsupportedVal String
1951 deriving (Show, Eq)
1952
1953 -- |Discriminants for `QlAdditionalResult.type`, bound from `enum AdditionalResultType` in
1954 -- `cbits/qlInstrument.h` (read from the header, not hardcoded).
1955 data AdditionalResultType = AdditionalResultDouble
1956 | AdditionalResultString
1957 | AdditionalResultDoubleVector
1958 | AdditionalResultUnknown
1959 deriving (Show,Eq,Read)
1960 instance Enum AdditionalResultType where
1961 succ AdditionalResultDouble = AdditionalResultString
1962 succ AdditionalResultString = AdditionalResultDoubleVector
1963 succ AdditionalResultDoubleVector = AdditionalResultUnknown
1964 succ AdditionalResultUnknown = error "AdditionalResultType.succ: AdditionalResultUnknown has no successor"
1965
1966 pred AdditionalResultString = AdditionalResultDouble
1967 pred AdditionalResultDoubleVector = AdditionalResultString
1968 pred AdditionalResultUnknown = AdditionalResultDoubleVector
1969 pred AdditionalResultDouble = error "AdditionalResultType.pred: AdditionalResultDouble has no predecessor"
1970
1971 enumFromTo from to = go from
1972 where
1973 end = fromEnum to
1974 go v = case compare (fromEnum v) end of
1975 LT -> v : go (succ v)
1976 EQ -> [v]
1977 GT -> []
1978
1979 enumFrom from = enumFromTo from AdditionalResultUnknown
1980
1981 fromEnum AdditionalResultDouble = 0
1982 fromEnum AdditionalResultString = 1
1983 fromEnum AdditionalResultDoubleVector = 2
1984 fromEnum AdditionalResultUnknown = 3
1985
1986 toEnum 0 = AdditionalResultDouble
1987 toEnum 1 = AdditionalResultString
1988 toEnum 2 = AdditionalResultDoubleVector
1989 toEnum 3 = AdditionalResultUnknown
1990 toEnum unmatched = error ("AdditionalResultType.toEnum: Cannot match " ++ show unmatched)
1991
1992
1993
1994 -- |Registers `struct QlAdditionalResult*` with c2hs as `RawResultPtr`, `nocode` since we supply
1995 -- the Haskell type ourselves (below) rather than a c2hs-generated wrapper. This is what lets the
1996 -- `additionalResults` `{#fun#}` binding (in `QuantLib.Instrument`)'s low-level array-of-structs
1997 -- out-parameter (C type `struct QlAdditionalResult **`) be typed `Ptr RawResultPtr` =
1998 -- `Ptr (Ptr RawResult)`, instead of defaulting to an opaque `Ptr (Ptr ())`.
1999
2000
2001 type RawResultPtr = Ptr RawResult
2002
2003 -- |One raw `QlAdditionalResult` entry, peeked field-by-field via c2hs `{#get#}` hooks. Its
2004 -- `Storable` instance (`sizeOf`/`alignment` from `{#sizeof#}`/`{#alignof#}`, both read straight
2005 -- from the C struct layout, not hand-computed) is what lets `peekStructArray`
2006 -- (`QuantLib.Internal`) walk the C array via a plain `peekArray`, rather than hand-rolled pointer
2007 -- arithmetic.
2008 data RawResult = RawResult
2009 { rKey :: CString, rType :: CInt, rDval :: CDouble
2010 , rSval :: CString, rVarr :: Ptr CDouble, rVlen :: CUInt }
2011
2012 instance Storable RawResult where
2013 sizeOf _ = 48
2014
2015 alignment _ = 8
2016
2017 peek p = RawResult <$> (\ptr -> do {C2HSImp.peekByteOff ptr 0 :: IO (C2HSImp.Ptr C2HSImp.CChar)}) p
2018 <*> (\ptr -> do {C2HSImp.peekByteOff ptr 8 :: IO C2HSImp.CInt}) p
2019 <*> (\ptr -> do {C2HSImp.peekByteOff ptr 16 :: IO C2HSImp.CDouble}) p
2020 <*> (\ptr -> do {C2HSImp.peekByteOff ptr 24 :: IO (C2HSImp.Ptr C2HSImp.CChar)}) p
2021 <*> (\ptr -> do {C2HSImp.peekByteOff ptr 32 :: IO (C2HSImp.Ptr C2HSImp.CDouble)}) p
2022 <*> (\ptr -> do {C2HSImp.peekByteOff ptr 40 :: IO C2HSImp.CUInt}) p
2023 poke = error "RawResult is peek-only (read from C, never constructed in Haskell)"
2024
2025 -- |Convert one raw entry into its keyed Haskell value. `sval`/`varr` are only read for the
2026 -- discriminant that owns them; their buffers are released in bulk afterwards, by
2027 -- `qlFreeAdditionalResults`, not per-field here.
2028 convertResult :: RawResult -> IO (String, AdditionalResultVal)
2029 convertResult r = do
2030 key <- peekCString (rKey r)
2031 val <- case toEnum (fromIntegral (rType r)) of
2032 AdditionalResultDouble -> return (RealVal (realToFrac (rDval r)))
2033 AdditionalResultString -> StringVal <$> peekCString (rSval r)
2034 AdditionalResultDoubleVector -> RealVectorVal . map realToFrac
2035 <$> peekArray (fromIntegral (rVlen r)) (rVarr r)
2036 AdditionalResultUnknown -> UnsupportedVal <$> peekCString (rSval r)
2037 return (key, val)
2038
2039 -- |Peek the C array of `QlAdditionalResult` into a keyed list, then release the whole array (keys,
2040 -- `sval`/`varr` buffers, and the array itself) in one `qlFreeAdditionalResults` call.
2041 peekAdditionalResults :: Ptr CUInt -> Ptr RawResultPtr -> IO [(String, AdditionalResultVal)]
2042 peekAdditionalResults = peekStructArray convertResult (\l p -> qlFreeAdditionalResults l (castPtr p))
2043
2044 -- vim: set ff=unix ts=8 sts=2 sw=2 et:
2045
2046 foreign import ccall safe "QuantLib/Internal/Common.chs.h qlExercise"
2047 qlExercise'_ :: (C2HSImp.CInt -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO (QlExercise))))
2048
2049 foreign import ccall safe "QuantLib/Internal/Common.chs.h qlAmericanExercise"
2050 qlAmericanExercise'_ :: (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO (QlAmericanExercise))))))
2051
2052 foreign import ccall safe "QuantLib/Internal/Common.chs.h qlAmericanExercise1"
2053 qlAmericanExercise1'_ :: (C2HSImp.CInt -> (C2HSImp.CInt -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO (QlAmericanExercise)))))
2054
2055 foreign import ccall safe "QuantLib/Internal/Common.chs.h qlBermudanExercise"
2056 qlBermudanExercise'_ :: (C2HSImp.CUInt -> ((C2HSImp.Ptr C2HSImp.CInt) -> (C2HSImp.CInt -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO (QlBermudanExercise))))))
2057
2058 foreign import ccall safe "QuantLib/Internal/Common.chs.h qlEarlyExercise"
2059 qlEarlyExercise'_ :: (C2HSImp.CInt -> (C2HSImp.CInt -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO (QlExercise)))))
2060
2061 foreign import ccall safe "QuantLib/Internal/Common.chs.h qlEuropeanExercise"
2062 qlEuropeanExercise'_ :: (C2HSImp.CInt -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO (QlEuropeanExercise))))
2063
2064 foreign import ccall safe "QuantLib/Internal/Common.chs.h qlSwingExercise"
2065 qlSwingExercise'_ :: (C2HSImp.CUInt -> ((C2HSImp.Ptr C2HSImp.CInt) -> (C2HSImp.CUInt -> ((C2HSImp.Ptr C2HSImp.CUInt) -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO (QlSwingExercise)))))))
2066
2067 foreign import ccall safe "QuantLib/Internal/Common.chs.h qlSwingExercise1"
2068 qlSwingExercise1'_ :: (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CUInt -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO (QlSwingExercise))))))
2069
2070 foreign import ccall safe "QuantLib/Internal/Common.chs.h qlRebatedExercise"
2071 qlRebatedExercise'_ :: ((QlExercise) -> (C2HSImp.CDouble -> (C2HSImp.CUInt -> ((C2HSImp.Ptr (CCalendar)) -> (C2HSImp.CInt -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO (QlRebatedExercise))))))))
2072
2073 foreign import ccall safe "QuantLib/Internal/Common.chs.h qlAssetOrNothingPayoff"
2074 qlAssetOrNothingPayoff'_ :: (C2HSImp.CInt -> (C2HSImp.CDouble -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO (QlStrikedTypePayoff)))))
2075
2076 foreign import ccall safe "QuantLib/Internal/Common.chs.h qlAverageBasketPayoff"
2077 qlAverageBasketPayoff'_ :: ((QlPayoff) -> (C2HSImp.CUInt -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO (QlBasketPayoff)))))
2078
2079 foreign import ccall safe "QuantLib/Internal/Common.chs.h qlCashOrNothingPayoff"
2080 qlCashOrNothingPayoff'_ :: (C2HSImp.CInt -> (C2HSImp.CDouble -> (C2HSImp.CDouble -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO (QlStrikedTypePayoff))))))
2081
2082 foreign import ccall safe "QuantLib/Internal/Common.chs.h qlDoubleStickyRatchetPayoff"
2083 qlDoubleStickyRatchetPayoff'_ :: (C2HSImp.CDouble -> (C2HSImp.CDouble -> (C2HSImp.CDouble -> (C2HSImp.CDouble -> (C2HSImp.CDouble -> (C2HSImp.CDouble -> (C2HSImp.CDouble -> (C2HSImp.CDouble -> (C2HSImp.CDouble -> (C2HSImp.CDouble -> (C2HSImp.CDouble -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO (QlPayoff))))))))))))))
2084
2085 foreign import ccall safe "QuantLib/Internal/Common.chs.h qlFloatingTypePayoff"
2086 qlFloatingTypePayoff'_ :: (C2HSImp.CInt -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO (QlTypePayoff))))
2087
2088 foreign import ccall safe "QuantLib/Internal/Common.chs.h qlForwardTypePayoff"
2089 qlForwardTypePayoff'_ :: (C2HSImp.CInt -> (C2HSImp.CDouble -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO (QlPayoff)))))
2090
2091 foreign import ccall safe "QuantLib/Internal/Common.chs.h qlGapPayoff"
2092 qlGapPayoff'_ :: (C2HSImp.CInt -> (C2HSImp.CDouble -> (C2HSImp.CDouble -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO (QlStrikedTypePayoff))))))
2093
2094 foreign import ccall safe "QuantLib/Internal/Common.chs.h qlMaxBasketPayoff"
2095 qlMaxBasketPayoff'_ :: ((QlPayoff) -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO (QlBasketPayoff))))
2096
2097 foreign import ccall safe "QuantLib/Internal/Common.chs.h qlMinBasketPayoff"
2098 qlMinBasketPayoff'_ :: ((QlPayoff) -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO (QlBasketPayoff))))
2099
2100 foreign import ccall safe "QuantLib/Internal/Common.chs.h qlPercentageStrikePayoff"
2101 qlPercentageStrikePayoff'_ :: (C2HSImp.CInt -> (C2HSImp.CDouble -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO (QlPercentageStrikePayoff)))))
2102
2103 foreign import ccall safe "QuantLib/Internal/Common.chs.h qlPlainVanillaPayoff"
2104 qlPlainVanillaPayoff'_ :: (C2HSImp.CInt -> (C2HSImp.CDouble -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO (QlPlainVanillaPayoff)))))
2105
2106 foreign import ccall safe "QuantLib/Internal/Common.chs.h qlRatchetMaxPayoff"
2107 qlRatchetMaxPayoff'_ :: (C2HSImp.CDouble -> (C2HSImp.CDouble -> (C2HSImp.CDouble -> (C2HSImp.CDouble -> (C2HSImp.CDouble -> (C2HSImp.CDouble -> (C2HSImp.CDouble -> (C2HSImp.CDouble -> (C2HSImp.CDouble -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO (QlPayoff))))))))))))
2108
2109 foreign import ccall safe "QuantLib/Internal/Common.chs.h qlRatchetMinPayoff"
2110 qlRatchetMinPayoff'_ :: (C2HSImp.CDouble -> (C2HSImp.CDouble -> (C2HSImp.CDouble -> (C2HSImp.CDouble -> (C2HSImp.CDouble -> (C2HSImp.CDouble -> (C2HSImp.CDouble -> (C2HSImp.CDouble -> (C2HSImp.CDouble -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO (QlPayoff))))))))))))
2111
2112 foreign import ccall safe "QuantLib/Internal/Common.chs.h qlRatchetPayoff"
2113 qlRatchetPayoff'_ :: (C2HSImp.CDouble -> (C2HSImp.CDouble -> (C2HSImp.CDouble -> (C2HSImp.CDouble -> (C2HSImp.CDouble -> (C2HSImp.CDouble -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO (QlPayoff)))))))))
2114
2115 foreign import ccall safe "QuantLib/Internal/Common.chs.h qlSpreadBasketPayoff"
2116 qlSpreadBasketPayoff'_ :: ((QlPayoff) -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO (QlBasketPayoff))))
2117
2118 foreign import ccall safe "QuantLib/Internal/Common.chs.h qlStickyMaxPayoff"
2119 qlStickyMaxPayoff'_ :: (C2HSImp.CDouble -> (C2HSImp.CDouble -> (C2HSImp.CDouble -> (C2HSImp.CDouble -> (C2HSImp.CDouble -> (C2HSImp.CDouble -> (C2HSImp.CDouble -> (C2HSImp.CDouble -> (C2HSImp.CDouble -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO (QlPayoff))))))))))))
2120
2121 foreign import ccall safe "QuantLib/Internal/Common.chs.h qlStickyMinPayoff"
2122 qlStickyMinPayoff'_ :: (C2HSImp.CDouble -> (C2HSImp.CDouble -> (C2HSImp.CDouble -> (C2HSImp.CDouble -> (C2HSImp.CDouble -> (C2HSImp.CDouble -> (C2HSImp.CDouble -> (C2HSImp.CDouble -> (C2HSImp.CDouble -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO (QlPayoff))))))))))))
2123
2124 foreign import ccall safe "QuantLib/Internal/Common.chs.h qlStickyPayoff"
2125 qlStickyPayoff'_ :: (C2HSImp.CDouble -> (C2HSImp.CDouble -> (C2HSImp.CDouble -> (C2HSImp.CDouble -> (C2HSImp.CDouble -> (C2HSImp.CDouble -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO (QlPayoff)))))))))
2126
2127 foreign import ccall safe "QuantLib/Internal/Common.chs.h qlSuperFundPayoff"
2128 qlSuperFundPayoff'_ :: (C2HSImp.CDouble -> (C2HSImp.CDouble -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO (QlStrikedTypePayoff)))))
2129
2130 foreign import ccall safe "QuantLib/Internal/Common.chs.h qlSuperSharePayoff"
2131 qlSuperSharePayoff'_ :: (C2HSImp.CDouble -> (C2HSImp.CDouble -> (C2HSImp.CDouble -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO (QlStrikedTypePayoff))))))
2132
2133 foreign import ccall safe "QuantLib/Internal/Common.chs.h qlAverageBasketPayoff1"
2134 qlAverageBasketPayoff1'_ :: ((QlPayoff) -> (C2HSImp.CUInt -> ((C2HSImp.Ptr C2HSImp.CDouble) -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO (QlBasketPayoff))))))
2135
2136 foreign import ccall safe "QuantLib/Internal/Common.chs.h qlPayoffFromFunction"
2137 qlPayoffFromFunction'_ :: ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.FunPtr (C2HSImp.CDouble -> (IO C2HSImp.CDouble))) -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO (QlPayoff))))))
2138
2139 foreign import ccall safe "QuantLib/Internal/Common.chs.h qlBasketPayoffFromFunction"
2140 qlBasketPayoffFromFunction'_ :: ((QlPayoff) -> ((C2HSImp.FunPtr ((C2HSImp.Ptr C2HSImp.CDouble) -> (C2HSImp.CUInt -> (IO C2HSImp.CDouble)))) -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO (QlBasketPayoff)))))
2141
2142 foreign import ccall safe "QuantLib/Internal/Common.chs.h qlStrikedPayoffFromFunction"
2143 qlStrikedPayoffFromFunction'_ :: (C2HSImp.CInt -> (C2HSImp.CDouble -> ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.FunPtr (C2HSImp.CDouble -> (IO C2HSImp.CDouble))) -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO (QlStrikedTypePayoff)))))))
2144
2145 foreign import ccall safe "QuantLib/Internal/Common.chs.h qlSoftCallability"
2146 qlSoftCallability'_ :: (C2HSImp.CDouble -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CDouble -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO (C2HSImp.Ptr (CQlCallability))))))))
2147
2148 foreign import ccall safe "QuantLib/Internal/Common.chs.h qlCallability"
2149 qlCallability'_ :: (C2HSImp.CDouble -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO (C2HSImp.Ptr (CQlCallability))))))))
2150
2151 foreign import ccall safe "QuantLib/Internal/Common.chs.h qlCubicBSplinesFitting"
2152 qlCubicBSplinesFitting'_ :: (C2HSImp.CUInt -> ((C2HSImp.Ptr C2HSImp.CDouble) -> (C2HSImp.CInt -> (C2HSImp.CUInt -> ((C2HSImp.Ptr C2HSImp.CDouble) -> (C2HSImp.CUInt -> ((C2HSImp.Ptr C2HSImp.CDouble) -> (C2HSImp.CDouble -> (C2HSImp.CDouble -> ((C2HSImp.Ptr (COptimizationMethod)) -> ((C2HSImp.Ptr (CConstraint)) -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO (C2HSImp.Ptr (CFittedBondDiscountCurveFittingMethod)))))))))))))))
2153
2154 foreign import ccall safe "QuantLib/Internal/Common.chs.h qlExponentialSplinesFitting"
2155 qlExponentialSplinesFitting'_ :: (C2HSImp.CInt -> (C2HSImp.CUInt -> ((C2HSImp.Ptr C2HSImp.CDouble) -> (C2HSImp.CUInt -> ((C2HSImp.Ptr C2HSImp.CDouble) -> (C2HSImp.CDouble -> (C2HSImp.CDouble -> (C2HSImp.CUInt -> (C2HSImp.CDouble -> ((C2HSImp.Ptr (COptimizationMethod)) -> ((C2HSImp.Ptr (CConstraint)) -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO (C2HSImp.Ptr (CFittedBondDiscountCurveFittingMethod)))))))))))))))
2156
2157 foreign import ccall safe "QuantLib/Internal/Common.chs.h qlNelsonSiegelFitting"
2158 qlNelsonSiegelFitting'_ :: (C2HSImp.CUInt -> ((C2HSImp.Ptr C2HSImp.CDouble) -> (C2HSImp.CUInt -> ((C2HSImp.Ptr C2HSImp.CDouble) -> (C2HSImp.CDouble -> (C2HSImp.CDouble -> ((C2HSImp.Ptr (COptimizationMethod)) -> ((C2HSImp.Ptr (CConstraint)) -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO (C2HSImp.Ptr (CFittedBondDiscountCurveFittingMethod))))))))))))
2159
2160 foreign import ccall safe "QuantLib/Internal/Common.chs.h qlSimplePolynomialFitting"
2161 qlSimplePolynomialFitting'_ :: (C2HSImp.CUInt -> (C2HSImp.CInt -> (C2HSImp.CUInt -> ((C2HSImp.Ptr C2HSImp.CDouble) -> (C2HSImp.CUInt -> ((C2HSImp.Ptr C2HSImp.CDouble) -> (C2HSImp.CDouble -> (C2HSImp.CDouble -> ((C2HSImp.Ptr (COptimizationMethod)) -> ((C2HSImp.Ptr (CConstraint)) -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO (C2HSImp.Ptr (CFittedBondDiscountCurveFittingMethod))))))))))))))
2162
2163 foreign import ccall safe "QuantLib/Internal/Common.chs.h qlSvenssonFitting"
2164 qlSvenssonFitting'_ :: (C2HSImp.CUInt -> ((C2HSImp.Ptr C2HSImp.CDouble) -> (C2HSImp.CUInt -> ((C2HSImp.Ptr C2HSImp.CDouble) -> (C2HSImp.CDouble -> (C2HSImp.CDouble -> ((C2HSImp.Ptr (COptimizationMethod)) -> ((C2HSImp.Ptr (CConstraint)) -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO (C2HSImp.Ptr (CFittedBondDiscountCurveFittingMethod))))))))))))
2165
2166 foreign import ccall safe "QuantLib/Internal/Common.chs.h qlFdmSchemeDesc"
2167 qlFdmSchemeDesc'_ :: (C2HSImp.CInt -> (C2HSImp.CDouble -> (C2HSImp.CDouble -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO (C2HSImp.Ptr (CFdmSchemeDesc)))))))
2168
2169 foreign import ccall safe "QuantLib/Internal/Common.chs.h qlFdmSchemeDescCraigSneyd"
2170 qlFdmSchemeDescCraigSneyd'_ :: ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO (C2HSImp.Ptr (CFdmSchemeDesc))))
2171
2172 foreign import ccall safe "QuantLib/Internal/Common.chs.h qlFdmSchemeDescDouglas"
2173 qlFdmSchemeDescDouglas'_ :: ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO (C2HSImp.Ptr (CFdmSchemeDesc))))
2174
2175 foreign import ccall safe "QuantLib/Internal/Common.chs.h qlFdmSchemeDescExplicitEuler"
2176 qlFdmSchemeDescExplicitEuler'_ :: ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO (C2HSImp.Ptr (CFdmSchemeDesc))))
2177
2178 foreign import ccall safe "QuantLib/Internal/Common.chs.h qlFdmSchemeDescHundsdorfer"
2179 qlFdmSchemeDescHundsdorfer'_ :: ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO (C2HSImp.Ptr (CFdmSchemeDesc))))
2180
2181 foreign import ccall safe "QuantLib/Internal/Common.chs.h qlFdmSchemeDescImplicitEuler"
2182 qlFdmSchemeDescImplicitEuler'_ :: ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO (C2HSImp.Ptr (CFdmSchemeDesc))))
2183
2184 foreign import ccall safe "QuantLib/Internal/Common.chs.h qlFdmSchemeDescModifiedCraigSneyd"
2185 qlFdmSchemeDescModifiedCraigSneyd'_ :: ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO (C2HSImp.Ptr (CFdmSchemeDesc))))
2186
2187 foreign import ccall safe "QuantLib/Internal/Common.chs.h qlFdmSchemeDescModifiedHundsdorfer"
2188 qlFdmSchemeDescModifiedHundsdorfer'_ :: ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO (C2HSImp.Ptr (CFdmSchemeDesc))))
2189
2190 foreign import ccall safe "QuantLib/Internal/Common.chs.h qlBoundaryConstraint"
2191 qlBoundaryConstraint'_ :: (C2HSImp.CDouble -> (C2HSImp.CDouble -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO (C2HSImp.Ptr (CConstraint))))))
2192
2193 foreign import ccall safe "QuantLib/Internal/Common.chs.h qlCompositeConstraint"
2194 qlCompositeConstraint'_ :: ((C2HSImp.Ptr (CConstraint)) -> ((C2HSImp.Ptr (CConstraint)) -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO (C2HSImp.Ptr (CConstraint))))))
2195
2196 foreign import ccall safe "QuantLib/Internal/Common.chs.h qlNoConstraint"
2197 qlNoConstraint'_ :: ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO (C2HSImp.Ptr (CConstraint))))
2198
2199 foreign import ccall safe "QuantLib/Internal/Common.chs.h qlPositiveConstraint"
2200 qlPositiveConstraint'_ :: ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO (C2HSImp.Ptr (CConstraint))))
2201
2202 foreign import ccall safe "QuantLib/Internal/Common.chs.h qlLevenbergMarquardt"
2203 qlLevenbergMarquardt'_ :: (C2HSImp.CDouble -> (C2HSImp.CDouble -> (C2HSImp.CDouble -> (C2HSImp.CInt -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO (C2HSImp.Ptr (COptimizationMethod))))))))
2204
2205 foreign import ccall safe "QuantLib/Internal/Common.chs.h qlSimplex"
2206 qlSimplex'_ :: (C2HSImp.CDouble -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO (C2HSImp.Ptr (COptimizationMethod)))))
2207
2208 foreign import ccall safe "QuantLib/Internal/Common.chs.h qlEndCriteria"
2209 qlEndCriteria'_ :: (C2HSImp.CUInt -> (C2HSImp.CUInt -> (C2HSImp.CDouble -> (C2HSImp.CDouble -> (C2HSImp.CDouble -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO (C2HSImp.Ptr (CEndCriteria)))))))))
2210
2211 foreign import ccall safe "QuantLib/Internal/Common.chs.h qlRounding"
2212 qlRounding'_ :: ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO (C2HSImp.Ptr (CRounding))))
2213
2214 foreign import ccall safe "QuantLib/Internal/Common.chs.h qlRounding1"
2215 qlRounding1'_ :: (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO (C2HSImp.Ptr (CRounding)))))))
2216
2217 foreign import ccall safe "QuantLib/Internal/Common.chs.h qlLmConstWrapperCorrelationModel"
2218 qlLmConstWrapperCorrelationModel'_ :: ((C2HSImp.Ptr (CLmCorrelationModel)) -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO (C2HSImp.Ptr (CLmCorrelationModel)))))
2219
2220 foreign import ccall safe "QuantLib/Internal/Common.chs.h qlLmExponentialCorrelationModel"
2221 qlLmExponentialCorrelationModel'_ :: (C2HSImp.CUInt -> (C2HSImp.CDouble -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO (C2HSImp.Ptr (CLmCorrelationModel))))))
2222
2223 foreign import ccall safe "QuantLib/Internal/Common.chs.h qlLmLinearExponentialCorrelationModel"
2224 qlLmLinearExponentialCorrelationModel'_ :: (C2HSImp.CUInt -> (C2HSImp.CDouble -> (C2HSImp.CDouble -> (C2HSImp.CUInt -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO (C2HSImp.Ptr (CLmCorrelationModel))))))))
2225
2226 foreign import ccall safe "QuantLib/Internal/Common.chs.h qlLmConstWrapperVolatilityModel"
2227 qlLmConstWrapperVolatilityModel'_ :: ((C2HSImp.Ptr (CLmVolatilityModel)) -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO (C2HSImp.Ptr (CLmVolatilityModel)))))
2228
2229 foreign import ccall safe "QuantLib/Internal/Common.chs.h qlLmFixedVolatilityModel"
2230 qlLmFixedVolatilityModel'_ :: (C2HSImp.CUInt -> ((C2HSImp.Ptr C2HSImp.CDouble) -> (C2HSImp.CUInt -> ((C2HSImp.Ptr C2HSImp.CDouble) -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO (C2HSImp.Ptr (CLmVolatilityModel))))))))
2231
2232 foreign import ccall safe "QuantLib/Internal/Common.chs.h qlLmLinearExponentialVolatilityModel"
2233 qlLmLinearExponentialVolatilityModel'_ :: (C2HSImp.CUInt -> ((C2HSImp.Ptr C2HSImp.CDouble) -> (C2HSImp.CDouble -> (C2HSImp.CDouble -> (C2HSImp.CDouble -> (C2HSImp.CDouble -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO (C2HSImp.Ptr (CLmVolatilityModel))))))))))
2234
2235 foreign import ccall safe "QuantLib/Internal/Common.chs.h qlFaceValueClaim"
2236 qlFaceValueClaim'_ :: ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO (C2HSImp.Ptr (CQlClaim))))
2237
2238 foreign import ccall safe "QuantLib/Internal/Common.chs.h qlFaceValueAccrualClaim"
2239 qlFaceValueAccrualClaim'_ :: ((C2HSImp.Ptr (CBond')) -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO (C2HSImp.Ptr (CQlClaim)))))